Mercurial > hg > xemacs-beta

comparison src/debug.c @ 436:080151679be2 r21-2-26

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-26
author cvs
date Mon, 13 Aug 2007 11:31:24 +0200
parents 3ecd8885ac67
children 183866b06e0b
comparison
equal deleted inserted replaced
435:53cf74a9db44 436:080151679be2
43 43
44 struct debug_classes active_debug_classes; 44 struct debug_classes active_debug_classes;
45 45
46 enum debug_loop 46 enum debug_loop
47 { 47 {
48 ADD, 48 X_ADD,
49 DELETE, 49 X_DELETE,
50 LIST, 50 X_LIST,
51 ACTIVE, 51 X_ACTIVE,
52 INIT, 52 X_INIT,
53 VALIDATE, 53 X_VALIDATE,
54 TYPE, 54 X_TYPE,
55 SETTYPE 55 X_SETTYPE
56 }; 56 };
57 57
58 static Lisp_Object 58 static Lisp_Object
59 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)
60 { 60 {
61 int flag = (op == ADD) ? 1 : 0; 61 int flag = (op == X_ADD) ? 1 : 0;
62 Lisp_Object retval = Qnil; 62 Lisp_Object retval = Qnil;
63 63
64 #define FROB(item) \ 64 #define FROB(item) \
65 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)) \
66 { \ 66 { \
67 if (op == ADD || op == DELETE || op == INIT) \ 67 if (op == X_ADD || op == X_DELETE || op == X_INIT) \
68 active_debug_classes.item = flag; \ 68 active_debug_classes.item = flag; \
69 else if (op == LIST \ 69 else if (op == X_LIST \
70 || (op == ACTIVE && active_debug_classes.item)) \ 70 || (op == X_ACTIVE && active_debug_classes.item)) \
71 retval = Fcons (Q##item, retval); \ 71 retval = Fcons (Q##item, retval); \
72 else if (op == VALIDATE) \ 72 else if (op == X_VALIDATE) \
73 return Qt; \ 73 return Qt; \
74 else if (op == SETTYPE) \ 74 else if (op == X_SETTYPE) \
75 active_debug_classes.types_of_##item = XINT (type); \ 75 active_debug_classes.types_of_##item = XINT (type); \
76 else if (op == TYPE) \ 76 else if (op == X_TYPE) \
77 retval = make_int (active_debug_classes.types_of_##item); \ 77 retval = make_int (active_debug_classes.types_of_##item); \
78 if (op == INIT) active_debug_classes.types_of_##item = VALBITS; \ 78 if (op == X_INIT) active_debug_classes.types_of_##item = VALBITS; \
79 } 79 }
80 80
81 FROB (redisplay); 81 FROB (redisplay);
82 FROB (buffers); 82 FROB (buffers);
83 FROB (extents); 83 FROB (extents);
94 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, /*
95 Add a debug class to the list of active classes. 95 Add a debug class to the list of active classes.
96 */ 96 */
97 (class)) 97 (class))
98 { 98 {
99 if (NILP (xemacs_debug_loop (VALIDATE, class, Qnil))) 99 if (NILP (xemacs_debug_loop (X_VALIDATE, class, Qnil)))
100 error ("No such debug class exists"); 100 error ("No such debug class exists");
101 else 101 else
102 xemacs_debug_loop (ADD, class, Qnil); 102 xemacs_debug_loop (X_ADD, class, Qnil);
103 103
104 return (xemacs_debug_loop (ACTIVE, Qnil, Qnil)); 104 return (xemacs_debug_loop (X_ACTIVE, Qnil, Qnil));
105 } 105 }
106 106
107 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, /*
108 Delete a debug class from the list of active classes. 108 Delete a debug class from the list of active classes.
109 */ 109 */
110 (class)) 110 (class))
111 { 111 {
112 if (NILP (xemacs_debug_loop (VALIDATE, class, Qnil))) 112 if (NILP (xemacs_debug_loop (X_VALIDATE, class, Qnil)))
113 error ("No such debug class exists"); 113 error ("No such debug class exists");
114 else 114 else
115 xemacs_debug_loop (DELETE, class, Qnil); 115 xemacs_debug_loop (X_DELETE, class, Qnil);
116 116
117 return (xemacs_debug_loop (ACTIVE, Qnil, Qnil)); 117 return (xemacs_debug_loop (X_ACTIVE, Qnil, Qnil));
118 } 118 }
119 119
120 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, /*
121 Return a list of active debug classes. 121 Return a list of active debug classes.
122 */ 122 */
123 ()) 123 ())
124 { 124 {
125 return (xemacs_debug_loop (ACTIVE, Qnil, Qnil)); 125 return (xemacs_debug_loop (X_ACTIVE, Qnil, Qnil));
126 } 126 }
127 127
128 DEFUN ("debug-classes-list", Fdebug_classes_list, 0, 0, 0, /* 128 DEFUN ("debug-classes-list", Fdebug_classes_list, 0, 0, 0, /*
129 Return a list of all defined debug classes. 129 Return a list of all defined debug classes.
130 */ 130 */
131 ()) 131 ())
132 { 132 {
133 return (xemacs_debug_loop (LIST, Qnil, Qnil)); 133 return (xemacs_debug_loop (X_LIST, Qnil, Qnil));
134 } 134 }
135 135
136 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, /*
137 Set which classes of debug statements should be active. 137 Set which classes of debug statements should be active.
138 CLASSES should be a list of debug classes. 138 CLASSES should be a list of debug classes.
145 145
146 /* 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
147 valid, reject the entire list without doing anything. */ 147 valid, reject the entire list without doing anything. */
148 LIST_LOOP (rest, classes ) 148 LIST_LOOP (rest, classes )
149 { 149 {
150 if (NILP (xemacs_debug_loop (VALIDATE, XCAR (rest), Qnil))) 150 if (NILP (xemacs_debug_loop (X_VALIDATE, XCAR (rest), Qnil)))
151 error ("Invalid object in class list"); 151 error ("Invalid object in class list");
152 } 152 }
153 153
154 LIST_LOOP (rest, classes) 154 LIST_LOOP (rest, classes)
155 Fadd_debug_class_to_check (XCAR (rest)); 155 Fadd_debug_class_to_check (XCAR (rest));
156 156
157 return (xemacs_debug_loop (ACTIVE, Qnil, Qnil)); 157 return (xemacs_debug_loop (X_ACTIVE, Qnil, Qnil));
158 } 158 }
159 159
160 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, /*
161 For the given debug CLASS, set which TYPES are actually interesting. 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. 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. 163 Lists of defined types and their values are located in the source code.
164 */ 164 */
165 (class, type)) 165 (class, type))
166 { 166 {
167 CHECK_INT (type); 167 CHECK_INT (type);
168 if (NILP (xemacs_debug_loop (VALIDATE, class, Qnil))) 168 if (NILP (xemacs_debug_loop (X_VALIDATE, class, Qnil)))
169 error ("Invalid debug class"); 169 error ("Invalid debug class");
170 170
171 xemacs_debug_loop (SETTYPE, class, type); 171 xemacs_debug_loop (X_SETTYPE, class, type);
172 172
173 return (xemacs_debug_loop (TYPE, class, Qnil)); 173 return (xemacs_debug_loop (X_TYPE, class, Qnil));
174 } 174 }
175 175
176 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, /*
177 For the given CLASS, return the associated type value. 177 For the given CLASS, return the associated type value.
178 */ 178 */
179 (class)) 179 (class))
180 { 180 {
181 if (NILP (xemacs_debug_loop (VALIDATE, class, Qnil))) 181 if (NILP (xemacs_debug_loop (X_VALIDATE, class, Qnil)))
182 error ("Invalid debug class"); 182 error ("Invalid debug class");
183 183
184 return (xemacs_debug_loop (TYPE, class, Qnil)); 184 return (xemacs_debug_loop (X_TYPE, class, Qnil));
185 } 185 }
186 186
187 void 187 void
188 syms_of_debug (void) 188 syms_of_debug (void)
189 { 189 {
208 { 208 {
209 /* 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
210 the flags should be set here. 210 the flags should be set here.
211 All functions called by this function are "allowed" according 211 All functions called by this function are "allowed" according
212 to emacs.c. */ 212 to emacs.c. */
213 xemacs_debug_loop (INIT, Qnil, Qnil); 213 xemacs_debug_loop (X_INIT, Qnil, Qnil);
214 } 214 }
215 215
216 void 216 void
217 vars_of_debug (void) 217 vars_of_debug (void)
218 { 218 {