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