Mercurial > hg > xemacs-beta

comparison src/specifier.c @ 440:8de8e3f6228a r21-2-28

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-28
author cvs
date Mon, 13 Aug 2007 11:33:38 +0200
parents 9d177e8d4150
children abe6d1db359e
comparison
equal deleted inserted replaced
439:357dd071b03c 440:8de8e3f6228a
65 } specifier_type_entry_dynarr; 65 } specifier_type_entry_dynarr;
66 66
67 static specifier_type_entry_dynarr *the_specifier_type_entry_dynarr; 67 static specifier_type_entry_dynarr *the_specifier_type_entry_dynarr;
68 68
69 static const struct lrecord_description ste_description_1[] = { 69 static const struct lrecord_description ste_description_1[] = {
70 { XD_LISP_OBJECT, offsetof(specifier_type_entry, symbol), 1 }, 70 { XD_LISP_OBJECT, offsetof (specifier_type_entry, symbol) },
71 { XD_STRUCT_PTR, offsetof(specifier_type_entry, meths), 1, &specifier_methods_description }, 71 { XD_STRUCT_PTR, offsetof (specifier_type_entry, meths), 1, &specifier_methods_description },
72 { XD_END } 72 { XD_END }
73 }; 73 };
74 74
75 static const struct struct_description ste_description = { 75 static const struct struct_description ste_description = {
76 sizeof(specifier_type_entry), 76 sizeof (specifier_type_entry),
77 ste_description_1 77 ste_description_1
78 }; 78 };
79 79
80 static const struct lrecord_description sted_description_1[] = { 80 static const struct lrecord_description sted_description_1[] = {
81 XD_DYNARR_DESC(specifier_type_entry_dynarr, &ste_description), 81 XD_DYNARR_DESC (specifier_type_entry_dynarr, &ste_description),
82 { XD_END } 82 { XD_END }
83 }; 83 };
84 84
85 static const struct struct_description sted_description = { 85 static const struct struct_description sted_description = {
86 sizeof(specifier_type_entry_dynarr), 86 sizeof (specifier_type_entry_dynarr),
87 sted_description_1 87 sted_description_1
88 }; 88 };
89 89
90 static Lisp_Object Vspecifier_type_list; 90 static Lisp_Object Vspecifier_type_list;
91 91
160 160
161 for (rest = Vall_specifiers; 161 for (rest = Vall_specifiers;
162 !NILP (rest); 162 !NILP (rest);
163 rest = XSPECIFIER (rest)->next_specifier) 163 rest = XSPECIFIER (rest)->next_specifier)
164 { 164 {
165 struct Lisp_Specifier *sp = XSPECIFIER (rest); 165 Lisp_Specifier *sp = XSPECIFIER (rest);
166 /* This effectively changes the specifier specs. 166 /* This effectively changes the specifier specs.
167 However, there's no need to call 167 However, there's no need to call
168 recompute_cached_specifier_everywhere() or the 168 recompute_cached_specifier_everywhere() or the
169 after-change methods because the only specs we 169 after-change methods because the only specs we
170 are removing are for dead objects, and they can 170 are removing are for dead objects, and they can
187 187
188 for (rest = Vall_specifiers; 188 for (rest = Vall_specifiers;
189 !NILP (rest); 189 !NILP (rest);
190 rest = XSPECIFIER (rest)->next_specifier) 190 rest = XSPECIFIER (rest)->next_specifier)
191 { 191 {
192 struct Lisp_Specifier *sp = XSPECIFIER (rest); 192 Lisp_Specifier *sp = XSPECIFIER (rest);
193 193
194 /* Make sure we're actually going to be changing something. 194 /* Make sure we're actually going to be changing something.
195 Fremove_specifier() always calls 195 Fremove_specifier() always calls
196 recompute_cached_specifier_everywhere() (#### but should 196 recompute_cached_specifier_everywhere() (#### but should
197 be smarter about this). */ 197 be smarter about this). */
201 } 201 }
202 202
203 static Lisp_Object 203 static Lisp_Object
204 mark_specifier (Lisp_Object obj) 204 mark_specifier (Lisp_Object obj)
205 { 205 {
206 struct Lisp_Specifier *specifier = XSPECIFIER (obj); 206 Lisp_Specifier *specifier = XSPECIFIER (obj);
207 207
208 mark_object (specifier->global_specs); 208 mark_object (specifier->global_specs);
209 mark_object (specifier->device_specs); 209 mark_object (specifier->device_specs);
210 mark_object (specifier->frame_specs); 210 mark_object (specifier->frame_specs);
211 mark_object (specifier->window_specs); 211 mark_object (specifier->window_specs);
245 !NILP (rest); 245 !NILP (rest);
246 rest = XSPECIFIER (rest)->next_specifier) 246 rest = XSPECIFIER (rest)->next_specifier)
247 { 247 {
248 if (! marked_p (rest)) 248 if (! marked_p (rest))
249 { 249 {
250 struct Lisp_Specifier* sp = XSPECIFIER (rest); 250 Lisp_Specifier* sp = XSPECIFIER (rest);
251 /* A bit of assertion that we're removing both parts of the 251 /* A bit of assertion that we're removing both parts of the
252 magic one altogether */ 252 magic one altogether */
253 assert (!MAGIC_SPECIFIER_P(sp) 253 assert (!MAGIC_SPECIFIER_P(sp)
254 || (BODILY_SPECIFIER_P(sp) && marked_p (sp->fallback)) 254 || (BODILY_SPECIFIER_P(sp) && marked_p (sp->fallback))
255 || (GHOST_SPECIFIER_P(sp) && marked_p (sp->magic_parent))); 255 || (GHOST_SPECIFIER_P(sp) && marked_p (sp->magic_parent)));
265 } 265 }
266 266
267 static void 267 static void
268 print_specifier (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) 268 print_specifier (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
269 { 269 {
270 struct Lisp_Specifier *sp = XSPECIFIER (obj); 270 Lisp_Specifier *sp = XSPECIFIER (obj);
271 char buf[100]; 271 char buf[100];
272 int count = specpdl_depth (); 272 int count = specpdl_depth ();
273 Lisp_Object the_specs; 273 Lisp_Object the_specs;
274 274
275 if (print_readably) 275 if (print_readably)
297 } 297 }
298 298
299 static void 299 static void
300 finalize_specifier (void *header, int for_disksave) 300 finalize_specifier (void *header, int for_disksave)
301 { 301 {
302 struct Lisp_Specifier *sp = (struct Lisp_Specifier *) header; 302 Lisp_Specifier *sp = (Lisp_Specifier *) header;
303 /* don't be snafued by the disksave finalization. */ 303 /* don't be snafued by the disksave finalization. */
304 if (!for_disksave && !GHOST_SPECIFIER_P(sp) && sp->caching) 304 if (!for_disksave && !GHOST_SPECIFIER_P(sp) && sp->caching)
305 { 305 {
306 xfree (sp->caching); 306 xfree (sp->caching);
307 sp->caching = 0; 307 sp->caching = 0;
309 } 309 }
310 310
311 static int 311 static int
312 specifier_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) 312 specifier_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
313 { 313 {
314 struct Lisp_Specifier *s1 = XSPECIFIER (obj1); 314 Lisp_Specifier *s1 = XSPECIFIER (obj1);
315 struct Lisp_Specifier *s2 = XSPECIFIER (obj2); 315 Lisp_Specifier *s2 = XSPECIFIER (obj2);
316 int retval; 316 int retval;
317 Lisp_Object old_inhibit_quit = Vinhibit_quit; 317 Lisp_Object old_inhibit_quit = Vinhibit_quit;
318 318
319 /* This function can be called from within redisplay. 319 /* This function can be called from within redisplay.
320 internal_equal can trigger a quit. That leads to Bad Things. */ 320 internal_equal can trigger a quit. That leads to Bad Things. */
338 } 338 }
339 339
340 static unsigned long 340 static unsigned long
341 specifier_hash (Lisp_Object obj, int depth) 341 specifier_hash (Lisp_Object obj, int depth)
342 { 342 {
343 struct Lisp_Specifier *s = XSPECIFIER (obj); 343 Lisp_Specifier *s = XSPECIFIER (obj);
344 344
345 /* specifier hashing is a bit problematic because there are so 345 /* specifier hashing is a bit problematic because there are so
346 many places where data can be stored. We pick what are perhaps 346 many places where data can be stored. We pick what are perhaps
347 the most likely places where interesting stuff will be. */ 347 the most likely places where interesting stuff will be. */
348 return HASH5 ((HAS_SPECMETH_P (s, hash) ? 348 return HASH5 ((HAS_SPECMETH_P (s, hash) ?
354 } 354 }
355 355
356 static size_t 356 static size_t
357 sizeof_specifier (CONST void *header) 357 sizeof_specifier (CONST void *header)
358 { 358 {
359 if (GHOST_SPECIFIER_P ((struct Lisp_Specifier *) header)) 359 if (GHOST_SPECIFIER_P ((Lisp_Specifier *) header))
360 return offsetof (struct Lisp_Specifier, data); 360 return offsetof (Lisp_Specifier, data);
361 else 361 else
362 { 362 {
363 CONST struct Lisp_Specifier *p = (CONST struct Lisp_Specifier *) header; 363 CONST Lisp_Specifier *p = (CONST Lisp_Specifier *) header;
364 return offsetof (struct Lisp_Specifier, data) + p->methods->extra_data_size; 364 return offsetof (Lisp_Specifier, data) + p->methods->extra_data_size;
365 } 365 }
366 } 366 }
367 367
368 static const struct lrecord_description specifier_methods_description_1[] = { 368 static const struct lrecord_description specifier_methods_description_1[] = {
369 { XD_LISP_OBJECT, offsetof(struct specifier_methods, predicate_symbol), 1 }, 369 { XD_LISP_OBJECT, offsetof (struct specifier_methods, predicate_symbol) },
370 { XD_END } 370 { XD_END }
371 }; 371 };
372 372
373 const struct struct_description specifier_methods_description = { 373 const struct struct_description specifier_methods_description = {
374 sizeof(struct specifier_methods), 374 sizeof (struct specifier_methods),
375 specifier_methods_description_1 375 specifier_methods_description_1
376 }; 376 };
377 377
378 static const struct lrecord_description specifier_caching_description_1[] = { 378 static const struct lrecord_description specifier_caching_description_1[] = {
379 { XD_END } 379 { XD_END }
380 }; 380 };
381 381
382 static const struct struct_description specifier_caching_description = { 382 static const struct struct_description specifier_caching_description = {
383 sizeof(struct specifier_caching), 383 sizeof (struct specifier_caching),
384 specifier_caching_description_1 384 specifier_caching_description_1
385 }; 385 };
386 386
387 static const struct lrecord_description specifier_description[] = { 387 static const struct lrecord_description specifier_description[] = {
388 { XD_STRUCT_PTR, offsetof(struct Lisp_Specifier, methods), 1, &specifier_methods_description }, 388 { XD_STRUCT_PTR, offsetof (Lisp_Specifier, methods), 1, &specifier_methods_description },
389 { XD_LO_LINK, offsetof(struct Lisp_Specifier, next_specifier) }, 389 { XD_LO_LINK, offsetof (Lisp_Specifier, next_specifier) },
390 { XD_LISP_OBJECT, offsetof(struct Lisp_Specifier, global_specs), 5 }, 390 { XD_LISP_OBJECT, offsetof (Lisp_Specifier, global_specs) },
391 { XD_STRUCT_PTR, offsetof(struct Lisp_Specifier, caching), 1, &specifier_caching_description }, 391 { XD_LISP_OBJECT, offsetof (Lisp_Specifier, device_specs) },
392 { XD_LISP_OBJECT, offsetof(struct Lisp_Specifier, magic_parent), 2 }, 392 { XD_LISP_OBJECT, offsetof (Lisp_Specifier, frame_specs) },
393 { XD_LISP_OBJECT, offsetof (Lisp_Specifier, window_specs) },
394 { XD_LISP_OBJECT, offsetof (Lisp_Specifier, buffer_specs) },
395 { XD_STRUCT_PTR, offsetof (Lisp_Specifier, caching), 1, &specifier_caching_description },
396 { XD_LISP_OBJECT, offsetof (Lisp_Specifier, magic_parent) },
397 { XD_LISP_OBJECT, offsetof (Lisp_Specifier, fallback) },
393 { XD_SPECIFIER_END } 398 { XD_SPECIFIER_END }
394 }; 399 };
395 400
396 const struct lrecord_description specifier_empty_extra_description[] = { 401 const struct lrecord_description specifier_empty_extra_description[] = {
397 { XD_END } 402 { XD_END }
401 mark_specifier, print_specifier, 406 mark_specifier, print_specifier,
402 finalize_specifier, 407 finalize_specifier,
403 specifier_equal, specifier_hash, 408 specifier_equal, specifier_hash,
404 specifier_description, 409 specifier_description,
405 sizeof_specifier, 410 sizeof_specifier,
406 struct Lisp_Specifier); 411 Lisp_Specifier);
407 412
408 /************************************************************************/ 413 /************************************************************************/
409 /* Creating specifiers */ 414 /* Creating specifiers */
410 /************************************************************************/ 415 /************************************************************************/
411 416
465 static Lisp_Object 470 static Lisp_Object
466 make_specifier_internal (struct specifier_methods *spec_meths, 471 make_specifier_internal (struct specifier_methods *spec_meths,
467 size_t data_size, int call_create_meth) 472 size_t data_size, int call_create_meth)
468 { 473 {
469 Lisp_Object specifier; 474 Lisp_Object specifier;
470 struct Lisp_Specifier *sp = (struct Lisp_Specifier *) 475 Lisp_Specifier *sp = (Lisp_Specifier *)
471 alloc_lcrecord (offsetof (struct Lisp_Specifier, data) + 476 alloc_lcrecord (offsetof (Lisp_Specifier, data) + data_size,
472 data_size, &lrecord_specifier); 477 &lrecord_specifier);
473 478
474 sp->methods = spec_meths; 479 sp->methods = spec_meths;
475 sp->global_specs = Qnil; 480 sp->global_specs = Qnil;
476 sp->device_specs = Qnil; 481 sp->device_specs = Qnil;
477 sp->frame_specs = Qnil; 482 sp->frame_specs = Qnil;
1639 build_up_processed_list (Lisp_Object specifier, Lisp_Object locale, 1644 build_up_processed_list (Lisp_Object specifier, Lisp_Object locale,
1640 Lisp_Object inst_list) 1645 Lisp_Object inst_list)
1641 { 1646 {
1642 /* The return value of this function must be GCPRO'd. */ 1647 /* The return value of this function must be GCPRO'd. */
1643 Lisp_Object rest, list_to_build_up = Qnil; 1648 Lisp_Object rest, list_to_build_up = Qnil;
1644 struct Lisp_Specifier *sp = XSPECIFIER (specifier); 1649 Lisp_Specifier *sp = XSPECIFIER (specifier);
1645 struct gcpro gcpro1; 1650 struct gcpro gcpro1;
1646 1651
1647 GCPRO1 (list_to_build_up); 1652 GCPRO1 (list_to_build_up);
1648 LIST_LOOP (rest, inst_list) 1653 LIST_LOOP (rest, inst_list)
1649 { 1654 {
1696 1701
1697 static void 1702 static void
1698 specifier_add_spec (Lisp_Object specifier, Lisp_Object locale, 1703 specifier_add_spec (Lisp_Object specifier, Lisp_Object locale,
1699 Lisp_Object inst_list, enum spec_add_meth add_meth) 1704 Lisp_Object inst_list, enum spec_add_meth add_meth)
1700 { 1705 {
1701 struct Lisp_Specifier *sp = XSPECIFIER (specifier); 1706 Lisp_Specifier *sp = XSPECIFIER (specifier);
1702 enum spec_locale_type type = locale_type_from_locale (locale); 1707 enum spec_locale_type type = locale_type_from_locale (locale);
1703 Lisp_Object *orig_inst_list, tem; 1708 Lisp_Object *orig_inst_list, tem;
1704 Lisp_Object list_to_build_up = Qnil; 1709 Lisp_Object list_to_build_up = Qnil;
1705 struct gcpro gcpro1; 1710 struct gcpro gcpro1;
1706 1711
2367 global value. */ 2372 global value. */
2368 2373
2369 void 2374 void
2370 set_specifier_fallback (Lisp_Object specifier, Lisp_Object fallback) 2375 set_specifier_fallback (Lisp_Object specifier, Lisp_Object fallback)
2371 { 2376 {
2372 struct Lisp_Specifier *sp = XSPECIFIER (specifier); 2377 Lisp_Specifier *sp = XSPECIFIER (specifier);
2373 assert (SPECIFIERP (fallback) || 2378 assert (SPECIFIERP (fallback) ||
2374 !NILP (Fvalid_inst_list_p (fallback, Fspecifier_type (specifier)))); 2379 !NILP (Fvalid_inst_list_p (fallback, Fspecifier_type (specifier))));
2375 if (SPECIFIERP (fallback)) 2380 if (SPECIFIERP (fallback))
2376 assert (EQ (Fspecifier_type (specifier), Fspecifier_type (fallback))); 2381 assert (EQ (Fspecifier_type (specifier), Fspecifier_type (fallback)));
2377 if (BODILY_SPECIFIER_P (sp)) 2382 if (BODILY_SPECIFIER_P (sp))
2417 Lisp_Object inst_list, 2422 Lisp_Object inst_list,
2418 Error_behavior errb, int no_quit, 2423 Error_behavior errb, int no_quit,
2419 Lisp_Object depth) 2424 Lisp_Object depth)
2420 { 2425 {
2421 /* This function can GC */ 2426 /* This function can GC */
2422 struct Lisp_Specifier *sp; 2427 Lisp_Specifier *sp;
2423 Lisp_Object device; 2428 Lisp_Object device;
2424 Lisp_Object rest; 2429 Lisp_Object rest;
2425 int count = specpdl_depth (); 2430 int count = specpdl_depth ();
2426 struct gcpro gcpro1, gcpro2; 2431 struct gcpro gcpro1, gcpro2;
2427 2432
2500 Lisp_Object window = Qnil; 2505 Lisp_Object window = Qnil;
2501 Lisp_Object frame = Qnil; 2506 Lisp_Object frame = Qnil;
2502 Lisp_Object device = Qnil; 2507 Lisp_Object device = Qnil;
2503 Lisp_Object tag = Qnil; 2508 Lisp_Object tag = Qnil;
2504 struct device *d; 2509 struct device *d;
2505 struct Lisp_Specifier *sp; 2510 Lisp_Specifier *sp;
2506 2511
2507 sp = XSPECIFIER (specifier); 2512 sp = XSPECIFIER (specifier);
2508 2513
2509 /* Attempt to determine buffer, window, frame, and device from the 2514 /* Attempt to determine buffer, window, frame, and device from the
2510 domain. */ 2515 domain. */
2703 you should not use this function; use `specifier-instance' instead. 2708 you should not use this function; use `specifier-instance' instead.
2704 */ 2709 */
2705 (specifier, domain, inst_list, default_)) 2710 (specifier, domain, inst_list, default_))
2706 { 2711 {
2707 Lisp_Object val = Qunbound; 2712 Lisp_Object val = Qunbound;
2708 struct Lisp_Specifier *sp = XSPECIFIER (specifier); 2713 Lisp_Specifier *sp = XSPECIFIER (specifier);
2709 struct gcpro gcpro1; 2714 struct gcpro gcpro1;
2710 Lisp_Object built_up_list = Qnil; 2715 Lisp_Object built_up_list = Qnil;
2711 2716
2712 CHECK_SPECIFIER (specifier); 2717 CHECK_SPECIFIER (specifier);
2713 check_valid_domain (domain); 2718 check_valid_domain (domain);
2735 works. 2740 works.
2736 */ 2741 */
2737 (specifier, matchspec, domain, inst_list, default_)) 2742 (specifier, matchspec, domain, inst_list, default_))
2738 { 2743 {
2739 Lisp_Object val = Qunbound; 2744 Lisp_Object val = Qunbound;
2740 struct Lisp_Specifier *sp = XSPECIFIER (specifier); 2745 Lisp_Specifier *sp = XSPECIFIER (specifier);
2741 struct gcpro gcpro1; 2746 struct gcpro gcpro1;
2742 Lisp_Object built_up_list = Qnil; 2747 Lisp_Object built_up_list = Qnil;
2743 2748
2744 CHECK_SPECIFIER (specifier); 2749 CHECK_SPECIFIER (specifier);
2745 check_valid_specifier_matchspec (matchspec, XSPECIFIER (specifier)->methods, 2750 check_valid_specifier_matchspec (matchspec, XSPECIFIER (specifier)->methods,
2775 int struct_frame_offset, 2780 int struct_frame_offset,
2776 void (*value_changed_in_frame) 2781 void (*value_changed_in_frame)
2777 (Lisp_Object specifier, struct frame *f, 2782 (Lisp_Object specifier, struct frame *f,
2778 Lisp_Object oldval)) 2783 Lisp_Object oldval))
2779 { 2784 {
2780 struct Lisp_Specifier *sp = XSPECIFIER (specifier); 2785 Lisp_Specifier *sp = XSPECIFIER (specifier);
2781 assert (!GHOST_SPECIFIER_P (sp)); 2786 assert (!GHOST_SPECIFIER_P (sp));
2782 2787
2783 if (!sp->caching) 2788 if (!sp->caching)
2784 sp->caching = xnew_and_zero (struct specifier_caching); 2789 sp->caching = xnew_and_zero (struct specifier_caching);
2785 sp->caching->offset_into_struct_window = struct_window_offset; 2790 sp->caching->offset_into_struct_window = struct_window_offset;