(g2-UU+4E2D): Add HNG-KAK0262-0.
[chise/xemacs-chise.git.1] / lisp / specifier.el
1 ;;; specifier.el --- Lisp interface to specifiers
2
3 ;; Copyright (C) 1997, 2004 Free Software Foundation, Inc.
4 ;; Copyright (C) 1995, 1996, 2000, 2002 Ben Wing.
5
6 ;; Author: Ben Wing <ben@xemacs.org>
7 ;; Keywords: internal, dumped
8
9 ;;; Synched up with: Not in FSF.
10
11 ;; This file is part of XEmacs.
12
13 ;; XEmacs is free software; you can redistribute it and/or modify it
14 ;; under the terms of the GNU General Public License as published by
15 ;; the Free Software Foundation; either version 2, or (at your option)
16 ;; any later version.
17
18 ;; XEmacs is distributed in the hope that it will be useful, but
19 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
21 ;; General Public License for more details.
22
23 ;; You should have received a copy of the GNU General Public License
24 ;; along with XEmacs; see the file COPYING.  If not, write to the 
25 ;; Free Software Foundation, 59 Temple Place - Suite 330,
26 ;; Boston, MA 02111-1307, USA.
27
28 ;;; Commentary:
29
30 ;; This file is dumped with XEmacs.
31
32 ;;; Code:
33
34 (defun make-specifier-and-init (type spec-list &optional dont-canonicalize)
35   "Create and initialize a specifier of type TYPE with spec(s) SPEC-LIST.
36
37 A convenience API combining `make-specifier' and `set-specifier', allowing you
38 to create a specifier and add specs to it at the same time.
39 TYPE specifies the specifier type.  See `make-specifier' for known types.
40 SPEC-LIST supplies the specification(s) to be added to the specifier, in any
41   form acceptable to `canonicalize-spec-list'.
42 Optional DONT-CANONICALIZE, if non-nil, inhibits the conversion, and the
43   SPEC-LIST must already be in full form."
44   (let ((sp (make-specifier type)))
45     (if (not dont-canonicalize)
46         (setq spec-list (canonicalize-spec-list spec-list type)))
47     (add-spec-list-to-specifier sp spec-list)
48     sp))
49
50 ;; God damn, do I hate dynamic scoping.
51
52 (defun map-specifier (ms-specifier ms-func &optional ms-locale ms-maparg)
53   "Apply MS-FUNC to the specification(s) for MS-LOCALE in MS-SPECIFIER.
54
55 If optional MS-LOCALE is a locale, MS-FUNC will be called for that locale.
56 If MS-LOCALE is a locale type, MS-FUNC will be mapped over all locales of that
57 type.  If MS-LOCALE is 'all or nil, MS-FUNC will be mapped over all locales in
58 MS-SPECIFIER.
59
60 Optional MS-MAPARG will be passed to MS-FUNC.
61
62 MS-FUNC is called with four arguments: the MS-SPECIFIER, the locale
63 being mapped over, the inst-list for that locale, and the
64 optional MS-MAPARG.  If any invocation of MS-FUNC returns non-nil,
65 the mapping will stop and the returned value becomes the
66 value returned from `map-specifier'.  Otherwise, `map-specifier'
67 returns nil."
68   (let ((ms-specs (specifier-spec-list ms-specifier ms-locale))
69         ms-result)
70     (while (and ms-specs (not ms-result))
71       (let ((ms-this-spec (car ms-specs)))
72         (setq ms-result (funcall ms-func ms-specifier (car ms-this-spec)
73                               (cdr ms-this-spec) ms-maparg))
74         (setq ms-specs (cdr ms-specs))))
75     ms-result))
76
77 (defun canonicalize-inst-pair (inst-pair specifier-type &optional noerror)
78   "Canonicalize the given INST-PAIR.
79
80 SPECIFIER-TYPE specifies the type of specifier that this INST-PAIR
81 will be used for.
82
83 Canonicalizing means converting to the full form for an inst-pair, i.e.
84 `(TAG-SET . INSTANTIATOR)'.  A single, untagged instantiator is given
85 a tag set of nil (the empty set), and a single tag is converted into
86 a tag set consisting only of that tag.
87
88 If NOERROR is non-nil, signal an error if the inst-pair is invalid;
89 otherwise return t."
90   ;; OK, the possibilities are:
91   ;;
92   ;; a) a single instantiator
93   ;; b) a cons of a tag and an instantiator
94   ;; c) a cons of a tag set and an instantiator
95   (cond ((valid-instantiator-p inst-pair specifier-type)
96          ;; case (a)
97          (cons nil inst-pair))
98
99         ((not (consp inst-pair))
100          ;; not an inst-pair
101          (if noerror t
102            ;; this will signal an appropriate error.
103            (check-valid-instantiator inst-pair specifier-type)))
104
105         ((and (valid-specifier-tag-p (car inst-pair))
106               (valid-instantiator-p (cdr inst-pair) specifier-type))
107          ;; case (b)
108          (cons (list (car inst-pair)) (cdr inst-pair)))
109
110         ((and (valid-specifier-tag-set-p (car inst-pair))
111               (valid-instantiator-p (cdr inst-pair) specifier-type))
112          ;; case (c)
113          inst-pair)
114          
115         (t
116          (if noerror t
117            (signal 'error (list "Invalid specifier tag set"
118                                 (car inst-pair)))))))
119
120 (defun canonicalize-inst-list (inst-list specifier-type &optional noerror)
121   "Canonicalize the given INST-LIST (a list of inst-pairs).
122
123 SPECIFIER-TYPE specifies the type of specifier that this INST-LIST
124 will be used for.
125
126 Canonicalizing means converting to the full form for an inst-list, i.e.
127 `((TAG-SET . INSTANTIATOR) ...)'.  This function accepts a single
128 inst-pair or any abbreviation thereof or a list of (possibly
129 abbreviated) inst-pairs. (See `canonicalize-inst-pair'.)
130
131 If NOERROR is non-nil, signal an error if the inst-list is invalid;
132 otherwise return t."
133
134   ;; OK, the possibilities are:
135   ;;
136   ;; a) an inst-pair or various abbreviations thereof
137   ;; b) a list of (a)
138   (let ((result (canonicalize-inst-pair inst-list specifier-type t)))
139     (if (not (eq result t))
140         ;; case (a)
141         (list result)
142
143       (if (not (consp inst-list))
144           ;; not an inst-list.
145           (if noerror t
146            ;; this will signal an appropriate error.
147             (check-valid-instantiator inst-list specifier-type))
148
149         ;; case (b)
150         (catch 'cann-inst-list
151           ;; don't use mapcar here; we need to catch the case of
152           ;; an invalid list.
153           (let ((rest inst-list)
154                 (result nil))
155             (while rest
156               (if (not (consp rest))
157                   (if noerror (throw 'cann-inst-list t)
158                     (signal 'error (list "Invalid list format" inst-list)))
159                 (let ((res2 (canonicalize-inst-pair (car rest) specifier-type
160                                                     noerror)))
161                   (if (eq res2 t)
162                       ;; at this point, we know we're noerror because
163                       ;; otherwise canonicalize-inst-pair would have
164                       ;; signalled an error.
165                       (throw 'cann-inst-list t)
166                     (setq result (cons res2 result)))))
167               (setq rest (cdr rest)))
168             (nreverse result)))))))
169
170 (defun canonicalize-spec (spec specifier-type &optional noerror)
171   "Canonicalize the given SPEC (a specification).
172
173 SPECIFIER-TYPE is the type of specifier that this SPEC will be used for.
174
175 Canonicalizing means converting to the full form for a spec, i.e.
176 `(LOCALE (TAG-SET . INSTANTIATOR) ...)'.  This function accepts a
177 possibly abbreviated inst-list or a cons of a locale and a possibly
178 abbreviated inst-list. (See `canonicalize-inst-list'.)
179
180 If NOERROR is nil, signal an error if the specification is invalid;
181 otherwise return t."
182   ;; OK, the possibilities are:
183   ;;
184   ;; a) an inst-list or some abbreviation thereof
185   ;; b) a cons of a locale and an inst-list
186   (let ((result (canonicalize-inst-list spec specifier-type t)))
187     (if (not (eq result t))
188         ;; case (a)
189         (cons 'global result)
190
191       (if (not (consp spec))
192           ;; not a spec.
193           (if noerror t
194             ;; this will signal an appropriate error.
195             (check-valid-instantiator spec specifier-type))
196
197         (if (not (valid-specifier-locale-p (car spec)))
198             ;; invalid locale.
199             (if noerror t
200               (signal 'error (list "Invalid specifier locale" (car spec))))
201
202           ;; case (b)
203           (let ((result (canonicalize-inst-list (cdr spec) specifier-type
204                                                 noerror)))
205             (if (eq result t)
206                 ;; at this point, we know we're noerror because
207                 ;; otherwise canonicalize-inst-list would have
208                 ;; signalled an error.
209                 t
210               (cons (car spec) result))))))))
211
212 (defun canonicalize-spec-list (spec-list specifier-type &optional noerror)
213   "Canonicalize the given SPEC-LIST (a list of specifications).
214
215 SPECIFIER-TYPE specifies the type of specifier that this SPEC-LIST
216 will be used for.
217
218 Canonicalizing means converting to the full form for a spec-list, i.e.
219 `((LOCALE (TAG-SET . INSTANTIATOR) ...) ...)'.  This function accepts
220 a possibly abbreviated specification or a list of such things. (See
221 `canonicalize-spec'.) This is the function used to convert spec-lists
222 accepted by `set-specifier' and such into a form suitable for
223 `add-spec-list-to-specifier'.
224
225 The canonicalization algorithm is as follows:
226
227 1. Attempt to parse SPEC-LIST as a single, possibly abbreviated, specification.
228 2. If (1) fails, attempt to parse SPEC-LIST as a list of (abbreviated)
229    specifications.
230 3. If (2) fails, SPEC-LIST is invalid.
231
232 A possibly abbreviated specification SPEC is parsed by
233
234 1. Attempt to parse SPEC as a possibly abbreviated inst-list.
235 2. If (1) fails, attempt to parse SPEC as a cons of a locale and an
236    (abbreviated) inst-list.
237 3. If (2) fails, SPEC is invalid.
238
239 A possibly abbreviated inst-list INST-LIST is parsed by
240
241 1. Attempt to parse INST-LIST as a possibly abbreviated inst-pair.
242 2. If (1) fails, attempt to parse INST-LIST as a list of (abbreviated)
243    inst-pairs.
244 3. If (2) fails, INST-LIST is invalid.
245
246 A possibly abbreviated inst-pair INST-PAIR is parsed by
247
248 1. Check if INST-PAIR is `valid-instantiator-p'.
249 2. If not, check if INST-PAIR is a cons of something that is a tag, ie,
250    `valid-specifier-tag-p', and something that is `valid-instantiator-p'.
251 3. If not, check if INST-PAIR is a cons of a list of tags and something that
252    is `valid-instantiator-p'.
253
254 In summary, this function generally prefers more abbreviated forms.
255
256 This function tries extremely hard to resolve any ambiguities, and the
257 built-in specifier types (font, image, toolbar, etc.) are designed so that
258 there won't be any ambiguities.  (#### Unfortunately there are bugs in the
259 treatment of toolbar spec-lists and generic spec-lists; avoid depending on
260 canonicalization for these types.)
261
262 If NOERROR is nil, signal an error if the spec-list is invalid;
263 otherwise return t."
264   ;; OK, the possibilities are:
265   ;;
266   ;; a) a spec or various abbreviations thereof
267   ;; b) a list of (a)
268   (let ((result (canonicalize-spec spec-list specifier-type t)))
269     (if (not (eq result t))
270         ;; case (a)
271         (list result)
272
273       (if (not (consp spec-list))
274           ;; not a spec-list.
275           (if noerror t
276            ;; this will signal an appropriate error.
277             (check-valid-instantiator spec-list specifier-type))
278
279         ;; case (b)
280         (catch 'cann-spec-list
281           ;; don't use mapcar here; we need to catch the case of
282           ;; an invalid list.
283           (let ((rest spec-list)
284                 (result nil))
285             (while rest
286               (if (not (consp rest))
287                   (if noerror (throw 'cann-spec-list t)
288                     (signal 'error (list "Invalid list format" spec-list)))
289                 (let ((res2 (canonicalize-spec (car rest) specifier-type
290                                                noerror)))
291                   (if (eq res2 t)
292                       ;; at this point, we know we're noerror because
293                       ;; otherwise canonicalize-spec would have
294                       ;; signalled an error.
295                       (throw 'cann-spec-list t)
296                     (setq result (cons res2 result)))))
297               (setq rest (cdr rest)))
298             (nreverse result)))))))
299
300 (defun set-specifier (specifier value &optional locale tag-set how-to-add)
301   "Add the specification(s) given by VALUE to SPECIFIER in LOCALE.
302
303 VALUE may be any of the values accepted by `canonicalize-spec-list', including
304
305 -- an instantiator (either a Lisp object which will be returned when the
306    specifier is instanced, or a Lisp object that can be instantiated to
307    produce an opaque value: eg, a font name (string) can be used for a font
308    specifier, but an instance will be a font object)
309 -- a list of instantiators
310 -- a cons of a locale and an instantiator, or of a locale and a list of
311    instantiators
312 -- a cons of a tag or tag-set and an instantiator (or list of instantiators)
313 -- a cons of a locale and the previous type of item
314 -- a list of one or more of any of the previous types of items
315 -- a canonical spec-list.
316
317 See `canonicalize-spec-list' for details.  If you need to know the details,
318 though, strongly consider using the unambiguous APIs `add-spec-to-specifier'
319 and `add-spec-list-to-specifier' instead.
320
321 Finally, VALUE can itself be a specifier (of the same type as
322 SPECIFIER), if you want to copy specifications from one specifier
323 to another; this is equivalent to calling `copy-specifier', and
324 LOCALE, TAG-SET, and HOW-TO-ADD have the same semantics as with
325 that function.
326
327 Note that a VALUE of `nil' is either illegal or will be treated as a value of
328 `nil'; it does not remove existing specifications.  Use `remove-specifier' for
329 that.  N.B. `remove-specifier' defaults to removing all specifications, not
330 just the 'global one!
331
332 Warning: this function is inherently heuristic, and should not be relied on to
333 properly resolve ambiguities, when specifier instantiators can be lists
334 \(currently, for toolbar specifiers and generic specifiers).  In those cases
335 use either `add-spec-to-specifier' or `add-spec-list-to-specifier'.
336
337 LOCALE indicates where this specification is active, and should be
338 a buffer, a window, a frame, a device, or the symbol `global' to
339 indicate that it applies everywhere.  LOCALE defaults to
340 `global' if omitted, and is overridden by locales provided by VALUE (in the
341 cases where value is a full specification or a spec-list).
342
343 Optional argument TAG-SET is a tag or a list of tags, to be associated
344 with the VALUE.  Tags are symbols (usually naming device types, such
345 as `x' and `tty', or device classes, such as `color', `mono', and
346 `grayscale'); specifying a TAG-SET restricts the scope of VALUE to
347 devices that match all specified tags. (You can also create your
348 own tags using `define-specifier-tag', and use them to identify
349 specifications added by you, so you can remove them later.)
350
351 Optional argument HOW-TO-ADD should be either nil or one of the
352 symbols `prepend', `append', `remove-tag-set-prepend',
353 `remove-tag-set-append', `remove-locale', `remove-locale-type',
354 or `remove-all'.  This specifies what to do with existing
355 specifications in LOCALE (and possibly elsewhere in the specifier).
356 Most of the time, you do not need to worry about this argument;
357 the default behavior of `remove-tag-set-prepend' is usually fine.
358 See `copy-specifier' and `add-spec-to-specifier' for a full
359 description of what each of these means.
360
361 Note that `set-specifier' is exactly complementary to `specifier-specs'
362 except in the case where SPECIFIER has no specs at all in it but nil
363 is a valid instantiator (in that case, `specifier-specs' will return
364 nil (meaning no specs) and `set-specifier' will interpret the `nil'
365 as meaning \"I'm adding a global instantiator and its value is `nil'\"),
366 or in strange cases where there is an ambiguity between a spec-list
367 and an inst-list, etc. (The built-in specifier types are designed
368 in such a way as to avoid any such ambiguities.)"
369
370   ;; backward compatibility: the old function had HOW-TO-ADD as the
371   ;; third argument and no arguments after that.
372   ;; #### this should disappear at some point.
373   (if (and (null how-to-add)
374            (memq locale '(prepend append remove-tag-set-prepend
375                                   remove-tag-set-append remove-locale
376                                   remove-locale-type remove-all)))
377       (progn
378         (setq how-to-add locale)
379         (setq locale nil)))
380
381   ;; proper beginning of the function.
382   (let ((is-valid (valid-instantiator-p value (specifier-type specifier)))
383         (nval value))
384     (cond ((and (not is-valid) (specifierp nval))
385            (copy-specifier nval specifier locale tag-set nil how-to-add))
386           (t
387            (if tag-set
388                (progn
389                  (if (not (listp tag-set))
390                      (setq tag-set (list tag-set)))
391                  ;; You tend to get more accurate errors
392                  ;; for a variety of cases if you call
393                  ;; canonicalize-tag-set here.
394                  (setq tag-set (canonicalize-tag-set tag-set))
395                  (if (and (not is-valid) (consp nval))
396                      (setq nval
397                            (mapcar #'(lambda (x)
398                                        (check-valid-instantiator
399                                         x (specifier-type specifier))
400                                        (cons tag-set x))
401                                    nval))
402                    (setq nval (cons tag-set nval)))))
403            (if locale
404                (setq nval (cons locale nval)))
405            (add-spec-list-to-specifier
406             specifier
407             (canonicalize-spec-list nval (specifier-type specifier))
408             how-to-add))))
409   value)
410
411 (defun modify-specifier-instances (specifier func &optional args force default
412                                    locale tag-set)
413   "Modify all specifications that match LOCALE and TAG-SET by FUNC.
414
415 For each specification that exists for SPECIFIER, in locale LOCALE
416 that matches TAG-SET, call the function FUNC with the instance as its
417 first argument and with optional arguments ARGS.  The result is then
418 used as the new value of the instantiator.
419
420 If there is no specification in the domain LOCALE matching TAG-SET and
421 FORCE is non-nil, an explicit one is created from the matching
422 specifier instance if that exists or DEFAULT otherwise. If LOCALE is
423 not a domain (i.e. a buffer), DEFAULT is always used. FUNC is then
424 applied like above and the resulting specification is added."
425
426   (let ((spec-list (specifier-spec-list specifier locale tag-set)))
427     (cond
428      (spec-list
429       ;; Destructively edit the spec-list
430       (mapc #'(lambda (spec)
431                 (mapc #'(lambda (inst-pair)
432                           (setcdr inst-pair
433                                   (apply func (cdr inst-pair) args)))
434                       (cdr spec)))
435             spec-list)
436       (add-spec-list-to-specifier specifier spec-list))
437      (force
438       (set-specifier specifier
439                      (apply func
440                             (or (and (valid-specifier-domain-p locale)
441                                      (specifier-instance specifier))
442                                 default) args)
443                      locale tag-set)))))
444
445 (defmacro let-specifier (specifier-list &rest body)
446   "Add specifier specs, evaluate forms in BODY and restore the specifiers.
447 \(let-specifier SPECIFIER-LIST BODY...)
448
449 Each element of SPECIFIER-LIST should look like this:
450 \(SPECIFIER VALUE &optional LOCALE TAG-SET HOW-TO-ADD).
451
452 SPECIFIER is the specifier to be temporarily modified.  VALUE is the
453 instantiator to be temporarily added to SPECIFIER in LOCALE.  LOCALE,
454 TAG-SET and HOW-TO-ADD have the same meaning as in
455 `add-spec-to-specifier'.
456
457 The code resulting from macro expansion will add specifications to
458 specifiers using `add-spec-to-specifier'.  After BODY is finished, the
459 temporary specifications are removed and old spec-lists are restored.
460
461 LOCALE, TAG-SET and HOW-TO-ADD may be omitted, and default to nil.
462 The value of the last form in BODY is returned.
463
464 NOTE: If you want the specifier's instance to change in all
465 circumstances, use (selected-window) as the LOCALE.  If LOCALE is nil
466 or omitted, it defaults to `global'.
467
468 Example:
469     (let-specifier ((modeline-shadow-thickness 0 (selected-window)))
470       (sit-for 1))"
471   (check-argument-type 'listp specifier-list)
472   (flet ((gensym-frob (x name)
473            (if (or (atom x) (eq (car x) 'quote))
474                (list x)
475              (list (gensym name) x))))
476     ;; VARLIST is a list of
477     ;; ((SPECIFIERSYM SPECIFIER) (VALUE) (LOCALESYM LOCALE)
478     ;;  (TAG-SET) (HOW-TO-ADD))
479     ;; If any of these is an atom, then a separate symbol is
480     ;; unnecessary, the CAR will contain the atom and CDR will be nil.
481     (let* ((varlist (mapcar #'(lambda (listel)
482                                 (or (and (consp listel)
483                                          (<= (length listel) 5)
484                                          (> (length listel) 1))
485                                     (signal 'error
486                                             (list
487                                              "should be a list of 2-5 elements"
488                                              listel)))
489                                 ;; VALUE, TAG-SET and HOW-TO-ADD are
490                                 ;; referenced only once, so we needn't
491                                 ;; frob them with gensym.
492                                 (list (gensym-frob (nth 0 listel) "specifier-")
493                                       (list (nth 1 listel))
494                                       (gensym-frob (nth 2 listel) "locale-")
495                                       (list (nth 3 listel))
496                                       (list (nth 4 listel))))
497                             specifier-list))
498            ;; OLDVALLIST is a list of (OLDVALSYM OLDVALFORM)
499            (oldvallist (mapcar #'(lambda (varel)
500                                    (list (gensym "old-")
501                                          `(specifier-spec-list
502                                            ,(car (nth 0 varel))
503                                            ,(car (nth 2 varel)))))
504                                varlist)))
505       ;; Bind the appropriate variables.
506       `(let* (,@(mapcan #'(lambda (varel)
507                             (delq nil (mapcar
508                                        #'(lambda (varcons)
509                                            (and (cdr varcons) varcons))
510                                        varel)))
511                         varlist)
512                 ,@oldvallist)
513          (unwind-protect
514              (progn
515                ,@(mapcar #'(lambda (varel)
516                              `(add-spec-to-specifier
517                                ,(car (nth 0 varel)) ,(car (nth 1 varel))
518                                ,(car (nth 2 varel)) ,(car (nth 3 varel))
519                                ,(car (nth 4 varel))))
520                          varlist)
521                ,@body)
522            ;; Reverse the unwinding order, so that using the same
523            ;; specifier multiple times works.
524            ,@(apply #'nconc (nreverse (mapcar*
525                                        #'(lambda (oldval varel)
526                                            `((remove-specifier
527                                               ,(car (nth 0 varel))
528                                               ,(car (nth 2 varel)))
529                                              (add-spec-list-to-specifier
530                                               ,(car (nth 0 varel))
531                                               ,(car oldval))))
532                                        oldvallist varlist))))))))
533
534 (defun make-integer-specifier (spec-list)
535   "Return a new `integer' specifier object with the given specification list.
536 SPEC-LIST can be a list of specifications (each of which is a cons of a
537 locale and a list of instantiators), a single instantiator, or a list
538 of instantiators.  See `make-specifier' for more information about
539 specifiers.
540
541 Valid instantiators for integer specifiers are integers."
542   (make-specifier-and-init 'integer spec-list))
543
544 (defun make-boolean-specifier (spec-list)
545   "Return a new `boolean' specifier object with the given specification list.
546 SPEC-LIST can be a list of specifications (each of which is a cons of a
547 locale and a list of instantiators), a single instantiator, or a list
548 of instantiators.  See `make-specifier' for more information about
549 specifiers.
550
551 Valid instantiators for boolean specifiers are t and nil."
552   (make-specifier-and-init 'boolean spec-list))
553
554 (defun make-natnum-specifier (spec-list)
555   "Return a new `natnum' specifier object with the given specification list.
556 SPEC-LIST can be a list of specifications (each of which is a cons of a
557 locale and a list of instantiators), a single instantiator, or a list
558 of instantiators.  See `make-specifier' for more information about
559 specifiers.
560
561 Valid instantiators for natnum specifiers are non-negative integers."
562   (make-specifier-and-init 'natnum spec-list))
563
564 (defun make-generic-specifier (spec-list)
565   "Return a new `generic' specifier object with the given specification list.
566 SPEC-LIST can be a list of specifications (each of which is a cons of a
567 locale and a list of instantiators), a single instantiator, or a list
568 of instantiators.  See `make-specifier' for more information about
569 specifiers.
570
571 Valid instantiators for generic specifiers are all Lisp values.
572 They are returned back unchanged when a specifier is instantiated."
573   (make-specifier-and-init 'generic spec-list))
574
575 (defun make-display-table-specifier (spec-list)
576   "Return a new `display-table' specifier object with the given spec list.
577 SPEC-LIST can be a list of specifications (each of which is a cons of a
578 locale and a list of instantiators), a single instantiator, or a list
579 of instantiators.  See `make-specifier' for more information about
580 specifiers.
581
582 Valid instantiators for display-table specifiers are described in
583 detail in the doc string for `current-display-table'."
584   (make-specifier-and-init 'display-table spec-list))
585
586 ;; Evaluate this for testing:
587 ; (cl-prettyexpand '(let-specifier ((modeline-shadow-thickness 0 (selected-window) 'x) (fubar (value) baz)) (sit-for 1)))
588 \f
589 (define-specifier-tag 'win 'device-on-window-system-p)
590
591 ;; Add tags for device types that don't have support compiled
592 ;; into the binary that we're about to dump.  This will prevent
593 ;; code like
594 ;;
595 ;; (set-face-foreground 'default "black" nil '(x color))
596 ;;
597 ;; from producing an error if no X support was compiled in.
598
599 (or (valid-specifier-tag-p 'x)
600     (define-specifier-tag 'x (lambda (dev) (eq (device-type dev) 'x))))
601 (or (valid-specifier-tag-p 'tty)
602     (define-specifier-tag 'tty (lambda (dev) (eq (device-type dev) 'tty))))
603 (or (valid-specifier-tag-p 'mswindows)
604     (define-specifier-tag 'mswindows (lambda (dev)
605                                        (eq (device-type dev) 'mswindows))))
606 (or (valid-specifier-tag-p 'gtk)
607     (define-specifier-tag 'gtk (lambda (dev) (eq (device-type dev) 'gtk))))
608
609 ;; Add special tag for use by initialization code.  Code that
610 ;; sets up default specs should use this tag.  Code that needs to
611 ;; override default specs (e.g. the X resource initialization
612 ;; code) can safely clear specs with this tag without worrying
613 ;; about clobbering user settings.
614
615 (define-specifier-tag 'default)
616
617 ;;; specifier.el ends here