Mercurial > hg > xemacs-beta
comparison src/specifier.c @ 380:8626e4521993 r21-2-5
Import from CVS: tag r21-2-5
author | cvs |
---|---|
date | Mon, 13 Aug 2007 11:07:10 +0200 |
parents | cc15677e0335 |
children | bbff43aa5eb7 |
comparison
equal
deleted
inserted
replaced
379:76b7d63099ad | 380:8626e4521993 |
---|---|
181 static Lisp_Object | 181 static Lisp_Object |
182 mark_specifier (Lisp_Object obj, void (*markobj) (Lisp_Object)) | 182 mark_specifier (Lisp_Object obj, void (*markobj) (Lisp_Object)) |
183 { | 183 { |
184 struct Lisp_Specifier *specifier = XSPECIFIER (obj); | 184 struct Lisp_Specifier *specifier = XSPECIFIER (obj); |
185 | 185 |
186 ((markobj) (specifier->global_specs)); | 186 markobj (specifier->global_specs); |
187 ((markobj) (specifier->device_specs)); | 187 markobj (specifier->device_specs); |
188 ((markobj) (specifier->frame_specs)); | 188 markobj (specifier->frame_specs); |
189 ((markobj) (specifier->window_specs)); | 189 markobj (specifier->window_specs); |
190 ((markobj) (specifier->buffer_specs)); | 190 markobj (specifier->buffer_specs); |
191 ((markobj) (specifier->magic_parent)); | 191 markobj (specifier->magic_parent); |
192 ((markobj) (specifier->fallback)); | 192 markobj (specifier->fallback); |
193 if (!GHOST_SPECIFIER_P (XSPECIFIER (obj))) | 193 if (!GHOST_SPECIFIER_P (XSPECIFIER (obj))) |
194 MAYBE_SPECMETH (specifier, mark, (obj, markobj)); | 194 MAYBE_SPECMETH (specifier, mark, (obj, markobj)); |
195 return Qnil; | 195 return Qnil; |
196 } | 196 } |
197 | 197 |
221 | 221 |
222 for (rest = Vall_specifiers; | 222 for (rest = Vall_specifiers; |
223 !GC_NILP (rest); | 223 !GC_NILP (rest); |
224 rest = XSPECIFIER (rest)->next_specifier) | 224 rest = XSPECIFIER (rest)->next_specifier) |
225 { | 225 { |
226 if (! ((*obj_marked_p) (rest))) | 226 if (! obj_marked_p (rest)) |
227 { | 227 { |
228 struct Lisp_Specifier* sp = XSPECIFIER (rest); | 228 struct Lisp_Specifier* sp = XSPECIFIER (rest); |
229 /* A bit of assertion that we're removing both parts of the | 229 /* A bit of assertion that we're removing both parts of the |
230 magic one altogether */ | 230 magic one altogether */ |
231 assert (!GC_MAGIC_SPECIFIER_P(sp) | 231 assert (!GC_MAGIC_SPECIFIER_P(sp) |
232 || (GC_BODILY_SPECIFIER_P(sp) && (*obj_marked_p)(sp->fallback)) | 232 || (GC_BODILY_SPECIFIER_P(sp) && obj_marked_p (sp->fallback)) |
233 || (GC_GHOST_SPECIFIER_P(sp) && (*obj_marked_p)(sp->magic_parent))); | 233 || (GC_GHOST_SPECIFIER_P(sp) && obj_marked_p (sp->magic_parent))); |
234 /* This specifier is garbage. Remove it from the list. */ | 234 /* This specifier is garbage. Remove it from the list. */ |
235 if (GC_NILP (prev)) | 235 if (GC_NILP (prev)) |
236 Vall_specifiers = sp->next_specifier; | 236 Vall_specifiers = sp->next_specifier; |
237 else | 237 else |
238 XSPECIFIER (prev)->next_specifier = sp->next_specifier; | 238 XSPECIFIER (prev)->next_specifier = sp->next_specifier; |
285 sp->caching = 0; | 285 sp->caching = 0; |
286 } | 286 } |
287 } | 287 } |
288 | 288 |
289 static int | 289 static int |
290 specifier_equal (Lisp_Object o1, Lisp_Object o2, int depth) | 290 specifier_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) |
291 { | 291 { |
292 struct Lisp_Specifier *s1 = XSPECIFIER (o1); | 292 struct Lisp_Specifier *s1 = XSPECIFIER (obj1); |
293 struct Lisp_Specifier *s2 = XSPECIFIER (o2); | 293 struct Lisp_Specifier *s2 = XSPECIFIER (obj2); |
294 int retval; | 294 int retval; |
295 Lisp_Object old_inhibit_quit = Vinhibit_quit; | 295 Lisp_Object old_inhibit_quit = Vinhibit_quit; |
296 | 296 |
297 /* This function can be called from within redisplay. | 297 /* This function can be called from within redisplay. |
298 internal_equal can trigger a quit. That leads to Bad Things. */ | 298 internal_equal can trigger a quit. That leads to Bad Things. */ |
307 internal_equal (s1->window_specs, s2->window_specs, depth) && | 307 internal_equal (s1->window_specs, s2->window_specs, depth) && |
308 internal_equal (s1->buffer_specs, s2->buffer_specs, depth) && | 308 internal_equal (s1->buffer_specs, s2->buffer_specs, depth) && |
309 internal_equal (s1->fallback, s2->fallback, depth)); | 309 internal_equal (s1->fallback, s2->fallback, depth)); |
310 | 310 |
311 if (retval && HAS_SPECMETH_P (s1, equal)) | 311 if (retval && HAS_SPECMETH_P (s1, equal)) |
312 retval = SPECMETH (s1, equal, (o1, o2, depth - 1)); | 312 retval = SPECMETH (s1, equal, (obj1, obj2, depth - 1)); |
313 | 313 |
314 Vinhibit_quit = old_inhibit_quit; | 314 Vinhibit_quit = old_inhibit_quit; |
315 return retval; | 315 return retval; |
316 } | 316 } |
317 | 317 |
635 decode_locale_list (Lisp_Object locale) | 635 decode_locale_list (Lisp_Object locale) |
636 { | 636 { |
637 /* This cannot GC. */ | 637 /* This cannot GC. */ |
638 /* The return value of this function must be GCPRO'd. */ | 638 /* The return value of this function must be GCPRO'd. */ |
639 if (NILP (locale)) | 639 if (NILP (locale)) |
640 locale = list1 (Qall); | 640 { |
641 return list1 (Qall); | |
642 } | |
643 else if (CONSP (locale)) | |
644 { | |
645 Lisp_Object elt; | |
646 EXTERNAL_LIST_LOOP_2 (elt, locale) | |
647 check_valid_locale_or_locale_type (elt); | |
648 return locale; | |
649 } | |
641 else | 650 else |
642 { | 651 { |
643 Lisp_Object rest; | 652 check_valid_locale_or_locale_type (locale); |
644 if (!CONSP (locale)) | 653 return list1 (locale); |
645 locale = list1 (locale); | 654 } |
646 EXTERNAL_LIST_LOOP (rest, locale) | |
647 check_valid_locale_or_locale_type (XCAR (rest)); | |
648 } | |
649 return locale; | |
650 } | 655 } |
651 | 656 |
652 static enum spec_locale_type | 657 static enum spec_locale_type |
653 locale_type_from_locale (Lisp_Object locale) | 658 locale_type_from_locale (Lisp_Object locale) |
654 { | 659 { |
1844 Lisp_Object inst_list; | 1849 Lisp_Object inst_list; |
1845 struct gcpro gcpro1; | 1850 struct gcpro gcpro1; |
1846 | 1851 |
1847 CHECK_SPECIFIER (specifier); | 1852 CHECK_SPECIFIER (specifier); |
1848 check_modifiable_specifier (specifier); | 1853 check_modifiable_specifier (specifier); |
1849 | 1854 |
1850 locale = decode_locale (locale); | 1855 locale = decode_locale (locale); |
1851 check_valid_instantiator (instantiator, | 1856 check_valid_instantiator (instantiator, |
1852 decode_specifier_type | 1857 decode_specifier_type |
1853 (Fspecifier_type (specifier), ERROR_ME), | 1858 (Fspecifier_type (specifier), ERROR_ME), |
1854 ERROR_ME); | 1859 ERROR_ME); |
2403 /* Given a SPECIFIER and a DOMAIN, return a specific instance for that | 2408 /* Given a SPECIFIER and a DOMAIN, return a specific instance for that |
2404 specifier. Try to find one by checking the specifier types from most | 2409 specifier. Try to find one by checking the specifier types from most |
2405 specific (buffer) to most general (global). If we find an instance, | 2410 specific (buffer) to most general (global). If we find an instance, |
2406 return it. Otherwise return Qunbound. */ | 2411 return it. Otherwise return Qunbound. */ |
2407 | 2412 |
2408 #define CHECK_INSTANCE_ENTRY(key, matchspec, type) \ | 2413 #define CHECK_INSTANCE_ENTRY(key, matchspec, type) do { \ |
2409 do { \ | 2414 Lisp_Object *CIE_inst_list = \ |
2410 Lisp_Object *__inst_list = \ | |
2411 specifier_get_inst_list (specifier, key, type); \ | 2415 specifier_get_inst_list (specifier, key, type); \ |
2412 if (__inst_list) \ | 2416 if (CIE_inst_list) \ |
2413 { \ | 2417 { \ |
2414 Lisp_Object __val__ = \ | 2418 Lisp_Object CIE_val = \ |
2415 specifier_instance_from_inst_list (specifier, matchspec, \ | 2419 specifier_instance_from_inst_list (specifier, matchspec, \ |
2416 domain, *__inst_list, \ | 2420 domain, *CIE_inst_list, \ |
2417 errb, no_quit, depth); \ | 2421 errb, no_quit, depth); \ |
2418 if (!UNBOUNDP (__val__)) \ | 2422 if (!UNBOUNDP (CIE_val)) \ |
2419 return __val__; \ | 2423 return CIE_val; \ |
2420 } \ | 2424 } \ |
2421 } while (0) | 2425 } while (0) |
2422 | 2426 |
2423 /* We accept any window, frame or device domain and do our checking | 2427 /* We accept any window, frame or device domain and do our checking |
2424 starting from as specific a locale type as we can determine from the | 2428 starting from as specific a locale type as we can determine from the |
2478 from Lisp). */ | 2482 from Lisp). */ |
2479 depth = Qzero; | 2483 depth = Qzero; |
2480 goto do_fallback; | 2484 goto do_fallback; |
2481 } | 2485 } |
2482 | 2486 |
2483 try_again: | 2487 retry: |
2484 /* First see if we can generate one from the window specifiers. */ | 2488 /* First see if we can generate one from the window specifiers. */ |
2485 if (!NILP (window)) | 2489 if (!NILP (window)) |
2486 CHECK_INSTANCE_ENTRY (window, matchspec, LOCALE_WINDOW); | 2490 CHECK_INSTANCE_ENTRY (window, matchspec, LOCALE_WINDOW); |
2487 | 2491 |
2488 /* Next see if we can generate one from the buffer specifiers. */ | 2492 /* Next see if we can generate one from the buffer specifiers. */ |
2512 { | 2516 { |
2513 /* If you introduced loops in the default specifier chain, | 2517 /* If you introduced loops in the default specifier chain, |
2514 then you're fucked, so you better not do this. */ | 2518 then you're fucked, so you better not do this. */ |
2515 specifier = sp->fallback; | 2519 specifier = sp->fallback; |
2516 sp = XSPECIFIER (specifier); | 2520 sp = XSPECIFIER (specifier); |
2517 goto try_again; | 2521 goto retry; |
2518 } | 2522 } |
2519 | 2523 |
2520 assert (CONSP (sp->fallback)); | 2524 assert (CONSP (sp->fallback)); |
2521 return specifier_instance_from_inst_list (specifier, matchspec, domain, | 2525 return specifier_instance_from_inst_list (specifier, matchspec, domain, |
2522 sp->fallback, errb, no_quit, | 2526 sp->fallback, errb, no_quit, |
3124 { | 3128 { |
3125 Vcached_specifiers = Qnil; | 3129 Vcached_specifiers = Qnil; |
3126 staticpro (&Vcached_specifiers); | 3130 staticpro (&Vcached_specifiers); |
3127 | 3131 |
3128 /* Do NOT mark through this, or specifiers will never be GC'd. | 3132 /* Do NOT mark through this, or specifiers will never be GC'd. |
3129 This is the same deal as for weak hashtables. */ | 3133 This is the same deal as for weak hash tables. */ |
3130 Vall_specifiers = Qnil; | 3134 Vall_specifiers = Qnil; |
3131 | 3135 |
3132 Vuser_defined_tags = Qnil; | 3136 Vuser_defined_tags = Qnil; |
3133 staticpro (&Vuser_defined_tags); | 3137 staticpro (&Vuser_defined_tags); |
3134 | 3138 |