Mercurial > hg > xemacs-beta
annotate src/debug.c @ 5258:1ed4cefddd12
Add a couple of extra docstring backslashes, #'format-time-string
2010-09-05 Aidan Kehoe <kehoea@parhasard.net>
* editfns.c (Fformat_time_string):
Use two backslashes so that there is at least one present in the
output of describe function, when describing the Roman month
number syntax in this function's docstring. Thanks for provoking
me to look at this, Stephen Turnbull.
author | Aidan Kehoe <kehoea@parhasard.net> |
---|---|
date | Sun, 05 Sep 2010 19:22:37 +0100 |
parents | e0138eaaca0c |
children | 308d34e9f07d |
rev | line source |
---|---|
428 | 1 /* Debugging aids -- togglable assertions. |
2 Copyright (C) 1994 Free Software Foundation, Inc. | |
3 | |
4 This file is part of XEmacs. | |
5 | |
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 | |
9 later version. | |
10 | |
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 | |
14 for more details. | |
15 | |
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. */ | |
20 | |
21 /* Synched up with: Not in FSF. */ | |
22 | |
23 /* This file has been Mule-ized. */ | |
24 | |
25 /* Written by Chuck Thompson */ | |
26 | |
27 #include <config.h> | |
28 #include "lisp.h" | |
29 #include "debug.h" | |
30 #include "bytecode.h" | |
31 | |
32 /* | |
33 * To add a new debug class: | |
1318 | 34 * 1. Add a symbol definition for it here or in general-slots.h, if one |
35 * doesn't exist elsewhere. If you add it here, make sure to add a | |
36 * defsymbol line for it in syms_of_debug. | |
428 | 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. | |
40 */ | |
41 | |
42 struct debug_classes active_debug_classes; | |
43 | |
44 enum debug_loop | |
45 { | |
436 | 46 X_ADD, |
47 X_DELETE, | |
48 X_LIST, | |
49 X_ACTIVE, | |
50 X_INIT, | |
51 X_VALIDATE, | |
52 X_TYPE, | |
53 X_SETTYPE | |
428 | 54 }; |
55 | |
56 static Lisp_Object | |
1204 | 57 xemacs_debug_loop (enum debug_loop op, Lisp_Object class_, Lisp_Object type) |
428 | 58 { |
436 | 59 int flag = (op == X_ADD) ? 1 : 0; |
428 | 60 Lisp_Object retval = Qnil; |
61 | |
1318 | 62 #define FROB(item) \ |
63 if (op == X_LIST || op == X_ACTIVE || op == X_INIT || EQ (class_, Q##item)) \ | |
64 { \ | |
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) \ | |
71 return Qt; \ | |
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; \ | |
428 | 77 } |
78 | |
79 FROB (redisplay); | |
80 FROB (buffers); | |
81 FROB (extents); | |
82 FROB (faces); | |
83 FROB (windows); | |
84 FROB (frames); | |
85 FROB (devices); | |
86 FROB (byte_code); | |
87 | |
88 return retval; | |
89 #undef FROB | |
90 } | |
91 | |
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. | |
94 */ | |
1204 | 95 (class_)) |
428 | 96 { |
1204 | 97 if (NILP (xemacs_debug_loop (X_VALIDATE, class_, Qnil))) |
563 | 98 invalid_argument ("No such debug class exists", Qunbound); |
428 | 99 else |
1204 | 100 xemacs_debug_loop (X_ADD, class_, Qnil); |
428 | 101 |
436 | 102 return (xemacs_debug_loop (X_ACTIVE, Qnil, Qnil)); |
428 | 103 } |
104 | |
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. | |
107 */ | |
1204 | 108 (class_)) |
428 | 109 { |
1204 | 110 if (NILP (xemacs_debug_loop (X_VALIDATE, class_, Qnil))) |
563 | 111 invalid_argument ("No such debug class exists", Qunbound); |
428 | 112 else |
1204 | 113 xemacs_debug_loop (X_DELETE, class_, Qnil); |
428 | 114 |
436 | 115 return (xemacs_debug_loop (X_ACTIVE, Qnil, Qnil)); |
428 | 116 } |
117 | |
118 DEFUN ("debug-classes-being-checked", Fdebug_classes_being_checked, 0, 0, 0, /* | |
119 Return a list of active debug classes. | |
120 */ | |
121 ()) | |
122 { | |
436 | 123 return (xemacs_debug_loop (X_ACTIVE, Qnil, Qnil)); |
428 | 124 } |
125 | |
126 DEFUN ("debug-classes-list", Fdebug_classes_list, 0, 0, 0, /* | |
127 Return a list of all defined debug classes. | |
128 */ | |
129 ()) | |
130 { | |
436 | 131 return (xemacs_debug_loop (X_LIST, Qnil, Qnil)); |
428 | 132 } |
133 | |
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. | |
137 */ | |
138 (classes)) | |
139 { | |
140 Lisp_Object rest; | |
141 | |
142 CHECK_LIST (classes); | |
143 | |
144 /* Make sure all objects in the list are valid. If anyone is not | |
145 valid, reject the entire list without doing anything. */ | |
1204 | 146 LIST_LOOP (rest, classes) |
428 | 147 { |
436 | 148 if (NILP (xemacs_debug_loop (X_VALIDATE, XCAR (rest), Qnil))) |
563 | 149 sferror ("Invalid object in class list", Qunbound); |
428 | 150 } |
151 | |
152 LIST_LOOP (rest, classes) | |
153 Fadd_debug_class_to_check (XCAR (rest)); | |
154 | |
436 | 155 return (xemacs_debug_loop (X_ACTIVE, Qnil, Qnil)); |
428 | 156 } |
157 | |
158 DEFUN ("set-debug-class-types-to-check", Fset_debug_class_types_to_check, 2, 2, 0, /* | |
159 For the given debug CLASS, set which TYPES are actually interesting. | |
160 TYPES should be an integer representing the or'd value of all desired types. | |
161 Lists of defined types and their values are located in the source code. | |
162 */ | |
1204 | 163 (class_, type)) |
428 | 164 { |
165 CHECK_INT (type); | |
1204 | 166 if (NILP (xemacs_debug_loop (X_VALIDATE, class_, Qnil))) |
563 | 167 invalid_argument ("Invalid debug class", Qunbound); |
428 | 168 |
1204 | 169 xemacs_debug_loop (X_SETTYPE, class_, type); |
428 | 170 |
1204 | 171 return (xemacs_debug_loop (X_TYPE, class_, Qnil)); |
428 | 172 } |
173 | |
174 DEFUN ("debug-types-being-checked", Fdebug_types_being_checked, 1, 1, 0, /* | |
175 For the given CLASS, return the associated type value. | |
176 */ | |
1204 | 177 (class_)) |
428 | 178 { |
1204 | 179 if (NILP (xemacs_debug_loop (X_VALIDATE, class_, Qnil))) |
563 | 180 invalid_argument ("Invalid debug class", Qunbound); |
428 | 181 |
1204 | 182 return (xemacs_debug_loop (X_TYPE, class_, Qnil)); |
428 | 183 } |
184 | |
185 void | |
186 syms_of_debug (void) | |
187 { | |
188 DEFSUBR (Fadd_debug_class_to_check); | |
189 DEFSUBR (Fdelete_debug_class_to_check); | |
190 DEFSUBR (Fdebug_classes_being_checked); | |
191 DEFSUBR (Fdebug_classes_list); | |
192 DEFSUBR (Fset_debug_classes_to_check); | |
193 DEFSUBR (Fset_debug_class_types_to_check); | |
194 DEFSUBR (Fdebug_types_being_checked); | |
195 } | |
196 | |
197 void | |
198 reinit_vars_of_debug (void) | |
199 { | |
200 /* If you need to have any classes active early on in startup, then | |
201 the flags should be set here. | |
202 All functions called by this function are "allowed" according | |
203 to emacs.c. */ | |
436 | 204 xemacs_debug_loop (X_INIT, Qnil, Qnil); |
428 | 205 } |
206 | |
207 void | |
208 vars_of_debug (void) | |
209 { | |
4852
e0138eaaca0c
need to provide debug-xemacs for debug-on-error changes to work
Ben Wing <ben@xemacs.org>
parents:
2367
diff
changeset
|
210 Fprovide (intern ("debug-xemacs")); |
428 | 211 } |