Mercurial > hg > xemacs-beta

comparison src/specifier.h @ 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 501cfd01ee6d
children 11054d720c21
comparison
equal deleted inserted replaced
411:12e008d41344 412:697ef44129c6
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, 19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */ 20 Boston, MA 02111-1307, USA. */
21 21
22 /* Synched up with: Not in FSF. */ 22 /* Synched up with: Not in FSF. */
23 23
24 #ifndef INCLUDED_specifier_h_ 24 #ifndef _XEMACS_SPECIFIER_H_
25 #define INCLUDED_specifier_h_ 25 #define _XEMACS_SPECIFIER_H_
26 26
27 /* 27 /*
28 MAGIC SPECIFIERS 28 MAGIC SPECIFIERS
29 ================ 29 ================
30 30
81 4. All specifiers are added to Vall_specifiers list, both bodily and 81 4. All specifiers are added to Vall_specifiers list, both bodily and
82 ghost. The pair of objects is always removed from the list at the 82 ghost. The pair of objects is always removed from the list at the
83 same time. 83 same time.
84 */ 84 */
85 85
86 extern const struct struct_description specifier_methods_description;
87
88 struct specifier_methods 86 struct specifier_methods
89 { 87 {
90 const char *name; 88 CONST char *name;
91 Lisp_Object predicate_symbol; 89 Lisp_Object predicate_symbol;
92 90
93 /* Implementation specific methods: */ 91 /* Implementation specific methods: */
94 92
95 /* Create method: Initialize specifier data. Optional. */ 93 /* Create method: Initialize specifier data. Optional. */
96 void (*create_method) (Lisp_Object specifier); 94 void (*create_method) (Lisp_Object specifier);
97 95
98 /* Mark method: Mark any lisp object within specifier data 96 /* Mark method: Mark any lisp object within specifier data
99 structure. Not required if no specifier data are Lisp_Objects. */ 97 structure. Not required if no specifier data are Lisp_Objects. */
100 void (*mark_method) (Lisp_Object specifier); 98 void (*mark_method) (Lisp_Object specifier, void (*markobj) (Lisp_Object));
101 99
102 /* Equal method: Compare two specifiers. This is called after 100 /* Equal method: Compare two specifiers. This is called after
103 ensuring that the two specifiers are of the same type, and have 101 ensuring that the two specifiers are of the same type, and have
104 the same specs. Quit is inhibited during the call so it is safe 102 the same specs. Quit is inhibited during the call so it is safe
105 to call internal_equal(). 103 to call internal_equal().
121 valid for this specifier type. If not, signal an error. 119 valid for this specifier type. If not, signal an error.
122 120
123 If this function is not present, all instantiators are considered 121 If this function is not present, all instantiators are considered
124 valid. */ 122 valid. */
125 void (*validate_method) (Lisp_Object instantiator); 123 void (*validate_method) (Lisp_Object instantiator);
126
127
128 /* Copy method: Given an instantiator, copy the bits that we need to
129 for this specifier type.
130
131 If this function is not present, then Fcopy_tree is used. */
132 Lisp_Object (*copy_instantiator_method) (Lisp_Object instantiator);
133 124
134 /* Validate-matchspec method: Given a matchspec, verify that it's 125 /* Validate-matchspec method: Given a matchspec, verify that it's
135 valid for this specifier type. If not, signal an error. 126 valid for this specifier type. If not, signal an error.
136 127
137 If this function is not present, *no* matchspecs are considered 128 If this function is not present, *no* matchspecs are considered
192 183
193 #### Do not still know if this can safely eval. */ 184 #### Do not still know if this can safely eval. */
194 void (*after_change_method) (Lisp_Object specifier, 185 void (*after_change_method) (Lisp_Object specifier,
195 Lisp_Object locale); 186 Lisp_Object locale);
196 187
197 const struct lrecord_description *extra_description;
198 int extra_data_size; 188 int extra_data_size;
199 }; 189 };
200 190
201 struct Lisp_Specifier 191 struct Lisp_Specifier
202 { 192 {
235 Lisp_Object fallback; 225 Lisp_Object fallback;
236 226
237 /* type-specific extra data attached to a specifier */ 227 /* type-specific extra data attached to a specifier */
238 char data[1]; 228 char data[1];
239 }; 229 };
240 typedef struct Lisp_Specifier Lisp_Specifier; 230
241 231 DECLARE_LRECORD (specifier, struct Lisp_Specifier);
242 DECLARE_LRECORD (specifier, Lisp_Specifier); 232 #define XSPECIFIER(x) XRECORD (x, specifier, struct Lisp_Specifier)
243 #define XSPECIFIER(x) XRECORD (x, specifier, Lisp_Specifier)
244 #define XSETSPECIFIER(x, p) XSETRECORD (x, p, specifier) 233 #define XSETSPECIFIER(x, p) XSETRECORD (x, p, specifier)
245 #define SPECIFIERP(x) RECORDP (x, specifier) 234 #define SPECIFIERP(x) RECORDP (x, specifier)
235 #define GC_SPECIFIERP(x) GC_RECORDP (x, specifier)
246 #define CHECK_SPECIFIER(x) CHECK_RECORD (x, specifier) 236 #define CHECK_SPECIFIER(x) CHECK_RECORD (x, specifier)
247 #define CONCHECK_SPECIFIER(x) CONCHECK_RECORD (x, specifier) 237 #define CONCHECK_SPECIFIER(x) CONCHECK_RECORD (x, specifier)
248 238
249 /***** Calling a specifier method *****/ 239 /***** Calling a specifier method *****/
250 240
251 #define RAW_SPECMETH(sp, m) ((sp)->methods->m##_method) 241 #define RAW_SPECMETH(sp, m) ((sp)->methods->m##_method)
252 #define HAS_SPECMETH_P(sp, m) (!!RAW_SPECMETH (sp, m)) 242 #define HAS_SPECMETH_P(sp, m) (!!RAW_SPECMETH (sp, m))
253 #define SPECMETH(sp, m, args) (((sp)->methods->m##_method) args) 243 #define SPECMETH(sp, m, args) (((sp)->methods->m##_method) args)
254 244
255 /* Call a void-returning specifier method, if it exists. */ 245 /* Call a void-returning specifier method, if it exists. */
256 #define MAYBE_SPECMETH(sp, m, args) do { \ 246 #define MAYBE_SPECMETH(sp, m, args) do { \
257 Lisp_Specifier *maybe_specmeth_sp = (sp); \ 247 struct Lisp_Specifier *maybe_specmeth_sp = (sp); \
258 if (HAS_SPECMETH_P (maybe_specmeth_sp, m)) \ 248 if (HAS_SPECMETH_P (maybe_specmeth_sp, m)) \
259 SPECMETH (maybe_specmeth_sp, m, args); \ 249 SPECMETH (maybe_specmeth_sp, m, args); \
260 } while (0) 250 } while (0)
261 251
262 /***** Defining new specifier types *****/ 252 /***** Defining new specifier types *****/
263
264 #define specifier_data_offset (offsetof (Lisp_Specifier, data))
265 extern const struct lrecord_description specifier_empty_extra_description[];
266 253
267 #ifdef ERROR_CHECK_TYPECHECK 254 #ifdef ERROR_CHECK_TYPECHECK
268 #define DECLARE_SPECIFIER_TYPE(type) \ 255 #define DECLARE_SPECIFIER_TYPE(type) \
269 extern struct specifier_methods * type##_specifier_methods; \ 256 extern struct specifier_methods * type##_specifier_methods; \
270 INLINE_HEADER struct type##_specifier * \ 257 INLINE struct type##_specifier * \
271 error_check_##type##_specifier_data (Lisp_Specifier *sp); \ 258 error_check_##type##_specifier_data (struct Lisp_Specifier *sp); \
272 INLINE_HEADER struct type##_specifier * \ 259 INLINE struct type##_specifier * \
273 error_check_##type##_specifier_data (Lisp_Specifier *sp) \ 260 error_check_##type##_specifier_data (struct Lisp_Specifier *sp) \
274 { \ 261 { \
275 if (SPECIFIERP (sp->magic_parent)) \ 262 if (SPECIFIERP (sp->magic_parent)) \
276 { \ 263 { \
277 assert (SPECIFIER_TYPE_P (sp, type)); \ 264 assert (SPECIFIER_TYPE_P (sp, type)); \
278 sp = XSPECIFIER (sp->magic_parent); \ 265 sp = XSPECIFIER (sp->magic_parent); \
280 else \ 267 else \
281 assert (NILP (sp->magic_parent) || EQ (sp->magic_parent, Qt)); \ 268 assert (NILP (sp->magic_parent) || EQ (sp->magic_parent, Qt)); \
282 assert (SPECIFIER_TYPE_P (sp, type)); \ 269 assert (SPECIFIER_TYPE_P (sp, type)); \
283 return (struct type##_specifier *) sp->data; \ 270 return (struct type##_specifier *) sp->data; \
284 } \ 271 } \
285 INLINE_HEADER Lisp_Specifier * \
286 error_check_##type##_specifier_type (Lisp_Object obj); \
287 INLINE_HEADER Lisp_Specifier * \
288 error_check_##type##_specifier_type (Lisp_Object obj) \
289 { \
290 Lisp_Specifier *sp = XSPECIFIER (obj); \
291 assert (SPECIFIER_TYPE_P (sp, type)); \
292 return sp; \
293 } \
294 DECLARE_NOTHING 272 DECLARE_NOTHING
295 #else 273 #else
296 #define DECLARE_SPECIFIER_TYPE(type) \ 274 #define DECLARE_SPECIFIER_TYPE(type) \
297 extern struct specifier_methods * type##_specifier_methods 275 extern struct specifier_methods * type##_specifier_methods
298 #endif /* ERROR_CHECK_TYPECHECK */ 276 #endif /* ERROR_CHECK_TYPECHECK */
299 277
300 #define DEFINE_SPECIFIER_TYPE(type) \ 278 #define DEFINE_SPECIFIER_TYPE(type) \
301 struct specifier_methods * type##_specifier_methods 279 struct specifier_methods * type##_specifier_methods
302 280
303 #define INITIALIZE_SPECIFIER_TYPE(type, obj_name, pred_sym) do { \ 281 #define INITIALIZE_SPECIFIER_TYPE(type, obj_name, pred_sym) do { \
304 type##_specifier_methods = xnew_and_zero (struct specifier_methods); \ 282 type##_specifier_methods = xnew_and_zero (struct specifier_methods); \
305 type##_specifier_methods->name = obj_name; \ 283 type##_specifier_methods->name = obj_name; \
306 type##_specifier_methods->extra_description = \ 284 defsymbol (&type##_specifier_methods->predicate_symbol, pred_sym); \
307 specifier_empty_extra_description; \ 285 add_entry_to_specifier_type_list (Q##type, type##_specifier_methods); \
308 defsymbol_nodump (&type##_specifier_methods->predicate_symbol, pred_sym); \
309 add_entry_to_specifier_type_list (Q##type, type##_specifier_methods); \
310 dumpstruct (&type##_specifier_methods, &specifier_methods_description); \
311 } while (0)
312
313 #define REINITIALIZE_SPECIFIER_TYPE(type) do { \
314 staticpro_nodump (&type##_specifier_methods->predicate_symbol); \
315 } while (0) 286 } while (0)
316 287
317 #define INITIALIZE_SPECIFIER_TYPE_WITH_DATA(type, obj_name, pred_sym) \ 288 #define INITIALIZE_SPECIFIER_TYPE_WITH_DATA(type, obj_name, pred_sym) \
318 do { \ 289 do { \
319 INITIALIZE_SPECIFIER_TYPE (type, obj_name, pred_sym); \ 290 INITIALIZE_SPECIFIER_TYPE (type, obj_name, pred_sym); \
320 type##_specifier_methods->extra_data_size = \ 291 type##_specifier_methods->extra_data_size = \
321 sizeof (struct type##_specifier); \ 292 sizeof (struct type##_specifier); \
322 type##_specifier_methods->extra_description = \
323 type##_specifier_description; \
324 } while (0) 293 } while (0)
325 294
326 /* Declare that specifier-type TYPE has method METH; used in 295 /* Declare that specifier-type TYPE has method METH; used in
327 initialization routines */ 296 initialization routines */
328 #define SPECIFIER_HAS_METHOD(type, meth) \ 297 #define SPECIFIER_HAS_METHOD(type, meth) \
332 301
333 #define SPECIFIER_TYPE_P(sp, type) \ 302 #define SPECIFIER_TYPE_P(sp, type) \
334 ((sp)->methods == type##_specifier_methods) 303 ((sp)->methods == type##_specifier_methods)
335 304
336 /* Any of the two of the magic spec */ 305 /* Any of the two of the magic spec */
337 #define MAGIC_SPECIFIER_P(sp) (!NILP((sp)->magic_parent)) 306 #define MAGIC_SPECIFIER_P(sp) \
307 (!NILP((sp)->magic_parent))
338 /* Normal part of the magic specifier */ 308 /* Normal part of the magic specifier */
339 #define BODILY_SPECIFIER_P(sp) EQ ((sp)->magic_parent, Qt) 309 #define BODILY_SPECIFIER_P(sp) \
310 (EQ ((sp)->magic_parent, Qt))
340 /* Ghost part of the magic specifier */ 311 /* Ghost part of the magic specifier */
341 #define GHOST_SPECIFIER_P(sp) SPECIFIERP((sp)->magic_parent) 312 #define GHOST_SPECIFIER_P(sp) \
342 313 (SPECIFIERP((sp)->magic_parent))
343 #define GHOST_SPECIFIER(sp) XSPECIFIER ((sp)->fallback) 314 /* The same three, when used in GC */
315 #define GC_MAGIC_SPECIFIER_P(sp) \
316 (!GC_NILP((sp)->magic_parent))
317 #define GC_BODILY_SPECIFIER_P(sp) \
318 (GC_EQ ((sp)->magic_parent, Qt))
319 #define GC_GHOST_SPECIFIER_P(sp) \
320 (GC_SPECIFIERP((sp)->magic_parent))
321
322 #define GHOST_SPECIFIER(sp) \
323 (XSPECIFIER ((sp)->fallback))
344 324
345 #ifdef ERROR_CHECK_TYPECHECK 325 #ifdef ERROR_CHECK_TYPECHECK
346 # define SPECIFIER_TYPE_DATA(sp, type) \ 326 # define SPECIFIER_TYPE_DATA(sp, type) \
347 error_check_##type##_specifier_data (sp) 327 error_check_##type##_specifier_data (sp)
348 #else 328 #else
351 (GHOST_SPECIFIER_P(sp) \ 331 (GHOST_SPECIFIER_P(sp) \
352 ? XSPECIFIER((sp)->magic_parent)->data \ 332 ? XSPECIFIER((sp)->magic_parent)->data \
353 : (sp)->data)) 333 : (sp)->data))
354 #endif 334 #endif
355 335
356 #ifdef ERROR_CHECK_TYPECHECK 336 /* #### Need to create ERROR_CHECKING versions of these. */
357 # define XSPECIFIER_TYPE(x, type) \ 337
358 error_check_##type##_specifier_type (x) 338 #define XSPECIFIER_TYPE(x, type) XSPECIFIER (x)
359 # define XSETSPECIFIER_TYPE(x, p, type) do \ 339 #define XSETSPECIFIER_TYPE(x, p, type) XSETSPECIFIER (x, p)
360 { \ 340 #define SPECIFIER_TYPEP(x, type) \
361 XSETSPECIFIER (x, p); \
362 assert (SPECIFIER_TYPEP (XSPECIFIER(x), type)); \
363 } while (0)
364 #else
365 # define XSPECIFIER_TYPE(x, type) XSPECIFIER (x)
366 # define XSETSPECIFIER_TYPE(x, p, type) XSETSPECIFIER (x, p)
367 #endif /* ERROR_CHECK_TYPE_CHECK */
368
369 #define SPECIFIER_TYPEP(x, type) \
370 (SPECIFIERP (x) && SPECIFIER_TYPE_P (XSPECIFIER (x), type)) 341 (SPECIFIERP (x) && SPECIFIER_TYPE_P (XSPECIFIER (x), type))
371 #define CHECK_SPECIFIER_TYPE(x, type) do { \ 342 #define CHECK_SPECIFIER_TYPE(x, type) do { \
372 CHECK_SPECIFIER (x); \ 343 CHECK_SPECIFIER (x); \
373 if (!SPECIFIER_TYPE_P (XSPECIFIER (x), type)) \ 344 if (!SPECIFIER_TYPE_P (XSPECIFIER (x), type)) \
374 dead_wrong_type_argument \ 345 dead_wrong_type_argument \
411 int offset_into_struct_frame; 382 int offset_into_struct_frame;
412 void (*value_changed_in_frame) (Lisp_Object specifier, struct frame *f, 383 void (*value_changed_in_frame) (Lisp_Object specifier, struct frame *f,
413 Lisp_Object oldval); 384 Lisp_Object oldval);
414 }; 385 };
415 386
416 /* #### get image instances out of domains! */
417
418 /* #### I think the following should abort() rather than return nil
419 when an invalid domain is given; much more likely we'll catch design
420 errors early. --ben */
421
422 /* This turns out to be used heavily so we make it a macro to make it
423 inline. Also, the majority of the time the object will turn out to
424 be a window so we move it from being checked last to being checked
425 first. */
426 #define DOMAIN_DEVICE(obj) \
427 (WINDOWP (obj) ? WINDOW_DEVICE (XWINDOW (obj)) \
428 : (FRAMEP (obj) ? FRAME_DEVICE (XFRAME (obj)) \
429 : (DEVICEP (obj) ? obj \
430 : (IMAGE_INSTANCEP (obj) ? image_instance_device (obj) \
431 : Qnil))))
432
433 #define DOMAIN_FRAME(obj) \
434 (WINDOWP (obj) ? WINDOW_FRAME (XWINDOW (obj)) \
435 : (FRAMEP (obj) ? obj \
436 : (IMAGE_INSTANCEP (obj) ? image_instance_frame (obj) \
437 : Qnil)))
438
439 #define DOMAIN_WINDOW(obj) \
440 (WINDOWP (obj) ? obj \
441 : (IMAGE_INSTANCEP (obj) ? image_instance_window (obj) \
442 : Qnil))
443
444 #define DOMAIN_LIVE_P(obj) \
445 (WINDOWP (obj) ? WINDOW_LIVE_P (XWINDOW (obj)) \
446 : (FRAMEP (obj) ? FRAME_LIVE_P (XFRAME (obj)) \
447 : (DEVICEP (obj) ? DEVICE_LIVE_P (XDEVICE (obj)) \
448 : (IMAGE_INSTANCEP (obj) ? image_instance_live_p (obj) \
449 : 0))))
450
451 #define DOMAIN_XDEVICE(obj) \
452 (XDEVICE (DOMAIN_DEVICE (obj)))
453 #define DOMAIN_XFRAME(obj) \
454 (XFRAME (DOMAIN_FRAME (obj)))
455 #define DOMAIN_XWINDOW(obj) \
456 (XWINDOW (DOMAIN_WINDOW (obj)))
457
458 EXFUN (Fcopy_specifier, 6); 387 EXFUN (Fcopy_specifier, 6);
459 EXFUN (Fmake_specifier, 1); 388 EXFUN (Fmake_specifier, 1);
460 EXFUN (Fset_specifier_dirty_flag, 1); 389 EXFUN (Fset_specifier_dirty_flag, 1);
461 EXFUN (Fspecifier_instance, 4); 390 EXFUN (Fspecifier_instance, 4);
462 EXFUN (Fvalid_specifier_locale_p, 1); 391 EXFUN (Fvalid_specifier_locale_p, 1);
466 Lisp_Object make_magic_specifier (Lisp_Object type); 395 Lisp_Object make_magic_specifier (Lisp_Object type);
467 Lisp_Object decode_locale_list (Lisp_Object locale); 396 Lisp_Object decode_locale_list (Lisp_Object locale);
468 extern enum spec_add_meth 397 extern enum spec_add_meth
469 decode_how_to_add_specification (Lisp_Object how_to_add); 398 decode_how_to_add_specification (Lisp_Object how_to_add);
470 Lisp_Object decode_specifier_tag_set (Lisp_Object tag_set); 399 Lisp_Object decode_specifier_tag_set (Lisp_Object tag_set);
471 Lisp_Object decode_domain (Lisp_Object domain);
472 400
473 void add_entry_to_specifier_type_list (Lisp_Object symbol, 401 void add_entry_to_specifier_type_list (Lisp_Object symbol,
474 struct specifier_methods *meths); 402 struct specifier_methods *meths);
475 void set_specifier_caching (Lisp_Object specifier, 403 void set_specifier_caching (Lisp_Object specifier,
476 int struct_window_offset, 404 int struct_window_offset,
495 Lisp_Object tag_set, Lisp_Object exact_p); 423 Lisp_Object tag_set, Lisp_Object exact_p);
496 424
497 int unlock_ghost_specifiers_protected (void); 425 int unlock_ghost_specifiers_protected (void);
498 426
499 void cleanup_specifiers (void); 427 void cleanup_specifiers (void);
500 void prune_specifiers (void); 428 void prune_specifiers (int (*obj_marked_p) (Lisp_Object));
501 void setup_device_initial_specifier_tags (struct device *d); 429 void setup_device_initial_specifier_tags (struct device *d);
502 void kill_specifier_buffer_locals (Lisp_Object buffer); 430 void kill_specifier_buffer_locals (Lisp_Object buffer);
503 431
504 DECLARE_SPECIFIER_TYPE (generic); 432 DECLARE_SPECIFIER_TYPE (generic);
505 #define XGENERIC_SPECIFIER(x) XSPECIFIER_TYPE (x, generic) 433 #define XGENERIC_SPECIFIER(x) XSPECIFIER_TYPE (x, generic)
534 #define XSETDISPLAYTABLE_SPECIFIER(x, p) XSETSPECIFIER_TYPE (x, p, display_table) 462 #define XSETDISPLAYTABLE_SPECIFIER(x, p) XSETSPECIFIER_TYPE (x, p, display_table)
535 #define DISPLAYTABLE_SPECIFIERP(x) SPECIFIER_TYPEP (x, display_table) 463 #define DISPLAYTABLE_SPECIFIERP(x) SPECIFIER_TYPEP (x, display_table)
536 #define CHECK_DISPLAYTABLE_SPECIFIER(x) CHECK_SPECIFIER_TYPE (x, display_table) 464 #define CHECK_DISPLAYTABLE_SPECIFIER(x) CHECK_SPECIFIER_TYPE (x, display_table)
537 #define CONCHECK_DISPLAYTABLE_SPECIFIER(x) CONCHECK_SPECIFIER_TYPE (x, display_table) 465 #define CONCHECK_DISPLAYTABLE_SPECIFIER(x) CONCHECK_SPECIFIER_TYPE (x, display_table)
538 466
539 #endif /* INCLUDED_specifier_h_ */ 467 #endif /* _XEMACS_SPECIFIER_H_ */