1 /* Debugging aids -- togglable assertions.
2 Copyright (C) 1994 Free Software Foundation, Inc.
4 This file is part of XEmacs.
6 XEmacs is free software; you can redistribute it and/or modify it
7 under the terms of the GNU General Public License as published by the
8 Free Software Foundation; either version 2, or (at your option) any
11 XEmacs is distributed in the hope that it will be useful, but WITHOUT
12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
13 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
16 You should have received a copy of the GNU General Public License
17 along with XEmacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
21 /* Synched up with: Not in FSF. */
23 /* This file has been Mule-ized. */
25 /* Written by Chuck Thompson */
33 * To add a new debug class:
34 * 1. Add a symbol definition for it here, if one doesn't exist
35 * elsewhere. If you add it here, make sure to add a defsymbol
36 * line for it in syms_of_debug.
37 * 2. Add an extern definition for the symbol to debug.h.
38 * 3. Add entries for the class to struct debug_classes in debug.h.
39 * 4. Add a FROB line for it in xemacs_debug_loop.
42 static Lisp_Object Qredisplay, Qbuffers, Qfaces, Qwindows, Qframes, Qdevices;
44 struct debug_classes active_debug_classes;
59 xemacs_debug_loop (enum debug_loop op, Lisp_Object class, Lisp_Object type)
61 int flag = (op == X_ADD) ? 1 : 0;
62 Lisp_Object retval = Qnil;
65 if (op == X_LIST || op == X_ACTIVE || op == X_INIT || EQ (class, Q##item)) \
67 if (op == X_ADD || op == X_DELETE || op == X_INIT) \
68 active_debug_classes.item = flag; \
69 else if (op == X_LIST \
70 || (op == X_ACTIVE && active_debug_classes.item)) \
71 retval = Fcons (Q##item, retval); \
72 else if (op == X_VALIDATE) \
74 else if (op == X_SETTYPE) \
75 active_debug_classes.types_of_##item = XINT (type); \
76 else if (op == X_TYPE) \
77 retval = make_int (active_debug_classes.types_of_##item); \
78 if (op == X_INIT) active_debug_classes.types_of_##item = VALBITS; \
94 DEFUN ("add-debug-class-to-check", Fadd_debug_class_to_check, 1, 1, 0, /*
95 Add a debug class to the list of active classes.
99 if (NILP (xemacs_debug_loop (X_VALIDATE, class, Qnil)))
100 error ("No such debug class exists");
102 xemacs_debug_loop (X_ADD, class, Qnil);
104 return (xemacs_debug_loop (X_ACTIVE, Qnil, Qnil));
107 DEFUN ("delete-debug-class-to-check", Fdelete_debug_class_to_check, 1, 1, 0, /*
108 Delete a debug class from the list of active classes.
112 if (NILP (xemacs_debug_loop (X_VALIDATE, class, Qnil)))
113 error ("No such debug class exists");
115 xemacs_debug_loop (X_DELETE, class, Qnil);
117 return (xemacs_debug_loop (X_ACTIVE, Qnil, Qnil));
120 DEFUN ("debug-classes-being-checked", Fdebug_classes_being_checked, 0, 0, 0, /*
121 Return a list of active debug classes.
125 return (xemacs_debug_loop (X_ACTIVE, Qnil, Qnil));
128 DEFUN ("debug-classes-list", Fdebug_classes_list, 0, 0, 0, /*
129 Return a list of all defined debug classes.
133 return (xemacs_debug_loop (X_LIST, Qnil, Qnil));
136 DEFUN ("set-debug-classes-to-check", Fset_debug_classes_to_check, 1, 1, 0, /*
137 Set which classes of debug statements should be active.
138 CLASSES should be a list of debug classes.
144 CHECK_LIST (classes);
146 /* Make sure all objects in the list are valid. If anyone is not
147 valid, reject the entire list without doing anything. */
148 LIST_LOOP (rest, classes )
150 if (NILP (xemacs_debug_loop (X_VALIDATE, XCAR (rest), Qnil)))
151 error ("Invalid object in class list");
154 LIST_LOOP (rest, classes)
155 Fadd_debug_class_to_check (XCAR (rest));
157 return (xemacs_debug_loop (X_ACTIVE, Qnil, Qnil));
160 DEFUN ("set-debug-class-types-to-check", Fset_debug_class_types_to_check, 2, 2, 0, /*
161 For the given debug CLASS, set which TYPES are actually interesting.
162 TYPES should be an integer representing the or'd value of all desired types.
163 Lists of defined types and their values are located in the source code.
168 if (NILP (xemacs_debug_loop (X_VALIDATE, class, Qnil)))
169 error ("Invalid debug class");
171 xemacs_debug_loop (X_SETTYPE, class, type);
173 return (xemacs_debug_loop (X_TYPE, class, Qnil));
176 DEFUN ("debug-types-being-checked", Fdebug_types_being_checked, 1, 1, 0, /*
177 For the given CLASS, return the associated type value.
181 if (NILP (xemacs_debug_loop (X_VALIDATE, class, Qnil)))
182 error ("Invalid debug class");
184 return (xemacs_debug_loop (X_TYPE, class, Qnil));
190 defsymbol (&Qredisplay, "redisplay");
191 defsymbol (&Qbuffers, "buffers");
192 defsymbol (&Qfaces, "faces");
193 defsymbol (&Qwindows, "windows");
194 defsymbol (&Qframes, "frames");
195 defsymbol (&Qdevices, "devices");
197 DEFSUBR (Fadd_debug_class_to_check);
198 DEFSUBR (Fdelete_debug_class_to_check);
199 DEFSUBR (Fdebug_classes_being_checked);
200 DEFSUBR (Fdebug_classes_list);
201 DEFSUBR (Fset_debug_classes_to_check);
202 DEFSUBR (Fset_debug_class_types_to_check);
203 DEFSUBR (Fdebug_types_being_checked);
207 reinit_vars_of_debug (void)
209 /* If you need to have any classes active early on in startup, then
210 the flags should be set here.
211 All functions called by this function are "allowed" according
213 xemacs_debug_loop (X_INIT, Qnil, Qnil);
219 reinit_vars_of_debug ();