Mercurial > hg > xemacs-beta
view src/debug.c @ 4549:68d1ca56cffa
First part of interactive checks that coding systems encode regions.
2008-01-21 Aidan Kehoe <kehoea@parhasard.net>
* coding.el (decode-coding-string):
(encode-coding-string): Accept GNU's NOCOPY argument for
these. Todo; write compiler macros to use it.
(query-coding-warning-face): New face, to show unencodable
characters.
(default-query-coding-region-safe-charset-skip-chars-map):
New variable, a cache used by #'default-query-coding-region.
(default-query-coding-region): Default implementation of
#'query-coding-region, using the safe-charsets and safe-chars
coding systemproperties.
(query-coding-region): New function; can a given coding system
encode a given region?
(query-coding-string): New function; can a given coding system
encode a given string?
(unencodable-char-position): Function API taken from GNU; return
the first unencodable position given a string and coding system.
(encode-coding-char): Function API taken from GNU; return CHAR
encoded using CODING-SYSTEM, or nil if CODING-SYSTEM would trash
CHAR.
((unless (featurep 'mule)): Override the default
query-coding-region implementation on non-Mule.
* mule/mule-coding.el (make-8-bit-generate-helper): Eliminate a
duplicate comment.
(make-8-bit-choose-category): Simplify implementation.
(8-bit-fixed-query-coding-region): Implementation of
#'query-coding-region for coding systems created with
#'make-8-bit-coding-system.
(make-8-bit-coding-system): Initialise the #'query-coding-region
implementation for these character sets.
(make-8-bit-coding-system): Ditto for the compiler macro version
of this function.
* unicode.el (unicode-query-coding-skip-chars-arg): New variable,
used by unicode-query-coding-region, initialised in
mule/general-late.el.
(unicode-query-coding-region): New function, the
#'query-coding-region implementation for Unicode coding systems.
Initialise the query-coding-function property for the Unicode
coding systems to #'unicode-query-coding-region.
* mule/mule-charset.el (charset-skip-chars-string): New
function. Return a #'skip-chars-forward argument that skips all
characters in CHARSET.
(map-charset-chars): Function synced from GNU, modified to work
with XEmacs. Map FUNC across the int value charset ranges of
CHARSET.
author | Aidan Kehoe <kehoea@parhasard.net> |
---|---|
date | Mon, 21 Jan 2008 22:51:21 +0100 |
parents | ecf1ebac70d8 |
children | e0138eaaca0c |
line wrap: on
line source
/* Debugging aids -- togglable assertions. Copyright (C) 1994 Free Software Foundation, Inc. This file is part of XEmacs. XEmacs is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. XEmacs is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with XEmacs; see the file COPYING. If not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ /* Synched up with: Not in FSF. */ /* This file has been Mule-ized. */ /* Written by Chuck Thompson */ #include <config.h> #include "lisp.h" #include "debug.h" #include "bytecode.h" /* * To add a new debug class: * 1. Add a symbol definition for it here or in general-slots.h, if one * doesn't exist elsewhere. If you add it here, make sure to add a * defsymbol line for it in syms_of_debug. * 2. Add an extern definition for the symbol to debug.h. * 3. Add entries for the class to struct debug_classes in debug.h. * 4. Add a FROB line for it in xemacs_debug_loop. */ struct debug_classes active_debug_classes; enum debug_loop { X_ADD, X_DELETE, X_LIST, X_ACTIVE, X_INIT, X_VALIDATE, X_TYPE, X_SETTYPE }; static Lisp_Object xemacs_debug_loop (enum debug_loop op, Lisp_Object class_, Lisp_Object type) { int flag = (op == X_ADD) ? 1 : 0; Lisp_Object retval = Qnil; #define FROB(item) \ if (op == X_LIST || op == X_ACTIVE || op == X_INIT || EQ (class_, Q##item)) \ { \ if (op == X_ADD || op == X_DELETE || op == X_INIT) \ active_debug_classes.item = flag; \ else if (op == X_LIST \ || (op == X_ACTIVE && active_debug_classes.item)) \ retval = Fcons (Q##item, retval); \ else if (op == X_VALIDATE) \ return Qt; \ else if (op == X_SETTYPE) \ active_debug_classes.types_of_##item = XINT (type); \ else if (op == X_TYPE) \ retval = make_int (active_debug_classes.types_of_##item); \ if (op == X_INIT) active_debug_classes.types_of_##item = VALBITS; \ } FROB (redisplay); FROB (buffers); FROB (extents); FROB (faces); FROB (windows); FROB (frames); FROB (devices); FROB (byte_code); return retval; #undef FROB } DEFUN ("add-debug-class-to-check", Fadd_debug_class_to_check, 1, 1, 0, /* Add a debug class to the list of active classes. */ (class_)) { if (NILP (xemacs_debug_loop (X_VALIDATE, class_, Qnil))) invalid_argument ("No such debug class exists", Qunbound); else xemacs_debug_loop (X_ADD, class_, Qnil); return (xemacs_debug_loop (X_ACTIVE, Qnil, Qnil)); } DEFUN ("delete-debug-class-to-check", Fdelete_debug_class_to_check, 1, 1, 0, /* Delete a debug class from the list of active classes. */ (class_)) { if (NILP (xemacs_debug_loop (X_VALIDATE, class_, Qnil))) invalid_argument ("No such debug class exists", Qunbound); else xemacs_debug_loop (X_DELETE, class_, Qnil); return (xemacs_debug_loop (X_ACTIVE, Qnil, Qnil)); } DEFUN ("debug-classes-being-checked", Fdebug_classes_being_checked, 0, 0, 0, /* Return a list of active debug classes. */ ()) { return (xemacs_debug_loop (X_ACTIVE, Qnil, Qnil)); } DEFUN ("debug-classes-list", Fdebug_classes_list, 0, 0, 0, /* Return a list of all defined debug classes. */ ()) { return (xemacs_debug_loop (X_LIST, Qnil, Qnil)); } DEFUN ("set-debug-classes-to-check", Fset_debug_classes_to_check, 1, 1, 0, /* Set which classes of debug statements should be active. CLASSES should be a list of debug classes. */ (classes)) { Lisp_Object rest; CHECK_LIST (classes); /* Make sure all objects in the list are valid. If anyone is not valid, reject the entire list without doing anything. */ LIST_LOOP (rest, classes) { if (NILP (xemacs_debug_loop (X_VALIDATE, XCAR (rest), Qnil))) sferror ("Invalid object in class list", Qunbound); } LIST_LOOP (rest, classes) Fadd_debug_class_to_check (XCAR (rest)); return (xemacs_debug_loop (X_ACTIVE, Qnil, Qnil)); } DEFUN ("set-debug-class-types-to-check", Fset_debug_class_types_to_check, 2, 2, 0, /* For the given debug CLASS, set which TYPES are actually interesting. TYPES should be an integer representing the or'd value of all desired types. Lists of defined types and their values are located in the source code. */ (class_, type)) { CHECK_INT (type); if (NILP (xemacs_debug_loop (X_VALIDATE, class_, Qnil))) invalid_argument ("Invalid debug class", Qunbound); xemacs_debug_loop (X_SETTYPE, class_, type); return (xemacs_debug_loop (X_TYPE, class_, Qnil)); } DEFUN ("debug-types-being-checked", Fdebug_types_being_checked, 1, 1, 0, /* For the given CLASS, return the associated type value. */ (class_)) { if (NILP (xemacs_debug_loop (X_VALIDATE, class_, Qnil))) invalid_argument ("Invalid debug class", Qunbound); return (xemacs_debug_loop (X_TYPE, class_, Qnil)); } void syms_of_debug (void) { DEFSUBR (Fadd_debug_class_to_check); DEFSUBR (Fdelete_debug_class_to_check); DEFSUBR (Fdebug_classes_being_checked); DEFSUBR (Fdebug_classes_list); DEFSUBR (Fset_debug_classes_to_check); DEFSUBR (Fset_debug_class_types_to_check); DEFSUBR (Fdebug_types_being_checked); } void reinit_vars_of_debug (void) { /* If you need to have any classes active early on in startup, then the flags should be set here. All functions called by this function are "allowed" according to emacs.c. */ xemacs_debug_loop (X_INIT, Qnil, Qnil); } void vars_of_debug (void) { }