1 /* Debugging aids -- togglable assertions.
2 Copyright (C) 1994 Free Software Foundation, Inc.
4 This file is part of SXEmacs
6 SXEmacs is free software: you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation, either version 3 of the License, or
9 (at your option) any later version.
11 SXEmacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with this program. If not, see <http://www.gnu.org/licenses/>. */
20 /* Synched up with: Not in FSF. */
22 /* This file has been Mule-ized. */
24 /* Written by Chuck Thompson */
32 * To add a new debug class:
33 * 1. Add a symbol definition for it here, if one doesn't exist
34 * elsewhere. If you add it here, make sure to add a defsymbol
35 * line for it in syms_of_debug.
36 * 2. Add an extern definition for the symbol to debug.h.
37 * 3. Add entries for the class to struct debug_classes in debug.h.
38 * 4. Add a FROB line for it in sxemacs_debug_loop.
41 static Lisp_Object Qredisplay, Qbuffers, Qfaces, Qwindows, Qframes, Qdevices;
43 struct debug_classes active_debug_classes;
57 sxemacs_debug_loop(enum debug_loop op, Lisp_Object class, Lisp_Object type)
59 int flag = (op == X_ADD) ? 1 : 0;
60 Lisp_Object retval = Qnil;
63 if (op == X_LIST || op == X_ACTIVE || op == X_INIT || EQ (class, Q##item)) \
65 if (op == X_ADD || op == X_DELETE || op == X_INIT) \
66 active_debug_classes.item = flag; \
67 else if (op == X_LIST \
68 || (op == X_ACTIVE && active_debug_classes.item)) \
69 retval = Fcons (Q##item, retval); \
70 else if (op == X_VALIDATE) \
72 else if (op == X_SETTYPE) \
73 active_debug_classes.types_of_##item = XINT (type); \
74 else if (op == X_TYPE) \
75 retval = make_int (active_debug_classes.types_of_##item); \
76 if (op == X_INIT) active_debug_classes.types_of_##item = VALBITS; \
92 DEFUN("add-debug-class-to-check", Fadd_debug_class_to_check, 1, 1, 0, /*
93 Add a debug class to the list of active classes.
97 if (NILP(sxemacs_debug_loop(X_VALIDATE, class, Qnil)))
98 error("No such debug class exists");
100 sxemacs_debug_loop(X_ADD, class, Qnil);
102 return (sxemacs_debug_loop(X_ACTIVE, Qnil, Qnil));
105 DEFUN("delete-debug-class-to-check", Fdelete_debug_class_to_check, 1, 1, 0, /*
106 Delete a debug class from the list of active classes.
110 if (NILP(sxemacs_debug_loop(X_VALIDATE, class, Qnil)))
111 error("No such debug class exists");
113 sxemacs_debug_loop(X_DELETE, class, Qnil);
115 return (sxemacs_debug_loop(X_ACTIVE, Qnil, Qnil));
118 DEFUN("debug-classes-being-checked", Fdebug_classes_being_checked, 0, 0, 0, /*
119 Return a list of active debug classes.
123 return (sxemacs_debug_loop(X_ACTIVE, Qnil, Qnil));
126 DEFUN("debug-classes-list", Fdebug_classes_list, 0, 0, 0, /*
127 Return a list of all defined debug classes.
131 return (sxemacs_debug_loop(X_LIST, Qnil, Qnil));
134 DEFUN("set-debug-classes-to-check", Fset_debug_classes_to_check, 1, 1, 0, /*
135 Set which classes of debug statements should be active.
136 CLASSES should be a list of debug classes.
144 /* Make sure all objects in the list are valid. If anyone is not
145 valid, reject the entire list without doing anything. */
146 LIST_LOOP(rest, classes) {
147 if (NILP(sxemacs_debug_loop(X_VALIDATE, XCAR(rest), Qnil)))
148 error("Invalid object in class list");
151 LIST_LOOP(rest, classes)
152 Fadd_debug_class_to_check(XCAR(rest));
154 return (sxemacs_debug_loop(X_ACTIVE, Qnil, Qnil));
157 DEFUN("set-debug-class-types-to-check", Fset_debug_class_types_to_check, 2, 2, 0, /*
158 For the given debug CLASS, set which TYPES are actually interesting.
159 TYPES should be an integer representing the or'd value of all desired types.
160 Lists of defined types and their values are located in the source code.
165 if (NILP(sxemacs_debug_loop(X_VALIDATE, class, Qnil)))
166 error("Invalid debug class");
168 sxemacs_debug_loop(X_SETTYPE, class, type);
170 return (sxemacs_debug_loop(X_TYPE, class, Qnil));
173 DEFUN("debug-types-being-checked", Fdebug_types_being_checked, 1, 1, 0, /*
174 For the given CLASS, return the associated type value.
178 if (NILP(sxemacs_debug_loop(X_VALIDATE, class, Qnil)))
179 error("Invalid debug class");
181 return (sxemacs_debug_loop(X_TYPE, class, Qnil));
184 void syms_of_debug(void)
186 defsymbol(&Qredisplay, "redisplay");
187 defsymbol(&Qbuffers, "buffers");
188 defsymbol(&Qfaces, "faces");
189 defsymbol(&Qwindows, "windows");
190 defsymbol(&Qframes, "frames");
191 defsymbol(&Qdevices, "devices");
193 DEFSUBR(Fadd_debug_class_to_check);
194 DEFSUBR(Fdelete_debug_class_to_check);
195 DEFSUBR(Fdebug_classes_being_checked);
196 DEFSUBR(Fdebug_classes_list);
197 DEFSUBR(Fset_debug_classes_to_check);
198 DEFSUBR(Fset_debug_class_types_to_check);
199 DEFSUBR(Fdebug_types_being_checked);
202 void reinit_vars_of_debug(void)
204 /* If you need to have any classes active early on in startup, then
205 the flags should be set here.
206 All functions called by this function are "allowed" according
208 sxemacs_debug_loop(X_INIT, Qnil, Qnil);
211 void vars_of_debug(void)
213 reinit_vars_of_debug();