Mercurial > hg > xemacs-beta

comparison src/debug.c @ 398:74fd4e045ea6 r21-2-29

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