git.chise.org Git - chise/xemacs-chise.git-/blob - 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