Mercurial > hg > xemacs-beta

comparison src/debug.c @ 412:697ef44129c6 r21-2-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-14
author cvs
date Mon, 13 Aug 2007 11:20:41 +0200
parents 74fd4e045ea6
children 11054d720c21
comparison
equal deleted inserted replaced
411:12e008d41344 412:697ef44129c6
37 * 2. Add an extern definition for the symbol to debug.h. 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. 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. 39 * 4. Add a FROB line for it in xemacs_debug_loop.
40 */ 40 */
41 41
42 static Lisp_Object Qredisplay, Qbuffers, Qfaces, Qwindows, Qframes, Qdevices; 42 Lisp_Object Qredisplay, Qbuffers, Qfaces;
43 Lisp_Object Qwindows, Qframes, Qdevices;
43 44
44 struct debug_classes active_debug_classes; 45 struct debug_classes active_debug_classes;
45 46
46 enum debug_loop 47 enum debug_loop
47 { 48 {
48 X_ADD, 49 ADD,
49 X_DELETE, 50 DELETE,
50 X_LIST, 51 LIST,
51 X_ACTIVE, 52 ACTIVE,
52 X_INIT, 53 INIT,
53 X_VALIDATE, 54 VALIDATE,
54 X_TYPE, 55 TYPE,
55 X_SETTYPE 56 SETTYPE
56 }; 57 };
57 58
58 static Lisp_Object 59 static Lisp_Object
59 xemacs_debug_loop (enum debug_loop op, Lisp_Object class, Lisp_Object type) 60 xemacs_debug_loop (enum debug_loop op, Lisp_Object class, Lisp_Object type)
60 { 61 {
61 int flag = (op == X_ADD) ? 1 : 0; 62 int flag = (op == ADD) ? 1 : 0;
62 Lisp_Object retval = Qnil; 63 Lisp_Object retval = Qnil;
63 64
64 #define FROB(item) \ 65 #define FROB(item) \
65 if (op == X_LIST || op == X_ACTIVE || op == X_INIT || EQ (class, Q##item)) \ 66 if (op == LIST || op == ACTIVE || op == INIT || EQ (class, Q##item)) \
66 { \ 67 { \
67 if (op == X_ADD || op == X_DELETE || op == X_INIT) \ 68 if (op == ADD || op == DELETE || op == INIT) \
68 active_debug_classes.item = flag; \ 69 active_debug_classes.item = flag; \
69 else if (op == X_LIST \ 70 else if (op == LIST \
70 || (op == X_ACTIVE && active_debug_classes.item)) \ 71 || (op == ACTIVE && active_debug_classes.item)) \
71 retval = Fcons (Q##item, retval); \ 72 retval = Fcons (Q##item, retval); \
72 else if (op == X_VALIDATE) \ 73 else if (op == VALIDATE) \
73 return Qt; \ 74 return Qt; \
74 else if (op == X_SETTYPE) \ 75 else if (op == SETTYPE) \
75 active_debug_classes.types_of_##item = XINT (type); \ 76 active_debug_classes.types_of_##item = XINT (type); \
76 else if (op == X_TYPE) \ 77 else if (op == TYPE) \
77 retval = make_int (active_debug_classes.types_of_##item); \ 78 retval = make_int (active_debug_classes.types_of_##item); \
78 if (op == X_INIT) active_debug_classes.types_of_##item = VALBITS; \ 79 if (op == INIT) active_debug_classes.types_of_##item = VALBITS; \
79 } 80 }
80 81
81 FROB (redisplay); 82 FROB (redisplay);
82 FROB (buffers); 83 FROB (buffers);
83 FROB (extents); 84 FROB (extents);
94 DEFUN ("add-debug-class-to-check", Fadd_debug_class_to_check, 1, 1, 0, /* 95 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. 96 Add a debug class to the list of active classes.
96 */ 97 */
97 (class)) 98 (class))
98 { 99 {
99 if (NILP (xemacs_debug_loop (X_VALIDATE, class, Qnil))) 100 if (NILP (xemacs_debug_loop (VALIDATE, class, Qnil)))
100 error ("No such debug class exists"); 101 error ("No such debug class exists");
101 else 102 else
102 xemacs_debug_loop (X_ADD, class, Qnil); 103 xemacs_debug_loop (ADD, class, Qnil);
103 104
104 return (xemacs_debug_loop (X_ACTIVE, Qnil, Qnil)); 105 return (xemacs_debug_loop (ACTIVE, Qnil, Qnil));
105 } 106 }
106 107
107 DEFUN ("delete-debug-class-to-check", Fdelete_debug_class_to_check, 1, 1, 0, /* 108 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. 109 Delete a debug class from the list of active classes.
109 */ 110 */
110 (class)) 111 (class))
111 { 112 {
112 if (NILP (xemacs_debug_loop (X_VALIDATE, class, Qnil))) 113 if (NILP (xemacs_debug_loop (VALIDATE, class, Qnil)))
113 error ("No such debug class exists"); 114 error ("No such debug class exists");
114 else 115 else
115 xemacs_debug_loop (X_DELETE, class, Qnil); 116 xemacs_debug_loop (DELETE, class, Qnil);
116 117
117 return (xemacs_debug_loop (X_ACTIVE, Qnil, Qnil)); 118 return (xemacs_debug_loop (ACTIVE, Qnil, Qnil));
118 } 119 }
119 120
120 DEFUN ("debug-classes-being-checked", Fdebug_classes_being_checked, 0, 0, 0, /* 121 DEFUN ("debug-classes-being-checked", Fdebug_classes_being_checked, 0, 0, 0, /*
121 Return a list of active debug classes. 122 Return a list of active debug classes.
122 */ 123 */
123 ()) 124 ())
124 { 125 {
125 return (xemacs_debug_loop (X_ACTIVE, Qnil, Qnil)); 126 return (xemacs_debug_loop (ACTIVE, Qnil, Qnil));
126 } 127 }
127 128
128 DEFUN ("debug-classes-list", Fdebug_classes_list, 0, 0, 0, /* 129 DEFUN ("debug-classes-list", Fdebug_classes_list, 0, 0, 0, /*
129 Return a list of all defined debug classes. 130 Return a list of all defined debug classes.
130 */ 131 */
131 ()) 132 ())
132 { 133 {
133 return (xemacs_debug_loop (X_LIST, Qnil, Qnil)); 134 return (xemacs_debug_loop (LIST, Qnil, Qnil));
134 } 135 }
135 136
136 DEFUN ("set-debug-classes-to-check", Fset_debug_classes_to_check, 1, 1, 0, /* 137 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 Set which classes of debug statements should be active.
138 CLASSES should be a list of debug classes. 139 CLASSES should be a list of debug classes.
145 146
146 /* Make sure all objects in the list are valid. If anyone is not 147 /* Make sure all objects in the list are valid. If anyone is not
147 valid, reject the entire list without doing anything. */ 148 valid, reject the entire list without doing anything. */
148 LIST_LOOP (rest, classes ) 149 LIST_LOOP (rest, classes )
149 { 150 {
150 if (NILP (xemacs_debug_loop (X_VALIDATE, XCAR (rest), Qnil))) 151 if (NILP (xemacs_debug_loop (VALIDATE, XCAR (rest), Qnil)))
151 error ("Invalid object in class list"); 152 error ("Invalid object in class list");
152 } 153 }
153 154
154 LIST_LOOP (rest, classes) 155 LIST_LOOP (rest, classes)
155 Fadd_debug_class_to_check (XCAR (rest)); 156 Fadd_debug_class_to_check (XCAR (rest));
156 157
157 return (xemacs_debug_loop (X_ACTIVE, Qnil, Qnil)); 158 return (xemacs_debug_loop (ACTIVE, Qnil, Qnil));
158 } 159 }
159 160
160 DEFUN ("set-debug-class-types-to-check", Fset_debug_class_types_to_check, 2, 2, 0, /* 161 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 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 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. 164 Lists of defined types and their values are located in the source code.
164 */ 165 */
165 (class, type)) 166 (class, type))
166 { 167 {
167 CHECK_INT (type); 168 CHECK_INT (type);
168 if (NILP (xemacs_debug_loop (X_VALIDATE, class, Qnil))) 169 if (NILP (xemacs_debug_loop (VALIDATE, class, Qnil)))
169 error ("Invalid debug class"); 170 error ("Invalid debug class");
170 171
171 xemacs_debug_loop (X_SETTYPE, class, type); 172 xemacs_debug_loop (SETTYPE, class, type);
172 173
173 return (xemacs_debug_loop (X_TYPE, class, Qnil)); 174 return (xemacs_debug_loop (TYPE, class, Qnil));
174 } 175 }
175 176
176 DEFUN ("debug-types-being-checked", Fdebug_types_being_checked, 1, 1, 0, /* 177 DEFUN ("debug-types-being-checked", Fdebug_types_being_checked, 1, 1, 0, /*
177 For the given CLASS, return the associated type value. 178 For the given CLASS, return the associated type value.
178 */ 179 */
179 (class)) 180 (class))
180 { 181 {
181 if (NILP (xemacs_debug_loop (X_VALIDATE, class, Qnil))) 182 if (NILP (xemacs_debug_loop (VALIDATE, class, Qnil)))
182 error ("Invalid debug class"); 183 error ("Invalid debug class");
183 184
184 return (xemacs_debug_loop (X_TYPE, class, Qnil)); 185 return (xemacs_debug_loop (TYPE, class, Qnil));
185 } 186 }
186 187
187 void 188 void
188 syms_of_debug (void) 189 syms_of_debug (void)
189 { 190 {
191 defsymbol (&Qbuffers, "buffers"); 192 defsymbol (&Qbuffers, "buffers");
192 defsymbol (&Qfaces, "faces"); 193 defsymbol (&Qfaces, "faces");
193 defsymbol (&Qwindows, "windows"); 194 defsymbol (&Qwindows, "windows");
194 defsymbol (&Qframes, "frames"); 195 defsymbol (&Qframes, "frames");
195 defsymbol (&Qdevices, "devices"); 196 defsymbol (&Qdevices, "devices");
197 /* defsymbol (&Qbyte_code, "byte-code"); in bytecode.c */
196 198
197 DEFSUBR (Fadd_debug_class_to_check); 199 DEFSUBR (Fadd_debug_class_to_check);
198 DEFSUBR (Fdelete_debug_class_to_check); 200 DEFSUBR (Fdelete_debug_class_to_check);
199 DEFSUBR (Fdebug_classes_being_checked); 201 DEFSUBR (Fdebug_classes_being_checked);
200 DEFSUBR (Fdebug_classes_list); 202 DEFSUBR (Fdebug_classes_list);
202 DEFSUBR (Fset_debug_class_types_to_check); 204 DEFSUBR (Fset_debug_class_types_to_check);
203 DEFSUBR (Fdebug_types_being_checked); 205 DEFSUBR (Fdebug_types_being_checked);
204 } 206 }
205 207
206 void 208 void
207 reinit_vars_of_debug (void) 209 vars_of_debug (void)
208 { 210 {
209 /* If you need to have any classes active early on in startup, then 211 /* If you need to have any classes active early on in startup, then
210 the flags should be set here. 212 the flags should be set here.
211 All functions called by this function are "allowed" according 213 All functions called by this function are "allowed" according
212 to emacs.c. */ 214 to emacs.c. */
213 xemacs_debug_loop (X_INIT, Qnil, Qnil); 215 xemacs_debug_loop (INIT, Qnil, Qnil);
214 } 216 }
215
216 void
217 vars_of_debug (void)
218 {
219 reinit_vars_of_debug ();
220 }