1 /* Specifier implementation
2 Copyright (C) 1994, 1995 Board of Trustees, University of Illinois.
3 Copyright (C) 1995, 1996 Ben Wing.
4 Copyright (C) 1995 Sun Microsystems, Inc.
6 This file is part of XEmacs.
8 XEmacs is free software; you can redistribute it and/or modify it
9 under the terms of the GNU General Public License as published by the
10 Free Software Foundation; either version 2, or (at your option) any
13 XEmacs is distributed in the hope that it will be useful, but WITHOUT
14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
18 You should have received a copy of the GNU General Public License
19 along with XEmacs; see the file COPYING. If not, write to
20 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
21 Boston, MA 02111-1307, USA. */
23 /* Synched up with: Not in FSF. */
25 /* Design by Ben Wing;
26 Original version by Chuck Thompson;
27 rewritten by Ben Wing;
28 Magic specifiers by Kirill Katsnelson;
38 #include "specifier.h"
40 #include "glyphs.h" /* for DISP_TABLE_SIZE definition */
42 Lisp_Object Qspecifierp;
43 Lisp_Object Qprepend, Qappend, Qremove_tag_set_prepend, Qremove_tag_set_append;
44 Lisp_Object Qremove_locale, Qremove_locale_type, Qremove_all;
45 Lisp_Object Qfallback;
47 /* Qinteger, Qboolean, Qgeneric defined in general.c. */
50 Lisp_Object Qconsole_type, Qdevice_class;
52 static Lisp_Object Vuser_defined_tags;
54 typedef struct specifier_type_entry specifier_type_entry;
55 struct specifier_type_entry
58 struct specifier_methods *meths;
63 Dynarr_declare (specifier_type_entry);
64 } specifier_type_entry_dynarr;
66 specifier_type_entry_dynarr *the_specifier_type_entry_dynarr;
68 static Lisp_Object Vspecifier_type_list;
70 static Lisp_Object Vcached_specifiers;
71 /* Do NOT mark through this, or specifiers will never be GC'd. */
72 static Lisp_Object Vall_specifiers;
74 static Lisp_Object Vunlock_ghost_specifiers;
76 /* #### The purpose of this is to check for inheritance loops
77 in specifiers that can inherit from other specifiers, but it's
80 #### Look into this for 19.14. */
81 /* static Lisp_Object_dynarr current_specifiers; */
83 static void recompute_cached_specifier_everywhere (Lisp_Object specifier);
85 EXFUN (Fspecifier_specs, 4);
86 EXFUN (Fremove_specifier, 4);
89 /************************************************************************/
90 /* Specifier object methods */
91 /************************************************************************/
93 /* Remove dead objects from the specified assoc list. */
96 cleanup_assoc_list (Lisp_Object list)
98 Lisp_Object loop, prev, retval;
100 loop = retval = list;
105 Lisp_Object entry = XCAR (loop);
106 Lisp_Object key = XCAR (entry);
108 /* remember, dead windows can become alive again. */
109 if (!WINDOWP (key) && object_dead_p (key))
113 /* Removing the head. */
114 retval = XCDR (retval);
118 Fsetcdr (prev, XCDR (loop));
130 /* Remove dead objects from the various lists so that they
131 don't keep getting marked as long as this specifier exists and
132 therefore wasting memory. */
135 cleanup_specifiers (void)
139 for (rest = Vall_specifiers;
141 rest = XSPECIFIER (rest)->next_specifier)
143 struct Lisp_Specifier *sp = XSPECIFIER (rest);
144 /* This effectively changes the specifier specs.
145 However, there's no need to call
146 recompute_cached_specifier_everywhere() or the
147 after-change methods because the only specs we
148 are removing are for dead objects, and they can
149 never have any effect on the specifier values:
150 specifiers can only be instantiated over live
151 objects, and you can't derive a dead object
153 sp->device_specs = cleanup_assoc_list (sp->device_specs);
154 sp->frame_specs = cleanup_assoc_list (sp->frame_specs);
155 sp->buffer_specs = cleanup_assoc_list (sp->buffer_specs);
156 /* windows are handled specially because dead windows
157 can be resurrected */
162 kill_specifier_buffer_locals (Lisp_Object buffer)
166 for (rest = Vall_specifiers;
168 rest = XSPECIFIER (rest)->next_specifier)
170 struct Lisp_Specifier *sp = XSPECIFIER (rest);
172 /* Make sure we're actually going to be changing something.
173 Fremove_specifier() always calls
174 recompute_cached_specifier_everywhere() (#### but should
175 be smarter about this). */
176 if (!NILP (assq_no_quit (buffer, sp->buffer_specs)))
177 Fremove_specifier (rest, buffer, Qnil, Qnil);
182 mark_specifier (Lisp_Object obj, void (*markobj) (Lisp_Object))
184 struct Lisp_Specifier *specifier = XSPECIFIER (obj);
186 markobj (specifier->global_specs);
187 markobj (specifier->device_specs);
188 markobj (specifier->frame_specs);
189 markobj (specifier->window_specs);
190 markobj (specifier->buffer_specs);
191 markobj (specifier->magic_parent);
192 markobj (specifier->fallback);
193 if (!GHOST_SPECIFIER_P (XSPECIFIER (obj)))
194 MAYBE_SPECMETH (specifier, mark, (obj, markobj));
198 /* The idea here is that the specifier specs point to locales
199 (windows, buffers, frames, and devices), and we want to make sure
200 that the specs disappear automatically when the associated locale
201 is no longer in use. For all but windows, "no longer in use"
202 corresponds exactly to when the object is deleted (non-deleted
203 objects are always held permanently in special lists, and deleted
204 objects are never on these lists and never reusable). To handle
205 this, we just have cleanup_specifiers() called periodically
206 (at the beginning of garbage collection); it removes all dead
209 For windows, however, it's trickier because dead objects can be
210 converted to live ones again if the dead object is in a window
211 configuration. Therefore, for windows, "no longer in use"
212 corresponds to when the window object is garbage-collected.
213 We now use weak lists for this purpose.
218 prune_specifiers (int (*obj_marked_p) (Lisp_Object))
220 Lisp_Object rest, prev = Qnil;
222 for (rest = Vall_specifiers;
224 rest = XSPECIFIER (rest)->next_specifier)
226 if (! obj_marked_p (rest))
228 struct Lisp_Specifier* sp = XSPECIFIER (rest);
229 /* A bit of assertion that we're removing both parts of the
230 magic one altogether */
231 assert (!GC_MAGIC_SPECIFIER_P(sp)
232 || (GC_BODILY_SPECIFIER_P(sp) && obj_marked_p (sp->fallback))
233 || (GC_GHOST_SPECIFIER_P(sp) && obj_marked_p (sp->magic_parent)));
234 /* This specifier is garbage. Remove it from the list. */
236 Vall_specifiers = sp->next_specifier;
238 XSPECIFIER (prev)->next_specifier = sp->next_specifier;
246 print_specifier (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
248 struct Lisp_Specifier *sp = XSPECIFIER (obj);
250 int count = specpdl_depth ();
251 Lisp_Object the_specs;
254 error ("printing unreadable object #<%s-specifier 0x%x>",
255 sp->methods->name, sp->header.uid);
257 sprintf (buf, "#<%s-specifier global=", sp->methods->name);
258 write_c_string (buf, printcharfun);
259 specbind (Qprint_string_length, make_int (100));
260 specbind (Qprint_length, make_int (5));
261 the_specs = Fspecifier_specs (obj, Qglobal, Qnil, Qnil);
262 if (NILP (the_specs))
263 /* there are no global specs */
264 write_c_string ("<unspecified>", printcharfun);
266 print_internal (the_specs, printcharfun, 1);
267 if (!NILP (sp->fallback))
269 write_c_string (" fallback=", printcharfun);
270 print_internal (sp->fallback, printcharfun, escapeflag);
272 unbind_to (count, Qnil);
273 sprintf (buf, " 0x%x>", sp->header.uid);
274 write_c_string (buf, printcharfun);
278 finalize_specifier (void *header, int for_disksave)
280 struct Lisp_Specifier *sp = (struct Lisp_Specifier *) header;
281 /* don't be snafued by the disksave finalization. */
282 if (!for_disksave && !GC_GHOST_SPECIFIER_P(sp) && sp->caching)
290 specifier_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
292 struct Lisp_Specifier *s1 = XSPECIFIER (obj1);
293 struct Lisp_Specifier *s2 = XSPECIFIER (obj2);
295 Lisp_Object old_inhibit_quit = Vinhibit_quit;
297 /* This function can be called from within redisplay.
298 internal_equal can trigger a quit. That leads to Bad Things. */
303 (s1->methods == s2->methods &&
304 internal_equal (s1->global_specs, s2->global_specs, depth) &&
305 internal_equal (s1->device_specs, s2->device_specs, depth) &&
306 internal_equal (s1->frame_specs, s2->frame_specs, depth) &&
307 internal_equal (s1->window_specs, s2->window_specs, depth) &&
308 internal_equal (s1->buffer_specs, s2->buffer_specs, depth) &&
309 internal_equal (s1->fallback, s2->fallback, depth));
311 if (retval && HAS_SPECMETH_P (s1, equal))
312 retval = SPECMETH (s1, equal, (obj1, obj2, depth - 1));
314 Vinhibit_quit = old_inhibit_quit;
319 specifier_hash (Lisp_Object obj, int depth)
321 struct Lisp_Specifier *s = XSPECIFIER (obj);
323 /* specifier hashing is a bit problematic because there are so
324 many places where data can be stored. We pick what are perhaps
325 the most likely places where interesting stuff will be. */
326 return HASH5 ((HAS_SPECMETH_P (s, hash) ?
327 SPECMETH (s, hash, (obj, depth)) : 0),
328 (unsigned long) s->methods,
329 internal_hash (s->global_specs, depth + 1),
330 internal_hash (s->frame_specs, depth + 1),
331 internal_hash (s->buffer_specs, depth + 1));
335 sizeof_specifier (CONST void *header)
337 if (GHOST_SPECIFIER_P ((struct Lisp_Specifier *) header))
338 return sizeof (struct Lisp_Specifier);
341 CONST struct Lisp_Specifier *p = (CONST struct Lisp_Specifier *) header;
342 return sizeof (*p) + p->methods->extra_data_size - 1;
346 DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("specifier", specifier,
347 mark_specifier, print_specifier,
349 specifier_equal, specifier_hash,
351 struct Lisp_Specifier);
353 /************************************************************************/
354 /* Creating specifiers */
355 /************************************************************************/
357 static struct specifier_methods *
358 decode_specifier_type (Lisp_Object type, Error_behavior errb)
362 for (i = 0; i < Dynarr_length (the_specifier_type_entry_dynarr); i++)
364 if (EQ (type, Dynarr_at (the_specifier_type_entry_dynarr, i).symbol))
365 return Dynarr_at (the_specifier_type_entry_dynarr, i).meths;
368 maybe_signal_simple_error ("Invalid specifier type", type,
375 valid_specifier_type_p (Lisp_Object type)
377 return decode_specifier_type (type, ERROR_ME_NOT) != 0;
380 DEFUN ("valid-specifier-type-p", Fvalid_specifier_type_p, 1, 1, 0, /*
381 Given a SPECIFIER-TYPE, return non-nil if it is valid.
382 Valid types are 'generic, 'integer, boolean, 'color, 'font, 'image,
383 'face-boolean, and 'toolbar.
387 return valid_specifier_type_p (specifier_type) ? Qt : Qnil;
390 DEFUN ("specifier-type-list", Fspecifier_type_list, 0, 0, 0, /*
391 Return a list of valid specifier types.
395 return Fcopy_sequence (Vspecifier_type_list);
399 add_entry_to_specifier_type_list (Lisp_Object symbol,
400 struct specifier_methods *meths)
402 struct specifier_type_entry entry;
404 entry.symbol = symbol;
406 Dynarr_add (the_specifier_type_entry_dynarr, entry);
407 Vspecifier_type_list = Fcons (symbol, Vspecifier_type_list);
411 make_specifier_internal (struct specifier_methods *spec_meths,
412 size_t data_size, int call_create_meth)
414 Lisp_Object specifier;
415 struct Lisp_Specifier *sp = (struct Lisp_Specifier *)
416 alloc_lcrecord (sizeof (struct Lisp_Specifier) +
417 data_size - 1, lrecord_specifier);
419 sp->methods = spec_meths;
420 sp->global_specs = Qnil;
421 sp->device_specs = Qnil;
422 sp->frame_specs = Qnil;
423 sp->window_specs = make_weak_list (WEAK_LIST_KEY_ASSOC);
424 sp->buffer_specs = Qnil;
426 sp->magic_parent = Qnil;
428 sp->next_specifier = Vall_specifiers;
430 XSETSPECIFIER (specifier, sp);
431 Vall_specifiers = specifier;
433 if (call_create_meth)
437 MAYBE_SPECMETH (XSPECIFIER (specifier), create, (specifier));
444 make_specifier (struct specifier_methods *meths)
446 return make_specifier_internal (meths, meths->extra_data_size, 1);
450 make_magic_specifier (Lisp_Object type)
452 /* This function can GC */
453 struct specifier_methods *meths = decode_specifier_type (type, ERROR_ME);
454 Lisp_Object bodily, ghost;
457 bodily = make_specifier (meths);
459 ghost = make_specifier_internal (meths, 0, 0);
462 /* Connect guys together */
463 XSPECIFIER(bodily)->magic_parent = Qt;
464 XSPECIFIER(bodily)->fallback = ghost;
465 XSPECIFIER(ghost)->magic_parent = bodily;
470 DEFUN ("make-specifier", Fmake_specifier, 1, 1, 0, /*
471 Return a new specifier object of type TYPE.
473 A specifier is an object that can be used to keep track of a property
474 whose value can be per-buffer, per-window, per-frame, or per-device,
475 and can further be restricted to a particular console-type or device-class.
476 Specifiers are used, for example, for the various built-in properties of a
477 face; this allows a face to have different values in different frames,
478 buffers, etc. For more information, see `specifier-instance',
479 `specifier-specs', and `add-spec-to-specifier'; or, for a detailed
480 description of specifiers, including how they are instantiated over a
481 particular domain (i.e. how their value in that domain is determined),
482 see the chapter on specifiers in the XEmacs Lisp Reference Manual.
484 TYPE specifies the particular type of specifier, and should be one of
485 the symbols 'generic, 'integer, 'boolean, 'color, 'font, 'image,
486 'face-boolean, or 'toolbar.
488 For more information on particular types of specifiers, see the functions
489 `generic-specifier-p', `integer-specifier-p', `boolean-specifier-p',
490 `color-specifier-p', `font-specifier-p', `image-specifier-p',
491 `face-boolean-specifier-p', and `toolbar-specifier-p'.
495 /* This function can GC */
496 struct specifier_methods *meths = decode_specifier_type (type,
499 return make_specifier (meths);
502 DEFUN ("specifierp", Fspecifierp, 1, 1, 0, /*
503 Return t if OBJECT is a specifier.
505 A specifier is an object that can be used to keep track of a property
506 whose value can be per-buffer, per-window, per-frame, or per-device,
507 and can further be restricted to a particular console-type or device-class.
508 See `make-specifier'.
512 return SPECIFIERP (object) ? Qt : Qnil;
515 DEFUN ("specifier-type", Fspecifier_type, 1, 1, 0, /*
516 Return the type of SPECIFIER.
520 CHECK_SPECIFIER (specifier);
521 return intern (XSPECIFIER (specifier)->methods->name);
525 /************************************************************************/
526 /* Locales and domains */
527 /************************************************************************/
529 DEFUN ("valid-specifier-locale-p", Fvalid_specifier_locale_p, 1, 1, 0, /*
530 Return t if LOCALE is a valid specifier locale.
531 Valid locales are devices, frames, windows, buffers, and 'global.
536 /* This cannot GC. */
537 return ((DEVICEP (locale) && DEVICE_LIVE_P (XDEVICE (locale))) ||
538 (FRAMEP (locale) && FRAME_LIVE_P (XFRAME (locale))) ||
539 (BUFFERP (locale) && BUFFER_LIVE_P (XBUFFER (locale))) ||
540 /* dead windows are allowed because they may become live
541 windows again when a window configuration is restored */
543 EQ (locale, Qglobal))
547 DEFUN ("valid-specifier-domain-p", Fvalid_specifier_domain_p, 1, 1, 0, /*
548 Return t if DOMAIN is a valid specifier domain.
549 A domain is used to instance a specifier (i.e. determine the specifier's
550 value in that domain). Valid domains are windows, frames, and devices.
555 /* This cannot GC. */
556 return ((DEVICEP (domain) && DEVICE_LIVE_P (XDEVICE (domain))) ||
557 (FRAMEP (domain) && FRAME_LIVE_P (XFRAME (domain))) ||
558 (WINDOWP (domain) && WINDOW_LIVE_P (XWINDOW (domain))))
562 DEFUN ("valid-specifier-locale-type-p", Fvalid_specifier_locale_type_p, 1, 1, 0, /*
563 Given a specifier LOCALE-TYPE, return non-nil if it is valid.
564 Valid locale types are 'global, 'device, 'frame, 'window, and 'buffer.
565 \(Note, however, that in functions that accept either a locale or a locale
566 type, 'global is considered an individual locale.)
570 /* This cannot GC. */
571 return (EQ (locale_type, Qglobal) ||
572 EQ (locale_type, Qdevice) ||
573 EQ (locale_type, Qframe) ||
574 EQ (locale_type, Qwindow) ||
575 EQ (locale_type, Qbuffer)) ? Qt : Qnil;
579 check_valid_locale_or_locale_type (Lisp_Object locale)
581 /* This cannot GC. */
582 if (EQ (locale, Qall) ||
583 !NILP (Fvalid_specifier_locale_p (locale)) ||
584 !NILP (Fvalid_specifier_locale_type_p (locale)))
586 signal_simple_error ("Invalid specifier locale or locale type", locale);
589 DEFUN ("specifier-locale-type-from-locale", Fspecifier_locale_type_from_locale,
591 Given a specifier LOCALE, return its type.
595 /* This cannot GC. */
596 if (NILP (Fvalid_specifier_locale_p (locale)))
597 signal_simple_error ("Invalid specifier locale", locale);
598 if (DEVICEP (locale)) return Qdevice;
599 if (FRAMEP (locale)) return Qframe;
600 if (WINDOWP (locale)) return Qwindow;
601 if (BUFFERP (locale)) return Qbuffer;
602 assert (EQ (locale, Qglobal));
607 decode_locale (Lisp_Object locale)
609 /* This cannot GC. */
612 else if (!NILP (Fvalid_specifier_locale_p (locale)))
615 signal_simple_error ("Invalid specifier locale", locale);
620 static enum spec_locale_type
621 decode_locale_type (Lisp_Object locale_type)
623 /* This cannot GC. */
624 if (EQ (locale_type, Qglobal)) return LOCALE_GLOBAL;
625 if (EQ (locale_type, Qdevice)) return LOCALE_DEVICE;
626 if (EQ (locale_type, Qframe)) return LOCALE_FRAME;
627 if (EQ (locale_type, Qwindow)) return LOCALE_WINDOW;
628 if (EQ (locale_type, Qbuffer)) return LOCALE_BUFFER;
630 signal_simple_error ("Invalid specifier locale type", locale_type);
631 return LOCALE_GLOBAL; /* not reached */
635 decode_locale_list (Lisp_Object locale)
637 /* This cannot GC. */
638 /* The return value of this function must be GCPRO'd. */
643 else if (CONSP (locale))
646 EXTERNAL_LIST_LOOP_2 (elt, locale)
647 check_valid_locale_or_locale_type (elt);
652 check_valid_locale_or_locale_type (locale);
653 return list1 (locale);
657 static enum spec_locale_type
658 locale_type_from_locale (Lisp_Object locale)
660 return decode_locale_type (Fspecifier_locale_type_from_locale (locale));
664 check_valid_domain (Lisp_Object domain)
666 if (NILP (Fvalid_specifier_domain_p (domain)))
667 signal_simple_error ("Invalid specifier domain", domain);
671 decode_domain (Lisp_Object domain)
674 return Fselected_window (Qnil);
675 check_valid_domain (domain);
680 /************************************************************************/
682 /************************************************************************/
684 DEFUN ("valid-specifier-tag-p", Fvalid_specifier_tag_p, 1, 1, 0, /*
685 Return non-nil if TAG is a valid specifier tag.
686 See also `valid-specifier-tag-set-p'.
690 return (valid_console_type_p (tag) ||
691 valid_device_class_p (tag) ||
692 !NILP (assq_no_quit (tag, Vuser_defined_tags))) ? Qt : Qnil;
695 DEFUN ("valid-specifier-tag-set-p", Fvalid_specifier_tag_set_p, 1, 1, 0, /*
696 Return non-nil if TAG-SET is a valid specifier tag set.
698 A specifier tag set is an entity that is attached to an instantiator
699 and can be used to restrict the scope of that instantiator to a
700 particular device class or device type and/or to mark instantiators
701 added by a particular package so that they can be later removed.
703 A specifier tag set consists of a list of zero of more specifier tags,
704 each of which is a symbol that is recognized by XEmacs as a tag.
705 \(The valid device types and device classes are always tags, as are
706 any tags defined by `define-specifier-tag'.) It is called a "tag set"
707 \(as opposed to a list) because the order of the tags or the number of
708 times a particular tag occurs does not matter.
710 Each tag has a predicate associated with it, which specifies whether
711 that tag applies to a particular device. The tags which are device types
712 and classes match devices of that type or class. User-defined tags can
713 have any predicate, or none (meaning that all devices match). When
714 attempting to instance a specifier, a particular instantiator is only
715 considered if the device of the domain being instanced over matches
716 all tags in the tag set attached to that instantiator.
718 Most of the time, a tag set is not specified, and the instantiator
719 gets a null tag set, which matches all devices.
725 for (rest = tag_set; !NILP (rest); rest = XCDR (rest))
729 if (NILP (Fvalid_specifier_tag_p (XCAR (rest))))
737 decode_specifier_tag_set (Lisp_Object tag_set)
739 /* The return value of this function must be GCPRO'd. */
740 if (!NILP (Fvalid_specifier_tag_p (tag_set)))
741 return list1 (tag_set);
742 if (NILP (Fvalid_specifier_tag_set_p (tag_set)))
743 signal_simple_error ("Invalid specifier tag-set", tag_set);
748 canonicalize_tag_set (Lisp_Object tag_set)
750 int len = XINT (Flength (tag_set));
751 Lisp_Object *tags, rest;
754 /* We assume in this function that the tag_set has already been
755 validated, so there are no surprises. */
757 if (len == 0 || len == 1)
758 /* most common case */
761 tags = alloca_array (Lisp_Object, len);
764 LIST_LOOP (rest, tag_set)
765 tags[i++] = XCAR (rest);
767 /* Sort the list of tags. We use a bubble sort here (copied from
768 extent_fragment_update()) -- reduces the function call overhead,
769 and is the fastest sort for small numbers of items. */
771 for (i = 1; i < len; i++)
775 strcmp ((char *) string_data (XSYMBOL (tags[j])->name),
776 (char *) string_data (XSYMBOL (tags[j+1])->name)) > 0)
778 Lisp_Object tmp = tags[j];
785 /* Now eliminate duplicates. */
787 for (i = 1, j = 1; i < len; i++)
789 /* j holds the destination, i the source. */
790 if (!EQ (tags[i], tags[i-1]))
794 return Flist (j, tags);
797 DEFUN ("canonicalize-tag-set", Fcanonicalize_tag_set, 1, 1, 0, /*
798 Canonicalize the given tag set.
799 Two canonicalized tag sets can be compared with `equal' to see if they
800 represent the same tag set. (Specifically, canonicalizing involves
801 sorting by symbol name and removing duplicates.)
805 if (NILP (Fvalid_specifier_tag_set_p (tag_set)))
806 signal_simple_error ("Invalid tag set", tag_set);
807 return canonicalize_tag_set (tag_set);
811 device_matches_specifier_tag_set_p (Lisp_Object device, Lisp_Object tag_set)
813 Lisp_Object devtype, devclass, rest;
814 struct device *d = XDEVICE (device);
816 devtype = DEVICE_TYPE (d);
817 devclass = DEVICE_CLASS (d);
819 LIST_LOOP (rest, tag_set)
821 Lisp_Object tag = XCAR (rest);
824 if (EQ (tag, devtype) || EQ (tag, devclass))
826 assoc = assq_no_quit (tag, DEVICE_USER_DEFINED_TAGS (d));
827 /* other built-in tags (device types/classes) are not in
828 the user-defined-tags list. */
829 if (NILP (assoc) || NILP (XCDR (assoc)))
836 DEFUN ("device-matches-specifier-tag-set-p", Fdevice_matches_specifier_tag_set_p, 2, 2, 0, /*
837 Return non-nil if DEVICE matches specifier tag set TAG-SET.
838 This means that DEVICE matches each tag in the tag set. (Every
839 tag recognized by XEmacs has a predicate associated with it that
840 specifies which devices match it.)
844 CHECK_LIVE_DEVICE (device);
846 if (NILP (Fvalid_specifier_tag_set_p (tag_set)))
847 signal_simple_error ("Invalid tag set", tag_set);
849 return device_matches_specifier_tag_set_p (device, tag_set) ? Qt : Qnil;
852 DEFUN ("define-specifier-tag", Fdefine_specifier_tag, 1, 2, 0, /*
853 Define a new specifier tag.
854 If PREDICATE is specified, it should be a function of one argument
855 \(a device) that specifies whether the tag matches that particular
856 device. If PREDICATE is omitted, the tag matches all devices.
858 You can redefine an existing user-defined specifier tag. However,
859 you cannot redefine the built-in specifier tags (the device types
860 and classes) or the symbols nil, t, 'all, or 'global.
864 Lisp_Object assoc, devcons, concons;
868 if (valid_device_class_p (tag) ||
869 valid_console_type_p (tag))
870 signal_simple_error ("Cannot redefine built-in specifier tags", tag);
871 /* Try to prevent common instantiators and locales from being
872 redefined, to reduce ambiguity */
873 if (NILP (tag) || EQ (tag, Qt) || EQ (tag, Qall) || EQ (tag, Qglobal))
874 signal_simple_error ("Cannot define nil, t, 'all, or 'global",
876 assoc = assq_no_quit (tag, Vuser_defined_tags);
880 Vuser_defined_tags = Fcons (Fcons (tag, predicate), Vuser_defined_tags);
881 DEVICE_LOOP_NO_BREAK (devcons, concons)
883 struct device *d = XDEVICE (XCAR (devcons));
884 /* Initially set the value to t in case of error
886 DEVICE_USER_DEFINED_TAGS (d) =
887 Fcons (Fcons (tag, Qt), DEVICE_USER_DEFINED_TAGS (d));
890 else if (!NILP (predicate) && !NILP (XCDR (assoc)))
893 XCDR (assoc) = predicate;
896 /* recompute the tag values for all devices. However, in the special
897 case where both the old and new predicates are nil, we know that
898 we don't have to do this. (It's probably common for people to
899 call (define-specifier-tag) more than once on the same tag,
900 and the most common case is where PREDICATE is not specified.) */
904 DEVICE_LOOP_NO_BREAK (devcons, concons)
906 Lisp_Object device = XCAR (devcons);
907 assoc = assq_no_quit (tag,
908 DEVICE_USER_DEFINED_TAGS (XDEVICE (device)));
909 assert (CONSP (assoc));
910 if (NILP (predicate))
913 XCDR (assoc) = !NILP (call1 (predicate, device)) ? Qt : Qnil;
920 /* Called at device-creation time to initialize the user-defined
921 tag values for the newly-created device. */
924 setup_device_initial_specifier_tags (struct device *d)
926 Lisp_Object rest, rest2;
929 XSETDEVICE (device, d);
931 DEVICE_USER_DEFINED_TAGS (d) = Fcopy_alist (Vuser_defined_tags);
933 /* Now set up the initial values */
934 LIST_LOOP (rest, DEVICE_USER_DEFINED_TAGS (d))
935 XCDR (XCAR (rest)) = Qt;
937 for (rest = Vuser_defined_tags, rest2 = DEVICE_USER_DEFINED_TAGS (d);
938 !NILP (rest); rest = XCDR (rest), rest2 = XCDR (rest2))
940 Lisp_Object predicate = XCDR (XCAR (rest));
941 if (NILP (predicate))
942 XCDR (XCAR (rest2)) = Qt;
944 XCDR (XCAR (rest2)) = !NILP (call1 (predicate, device)) ? Qt : Qnil;
948 DEFUN ("device-matching-specifier-tag-list", Fdevice_matching_specifier_tag_list,
950 Return a list of all specifier tags matching DEVICE.
951 DEVICE defaults to the selected device if omitted.
955 struct device *d = decode_device (device);
956 Lisp_Object rest, list = Qnil;
961 LIST_LOOP (rest, DEVICE_USER_DEFINED_TAGS (d))
963 if (!NILP (XCDR (XCAR (rest))))
964 list = Fcons (XCAR (XCAR (rest)), list);
967 list = Fnreverse (list);
968 list = Fcons (DEVICE_CLASS (d), list);
969 list = Fcons (DEVICE_TYPE (d), list);
971 RETURN_UNGCPRO (list);
974 DEFUN ("specifier-tag-list", Fspecifier_tag_list, 0, 0, 0, /*
975 Return a list of all currently-defined specifier tags.
976 This includes the built-in ones (the device types and classes).
980 Lisp_Object list = Qnil, rest;
985 LIST_LOOP (rest, Vuser_defined_tags)
986 list = Fcons (XCAR (XCAR (rest)), list);
988 list = Fnreverse (list);
989 list = nconc2 (Fcopy_sequence (Vdevice_class_list), list);
990 list = nconc2 (Fcopy_sequence (Vconsole_type_list), list);
992 RETURN_UNGCPRO (list);
995 DEFUN ("specifier-tag-predicate", Fspecifier_tag_predicate, 1, 1, 0, /*
996 Return the predicate for the given specifier tag.
1000 /* The return value of this function must be GCPRO'd. */
1003 if (NILP (Fvalid_specifier_tag_p (tag)))
1004 signal_simple_error ("Invalid specifier tag", tag);
1006 /* Make up some predicates for the built-in types */
1008 if (valid_console_type_p (tag))
1009 return list3 (Qlambda, list1 (Qdevice),
1010 list3 (Qeq, list2 (Qquote, tag),
1011 list2 (Qconsole_type, Qdevice)));
1013 if (valid_device_class_p (tag))
1014 return list3 (Qlambda, list1 (Qdevice),
1015 list3 (Qeq, list2 (Qquote, tag),
1016 list2 (Qdevice_class, Qdevice)));
1018 return XCDR (assq_no_quit (tag, Vuser_defined_tags));
1021 /* Return true if A "matches" B. If EXACT_P is 0, A must be a subset of B.
1022 Otherwise, A must be `equal' to B. The sets must be canonicalized. */
1024 tag_sets_match_p (Lisp_Object a, Lisp_Object b, int exact_p)
1028 while (!NILP (a) && !NILP (b))
1030 if (EQ (XCAR (a), XCAR (b)))
1039 while (!NILP (a) && !NILP (b))
1041 if (!EQ (XCAR (a), XCAR (b)))
1047 return NILP (a) && NILP (b);
1052 /************************************************************************/
1053 /* Spec-lists and inst-lists */
1054 /************************************************************************/
1057 call_validate_method (Lisp_Object boxed_method, Lisp_Object instantiator)
1059 ((void (*)(Lisp_Object)) get_opaque_ptr (boxed_method)) (instantiator);
1064 check_valid_instantiator (Lisp_Object instantiator,
1065 struct specifier_methods *meths,
1066 Error_behavior errb)
1068 if (meths->validate_method)
1072 if (ERRB_EQ (errb, ERROR_ME))
1074 (meths->validate_method) (instantiator);
1079 Lisp_Object opaque = make_opaque_ptr ((void *)
1080 meths->validate_method);
1081 struct gcpro gcpro1;
1084 retval = call_with_suspended_errors
1085 ((lisp_fn_t) call_validate_method,
1086 Qnil, Qspecifier, errb, 2, opaque, instantiator);
1088 free_opaque_ptr (opaque);
1097 DEFUN ("check-valid-instantiator", Fcheck_valid_instantiator, 2, 2, 0, /*
1098 Signal an error if INSTANTIATOR is invalid for SPECIFIER-TYPE.
1100 (instantiator, specifier_type))
1102 struct specifier_methods *meths = decode_specifier_type (specifier_type,
1105 return check_valid_instantiator (instantiator, meths, ERROR_ME);
1108 DEFUN ("valid-instantiator-p", Fvalid_instantiator_p, 2, 2, 0, /*
1109 Return non-nil if INSTANTIATOR is valid for SPECIFIER-TYPE.
1111 (instantiator, specifier_type))
1113 struct specifier_methods *meths = decode_specifier_type (specifier_type,
1116 return check_valid_instantiator (instantiator, meths, ERROR_ME_NOT);
1120 check_valid_inst_list (Lisp_Object inst_list, struct specifier_methods *meths,
1121 Error_behavior errb)
1125 LIST_LOOP (rest, inst_list)
1127 Lisp_Object inst_pair, tag_set;
1131 maybe_signal_simple_error ("Invalid instantiator list", inst_list,
1135 if (!CONSP (inst_pair = XCAR (rest)))
1137 maybe_signal_simple_error ("Invalid instantiator pair", inst_pair,
1141 if (NILP (Fvalid_specifier_tag_set_p (tag_set = XCAR (inst_pair))))
1143 maybe_signal_simple_error ("Invalid specifier tag", tag_set,
1148 if (NILP (check_valid_instantiator (XCDR (inst_pair), meths, errb)))
1155 DEFUN ("check-valid-inst-list", Fcheck_valid_inst_list, 2, 2, 0, /*
1156 Signal an error if INST-LIST is invalid for specifier type TYPE.
1160 struct specifier_methods *meths = decode_specifier_type (type, ERROR_ME);
1162 return check_valid_inst_list (inst_list, meths, ERROR_ME);
1165 DEFUN ("valid-inst-list-p", Fvalid_inst_list_p, 2, 2, 0, /*
1166 Return non-nil if INST-LIST is valid for specifier type TYPE.
1170 struct specifier_methods *meths = decode_specifier_type (type, ERROR_ME);
1172 return check_valid_inst_list (inst_list, meths, ERROR_ME_NOT);
1176 check_valid_spec_list (Lisp_Object spec_list, struct specifier_methods *meths,
1177 Error_behavior errb)
1181 LIST_LOOP (rest, spec_list)
1183 Lisp_Object spec, locale;
1184 if (!CONSP (rest) || !CONSP (spec = XCAR (rest)))
1186 maybe_signal_simple_error ("Invalid specification list", spec_list,
1190 if (NILP (Fvalid_specifier_locale_p (locale = XCAR (spec))))
1192 maybe_signal_simple_error ("Invalid specifier locale", locale,
1197 if (NILP (check_valid_inst_list (XCDR (spec), meths, errb)))
1204 DEFUN ("check-valid-spec-list", Fcheck_valid_spec_list, 2, 2, 0, /*
1205 Signal an error if SPEC-LIST is invalid for specifier type TYPE.
1209 struct specifier_methods *meths = decode_specifier_type (type, ERROR_ME);
1211 return check_valid_spec_list (spec_list, meths, ERROR_ME);
1214 DEFUN ("valid-spec-list-p", Fvalid_spec_list_p, 2, 2, 0, /*
1215 Return non-nil if SPEC-LIST is valid for specifier type TYPE.
1219 struct specifier_methods *meths = decode_specifier_type (type, ERROR_ME);
1221 return check_valid_spec_list (spec_list, meths, ERROR_ME_NOT);
1225 decode_how_to_add_specification (Lisp_Object how_to_add)
1227 if (NILP (how_to_add) || EQ (Qremove_tag_set_prepend, how_to_add))
1228 return SPEC_REMOVE_TAG_SET_PREPEND;
1229 if (EQ (Qremove_tag_set_append, how_to_add))
1230 return SPEC_REMOVE_TAG_SET_APPEND;
1231 if (EQ (Qappend, how_to_add))
1233 if (EQ (Qprepend, how_to_add))
1234 return SPEC_PREPEND;
1235 if (EQ (Qremove_locale, how_to_add))
1236 return SPEC_REMOVE_LOCALE;
1237 if (EQ (Qremove_locale_type, how_to_add))
1238 return SPEC_REMOVE_LOCALE_TYPE;
1239 if (EQ (Qremove_all, how_to_add))
1240 return SPEC_REMOVE_ALL;
1242 signal_simple_error ("Invalid `how-to-add' flag", how_to_add);
1244 return SPEC_PREPEND; /* not reached */
1247 /* Given a specifier object SPEC, return bodily specifier if SPEC is a
1248 ghost specifier, otherwise return the object itself
1251 bodily_specifier (Lisp_Object spec)
1253 return (GHOST_SPECIFIER_P (XSPECIFIER (spec))
1254 ? XSPECIFIER(spec)->magic_parent : spec);
1257 /* Signal error if (specifier SPEC is read-only.
1258 Read only are ghost specifiers unless Vunlock_ghost_specifiers is
1259 non-nil. All other specifiers are read-write.
1262 check_modifiable_specifier (Lisp_Object spec)
1264 if (NILP (Vunlock_ghost_specifiers)
1265 && GHOST_SPECIFIER_P (XSPECIFIER (spec)))
1266 signal_simple_error ("Attempt to modify read-only specifier",
1270 /* Helper function which unwind protects the value of
1271 Vunlock_ghost_specifiers, then sets it to non-nil value */
1273 restore_unlock_value (Lisp_Object val)
1275 Vunlock_ghost_specifiers = val;
1280 unlock_ghost_specifiers_protected (void)
1282 int depth = specpdl_depth ();
1283 record_unwind_protect (restore_unlock_value,
1284 Vunlock_ghost_specifiers);
1285 Vunlock_ghost_specifiers = Qt;
1289 /* This gets hit so much that the function call overhead had a
1290 measurable impact (according to Quantify). #### We should figure
1291 out the frequency with which this is called with the various types
1292 and reorder the check accordingly. */
1293 #define SPECIFIER_GET_SPEC_LIST(specifier, type) \
1294 (type == LOCALE_GLOBAL ? &(XSPECIFIER (specifier)->global_specs) : \
1295 type == LOCALE_DEVICE ? &(XSPECIFIER (specifier)->device_specs) : \
1296 type == LOCALE_FRAME ? &(XSPECIFIER (specifier)->frame_specs) : \
1297 type == LOCALE_WINDOW ? &(XWEAK_LIST_LIST \
1298 (XSPECIFIER (specifier)->window_specs)) : \
1299 type == LOCALE_BUFFER ? &(XSPECIFIER (specifier)->buffer_specs) : \
1302 static Lisp_Object *
1303 specifier_get_inst_list (Lisp_Object specifier, Lisp_Object locale,
1304 enum spec_locale_type type)
1306 Lisp_Object *spec_list = SPECIFIER_GET_SPEC_LIST (specifier, type);
1307 Lisp_Object specification;
1309 if (type == LOCALE_GLOBAL)
1311 /* Calling assq_no_quit when it is just going to return nil anyhow
1312 is extremely expensive. So sayeth Quantify. */
1313 if (!CONSP (*spec_list))
1315 specification = assq_no_quit (locale, *spec_list);
1316 if (NILP (specification))
1318 return &XCDR (specification);
1321 /* For the given INST_LIST, return a new INST_LIST containing all elements
1322 where TAG-SET matches the element's tag set. EXACT_P indicates whether
1323 the match must be exact (as opposed to a subset). SHORT_P indicates
1324 that the short form (for `specifier-specs') should be returned if
1325 possible. If COPY_TREE_P, `copy-tree' is used to ensure that no
1326 elements of the new list are shared with the initial list.
1330 specifier_process_inst_list (Lisp_Object inst_list,
1331 Lisp_Object tag_set, int exact_p,
1332 int short_p, int copy_tree_p)
1334 Lisp_Object retval = Qnil;
1336 struct gcpro gcpro1;
1339 LIST_LOOP (rest, inst_list)
1341 Lisp_Object tagged_inst = XCAR (rest);
1342 Lisp_Object tagged_inst_tag = XCAR (tagged_inst);
1343 if (tag_sets_match_p (tag_set, tagged_inst_tag, exact_p))
1345 if (short_p && NILP (tagged_inst_tag))
1346 retval = Fcons (copy_tree_p ?
1347 Fcopy_tree (XCDR (tagged_inst), Qt) :
1351 retval = Fcons (copy_tree_p ? Fcopy_tree (tagged_inst, Qt) :
1352 tagged_inst, retval);
1355 retval = Fnreverse (retval);
1357 /* If there is a single instantiator and the short form is
1358 requested, return just the instantiator (rather than a one-element
1359 list of it) unless it is nil (so that it can be distinguished from
1360 no instantiators at all). */
1361 if (short_p && CONSP (retval) && !NILP (XCAR (retval)) &&
1362 NILP (XCDR (retval)))
1363 return XCAR (retval);
1369 specifier_get_external_inst_list (Lisp_Object specifier, Lisp_Object locale,
1370 enum spec_locale_type type,
1371 Lisp_Object tag_set, int exact_p,
1372 int short_p, int copy_tree_p)
1374 Lisp_Object *inst_list = specifier_get_inst_list (specifier, locale,
1376 if (!inst_list || NILP (*inst_list))
1378 /* nil for *inst_list should only occur in 'global */
1379 assert (!inst_list || EQ (locale, Qglobal));
1383 return specifier_process_inst_list (*inst_list, tag_set, exact_p,
1384 short_p, copy_tree_p);
1388 specifier_get_external_spec_list (Lisp_Object specifier,
1389 enum spec_locale_type type,
1390 Lisp_Object tag_set, int exact_p)
1392 Lisp_Object *spec_list = SPECIFIER_GET_SPEC_LIST (specifier, type);
1393 Lisp_Object retval = Qnil;
1395 struct gcpro gcpro1;
1397 assert (type != LOCALE_GLOBAL);
1398 /* We're about to let stuff go external; make sure there aren't
1400 *spec_list = cleanup_assoc_list (*spec_list);
1403 LIST_LOOP (rest, *spec_list)
1405 Lisp_Object spec = XCAR (rest);
1406 Lisp_Object inst_list =
1407 specifier_process_inst_list (XCDR (spec), tag_set, exact_p, 0, 1);
1408 if (!NILP (inst_list))
1409 retval = Fcons (Fcons (XCAR (spec), inst_list), retval);
1411 RETURN_UNGCPRO (Fnreverse (retval));
1414 static Lisp_Object *
1415 specifier_new_spec (Lisp_Object specifier, Lisp_Object locale,
1416 enum spec_locale_type type)
1418 Lisp_Object *spec_list = SPECIFIER_GET_SPEC_LIST (specifier, type);
1419 Lisp_Object new_spec = Fcons (locale, Qnil);
1420 assert (type != LOCALE_GLOBAL);
1421 *spec_list = Fcons (new_spec, *spec_list);
1422 return &XCDR (new_spec);
1425 /* For the given INST_LIST, return a new list comprised of elements
1426 where TAG_SET does not match the element's tag set. This operation
1430 specifier_process_remove_inst_list (Lisp_Object inst_list,
1431 Lisp_Object tag_set, int exact_p,
1434 Lisp_Object prev = Qnil, rest;
1438 LIST_LOOP (rest, inst_list)
1440 if (tag_sets_match_p (tag_set, XCAR (XCAR (rest)), exact_p))
1442 /* time to remove. */
1445 inst_list = XCDR (rest);
1447 XCDR (prev) = XCDR (rest);
1457 specifier_remove_spec (Lisp_Object specifier, Lisp_Object locale,
1458 enum spec_locale_type type,
1459 Lisp_Object tag_set, int exact_p)
1461 Lisp_Object *spec_list = SPECIFIER_GET_SPEC_LIST (specifier, type);
1465 if (type == LOCALE_GLOBAL)
1466 *spec_list = specifier_process_remove_inst_list (*spec_list, tag_set,
1467 exact_p, &was_removed);
1470 assoc = assq_no_quit (locale, *spec_list);
1472 /* this locale is not found. */
1474 XCDR (assoc) = specifier_process_remove_inst_list (XCDR (assoc),
1477 if (NILP (XCDR (assoc)))
1478 /* no inst-pairs left; remove this locale entirely. */
1479 *spec_list = remassq_no_quit (locale, *spec_list);
1483 MAYBE_SPECMETH (XSPECIFIER (specifier), after_change,
1484 (bodily_specifier (specifier), locale));
1488 specifier_remove_locale_type (Lisp_Object specifier,
1489 enum spec_locale_type type,
1490 Lisp_Object tag_set, int exact_p)
1492 Lisp_Object *spec_list = SPECIFIER_GET_SPEC_LIST (specifier, type);
1493 Lisp_Object prev = Qnil, rest;
1495 assert (type != LOCALE_GLOBAL);
1496 LIST_LOOP (rest, *spec_list)
1499 int remove_spec = 0;
1500 Lisp_Object spec = XCAR (rest);
1502 /* There may be dead objects floating around */
1503 /* remember, dead windows can become alive again. */
1504 if (!WINDOWP (XCAR (spec)) && object_dead_p (XCAR (spec)))
1511 XCDR (spec) = specifier_process_remove_inst_list (XCDR (spec),
1514 if (NILP (XCDR (spec)))
1521 *spec_list = XCDR (rest);
1523 XCDR (prev) = XCDR (rest);
1529 MAYBE_SPECMETH (XSPECIFIER (specifier), after_change,
1530 (bodily_specifier (specifier), XCAR (spec)));
1534 /* NEW_LIST is going to be added to INST_LIST, with add method ADD_METH.
1535 Frob INST_LIST according to ADD_METH. No need to call an after-change
1536 function; the calling function will do this. Return either SPEC_PREPEND
1537 or SPEC_APPEND, indicating whether to prepend or append the NEW_LIST. */
1539 static enum spec_add_meth
1540 handle_multiple_add_insts (Lisp_Object *inst_list,
1541 Lisp_Object new_list,
1542 enum spec_add_meth add_meth)
1546 case SPEC_REMOVE_TAG_SET_APPEND:
1547 add_meth = SPEC_APPEND;
1548 goto remove_tag_set;
1549 case SPEC_REMOVE_TAG_SET_PREPEND:
1550 add_meth = SPEC_PREPEND;
1555 LIST_LOOP (rest, new_list)
1557 Lisp_Object canontag = canonicalize_tag_set (XCAR (XCAR (rest)));
1558 struct gcpro gcpro1;
1561 /* pull out all elements from the existing list with the
1562 same tag as any tags in NEW_LIST. */
1563 *inst_list = remassoc_no_quit (canontag, *inst_list);
1568 case SPEC_REMOVE_LOCALE:
1570 return SPEC_PREPEND;
1574 return SPEC_PREPEND;
1578 /* Given a LOCALE and INST_LIST that is going to be added to SPECIFIER,
1579 copy, canonicalize, and call the going_to_add methods as necessary
1580 to produce a new list that is the one that really will be added
1581 to the specifier. */
1584 build_up_processed_list (Lisp_Object specifier, Lisp_Object locale,
1585 Lisp_Object inst_list)
1587 /* The return value of this function must be GCPRO'd. */
1588 Lisp_Object rest, list_to_build_up = Qnil;
1589 struct Lisp_Specifier *sp = XSPECIFIER (specifier);
1590 struct gcpro gcpro1;
1592 GCPRO1 (list_to_build_up);
1593 LIST_LOOP (rest, inst_list)
1595 Lisp_Object tag_set = XCAR (XCAR (rest));
1596 Lisp_Object instantiator = Fcopy_tree (XCDR (XCAR (rest)), Qt);
1597 Lisp_Object sub_inst_list = Qnil;
1598 struct gcpro ngcpro1, ngcpro2;
1600 NGCPRO2 (instantiator, sub_inst_list);
1601 /* call the will-add method; it may GC */
1602 sub_inst_list = HAS_SPECMETH_P (sp, going_to_add) ?
1603 SPECMETH (sp, going_to_add,
1604 (bodily_specifier (specifier), locale,
1605 tag_set, instantiator)) :
1607 if (EQ (sub_inst_list, Qt))
1608 /* no change here. */
1609 sub_inst_list = list1 (Fcons (canonicalize_tag_set (tag_set),
1613 /* now canonicalize all the tag sets in the new objects */
1615 LIST_LOOP (rest2, sub_inst_list)
1616 XCAR (XCAR (rest2)) = canonicalize_tag_set (XCAR (XCAR (rest2)));
1619 list_to_build_up = nconc2 (sub_inst_list, list_to_build_up);
1623 RETURN_UNGCPRO (Fnreverse (list_to_build_up));
1626 /* Add a specification (locale and instantiator list) to a specifier.
1627 ADD_METH specifies what to do with existing specifications in the
1628 specifier, and is an enum that corresponds to the values in
1629 `add-spec-to-specifier'. The calling routine is responsible for
1630 validating LOCALE and INST-LIST, but the tag-sets in INST-LIST
1631 do not need to be canonicalized. */
1633 /* #### I really need to rethink the after-change
1634 functions to make them easier to use and more efficient. */
1637 specifier_add_spec (Lisp_Object specifier, Lisp_Object locale,
1638 Lisp_Object inst_list, enum spec_add_meth add_meth)
1640 struct Lisp_Specifier *sp = XSPECIFIER (specifier);
1641 enum spec_locale_type type = locale_type_from_locale (locale);
1642 Lisp_Object *orig_inst_list, tem;
1643 Lisp_Object list_to_build_up = Qnil;
1644 struct gcpro gcpro1;
1646 GCPRO1 (list_to_build_up);
1647 list_to_build_up = build_up_processed_list (specifier, locale, inst_list);
1648 /* Now handle REMOVE_LOCALE_TYPE and REMOVE_ALL. These are the
1649 add-meth types that affect locales other than this one. */
1650 if (add_meth == SPEC_REMOVE_LOCALE_TYPE)
1651 specifier_remove_locale_type (specifier, type, Qnil, 0);
1652 else if (add_meth == SPEC_REMOVE_ALL)
1654 specifier_remove_locale_type (specifier, LOCALE_BUFFER, Qnil, 0);
1655 specifier_remove_locale_type (specifier, LOCALE_WINDOW, Qnil, 0);
1656 specifier_remove_locale_type (specifier, LOCALE_FRAME, Qnil, 0);
1657 specifier_remove_locale_type (specifier, LOCALE_DEVICE, Qnil, 0);
1658 specifier_remove_spec (specifier, Qglobal, LOCALE_GLOBAL, Qnil, 0);
1661 orig_inst_list = specifier_get_inst_list (specifier, locale, type);
1662 if (!orig_inst_list)
1663 orig_inst_list = specifier_new_spec (specifier, locale, type);
1664 add_meth = handle_multiple_add_insts (orig_inst_list, list_to_build_up,
1667 if (add_meth == SPEC_PREPEND)
1668 tem = nconc2 (list_to_build_up, *orig_inst_list);
1669 else if (add_meth == SPEC_APPEND)
1670 tem = nconc2 (*orig_inst_list, list_to_build_up);
1674 *orig_inst_list = tem;
1678 /* call the after-change method */
1679 MAYBE_SPECMETH (sp, after_change,
1680 (bodily_specifier (specifier), locale));
1684 specifier_copy_spec (Lisp_Object specifier, Lisp_Object dest,
1685 Lisp_Object locale, enum spec_locale_type type,
1686 Lisp_Object tag_set, int exact_p,
1687 enum spec_add_meth add_meth)
1689 Lisp_Object inst_list =
1690 specifier_get_external_inst_list (specifier, locale, type, tag_set,
1692 specifier_add_spec (dest, locale, inst_list, add_meth);
1696 specifier_copy_locale_type (Lisp_Object specifier, Lisp_Object dest,
1697 enum spec_locale_type type,
1698 Lisp_Object tag_set, int exact_p,
1699 enum spec_add_meth add_meth)
1701 Lisp_Object *src_list = SPECIFIER_GET_SPEC_LIST (specifier, type);
1704 /* This algorithm is O(n^2) in running time.
1705 It's certainly possible to implement an O(n log n) algorithm,
1706 but I doubt there's any need to. */
1708 LIST_LOOP (rest, *src_list)
1710 Lisp_Object spec = XCAR (rest);
1711 /* There may be dead objects floating around */
1712 /* remember, dead windows can become alive again. */
1713 if (WINDOWP (XCAR (spec)) || !object_dead_p (XCAR (spec)))
1716 specifier_process_inst_list (XCDR (spec), tag_set, exact_p, 0, 0),
1721 /* map MAPFUN over the locales in SPECIFIER that are given in LOCALE.
1722 CLOSURE is passed unchanged to MAPFUN. LOCALE can be one of
1724 -- nil (same as 'all)
1725 -- a single locale, locale type, or 'all
1726 -- a list of locales, locale types, and/or 'all
1728 MAPFUN is called for each locale and locale type given; for 'all,
1729 it is called for the locale 'global and for the four possible
1730 locale types. In each invocation, either LOCALE will be a locale
1731 and LOCALE_TYPE will be the locale type of this locale,
1732 or LOCALE will be nil and LOCALE_TYPE will be a locale type.
1733 If MAPFUN ever returns non-zero, the mapping is halted and the
1734 value returned is returned from map_specifier(). Otherwise, the
1735 mapping proceeds to the end and map_specifier() returns 0.
1739 map_specifier (Lisp_Object specifier, Lisp_Object locale,
1740 int (*mapfun) (Lisp_Object specifier,
1742 enum spec_locale_type locale_type,
1743 Lisp_Object tag_set,
1746 Lisp_Object tag_set, Lisp_Object exact_p,
1751 struct gcpro gcpro1, gcpro2;
1753 GCPRO2 (tag_set, locale);
1754 locale = decode_locale_list (locale);
1755 tag_set = decode_specifier_tag_set (tag_set);
1756 tag_set = canonicalize_tag_set (tag_set);
1758 LIST_LOOP (rest, locale)
1760 Lisp_Object theloc = XCAR (rest);
1761 if (!NILP (Fvalid_specifier_locale_p (theloc)))
1763 retval = (*mapfun) (specifier, theloc,
1764 locale_type_from_locale (theloc),
1765 tag_set, !NILP (exact_p), closure);
1769 else if (!NILP (Fvalid_specifier_locale_type_p (theloc)))
1771 retval = (*mapfun) (specifier, Qnil,
1772 decode_locale_type (theloc), tag_set,
1773 !NILP (exact_p), closure);
1779 assert (EQ (theloc, Qall));
1780 retval = (*mapfun) (specifier, Qnil, LOCALE_BUFFER, tag_set,
1781 !NILP (exact_p), closure);
1784 retval = (*mapfun) (specifier, Qnil, LOCALE_WINDOW, tag_set,
1785 !NILP (exact_p), closure);
1788 retval = (*mapfun) (specifier, Qnil, LOCALE_FRAME, tag_set,
1789 !NILP (exact_p), closure);
1792 retval = (*mapfun) (specifier, Qnil, LOCALE_DEVICE, tag_set,
1793 !NILP (exact_p), closure);
1796 retval = (*mapfun) (specifier, Qglobal, LOCALE_GLOBAL, tag_set,
1797 !NILP (exact_p), closure);
1807 DEFUN ("add-spec-to-specifier", Fadd_spec_to_specifier, 2, 5, 0, /*
1808 Add a specification to SPECIFIER.
1809 The specification maps from LOCALE (which should be a window, buffer,
1810 frame, device, or 'global, and defaults to 'global) to INSTANTIATOR,
1811 whose allowed values depend on the type of the specifier. Optional
1812 argument TAG-SET limits the instantiator to apply only to the specified
1813 tag set, which should be a list of tags all of which must match the
1814 device being instantiated over (tags are a device type, a device class,
1815 or tags defined with `define-specifier-tag'). Specifying a single
1816 symbol for TAG-SET is equivalent to specifying a one-element list
1817 containing that symbol. Optional argument HOW-TO-ADD specifies what to
1818 do if there are already specifications in the specifier.
1821 'prepend Put at the beginning of the current list of
1822 instantiators for LOCALE.
1823 'append Add to the end of the current list of
1824 instantiators for LOCALE.
1825 'remove-tag-set-prepend (this is the default)
1826 Remove any existing instantiators whose tag set is
1827 the same as TAG-SET; then put the new instantiator
1828 at the beginning of the current list. ("Same tag
1829 set" means that they contain the same elements.
1830 The order may be different.)
1831 'remove-tag-set-append
1832 Remove any existing instantiators whose tag set is
1833 the same as TAG-SET; then put the new instantiator
1834 at the end of the current list.
1835 'remove-locale Remove all previous instantiators for this locale
1836 before adding the new spec.
1837 'remove-locale-type Remove all specifications for all locales of the
1838 same type as LOCALE (this includes LOCALE itself)
1839 before adding the new spec.
1840 'remove-all Remove all specifications from the specifier
1841 before adding the new spec.
1843 You can retrieve the specifications for a particular locale or locale type
1844 with the function `specifier-spec-list' or `specifier-specs'.
1846 (specifier, instantiator, locale, tag_set, how_to_add))
1848 enum spec_add_meth add_meth;
1849 Lisp_Object inst_list;
1850 struct gcpro gcpro1;
1852 CHECK_SPECIFIER (specifier);
1853 check_modifiable_specifier (specifier);
1855 locale = decode_locale (locale);
1856 check_valid_instantiator (instantiator,
1857 decode_specifier_type
1858 (Fspecifier_type (specifier), ERROR_ME),
1860 /* tag_set might be newly-created material, but it's part of inst_list
1861 so is properly GC-protected. */
1862 tag_set = decode_specifier_tag_set (tag_set);
1863 add_meth = decode_how_to_add_specification (how_to_add);
1865 inst_list = list1 (Fcons (tag_set, instantiator));
1867 specifier_add_spec (specifier, locale, inst_list, add_meth);
1868 recompute_cached_specifier_everywhere (specifier);
1869 RETURN_UNGCPRO (Qnil);
1872 DEFUN ("add-spec-list-to-specifier", Fadd_spec_list_to_specifier, 2, 3, 0, /*
1873 Add a spec-list (a list of specifications) to SPECIFIER.
1874 The format of a spec-list is
1876 ((LOCALE (TAG-SET . INSTANTIATOR) ...) ...)
1879 LOCALE := a window, a buffer, a frame, a device, or 'global
1880 TAG-SET := an unordered list of zero or more TAGS, each of which
1882 TAG := a device class (see `valid-device-class-p'), a device type
1883 (see `valid-console-type-p'), or a tag defined with
1884 `define-specifier-tag'
1885 INSTANTIATOR := format determined by the type of specifier
1887 The pair (TAG-SET . INSTANTIATOR) is called an `inst-pair'.
1888 A list of inst-pairs is called an `inst-list'.
1889 The pair (LOCALE . INST-LIST) is called a `specification' or `spec'.
1890 A spec-list, then, can be viewed as a list of specifications.
1892 HOW-TO-ADD specifies how to combine the new specifications with
1893 the existing ones, and has the same semantics as for
1894 `add-spec-to-specifier'.
1896 In many circumstances, the higher-level function `set-specifier' is
1897 more convenient and should be used instead.
1899 (specifier, spec_list, how_to_add))
1901 enum spec_add_meth add_meth;
1904 CHECK_SPECIFIER (specifier);
1905 check_modifiable_specifier (specifier);
1907 check_valid_spec_list (spec_list,
1908 decode_specifier_type
1909 (Fspecifier_type (specifier), ERROR_ME),
1911 add_meth = decode_how_to_add_specification (how_to_add);
1913 LIST_LOOP (rest, spec_list)
1915 /* Placating the GCC god. */
1916 Lisp_Object specification = XCAR (rest);
1917 Lisp_Object locale = XCAR (specification);
1918 Lisp_Object inst_list = XCDR (specification);
1920 specifier_add_spec (specifier, locale, inst_list, add_meth);
1922 recompute_cached_specifier_everywhere (specifier);
1927 add_spec_to_ghost_specifier (Lisp_Object specifier, Lisp_Object instantiator,
1928 Lisp_Object locale, Lisp_Object tag_set,
1929 Lisp_Object how_to_add)
1931 int depth = unlock_ghost_specifiers_protected ();
1932 Fadd_spec_to_specifier (XSPECIFIER(specifier)->fallback,
1933 instantiator, locale, tag_set, how_to_add);
1934 unbind_to (depth, Qnil);
1937 struct specifier_spec_list_closure
1939 Lisp_Object head, tail;
1943 specifier_spec_list_mapfun (Lisp_Object specifier,
1945 enum spec_locale_type locale_type,
1946 Lisp_Object tag_set,
1950 struct specifier_spec_list_closure *cl =
1951 (struct specifier_spec_list_closure *) closure;
1952 Lisp_Object partial;
1955 partial = specifier_get_external_spec_list (specifier,
1960 partial = specifier_get_external_inst_list (specifier, locale,
1961 locale_type, tag_set,
1963 if (!NILP (partial))
1964 partial = list1 (Fcons (locale, partial));
1969 /* tack on the new list */
1970 if (NILP (cl->tail))
1971 cl->head = cl->tail = partial;
1973 XCDR (cl->tail) = partial;
1974 /* find the new tail */
1975 while (CONSP (XCDR (cl->tail)))
1976 cl->tail = XCDR (cl->tail);
1980 /* For the given SPECIFIER create and return a list of all specs
1981 contained within it, subject to LOCALE. If LOCALE is a locale, only
1982 specs in that locale will be returned. If LOCALE is a locale type,
1983 all specs in all locales of that type will be returned. If LOCALE is
1984 nil, all specs will be returned. This always copies lists and never
1985 returns the actual lists, because we do not want someone manipulating
1986 the actual objects. This may cause a slight loss of potential
1987 functionality but if we were to allow it then a user could manage to
1988 violate our assertion that the specs contained in the actual
1989 specifier lists are all valid. */
1991 DEFUN ("specifier-spec-list", Fspecifier_spec_list, 1, 4, 0, /*
1992 Return the spec-list of specifications for SPECIFIER in LOCALE.
1994 If LOCALE is a particular locale (a buffer, window, frame, device,
1995 or 'global), a spec-list consisting of the specification for that
1996 locale will be returned.
1998 If LOCALE is a locale type (i.e. 'buffer, 'window, 'frame, or 'device),
1999 a spec-list of the specifications for all locales of that type will be
2002 If LOCALE is nil or 'all, a spec-list of all specifications in SPECIFIER
2005 LOCALE can also be a list of locales, locale types, and/or 'all; the
2006 result is as if `specifier-spec-list' were called on each element of the
2007 list and the results concatenated together.
2009 Only instantiators where TAG-SET (a list of zero or more tags) is a
2010 subset of (or possibly equal to) the instantiator's tag set are returned.
2011 \(The default value of nil is a subset of all tag sets, so in this case
2012 no instantiators will be screened out.) If EXACT-P is non-nil, however,
2013 TAG-SET must be equal to an instantiator's tag set for the instantiator
2016 (specifier, locale, tag_set, exact_p))
2018 struct specifier_spec_list_closure cl;
2019 struct gcpro gcpro1, gcpro2;
2021 CHECK_SPECIFIER (specifier);
2022 cl.head = cl.tail = Qnil;
2023 GCPRO2 (cl.head, cl.tail);
2024 map_specifier (specifier, locale, specifier_spec_list_mapfun,
2025 tag_set, exact_p, &cl);
2031 DEFUN ("specifier-specs", Fspecifier_specs, 1, 4, 0, /*
2032 Return the specification(s) for SPECIFIER in LOCALE.
2034 If LOCALE is a single locale or is a list of one element containing a
2035 single locale, then a "short form" of the instantiators for that locale
2036 will be returned. Otherwise, this function is identical to
2037 `specifier-spec-list'.
2039 The "short form" is designed for readability and not for ease of use
2040 in Lisp programs, and is as follows:
2042 1. If there is only one instantiator, then an inst-pair (i.e. cons of
2043 tag and instantiator) will be returned; otherwise a list of
2044 inst-pairs will be returned.
2045 2. For each inst-pair returned, if the instantiator's tag is 'any,
2046 the tag will be removed and the instantiator itself will be returned
2047 instead of the inst-pair.
2048 3. If there is only one instantiator, its value is nil, and its tag is
2049 'any, a one-element list containing nil will be returned rather
2050 than just nil, to distinguish this case from there being no
2051 instantiators at all.
2053 (specifier, locale, tag_set, exact_p))
2055 if (!NILP (Fvalid_specifier_locale_p (locale)) ||
2056 (CONSP (locale) && !NILP (Fvalid_specifier_locale_p (XCAR (locale))) &&
2057 NILP (XCDR (locale))))
2059 struct gcpro gcpro1;
2061 CHECK_SPECIFIER (specifier);
2063 locale = XCAR (locale);
2065 tag_set = decode_specifier_tag_set (tag_set);
2066 tag_set = canonicalize_tag_set (tag_set);
2068 (specifier_get_external_inst_list (specifier, locale,
2069 locale_type_from_locale (locale),
2070 tag_set, !NILP (exact_p), 1, 1));
2073 return Fspecifier_spec_list (specifier, locale, tag_set, exact_p);
2077 remove_specifier_mapfun (Lisp_Object specifier,
2079 enum spec_locale_type locale_type,
2080 Lisp_Object tag_set,
2082 void *ignored_closure)
2085 specifier_remove_locale_type (specifier, locale_type, tag_set, exact_p);
2087 specifier_remove_spec (specifier, locale, locale_type, tag_set, exact_p);
2091 DEFUN ("remove-specifier", Fremove_specifier, 1, 4, 0, /*
2092 Remove specification(s) for SPECIFIER.
2094 If LOCALE is a particular locale (a window, buffer, frame, device,
2095 or 'global), the specification for that locale will be removed.
2097 If instead, LOCALE is a locale type (i.e. 'window, 'buffer, 'frame,
2098 or 'device), the specifications for all locales of that type will be
2101 If LOCALE is nil or 'all, all specifications will be removed.
2103 LOCALE can also be a list of locales, locale types, and/or 'all; this
2104 is equivalent to calling `remove-specifier' for each of the elements
2107 Only instantiators where TAG-SET (a list of zero or more tags) is a
2108 subset of (or possibly equal to) the instantiator's tag set are removed.
2109 The default value of nil is a subset of all tag sets, so in this case
2110 no instantiators will be screened out. If EXACT-P is non-nil, however,
2111 TAG-SET must be equal to an instantiator's tag set for the instantiator
2114 (specifier, locale, tag_set, exact_p))
2116 CHECK_SPECIFIER (specifier);
2117 check_modifiable_specifier (specifier);
2119 map_specifier (specifier, locale, remove_specifier_mapfun,
2120 tag_set, exact_p, 0);
2121 recompute_cached_specifier_everywhere (specifier);
2126 remove_ghost_specifier (Lisp_Object specifier, Lisp_Object locale,
2127 Lisp_Object tag_set, Lisp_Object exact_p)
2129 int depth = unlock_ghost_specifiers_protected ();
2130 Fremove_specifier (XSPECIFIER(specifier)->fallback,
2131 locale, tag_set, exact_p);
2132 unbind_to (depth, Qnil);
2135 struct copy_specifier_closure
2138 enum spec_add_meth add_meth;
2139 int add_meth_is_nil;
2143 copy_specifier_mapfun (Lisp_Object specifier,
2145 enum spec_locale_type locale_type,
2146 Lisp_Object tag_set,
2150 struct copy_specifier_closure *cl =
2151 (struct copy_specifier_closure *) closure;
2154 specifier_copy_locale_type (specifier, cl->dest, locale_type,
2156 cl->add_meth_is_nil ?
2157 SPEC_REMOVE_LOCALE_TYPE :
2160 specifier_copy_spec (specifier, cl->dest, locale, locale_type,
2162 cl->add_meth_is_nil ? SPEC_REMOVE_LOCALE :
2167 DEFUN ("copy-specifier", Fcopy_specifier, 1, 6, 0, /*
2168 Copy SPECIFIER to DEST, or create a new one if DEST is nil.
2170 If DEST is nil or omitted, a new specifier will be created and the
2171 specifications copied into it. Otherwise, the specifications will be
2172 copied into the existing specifier in DEST.
2174 If LOCALE is nil or 'all, all specifications will be copied. If LOCALE
2175 is a particular locale, the specification for that particular locale will
2176 be copied. If LOCALE is a locale type, the specifications for all locales
2177 of that type will be copied. LOCALE can also be a list of locales,
2178 locale types, and/or 'all; this is equivalent to calling `copy-specifier'
2179 for each of the elements of the list. See `specifier-spec-list' for more
2180 information about LOCALE.
2182 Only instantiators where TAG-SET (a list of zero or more tags) is a
2183 subset of (or possibly equal to) the instantiator's tag set are copied.
2184 The default value of nil is a subset of all tag sets, so in this case
2185 no instantiators will be screened out. If EXACT-P is non-nil, however,
2186 TAG-SET must be equal to an instantiator's tag set for the instantiator
2189 Optional argument HOW-TO-ADD specifies what to do with existing
2190 specifications in DEST. If nil, then whichever locales or locale types
2191 are copied will first be completely erased in DEST. Otherwise, it is
2192 the same as in `add-spec-to-specifier'.
2194 (specifier, dest, locale, tag_set, exact_p, how_to_add))
2196 struct gcpro gcpro1;
2197 struct copy_specifier_closure cl;
2199 CHECK_SPECIFIER (specifier);
2200 if (NILP (how_to_add))
2201 cl.add_meth_is_nil = 1;
2203 cl.add_meth_is_nil = 0;
2204 cl.add_meth = decode_how_to_add_specification (how_to_add);
2207 /* #### What about copying the extra data? */
2208 dest = make_specifier (XSPECIFIER (specifier)->methods);
2212 CHECK_SPECIFIER (dest);
2213 check_modifiable_specifier (dest);
2214 if (XSPECIFIER (dest)->methods != XSPECIFIER (specifier)->methods)
2215 error ("Specifiers not of same type");
2220 map_specifier (specifier, locale, copy_specifier_mapfun,
2221 tag_set, exact_p, &cl);
2223 recompute_cached_specifier_everywhere (dest);
2228 /************************************************************************/
2230 /************************************************************************/
2233 call_validate_matchspec_method (Lisp_Object boxed_method,
2234 Lisp_Object matchspec)
2236 ((void (*)(Lisp_Object)) get_opaque_ptr (boxed_method)) (matchspec);
2241 check_valid_specifier_matchspec (Lisp_Object matchspec,
2242 struct specifier_methods *meths,
2243 Error_behavior errb)
2245 if (meths->validate_matchspec_method)
2249 if (ERRB_EQ (errb, ERROR_ME))
2251 (meths->validate_matchspec_method) (matchspec);
2256 Lisp_Object opaque =
2257 make_opaque_ptr ((void *) meths->validate_matchspec_method);
2258 struct gcpro gcpro1;
2261 retval = call_with_suspended_errors
2262 ((lisp_fn_t) call_validate_matchspec_method,
2263 Qnil, Qspecifier, errb, 2, opaque, matchspec);
2265 free_opaque_ptr (opaque);
2273 maybe_signal_simple_error
2274 ("Matchspecs not allowed for this specifier type",
2275 intern (meths->name), Qspecifier, errb);
2280 DEFUN ("check-valid-specifier-matchspec", Fcheck_valid_specifier_matchspec, 2, 2, 0, /*
2281 Signal an error if MATCHSPEC is invalid for SPECIFIER-TYPE.
2282 See `specifier-matching-instance' for a description of matchspecs.
2284 (matchspec, specifier_type))
2286 struct specifier_methods *meths = decode_specifier_type (specifier_type,
2289 return check_valid_specifier_matchspec (matchspec, meths, ERROR_ME);
2292 DEFUN ("valid-specifier-matchspec-p", Fvalid_specifier_matchspec_p, 2, 2, 0, /*
2293 Return non-nil if MATCHSPEC is valid for SPECIFIER-TYPE.
2294 See `specifier-matching-instance' for a description of matchspecs.
2296 (matchspec, specifier_type))
2298 struct specifier_methods *meths = decode_specifier_type (specifier_type,
2301 return check_valid_specifier_matchspec (matchspec, meths, ERROR_ME_NOT);
2304 /* This function is purposely not callable from Lisp. If a Lisp
2305 caller wants to set a fallback, they should just set the
2309 set_specifier_fallback (Lisp_Object specifier, Lisp_Object fallback)
2311 struct Lisp_Specifier *sp = XSPECIFIER (specifier);
2312 assert (SPECIFIERP (fallback) ||
2313 !NILP (Fvalid_inst_list_p (fallback, Fspecifier_type (specifier))));
2314 if (SPECIFIERP (fallback))
2315 assert (EQ (Fspecifier_type (specifier), Fspecifier_type (fallback)));
2316 if (BODILY_SPECIFIER_P (sp))
2317 GHOST_SPECIFIER(sp)->fallback = fallback;
2319 sp->fallback = fallback;
2320 /* call the after-change method */
2321 MAYBE_SPECMETH (sp, after_change,
2322 (bodily_specifier (specifier), Qfallback));
2323 recompute_cached_specifier_everywhere (specifier);
2326 DEFUN ("specifier-fallback", Fspecifier_fallback, 1, 1, 0, /*
2327 Return the fallback value for SPECIFIER.
2328 Fallback values are provided by the C code for certain built-in
2329 specifiers to make sure that instancing won't fail even if all
2330 specs are removed from the specifier, or to implement simple
2331 inheritance behavior (e.g. this method is used to ensure that
2332 faces other than 'default inherit their attributes from 'default).
2333 By design, you cannot change the fallback value, and specifiers
2334 created with `make-specifier' will never have a fallback (although
2335 a similar, Lisp-accessible capability may be provided in the future
2336 to allow for inheritance).
2338 The fallback value will be an inst-list that is instanced like
2339 any other inst-list, a specifier of the same type as SPECIFIER
2340 \(results in inheritance), or nil for no fallback.
2342 When you instance a specifier, you can explicitly request that the
2343 fallback not be consulted. (The C code does this, for example, when
2344 merging faces.) See `specifier-instance'.
2348 CHECK_SPECIFIER (specifier);
2349 return Fcopy_tree (XSPECIFIER (specifier)->fallback, Qt);
2353 specifier_instance_from_inst_list (Lisp_Object specifier,
2354 Lisp_Object matchspec,
2356 Lisp_Object inst_list,
2357 Error_behavior errb, int no_quit,
2360 /* This function can GC */
2361 struct Lisp_Specifier *sp;
2364 int count = specpdl_depth ();
2365 struct gcpro gcpro1, gcpro2;
2367 GCPRO2 (specifier, inst_list);
2369 sp = XSPECIFIER (specifier);
2370 device = DFW_DEVICE (domain);
2373 /* The instantiate method is allowed to call eval. Since it
2374 is quite common for this function to get called from somewhere in
2375 redisplay we need to make sure that quits are ignored. Otherwise
2376 Fsignal will abort. */
2377 specbind (Qinhibit_quit, Qt);
2379 LIST_LOOP (rest, inst_list)
2381 Lisp_Object tagged_inst = XCAR (rest);
2382 Lisp_Object tag_set = XCAR (tagged_inst);
2384 if (device_matches_specifier_tag_set_p (device, tag_set))
2386 Lisp_Object val = XCDR (tagged_inst);
2388 if (HAS_SPECMETH_P (sp, instantiate))
2389 val = call_with_suspended_errors
2390 ((lisp_fn_t) RAW_SPECMETH (sp, instantiate),
2391 Qunbound, Qspecifier, errb, 5, specifier,
2392 matchspec, domain, val, depth);
2394 if (!UNBOUNDP (val))
2396 unbind_to (count, Qnil);
2403 unbind_to (count, Qnil);
2408 /* Given a SPECIFIER and a DOMAIN, return a specific instance for that
2409 specifier. Try to find one by checking the specifier types from most
2410 specific (buffer) to most general (global). If we find an instance,
2411 return it. Otherwise return Qunbound. */
2413 #define CHECK_INSTANCE_ENTRY(key, matchspec, type) do { \
2414 Lisp_Object *CIE_inst_list = \
2415 specifier_get_inst_list (specifier, key, type); \
2416 if (CIE_inst_list) \
2418 Lisp_Object CIE_val = \
2419 specifier_instance_from_inst_list (specifier, matchspec, \
2420 domain, *CIE_inst_list, \
2421 errb, no_quit, depth); \
2422 if (!UNBOUNDP (CIE_val)) \
2427 /* We accept any window, frame or device domain and do our checking
2428 starting from as specific a locale type as we can determine from the
2429 domain we are passed and going on up through as many other locale types
2430 as we can determine. In practice, when called from redisplay the
2431 arg will usually be a window and occasionally a frame. If
2432 triggered by a user call, who knows what it will usually be. */
2434 specifier_instance (Lisp_Object specifier, Lisp_Object matchspec,
2435 Lisp_Object domain, Error_behavior errb, int no_quit,
2436 int no_fallback, Lisp_Object depth)
2438 Lisp_Object buffer = Qnil;
2439 Lisp_Object window = Qnil;
2440 Lisp_Object frame = Qnil;
2441 Lisp_Object device = Qnil;
2442 Lisp_Object tag = Qnil;
2444 struct Lisp_Specifier *sp;
2446 sp = XSPECIFIER (specifier);
2448 /* Attempt to determine buffer, window, frame, and device from the
2450 if (WINDOWP (domain))
2452 else if (FRAMEP (domain))
2454 else if (DEVICEP (domain))
2457 /* #### dmoore - dammit, this should just signal an error or something
2459 #### No. Errors are handled in Lisp primitives implementation.
2460 Invalid domain is a design error here - kkm. */
2463 if (NILP (buffer) && !NILP (window))
2464 buffer = XWINDOW (window)->buffer;
2465 if (NILP (frame) && !NILP (window))
2466 frame = XWINDOW (window)->frame;
2468 /* frame had better exist; if device is undeterminable, something
2469 really went wrong. */
2470 device = XFRAME (frame)->device;
2472 /* device had better be determined by now; abort if not. */
2473 d = XDEVICE (device);
2474 tag = DEVICE_CLASS (d);
2476 depth = make_int (1 + XINT (depth));
2477 if (XINT (depth) > 20)
2479 maybe_error (Qspecifier, errb, "Apparent loop in specifier inheritance");
2480 /* The specification is fucked; at least try the fallback
2481 (which better not be fucked, because it's not changeable
2488 /* First see if we can generate one from the window specifiers. */
2490 CHECK_INSTANCE_ENTRY (window, matchspec, LOCALE_WINDOW);
2492 /* Next see if we can generate one from the buffer specifiers. */
2494 CHECK_INSTANCE_ENTRY (buffer, matchspec, LOCALE_BUFFER);
2496 /* Next see if we can generate one from the frame specifiers. */
2498 CHECK_INSTANCE_ENTRY (frame, matchspec, LOCALE_FRAME);
2500 /* If we still haven't succeeded try with the device specifiers. */
2501 CHECK_INSTANCE_ENTRY (device, matchspec, LOCALE_DEVICE);
2503 /* Last and least try the global specifiers. */
2504 CHECK_INSTANCE_ENTRY (Qglobal, matchspec, LOCALE_GLOBAL);
2507 /* We're out of specifiers and we still haven't generated an
2508 instance. At least try the fallback ... If this fails,
2509 then we just return Qunbound. */
2511 if (no_fallback || NILP (sp->fallback))
2512 /* I said, I don't want the fallbacks. */
2515 if (SPECIFIERP (sp->fallback))
2517 /* If you introduced loops in the default specifier chain,
2518 then you're fucked, so you better not do this. */
2519 specifier = sp->fallback;
2520 sp = XSPECIFIER (specifier);
2524 assert (CONSP (sp->fallback));
2525 return specifier_instance_from_inst_list (specifier, matchspec, domain,
2526 sp->fallback, errb, no_quit,
2529 #undef CHECK_INSTANCE_ENTRY
2532 specifier_instance_no_quit (Lisp_Object specifier, Lisp_Object matchspec,
2533 Lisp_Object domain, Error_behavior errb,
2534 int no_fallback, Lisp_Object depth)
2536 return specifier_instance (specifier, matchspec, domain, errb,
2537 1, no_fallback, depth);
2540 DEFUN ("specifier-instance", Fspecifier_instance, 1, 4, 0, /*
2541 Instantiate SPECIFIER (return its value) in DOMAIN.
2542 If no instance can be generated for this domain, return DEFAULT.
2544 DOMAIN should be a window, frame, or device. Other values that are legal
2545 as a locale (e.g. a buffer) are not valid as a domain because they do not
2546 provide enough information to identify a particular device (see
2547 `valid-specifier-domain-p'). DOMAIN defaults to the selected window
2550 "Instantiating" a specifier in a particular domain means determining
2551 the specifier's "value" in that domain. This is accomplished by
2552 searching through the specifications in the specifier that correspond
2553 to all locales that can be derived from the given domain, from specific
2554 to general. In most cases, the domain is an Emacs window. In that case
2555 specifications are searched for as follows:
2557 1. A specification whose locale is the window itself;
2558 2. A specification whose locale is the window's buffer;
2559 3. A specification whose locale is the window's frame;
2560 4. A specification whose locale is the window's frame's device;
2561 5. A specification whose locale is 'global.
2563 If all of those fail, then the C-code-provided fallback value for
2564 this specifier is consulted (see `specifier-fallback'). If it is
2565 an inst-list, then this function attempts to instantiate that list
2566 just as when a specification is located in the first five steps above.
2567 If the fallback is a specifier, `specifier-instance' is called
2568 recursively on this specifier and the return value used. Note,
2569 however, that if the optional argument NO-FALLBACK is non-nil,
2570 the fallback value will not be consulted.
2572 Note that there may be more than one specification matching a particular
2573 locale; all such specifications are considered before looking for any
2574 specifications for more general locales. Any particular specification
2575 that is found may be rejected because its tag set does not match the
2576 device being instantiated over, or because the specification is not
2577 valid for the device of the given domain (e.g. the font or color name
2578 does not exist for this particular X server).
2580 The returned value is dependent on the type of specifier. For example,
2581 for a font specifier (as returned by the `face-font' function), the returned
2582 value will be a font-instance object. For glyphs, the returned value
2583 will be a string, pixmap, or subwindow.
2585 See also `specifier-matching-instance'.
2587 (specifier, domain, default_, no_fallback))
2589 Lisp_Object instance;
2591 CHECK_SPECIFIER (specifier);
2592 domain = decode_domain (domain);
2594 instance = specifier_instance (specifier, Qunbound, domain, ERROR_ME, 0,
2595 !NILP (no_fallback), Qzero);
2596 return UNBOUNDP (instance) ? default_ : instance;
2599 DEFUN ("specifier-matching-instance", Fspecifier_matching_instance, 2, 5, 0, /*
2600 Return an instance for SPECIFIER in DOMAIN that matches MATCHSPEC.
2601 If no instance can be generated for this domain, return DEFAULT.
2603 This function is identical to `specifier-instance' except that a
2604 specification will only be considered if it matches MATCHSPEC.
2605 The definition of "match", and allowed values for MATCHSPEC, are
2606 dependent on the particular type of specifier. Here are some examples:
2608 -- For chartable (e.g. display table) specifiers, MATCHSPEC should be a
2609 character, and the specification (a chartable) must give a value for
2610 that character in order to be considered. This allows you to specify,
2611 e.g., a buffer-local display table that only gives values for particular
2612 characters. All other characters are handled as if the buffer-local
2613 display table is not there. (Chartable specifiers are not yet
2616 -- For font specifiers, MATCHSPEC should be a charset, and the specification
2617 (a font string) must have a registry that matches the charset's registry.
2618 (This only makes sense with Mule support.) This makes it easy to choose a
2619 font that can display a particular character. (This is what redisplay
2622 (specifier, matchspec, domain, default_, no_fallback))
2624 Lisp_Object instance;
2626 CHECK_SPECIFIER (specifier);
2627 check_valid_specifier_matchspec (matchspec, XSPECIFIER (specifier)->methods,
2629 domain = decode_domain (domain);
2631 instance = specifier_instance (specifier, matchspec, domain, ERROR_ME,
2632 0, !NILP (no_fallback), Qzero);
2633 return UNBOUNDP (instance) ? default_ : instance;
2636 DEFUN ("specifier-instance-from-inst-list", Fspecifier_instance_from_inst_list,
2638 Attempt to convert a particular inst-list into an instance.
2639 This attempts to instantiate INST-LIST in the given DOMAIN,
2640 as if INST-LIST existed in a specification in SPECIFIER. If
2641 the instantiation fails, DEFAULT is returned. In most circumstances,
2642 you should not use this function; use `specifier-instance' instead.
2644 (specifier, domain, inst_list, default_))
2646 Lisp_Object val = Qunbound;
2647 struct Lisp_Specifier *sp = XSPECIFIER (specifier);
2648 struct gcpro gcpro1;
2649 Lisp_Object built_up_list = Qnil;
2651 CHECK_SPECIFIER (specifier);
2652 check_valid_domain (domain);
2653 check_valid_inst_list (inst_list, sp->methods, ERROR_ME);
2654 GCPRO1 (built_up_list);
2655 built_up_list = build_up_processed_list (specifier, domain, inst_list);
2656 if (!NILP (built_up_list))
2657 val = specifier_instance_from_inst_list (specifier, Qunbound, domain,
2658 built_up_list, ERROR_ME,
2661 return UNBOUNDP (val) ? default_ : val;
2664 DEFUN ("specifier-matching-instance-from-inst-list", Fspecifier_matching_instance_from_inst_list,
2666 Attempt to convert a particular inst-list into an instance.
2667 This attempts to instantiate INST-LIST in the given DOMAIN
2668 \(as if INST-LIST existed in a specification in SPECIFIER),
2669 matching the specifications against MATCHSPEC.
2671 This function is analogous to `specifier-instance-from-inst-list'
2672 but allows for specification-matching as in `specifier-matching-instance'.
2673 See that function for a description of exactly how the matching process
2676 (specifier, matchspec, domain, inst_list, default_))
2678 Lisp_Object val = Qunbound;
2679 struct Lisp_Specifier *sp = XSPECIFIER (specifier);
2680 struct gcpro gcpro1;
2681 Lisp_Object built_up_list = Qnil;
2683 CHECK_SPECIFIER (specifier);
2684 check_valid_specifier_matchspec (matchspec, XSPECIFIER (specifier)->methods,
2686 check_valid_domain (domain);
2687 check_valid_inst_list (inst_list, sp->methods, ERROR_ME);
2688 GCPRO1 (built_up_list);
2689 built_up_list = build_up_processed_list (specifier, domain, inst_list);
2690 if (!NILP (built_up_list))
2691 val = specifier_instance_from_inst_list (specifier, matchspec, domain,
2692 built_up_list, ERROR_ME,
2695 return UNBOUNDP (val) ? default_ : val;
2699 /************************************************************************/
2700 /* Caching in the struct window or frame */
2701 /************************************************************************/
2703 /* Either STRUCT_WINDOW_OFFSET or STRUCT_FRAME_OFFSET can be 0 to indicate
2704 no caching in that sort of object. */
2706 /* #### It would be nice if the specifier caching automatically knew
2707 about specifier fallbacks, so we didn't have to do it ourselves. */
2710 set_specifier_caching (Lisp_Object specifier, int struct_window_offset,
2711 void (*value_changed_in_window)
2712 (Lisp_Object specifier, struct window *w,
2713 Lisp_Object oldval),
2714 int struct_frame_offset,
2715 void (*value_changed_in_frame)
2716 (Lisp_Object specifier, struct frame *f,
2717 Lisp_Object oldval))
2719 struct Lisp_Specifier *sp = XSPECIFIER (specifier);
2720 assert (!GHOST_SPECIFIER_P (sp));
2723 sp->caching = xnew_and_zero (struct specifier_caching);
2724 sp->caching->offset_into_struct_window = struct_window_offset;
2725 sp->caching->value_changed_in_window = value_changed_in_window;
2726 sp->caching->offset_into_struct_frame = struct_frame_offset;
2727 sp->caching->value_changed_in_frame = value_changed_in_frame;
2728 Vcached_specifiers = Fcons (specifier, Vcached_specifiers);
2729 if (BODILY_SPECIFIER_P (sp))
2730 GHOST_SPECIFIER(sp)->caching = sp->caching;
2731 recompute_cached_specifier_everywhere (specifier);
2735 recompute_one_cached_specifier_in_window (Lisp_Object specifier,
2739 Lisp_Object newval, *location;
2741 assert (!GHOST_SPECIFIER_P (XSPECIFIER (specifier)));
2743 XSETWINDOW (window, w);
2745 newval = specifier_instance (specifier, Qunbound, window, ERROR_ME_WARN,
2747 /* If newval ended up Qunbound, then the calling functions
2748 better be able to deal. If not, set a default so this
2749 never happens or correct it in the value_changed_in_window
2751 location = (Lisp_Object *)
2752 ((char *) w + XSPECIFIER (specifier)->caching->offset_into_struct_window);
2753 if (!EQ (newval, *location))
2755 Lisp_Object oldval = *location;
2757 (XSPECIFIER (specifier)->caching->value_changed_in_window)
2758 (specifier, w, oldval);
2763 recompute_one_cached_specifier_in_frame (Lisp_Object specifier,
2767 Lisp_Object newval, *location;
2769 assert (!GHOST_SPECIFIER_P (XSPECIFIER (specifier)));
2771 XSETFRAME (frame, f);
2773 newval = specifier_instance (specifier, Qunbound, frame, ERROR_ME_WARN,
2775 /* If newval ended up Qunbound, then the calling functions
2776 better be able to deal. If not, set a default so this
2777 never happens or correct it in the value_changed_in_frame
2779 location = (Lisp_Object *)
2780 ((char *) f + XSPECIFIER (specifier)->caching->offset_into_struct_frame);
2781 if (!EQ (newval, *location))
2783 Lisp_Object oldval = *location;
2785 (XSPECIFIER (specifier)->caching->value_changed_in_frame)
2786 (specifier, f, oldval);
2791 recompute_all_cached_specifiers_in_window (struct window *w)
2795 LIST_LOOP (rest, Vcached_specifiers)
2797 Lisp_Object specifier = XCAR (rest);
2798 if (XSPECIFIER (specifier)->caching->offset_into_struct_window)
2799 recompute_one_cached_specifier_in_window (specifier, w);
2804 recompute_all_cached_specifiers_in_frame (struct frame *f)
2808 LIST_LOOP (rest, Vcached_specifiers)
2810 Lisp_Object specifier = XCAR (rest);
2811 if (XSPECIFIER (specifier)->caching->offset_into_struct_frame)
2812 recompute_one_cached_specifier_in_frame (specifier, f);
2817 recompute_cached_specifier_everywhere_mapfun (struct window *w,
2820 Lisp_Object specifier = Qnil;
2822 VOID_TO_LISP (specifier, closure);
2823 recompute_one_cached_specifier_in_window (specifier, w);
2828 recompute_cached_specifier_everywhere (Lisp_Object specifier)
2830 Lisp_Object frmcons, devcons, concons;
2832 specifier = bodily_specifier (specifier);
2834 if (!XSPECIFIER (specifier)->caching)
2837 if (XSPECIFIER (specifier)->caching->offset_into_struct_window)
2839 FRAME_LOOP_NO_BREAK (frmcons, devcons, concons)
2840 map_windows (XFRAME (XCAR (frmcons)),
2841 recompute_cached_specifier_everywhere_mapfun,
2842 LISP_TO_VOID (specifier));
2845 if (XSPECIFIER (specifier)->caching->offset_into_struct_frame)
2847 FRAME_LOOP_NO_BREAK (frmcons, devcons, concons)
2848 recompute_one_cached_specifier_in_frame (specifier,
2849 XFRAME (XCAR (frmcons)));
2853 DEFUN ("set-specifier-dirty-flag", Fset_specifier_dirty_flag, 1, 1, 0, /*
2854 Force recomputation of any caches associated with SPECIFIER.
2855 Note that this automatically happens whenever you change a specification
2856 in SPECIFIER; you do not have to call this function then.
2857 One example of where this function is useful is when you have a
2858 toolbar button whose `active-p' field is an expression to be
2859 evaluated. Calling `set-specifier-dirty-flag' on the
2860 toolbar specifier will force the `active-p' fields to be
2865 CHECK_SPECIFIER (specifier);
2866 recompute_cached_specifier_everywhere (specifier);
2871 /************************************************************************/
2872 /* Generic specifier type */
2873 /************************************************************************/
2875 DEFINE_SPECIFIER_TYPE (generic);
2879 /* This is the string that used to be in `generic-specifier-p'.
2880 The idea is good, but it doesn't quite work in the form it's
2881 in. (One major problem is that validating an instantiator
2882 is supposed to require only that the specifier type is passed,
2883 while with this approach the actual specifier is needed.)
2885 What really needs to be done is to write a function
2886 `make-specifier-type' that creates new specifier types.
2887 #### I'll look into this for 19.14.
2890 "A generic specifier is a generalized kind of specifier with user-defined\n"
2891 "semantics. The instantiator can be any kind of Lisp object, and the\n"
2892 "instance computed from it is likewise any kind of Lisp object. The\n"
2893 "SPECIFIER-DATA should be an alist of methods governing how the specifier\n"
2894 "works. All methods are optional, and reasonable default methods will be\n"
2895 "provided. Currently there are two defined methods: 'instantiate and\n"
2898 "'instantiate specifies how to do the instantiation; if omitted, the\n"
2899 "instantiator itself is simply returned as the instance. The method\n"
2900 "should be a function that accepts three parameters (a specifier, the\n"
2901 "instantiator that matched the domain being instantiated over, and that\n"
2902 "domain), and should return a one-element list containing the instance,\n"
2903 "or nil if no instance exists. Note that the domain passed to this function\n"
2904 "is the domain being instantiated over, which may not be the same as the\n"
2905 "locale contained in the specification corresponding to the instantiator\n"
2906 "(for example, the domain being instantiated over could be a window, but\n"
2907 "the locale corresponding to the passed instantiator could be the window's\n"
2908 "buffer or frame).\n"
2910 "'validate specifies whether a given instantiator is valid; if omitted,\n"
2911 "all instantiators are considered valid. It should be a function of\n"
2912 "two arguments: an instantiator and a flag CAN-SIGNAL-ERROR. If this\n"
2913 "flag is false, the function must simply return t or nil indicating\n"
2914 "whether the instantiator is valid. If this flag is true, the function\n"
2915 "is free to signal an error if it encounters an invalid instantiator\n"
2916 "(this can be useful for issuing a specific error about exactly why the\n"
2917 "instantiator is valid). It can also return nil to indicate an invalid\n"
2918 "instantiator; in this case, a general error will be signalled."
2922 DEFUN ("generic-specifier-p", Fgeneric_specifier_p, 1, 1, 0, /*
2923 Return non-nil if OBJECT is a generic specifier.
2925 A generic specifier allows any kind of Lisp object as an instantiator,
2926 and returns back the Lisp object unchanged when it is instantiated.
2930 return GENERIC_SPECIFIERP (object) ? Qt : Qnil;
2934 /************************************************************************/
2935 /* Integer specifier type */
2936 /************************************************************************/
2938 DEFINE_SPECIFIER_TYPE (integer);
2941 integer_validate (Lisp_Object instantiator)
2943 CHECK_INT (instantiator);
2946 DEFUN ("integer-specifier-p", Finteger_specifier_p, 1, 1, 0, /*
2947 Return non-nil if OBJECT is an integer specifier.
2951 return INTEGER_SPECIFIERP (object) ? Qt : Qnil;
2954 /************************************************************************/
2955 /* Non-negative-integer specifier type */
2956 /************************************************************************/
2958 DEFINE_SPECIFIER_TYPE (natnum);
2961 natnum_validate (Lisp_Object instantiator)
2963 CHECK_NATNUM (instantiator);
2966 DEFUN ("natnum-specifier-p", Fnatnum_specifier_p, 1, 1, 0, /*
2967 Return non-nil if OBJECT is a natnum (non-negative-integer) specifier.
2971 return NATNUM_SPECIFIERP (object) ? Qt : Qnil;
2974 /************************************************************************/
2975 /* Boolean specifier type */
2976 /************************************************************************/
2978 DEFINE_SPECIFIER_TYPE (boolean);
2981 boolean_validate (Lisp_Object instantiator)
2983 if (!EQ (instantiator, Qt) && !EQ (instantiator, Qnil))
2984 signal_simple_error ("Must be t or nil", instantiator);
2987 DEFUN ("boolean-specifier-p", Fboolean_specifier_p, 1, 1, 0, /*
2988 Return non-nil if OBJECT is a boolean specifier.
2992 return BOOLEAN_SPECIFIERP (object) ? Qt : Qnil;
2995 /************************************************************************/
2996 /* Display table specifier type */
2997 /************************************************************************/
2999 DEFINE_SPECIFIER_TYPE (display_table);
3002 display_table_validate (Lisp_Object instantiator)
3004 if (!NILP(instantiator) &&
3005 (!VECTORP (instantiator) ||
3006 XVECTOR_LENGTH (instantiator) != DISP_TABLE_SIZE))
3007 dead_wrong_type_argument (display_table_specifier_methods->predicate_symbol,
3011 DEFUN ("display-table-specifier-p", Fdisplay_table_specifier_p, 1, 1, 0, /*
3012 Return non-nil if OBJECT is a display-table specifier.
3016 return DISPLAYTABLE_SPECIFIERP (object) ? Qt : Qnil;
3020 /************************************************************************/
3021 /* Initialization */
3022 /************************************************************************/
3025 syms_of_specifier (void)
3027 defsymbol (&Qspecifierp, "specifierp");
3029 defsymbol (&Qconsole_type, "console-type");
3030 defsymbol (&Qdevice_class, "device-class");
3032 /* Qinteger, Qboolean, Qgeneric defined in general.c */
3033 defsymbol (&Qnatnum, "natnum");
3035 DEFSUBR (Fvalid_specifier_type_p);
3036 DEFSUBR (Fspecifier_type_list);
3037 DEFSUBR (Fmake_specifier);
3038 DEFSUBR (Fspecifierp);
3039 DEFSUBR (Fspecifier_type);
3041 DEFSUBR (Fvalid_specifier_locale_p);
3042 DEFSUBR (Fvalid_specifier_domain_p);
3043 DEFSUBR (Fvalid_specifier_locale_type_p);
3044 DEFSUBR (Fspecifier_locale_type_from_locale);
3046 DEFSUBR (Fvalid_specifier_tag_p);
3047 DEFSUBR (Fvalid_specifier_tag_set_p);
3048 DEFSUBR (Fcanonicalize_tag_set);
3049 DEFSUBR (Fdevice_matches_specifier_tag_set_p);
3050 DEFSUBR (Fdefine_specifier_tag);
3051 DEFSUBR (Fdevice_matching_specifier_tag_list);
3052 DEFSUBR (Fspecifier_tag_list);
3053 DEFSUBR (Fspecifier_tag_predicate);
3055 DEFSUBR (Fcheck_valid_instantiator);
3056 DEFSUBR (Fvalid_instantiator_p);
3057 DEFSUBR (Fcheck_valid_inst_list);
3058 DEFSUBR (Fvalid_inst_list_p);
3059 DEFSUBR (Fcheck_valid_spec_list);
3060 DEFSUBR (Fvalid_spec_list_p);
3061 DEFSUBR (Fadd_spec_to_specifier);
3062 DEFSUBR (Fadd_spec_list_to_specifier);
3063 DEFSUBR (Fspecifier_spec_list);
3064 DEFSUBR (Fspecifier_specs);
3065 DEFSUBR (Fremove_specifier);
3066 DEFSUBR (Fcopy_specifier);
3068 DEFSUBR (Fcheck_valid_specifier_matchspec);
3069 DEFSUBR (Fvalid_specifier_matchspec_p);
3070 DEFSUBR (Fspecifier_fallback);
3071 DEFSUBR (Fspecifier_instance);
3072 DEFSUBR (Fspecifier_matching_instance);
3073 DEFSUBR (Fspecifier_instance_from_inst_list);
3074 DEFSUBR (Fspecifier_matching_instance_from_inst_list);
3075 DEFSUBR (Fset_specifier_dirty_flag);
3077 DEFSUBR (Fgeneric_specifier_p);
3078 DEFSUBR (Finteger_specifier_p);
3079 DEFSUBR (Fnatnum_specifier_p);
3080 DEFSUBR (Fboolean_specifier_p);
3081 DEFSUBR (Fdisplay_table_specifier_p);
3083 /* Symbols pertaining to specifier creation. Specifiers are created
3084 in the syms_of() functions. */
3086 /* locales are defined in general.c. */
3088 defsymbol (&Qprepend, "prepend");
3089 defsymbol (&Qappend, "append");
3090 defsymbol (&Qremove_tag_set_prepend, "remove-tag-set-prepend");
3091 defsymbol (&Qremove_tag_set_append, "remove-tag-set-append");
3092 defsymbol (&Qremove_locale, "remove-locale");
3093 defsymbol (&Qremove_locale_type, "remove-locale-type");
3094 defsymbol (&Qremove_all, "remove-all");
3096 defsymbol (&Qfallback, "fallback");
3100 specifier_type_create (void)
3102 the_specifier_type_entry_dynarr = Dynarr_new (specifier_type_entry);
3104 Vspecifier_type_list = Qnil;
3105 staticpro (&Vspecifier_type_list);
3107 INITIALIZE_SPECIFIER_TYPE (generic, "generic", "generic-specifier-p");
3109 INITIALIZE_SPECIFIER_TYPE (integer, "integer", "integer-specifier-p");
3111 SPECIFIER_HAS_METHOD (integer, validate);
3113 INITIALIZE_SPECIFIER_TYPE (natnum, "natnum", "natnum-specifier-p");
3115 SPECIFIER_HAS_METHOD (natnum, validate);
3117 INITIALIZE_SPECIFIER_TYPE (boolean, "boolean", "boolean-specifier-p");
3119 SPECIFIER_HAS_METHOD (boolean, validate);
3121 INITIALIZE_SPECIFIER_TYPE (display_table, "display-table", "display-table-p");
3123 SPECIFIER_HAS_METHOD (display_table, validate);
3127 vars_of_specifier (void)
3129 Vcached_specifiers = Qnil;
3130 staticpro (&Vcached_specifiers);
3132 /* Do NOT mark through this, or specifiers will never be GC'd.
3133 This is the same deal as for weak hash tables. */
3134 Vall_specifiers = Qnil;
3136 Vuser_defined_tags = Qnil;
3137 staticpro (&Vuser_defined_tags);
3139 Vunlock_ghost_specifiers = Qnil;
3140 staticpro (&Vunlock_ghost_specifiers);