Mercurial > hg > xemacs-beta

comparison src/specifier.c @ 276:6330739388db r21-0b36

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-0b36
author cvs
date Mon, 13 Aug 2007 10:30:37 +0200
parents c5d627a313b1
children 7df0dd720c89
comparison
equal deleted inserted replaced
275:a68ae4439f57 276:6330739388db
45 /* Qinteger, Qboolean, Qgeneric defined in general.c. */ 45 /* Qinteger, Qboolean, Qgeneric defined in general.c. */
46 Lisp_Object Qnatnum; 46 Lisp_Object Qnatnum;
47 47
48 Lisp_Object Qconsole_type, Qdevice_class; 48 Lisp_Object Qconsole_type, Qdevice_class;
49 49
50 Lisp_Object Vuser_defined_tags; 50 static Lisp_Object Vuser_defined_tags;
51 51
52 typedef struct specifier_type_entry specifier_type_entry; 52 typedef struct specifier_type_entry specifier_type_entry;
53 struct specifier_type_entry 53 struct specifier_type_entry
54 { 54 {
55 Lisp_Object symbol; 55 Lisp_Object symbol;
61 Dynarr_declare (specifier_type_entry); 61 Dynarr_declare (specifier_type_entry);
62 } specifier_type_entry_dynarr; 62 } specifier_type_entry_dynarr;
63 63
64 specifier_type_entry_dynarr *the_specifier_type_entry_dynarr; 64 specifier_type_entry_dynarr *the_specifier_type_entry_dynarr;
65 65
66 Lisp_Object Vspecifier_type_list; 66 static Lisp_Object Vspecifier_type_list;
67 67
68 Lisp_Object Vcached_specifiers; 68 static Lisp_Object Vcached_specifiers;
69 /* Do NOT mark through this, or specifiers will never be GC'd. */ 69 /* Do NOT mark through this, or specifiers will never be GC'd. */
70 Lisp_Object Vall_specifiers; 70 static Lisp_Object Vall_specifiers;
71
72 static Lisp_Object Vreveal_ghoste_specifiers;
71 73
72 /* #### The purpose of this is to check for inheritance loops 74 /* #### The purpose of this is to check for inheritance loops
73 in specifiers that can inherit from other specifiers, but it's 75 in specifiers that can inherit from other specifiers, but it's
74 not yet implemented. 76 not yet implemented.
75 77
76 #### Look into this for 19.14. */ 78 #### Look into this for 19.14. */
77 Lisp_Object_dynarr current_specifiers; 79 static Lisp_Object_dynarr current_specifiers;
78 80
79 static void recompute_cached_specifier_everywhere (Lisp_Object specifier); 81 static void recompute_cached_specifier_everywhere (Lisp_Object specifier);
80 82
81 EXFUN (Fspecifier_specs, 4); 83 EXFUN (Fspecifier_specs, 4);
82 EXFUN (Fremove_specifier, 4); 84 EXFUN (Fremove_specifier, 4);
182 ((markobj) (specifier->global_specs)); 184 ((markobj) (specifier->global_specs));
183 ((markobj) (specifier->device_specs)); 185 ((markobj) (specifier->device_specs));
184 ((markobj) (specifier->frame_specs)); 186 ((markobj) (specifier->frame_specs));
185 ((markobj) (specifier->window_specs)); 187 ((markobj) (specifier->window_specs));
186 ((markobj) (specifier->buffer_specs)); 188 ((markobj) (specifier->buffer_specs));
189 ((markobj) (specifier->magic_parent));
187 ((markobj) (specifier->fallback)); 190 ((markobj) (specifier->fallback));
188 MAYBE_SPECMETH (specifier, mark, (obj, markobj)); 191 if (!GHOST_SPECIFIER_P (XSPECIFIER (obj)))
192 MAYBE_SPECMETH (specifier, mark, (obj, markobj));
189 return Qnil; 193 return Qnil;
190 } 194 }
191 195
192 /* The idea here is that the specifier specs point to locales 196 /* The idea here is that the specifier specs point to locales
193 (windows, buffers, frames, and devices), and we want to make sure 197 (windows, buffers, frames, and devices), and we want to make sure
217 !GC_NILP (rest); 221 !GC_NILP (rest);
218 rest = XSPECIFIER (rest)->next_specifier) 222 rest = XSPECIFIER (rest)->next_specifier)
219 { 223 {
220 if (! ((*obj_marked_p) (rest))) 224 if (! ((*obj_marked_p) (rest)))
221 { 225 {
226 struct Lisp_Specifier* sp = XSPECIFIER (rest);
227 /* A bit of assertion that we're removing both parts of the
228 magic one altogether */
229 assert (!GC_MAGIC_SPECIFIER_P(sp)
230 || (GC_BODILY_SPECIFIER_P(sp) && (*obj_marked_p)(sp->fallback))
231 || (GC_GHOST_SPECIFIER_P(sp) && (*obj_marked_p)(sp->magic_parent)));
222 /* This specifier is garbage. Remove it from the list. */ 232 /* This specifier is garbage. Remove it from the list. */
223 if (GC_NILP (prev)) 233 if (GC_NILP (prev))
224 Vall_specifiers = XSPECIFIER (rest)->next_specifier; 234 Vall_specifiers = sp->next_specifier;
225 else 235 else
226 XSPECIFIER (prev)->next_specifier = 236 XSPECIFIER (prev)->next_specifier = sp->next_specifier;
227 XSPECIFIER (rest)->next_specifier;
228 } 237 }
238 else
239 prev = rest;
229 } 240 }
230 } 241 }
231 242
232 static void 243 static void
233 print_specifier (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) 244 print_specifier (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
264 static void 275 static void
265 finalize_specifier (void *header, int for_disksave) 276 finalize_specifier (void *header, int for_disksave)
266 { 277 {
267 struct Lisp_Specifier *sp = (struct Lisp_Specifier *) header; 278 struct Lisp_Specifier *sp = (struct Lisp_Specifier *) header;
268 /* don't be snafued by the disksave finalization. */ 279 /* don't be snafued by the disksave finalization. */
269 if (!for_disksave && sp->caching) 280 if (!for_disksave && !GC_GHOST_SPECIFIER_P(sp) && sp->caching)
270 { 281 {
271 xfree (sp->caching); 282 xfree (sp->caching);
272 sp->caching = 0; 283 sp->caching = 0;
273 } 284 }
274 } 285 }
291 internal_equal (s1->global_specs, s2->global_specs, depth) && 302 internal_equal (s1->global_specs, s2->global_specs, depth) &&
292 internal_equal (s1->device_specs, s2->device_specs, depth) && 303 internal_equal (s1->device_specs, s2->device_specs, depth) &&
293 internal_equal (s1->frame_specs, s2->frame_specs, depth) && 304 internal_equal (s1->frame_specs, s2->frame_specs, depth) &&
294 internal_equal (s1->window_specs, s2->window_specs, depth) && 305 internal_equal (s1->window_specs, s2->window_specs, depth) &&
295 internal_equal (s1->buffer_specs, s2->buffer_specs, depth)); 306 internal_equal (s1->buffer_specs, s2->buffer_specs, depth));
307 /* #### Why do not compare fallbacks here? */
296 308
297 if (retval && HAS_SPECMETH_P (s1, equal)) 309 if (retval && HAS_SPECMETH_P (s1, equal))
298 retval = SPECMETH (s1, equal, (o1, o2, depth - 1)); 310 retval = SPECMETH (s1, equal, (o1, o2, depth - 1));
299 311
300 Vinhibit_quit = old_inhibit_quit; 312 Vinhibit_quit = old_inhibit_quit;
318 } 330 }
319 331
320 static size_t 332 static size_t
321 sizeof_specifier (CONST void *header) 333 sizeof_specifier (CONST void *header)
322 { 334 {
323 CONST struct Lisp_Specifier *p = (CONST struct Lisp_Specifier *) header; 335 if (GHOST_SPECIFIER_P ((struct Lisp_Specifier *) header))
324 return sizeof (*p) + p->methods->extra_data_size - 1; 336 return sizeof (struct Lisp_Specifier);
337 else
338 {
339 CONST struct Lisp_Specifier *p = (CONST struct Lisp_Specifier *) header;
340 return sizeof (*p) + p->methods->extra_data_size - 1;
341 }
325 } 342 }
326 343
327 DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("specifier", specifier, 344 DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("specifier", specifier,
328 mark_specifier, print_specifier, 345 mark_specifier, print_specifier,
329 finalize_specifier, 346 finalize_specifier,
387 Dynarr_add (the_specifier_type_entry_dynarr, entry); 404 Dynarr_add (the_specifier_type_entry_dynarr, entry);
388 Vspecifier_type_list = Fcons (symbol, Vspecifier_type_list); 405 Vspecifier_type_list = Fcons (symbol, Vspecifier_type_list);
389 } 406 }
390 407
391 static Lisp_Object 408 static Lisp_Object
392 make_specifier (struct specifier_methods *spec_meths) 409 make_specifier_internal (struct specifier_methods *spec_meths,
410 size_t data_size, int call_create_meth)
393 { 411 {
394 Lisp_Object specifier; 412 Lisp_Object specifier;
395 struct gcpro gcpro1;
396 struct Lisp_Specifier *sp = (struct Lisp_Specifier *) 413 struct Lisp_Specifier *sp = (struct Lisp_Specifier *)
397 alloc_lcrecord (sizeof (struct Lisp_Specifier) + 414 alloc_lcrecord (sizeof (struct Lisp_Specifier) +
398 spec_meths->extra_data_size - 1, lrecord_specifier); 415 data_size - 1, lrecord_specifier);
399 416
400 sp->methods = spec_meths; 417 sp->methods = spec_meths;
401 sp->global_specs = Qnil; 418 sp->global_specs = Qnil;
402 sp->device_specs = Qnil; 419 sp->device_specs = Qnil;
403 sp->frame_specs = Qnil; 420 sp->frame_specs = Qnil;
404 sp->window_specs = make_weak_list (WEAK_LIST_KEY_ASSOC); 421 sp->window_specs = make_weak_list (WEAK_LIST_KEY_ASSOC);
405 sp->buffer_specs = Qnil; 422 sp->buffer_specs = Qnil;
406 sp->fallback = Qnil; 423 sp->fallback = Qnil;
424 sp->magic_parent = Qnil;
407 sp->caching = 0; 425 sp->caching = 0;
408 sp->next_specifier = Vall_specifiers; 426 sp->next_specifier = Vall_specifiers;
409 427
410 XSETSPECIFIER (specifier, sp); 428 XSETSPECIFIER (specifier, sp);
411 Vall_specifiers = specifier; 429 Vall_specifiers = specifier;
412 430
413 GCPRO1 (specifier); 431 if (call_create_meth)
414 MAYBE_SPECMETH (XSPECIFIER (specifier), create, (specifier)); 432 {
433 struct gcpro gcpro1;
434 GCPRO1 (specifier);
435 MAYBE_SPECMETH (XSPECIFIER (specifier), create, (specifier));
436 UNGCPRO;
437 }
438 return specifier;
439 }
440
441 static Lisp_Object
442 make_specifier (struct specifier_methods *meths)
443 {
444 return make_specifier_internal (meths, meths->extra_data_size, 1);
445 }
446
447 Lisp_Object
448 make_magic_specifier (Lisp_Object type)
449 {
450 /* This function can GC */
451 struct specifier_methods *meths = decode_specifier_type (type, ERROR_ME);
452 Lisp_Object bodily, ghost;
453 struct gcpro gcpro1;
454
455 bodily = make_specifier (meths);
456 GCPRO1 (bodily);
457 ghost = make_specifier_internal (meths, 0, 0);
415 UNGCPRO; 458 UNGCPRO;
416 return specifier; 459
460 /* Connect guys together */
461 XSPECIFIER(bodily)->magic_parent = Qt;
462 XSPECIFIER(bodily)->fallback = ghost;
463 XSPECIFIER(ghost)->magic_parent = bodily;
464
465 return bodily;
417 } 466 }
418 467
419 DEFUN ("make-specifier", Fmake_specifier, 1, 1, 0, /* 468 DEFUN ("make-specifier", Fmake_specifier, 1, 1, 0, /*
420 Return a new specifier object of type TYPE. 469 Return a new specifier object of type TYPE.
421 470
1186 signal_simple_error ("Invalid `how-to-add' flag", how_to_add); 1235 signal_simple_error ("Invalid `how-to-add' flag", how_to_add);
1187 1236
1188 return SPEC_PREPEND; /* not reached */ 1237 return SPEC_PREPEND; /* not reached */
1189 } 1238 }
1190 1239
1240 /* Given a specifier object SPEC, return its bodily specifier for a
1241 ghost specifier, otherwise return the object itself
1242 */
1243 static Lisp_Object
1244 bodily_specifier (Lisp_Object spec)
1245 {
1246 return (GHOST_SPECIFIER_P (XSPECIFIER (spec))
1247 ? XSPECIFIER(spec)->magic_parent : spec);
1248 }
1249
1250 /* Given a specifier object SPEC, return a specifier to be operated on
1251 by external lisp function. This is a ghost specifier for a magic
1252 specifier when and only when Vreveal_ghoste_specifiers is non-nil,
1253 otherwise SPEC itself.
1254 */
1255 static Lisp_Object
1256 maybe_ghost_specifier (Lisp_Object spec)
1257 {
1258 return (!NILP (Vreveal_ghoste_specifiers)
1259 && BODILY_SPECIFIER_P (XSPECIFIER (spec))
1260 ? XSPECIFIER(spec)->fallback : spec);
1261 }
1262
1263 /* Helper function which unwind protects the value of
1264 Vreveal_ghoste_specifiers, then sets it to non-nil value */
1265
1266 static Lisp_Object
1267 restore_reveal_value (Lisp_Object val)
1268 {
1269 Vreveal_ghoste_specifiers = val;
1270 return val;
1271 }
1272
1273 int
1274 reveal_ghost_specifiers_protected (void)
1275 {
1276 int depth = specpdl_depth ();
1277 record_unwind_protect (restore_reveal_value,
1278 Vreveal_ghoste_specifiers);
1279 Vreveal_ghoste_specifiers = Qt;
1280 return depth;
1281 }
1282
1191 /* This gets hit so much that the function call overhead had a 1283 /* This gets hit so much that the function call overhead had a
1192 measurable impact (according to Quantify). #### We should figure 1284 measurable impact (according to Quantify). #### We should figure
1193 out the frequency with which this is called with the various types 1285 out the frequency with which this is called with the various types
1194 and reorder the check accordingly. */ 1286 and reorder the check accordingly. */
1195 #define SPECIFIER_GET_SPEC_LIST(specifier, type) \ 1287 #define SPECIFIER_GET_SPEC_LIST(specifier, type) \
1380 /* no inst-pairs left; remove this locale entirely. */ 1472 /* no inst-pairs left; remove this locale entirely. */
1381 *spec_list = remassq_no_quit (locale, *spec_list); 1473 *spec_list = remassq_no_quit (locale, *spec_list);
1382 } 1474 }
1383 1475
1384 if (was_removed) 1476 if (was_removed)
1385 MAYBE_SPECMETH (XSPECIFIER (specifier), after_change, (specifier, locale)); 1477 MAYBE_SPECMETH (XSPECIFIER (specifier), after_change,
1478 (bodily_specifier (specifier), locale));
1386 } 1479 }
1387 1480
1388 static void 1481 static void
1389 specifier_remove_locale_type (Lisp_Object specifier, 1482 specifier_remove_locale_type (Lisp_Object specifier,
1390 enum spec_locale_type type, 1483 enum spec_locale_type type,
1426 else 1519 else
1427 prev = rest; 1520 prev = rest;
1428 1521
1429 if (was_removed) 1522 if (was_removed)
1430 MAYBE_SPECMETH (XSPECIFIER (specifier), after_change, 1523 MAYBE_SPECMETH (XSPECIFIER (specifier), after_change,
1431 (specifier, XCAR (spec))); 1524 (bodily_specifier (specifier), XCAR (spec)));
1432 } 1525 }
1433 } 1526 }
1434 1527
1435 /* NEW_LIST is going to be added to INST_LIST, with add method ADD_METH. 1528 /* NEW_LIST is going to be added to INST_LIST, with add method ADD_METH.
1436 Frob INST_LIST according to ADD_METH. No need to call an after-change 1529 Frob INST_LIST according to ADD_METH. No need to call an after-change
1500 1593
1501 NGCPRO2 (instantiator, sub_inst_list); 1594 NGCPRO2 (instantiator, sub_inst_list);
1502 /* call the will-add method; it may GC */ 1595 /* call the will-add method; it may GC */
1503 sub_inst_list = HAS_SPECMETH_P (sp, going_to_add) ? 1596 sub_inst_list = HAS_SPECMETH_P (sp, going_to_add) ?
1504 SPECMETH (sp, going_to_add, 1597 SPECMETH (sp, going_to_add,
1505 (specifier, locale, tag_set, instantiator)) : 1598 (bodily_specifier (specifier), locale,
1599 tag_set, instantiator)) :
1506 Qt; 1600 Qt;
1507 if (EQ (sub_inst_list, Qt)) 1601 if (EQ (sub_inst_list, Qt))
1508 /* no change here. */ 1602 /* no change here. */
1509 sub_inst_list = list1 (Fcons (canonicalize_tag_set (tag_set), 1603 sub_inst_list = list1 (Fcons (canonicalize_tag_set (tag_set),
1510 instantiator)); 1604 instantiator));
1574 *orig_inst_list = tem; 1668 *orig_inst_list = tem;
1575 1669
1576 UNGCPRO; 1670 UNGCPRO;
1577 1671
1578 /* call the after-change method */ 1672 /* call the after-change method */
1579 MAYBE_SPECMETH (sp, after_change, (specifier, locale)); 1673 MAYBE_SPECMETH (sp, after_change,
1674 (bodily_specifier (specifier), locale));
1580 } 1675 }
1581 1676
1582 static void 1677 static void
1583 specifier_copy_spec (Lisp_Object specifier, Lisp_Object dest, 1678 specifier_copy_spec (Lisp_Object specifier, Lisp_Object dest,
1584 Lisp_Object locale, enum spec_locale_type type, 1679 Lisp_Object locale, enum spec_locale_type type,
1759 tag_set = decode_specifier_tag_set (tag_set); 1854 tag_set = decode_specifier_tag_set (tag_set);
1760 add_meth = decode_how_to_add_specification (how_to_add); 1855 add_meth = decode_how_to_add_specification (how_to_add);
1761 1856
1762 inst_list = list1 (Fcons (tag_set, instantiator)); 1857 inst_list = list1 (Fcons (tag_set, instantiator));
1763 GCPRO1 (inst_list); 1858 GCPRO1 (inst_list);
1764 specifier_add_spec (specifier, locale, inst_list, add_meth); 1859 specifier_add_spec (maybe_ghost_specifier (specifier),
1860 locale, inst_list, add_meth);
1765 recompute_cached_specifier_everywhere (specifier); 1861 recompute_cached_specifier_everywhere (specifier);
1766 RETURN_UNGCPRO (Qnil); 1862 RETURN_UNGCPRO (Qnil);
1767 } 1863 }
1768 1864
1769 DEFUN ("add-spec-list-to-specifier", Fadd_spec_list_to_specifier, 2, 3, 0, /* 1865 DEFUN ("add-spec-list-to-specifier", Fadd_spec_list_to_specifier, 2, 3, 0, /*
1810 /* Placating the GCC god. */ 1906 /* Placating the GCC god. */
1811 Lisp_Object specification = XCAR (rest); 1907 Lisp_Object specification = XCAR (rest);
1812 Lisp_Object locale = XCAR (specification); 1908 Lisp_Object locale = XCAR (specification);
1813 Lisp_Object inst_list = XCDR (specification); 1909 Lisp_Object inst_list = XCDR (specification);
1814 1910
1815 specifier_add_spec (specifier, locale, inst_list, add_meth); 1911 specifier_add_spec (maybe_ghost_specifier (specifier),
1912 locale, inst_list, add_meth);
1816 } 1913 }
1817 recompute_cached_specifier_everywhere (specifier); 1914 recompute_cached_specifier_everywhere (specifier);
1818 return Qnil; 1915 return Qnil;
1916 }
1917
1918 void
1919 add_spec_to_ghost_specifier (Lisp_Object specifier, Lisp_Object instantiator,
1920 Lisp_Object locale, Lisp_Object tag_set,
1921 Lisp_Object how_to_add)
1922 {
1923 int depth = reveal_ghost_specifiers_protected ();
1924 Fadd_spec_to_specifier (specifier, instantiator, locale,
1925 tag_set, how_to_add);
1926 unbind_to (depth, Qnil);
1819 } 1927 }
1820 1928
1821 struct specifier_spec_list_closure 1929 struct specifier_spec_list_closure
1822 { 1930 {
1823 Lisp_Object head, tail; 1931 Lisp_Object head, tail;
1903 struct gcpro gcpro1, gcpro2; 2011 struct gcpro gcpro1, gcpro2;
1904 2012
1905 CHECK_SPECIFIER (specifier); 2013 CHECK_SPECIFIER (specifier);
1906 cl.head = cl.tail = Qnil; 2014 cl.head = cl.tail = Qnil;
1907 GCPRO2 (cl.head, cl.tail); 2015 GCPRO2 (cl.head, cl.tail);
1908 map_specifier (specifier, locale, specifier_spec_list_mapfun, 2016 map_specifier (maybe_ghost_specifier (specifier),
2017 locale, specifier_spec_list_mapfun,
1909 tag_set, exact_p, &cl); 2018 tag_set, exact_p, &cl);
1910 UNGCPRO; 2019 UNGCPRO;
1911 return cl.head; 2020 return cl.head;
1912 } 2021 }
1913 2022
1947 locale = XCAR (locale); 2056 locale = XCAR (locale);
1948 GCPRO1 (tag_set); 2057 GCPRO1 (tag_set);
1949 tag_set = decode_specifier_tag_set (tag_set); 2058 tag_set = decode_specifier_tag_set (tag_set);
1950 tag_set = canonicalize_tag_set (tag_set); 2059 tag_set = canonicalize_tag_set (tag_set);
1951 RETURN_UNGCPRO 2060 RETURN_UNGCPRO
1952 (specifier_get_external_inst_list (specifier, locale, 2061 (specifier_get_external_inst_list (maybe_ghost_specifier (specifier),
2062 locale,
1953 locale_type_from_locale (locale), 2063 locale_type_from_locale (locale),
1954 tag_set, !NILP (exact_p), 2064 tag_set, !NILP (exact_p),
1955 1, 1)); 2065 1, 1));
1956 } 2066 }
1957 else 2067 else
1997 to be removed. 2107 to be removed.
1998 */ 2108 */
1999 (specifier, locale, tag_set, exact_p)) 2109 (specifier, locale, tag_set, exact_p))
2000 { 2110 {
2001 CHECK_SPECIFIER (specifier); 2111 CHECK_SPECIFIER (specifier);
2002 map_specifier (specifier, locale, remove_specifier_mapfun, tag_set, 2112 map_specifier (maybe_ghost_specifier (specifier), locale,
2003 exact_p, 0); 2113 remove_specifier_mapfun, tag_set, exact_p, 0);
2004 recompute_cached_specifier_everywhere (specifier); 2114 recompute_cached_specifier_everywhere (specifier);
2005 return Qnil; 2115 return Qnil;
2116 }
2117
2118 void
2119 remove_ghost_specifier (Lisp_Object specifier, Lisp_Object locale,
2120 Lisp_Object tag_set, Lisp_Object exact_p)
2121 {
2122 int depth = reveal_ghost_specifiers_protected ();
2123 Fremove_specifier (specifier, locale, tag_set, exact_p);
2124 unbind_to (depth, Qnil);
2006 } 2125 }
2007 2126
2008 struct copy_specifier_closure 2127 struct copy_specifier_closure
2009 { 2128 {
2010 Lisp_Object dest; 2129 Lisp_Object dest;
2087 error ("Specifiers not of same type"); 2206 error ("Specifiers not of same type");
2088 } 2207 }
2089 2208
2090 cl.dest = dest; 2209 cl.dest = dest;
2091 GCPRO1 (dest); 2210 GCPRO1 (dest);
2092 map_specifier (specifier, locale, copy_specifier_mapfun, 2211 map_specifier (maybe_ghost_specifier (specifier), locale,
2093 tag_set, exact_p, &cl); 2212 copy_specifier_mapfun, tag_set, exact_p, &cl);
2094 UNGCPRO; 2213 UNGCPRO;
2095 recompute_cached_specifier_everywhere (specifier); 2214 recompute_cached_specifier_everywhere (dest);
2096 return dest; 2215 return dest;
2097 } 2216 }
2098 2217
2099 2218
2100 /************************************************************************/ 2219 /************************************************************************/
2183 struct Lisp_Specifier *sp = XSPECIFIER (specifier); 2302 struct Lisp_Specifier *sp = XSPECIFIER (specifier);
2184 assert (SPECIFIERP (fallback) || 2303 assert (SPECIFIERP (fallback) ||
2185 !NILP (Fvalid_inst_list_p (fallback, Fspecifier_type (specifier)))); 2304 !NILP (Fvalid_inst_list_p (fallback, Fspecifier_type (specifier))));
2186 if (SPECIFIERP (fallback)) 2305 if (SPECIFIERP (fallback))
2187 assert (EQ (Fspecifier_type (specifier), Fspecifier_type (fallback))); 2306 assert (EQ (Fspecifier_type (specifier), Fspecifier_type (fallback)));
2188 sp->fallback = fallback; 2307 if (BODILY_SPECIFIER_P (sp))
2308 GHOST_SPECIFIER(sp)->fallback = fallback;
2309 else
2310 sp->fallback = fallback;
2189 /* call the after-change method */ 2311 /* call the after-change method */
2190 MAYBE_SPECMETH (sp, after_change, (specifier, Qfallback)); 2312 MAYBE_SPECMETH (sp, after_change,
2313 (bodily_specifier (specifier), Qfallback));
2191 recompute_cached_specifier_everywhere (specifier); 2314 recompute_cached_specifier_everywhere (specifier);
2192 } 2315 }
2193 2316
2194 DEFUN ("specifier-fallback", Fspecifier_fallback, 1, 1, 0, /* 2317 DEFUN ("specifier-fallback", Fspecifier_fallback, 1, 1, 0, /*
2195 Return the fallback value for SPECIFIER. 2318 Return the fallback value for SPECIFIER.
2456 Lisp_Object instance; 2579 Lisp_Object instance;
2457 2580
2458 CHECK_SPECIFIER (specifier); 2581 CHECK_SPECIFIER (specifier);
2459 domain = decode_domain (domain); 2582 domain = decode_domain (domain);
2460 2583
2461 instance = specifier_instance (specifier, Qunbound, domain, ERROR_ME, 0, 2584 instance = specifier_instance (maybe_ghost_specifier (specifier),
2585 Qunbound, domain, ERROR_ME, 0,
2462 !NILP (no_fallback), Qzero); 2586 !NILP (no_fallback), Qzero);
2463 return UNBOUNDP (instance) ? default_ : instance; 2587 return UNBOUNDP (instance) ? default_ : instance;
2464 } 2588 }
2465 2589
2466 DEFUN ("specifier-matching-instance", Fspecifier_matching_instance, 2, 5, 0, /* 2590 DEFUN ("specifier-matching-instance", Fspecifier_matching_instance, 2, 5, 0, /*
2493 CHECK_SPECIFIER (specifier); 2617 CHECK_SPECIFIER (specifier);
2494 check_valid_specifier_matchspec (matchspec, XSPECIFIER (specifier)->methods, 2618 check_valid_specifier_matchspec (matchspec, XSPECIFIER (specifier)->methods,
2495 ERROR_ME); 2619 ERROR_ME);
2496 domain = decode_domain (domain); 2620 domain = decode_domain (domain);
2497 2621
2498 instance = specifier_instance (specifier, matchspec, domain, ERROR_ME, 0, 2622 instance = specifier_instance (maybe_ghost_specifier (specifier),
2499 !NILP (no_fallback), Qzero); 2623 matchspec, domain, ERROR_ME,
2624 0, !NILP (no_fallback), Qzero);
2500 return UNBOUNDP (instance) ? default_ : instance; 2625 return UNBOUNDP (instance) ? default_ : instance;
2501 } 2626 }
2502 2627
2503 DEFUN ("specifier-instance-from-inst-list", 2628 DEFUN ("specifier-instance-from-inst-list",
2504 Fspecifier_instance_from_inst_list, 3, 4, 0, /* 2629 Fspecifier_instance_from_inst_list, 3, 4, 0, /*
2517 2642
2518 CHECK_SPECIFIER (specifier); 2643 CHECK_SPECIFIER (specifier);
2519 check_valid_domain (domain); 2644 check_valid_domain (domain);
2520 check_valid_inst_list (inst_list, sp->methods, ERROR_ME); 2645 check_valid_inst_list (inst_list, sp->methods, ERROR_ME);
2521 GCPRO1 (built_up_list); 2646 GCPRO1 (built_up_list);
2522 built_up_list = build_up_processed_list (specifier, domain, inst_list); 2647 built_up_list = build_up_processed_list (maybe_ghost_specifier (specifier),
2648 domain, inst_list);
2523 if (!NILP (built_up_list)) 2649 if (!NILP (built_up_list))
2524 val = specifier_instance_from_inst_list (specifier, Qunbound, domain, 2650 val = specifier_instance_from_inst_list (maybe_ghost_specifier (specifier),
2525 built_up_list, ERROR_ME, 0, 2651 Qunbound, domain, built_up_list,
2526 Qzero); 2652 ERROR_ME, 0, Qzero);
2527 UNGCPRO; 2653 UNGCPRO;
2528 return UNBOUNDP (val) ? default_ : val; 2654 return UNBOUNDP (val) ? default_ : val;
2529 } 2655 }
2530 2656
2531 DEFUN ("specifier-matching-instance-from-inst-list", 2657 DEFUN ("specifier-matching-instance-from-inst-list",
2551 check_valid_specifier_matchspec (matchspec, XSPECIFIER (specifier)->methods, 2677 check_valid_specifier_matchspec (matchspec, XSPECIFIER (specifier)->methods,
2552 ERROR_ME); 2678 ERROR_ME);
2553 check_valid_domain (domain); 2679 check_valid_domain (domain);
2554 check_valid_inst_list (inst_list, sp->methods, ERROR_ME); 2680 check_valid_inst_list (inst_list, sp->methods, ERROR_ME);
2555 GCPRO1 (built_up_list); 2681 GCPRO1 (built_up_list);
2556 built_up_list = build_up_processed_list (specifier, domain, inst_list); 2682 built_up_list = build_up_processed_list (maybe_ghost_specifier (specifier),
2683 domain, inst_list);
2557 if (!NILP (built_up_list)) 2684 if (!NILP (built_up_list))
2558 val = specifier_instance_from_inst_list (specifier, matchspec, domain, 2685 val = specifier_instance_from_inst_list (maybe_ghost_specifier (specifier),
2559 built_up_list, ERROR_ME, 0, 2686 matchspec, domain, built_up_list,
2560 Qzero); 2687 ERROR_ME, 0, Qzero);
2561 UNGCPRO; 2688 UNGCPRO;
2562 return UNBOUNDP (val) ? default_ : val; 2689 return UNBOUNDP (val) ? default_ : val;
2563 } 2690 }
2564 2691
2565 2692
2582 void (*value_changed_in_frame) 2709 void (*value_changed_in_frame)
2583 (Lisp_Object specifier, struct frame *f, 2710 (Lisp_Object specifier, struct frame *f,
2584 Lisp_Object oldval)) 2711 Lisp_Object oldval))
2585 { 2712 {
2586 struct Lisp_Specifier *sp = XSPECIFIER (specifier); 2713 struct Lisp_Specifier *sp = XSPECIFIER (specifier);
2714 assert (!GHOST_SPECIFIER_P (sp));
2587 2715
2588 if (!sp->caching) 2716 if (!sp->caching)
2589 sp->caching = xnew_and_zero (struct specifier_caching); 2717 sp->caching = xnew_and_zero (struct specifier_caching);
2590 sp->caching->offset_into_struct_window = struct_window_offset; 2718 sp->caching->offset_into_struct_window = struct_window_offset;
2591 sp->caching->value_changed_in_window = value_changed_in_window; 2719 sp->caching->value_changed_in_window = value_changed_in_window;
2592 sp->caching->offset_into_struct_frame = struct_frame_offset; 2720 sp->caching->offset_into_struct_frame = struct_frame_offset;
2593 sp->caching->value_changed_in_frame = value_changed_in_frame; 2721 sp->caching->value_changed_in_frame = value_changed_in_frame;
2594 Vcached_specifiers = Fcons (specifier, Vcached_specifiers); 2722 Vcached_specifiers = Fcons (specifier, Vcached_specifiers);
2723 if (BODILY_SPECIFIER_P (sp))
2724 GHOST_SPECIFIER(sp)->caching = sp->caching;
2595 recompute_cached_specifier_everywhere (specifier); 2725 recompute_cached_specifier_everywhere (specifier);
2596 } 2726 }
2597 2727
2598 static void 2728 static void
2599 recompute_one_cached_specifier_in_window (Lisp_Object specifier, 2729 recompute_one_cached_specifier_in_window (Lisp_Object specifier,
2600 struct window *w) 2730 struct window *w)
2601 { 2731 {
2602 Lisp_Object window; 2732 Lisp_Object window;
2603 Lisp_Object newval, *location; 2733 Lisp_Object newval, *location;
2734
2735 assert (!GHOST_SPECIFIER_P (XSPECIFIER (specifier)));
2604 2736
2605 XSETWINDOW (window, w); 2737 XSETWINDOW (window, w);
2606 2738
2607 newval = specifier_instance (specifier, Qunbound, window, ERROR_ME_WARN, 2739 newval = specifier_instance (specifier, Qunbound, window, ERROR_ME_WARN,
2608 0, 0, Qzero); 2740 0, 0, Qzero);
2626 struct frame *f) 2758 struct frame *f)
2627 { 2759 {
2628 Lisp_Object frame; 2760 Lisp_Object frame;
2629 Lisp_Object newval, *location; 2761 Lisp_Object newval, *location;
2630 2762
2763 assert (!GHOST_SPECIFIER_P (XSPECIFIER (specifier)));
2764
2631 XSETFRAME (frame, f); 2765 XSETFRAME (frame, f);
2632 2766
2633 newval = specifier_instance (specifier, Qunbound, frame, ERROR_ME_WARN, 2767 newval = specifier_instance (specifier, Qunbound, frame, ERROR_ME_WARN,
2634 0, 0, Qzero); 2768 0, 0, Qzero);
2635 /* If newval ended up Qunbound, then the calling functions 2769 /* If newval ended up Qunbound, then the calling functions
2686 2820
2687 static void 2821 static void
2688 recompute_cached_specifier_everywhere (Lisp_Object specifier) 2822 recompute_cached_specifier_everywhere (Lisp_Object specifier)
2689 { 2823 {
2690 Lisp_Object frmcons, devcons, concons; 2824 Lisp_Object frmcons, devcons, concons;
2825
2826 specifier = bodily_specifier (specifier);
2691 2827
2692 if (!XSPECIFIER (specifier)->caching) 2828 if (!XSPECIFIER (specifier)->caching)
2693 return; 2829 return;
2694 2830
2695 if (XSPECIFIER (specifier)->caching->offset_into_struct_window) 2831 if (XSPECIFIER (specifier)->caching->offset_into_struct_window)
2991 This is the same deal as for weak hashtables. */ 3127 This is the same deal as for weak hashtables. */
2992 Vall_specifiers = Qnil; 3128 Vall_specifiers = Qnil;
2993 3129
2994 Vuser_defined_tags = Qnil; 3130 Vuser_defined_tags = Qnil;
2995 staticpro (&Vuser_defined_tags); 3131 staticpro (&Vuser_defined_tags);
2996 } 3132
3133 Vreveal_ghoste_specifiers = Qnil;
3134 staticpro (&Vreveal_ghoste_specifiers);
3135 }