Mercurial > hg > xemacs-beta

comparison lisp/specifier.el @ 442:abe6d1db359e r21-2-36

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-36
author cvs
date Mon, 13 Aug 2007 11:35:02 +0200
parents 3ecd8885ac67
children ff9d7f21f8d0
comparison
equal deleted inserted replaced
441:72a7cfa4a488 442:abe6d1db359e
1 ;;; specifier.el --- Lisp interface to specifiers 1 ;;; specifier.el --- Lisp interface to specifiers
2 2
3 ;; Copyright (C) 1997 Free Software Foundation, Inc. 3 ;; Copyright (C) 1997 Free Software Foundation, Inc.
4 ;; Copyright (C) 1995, 1996 Ben Wing. 4 ;; Copyright (C) 1995, 1996, 2000 Ben Wing.
5 5
6 ;; Author: Ben Wing <ben@xemacs.org> 6 ;; Author: Ben Wing <ben@xemacs.org>
7 ;; Keywords: internal, dumped 7 ;; Keywords: internal, dumped
8 8
9 ;;; Synched up with: Not in FSF. 9 ;;; Synched up with: Not in FSF.
273 indicate that it applies everywhere. LOCALE usually defaults to 273 indicate that it applies everywhere. LOCALE usually defaults to
274 `global' if omitted. 274 `global' if omitted.
275 275
276 VALUE is usually what is called an \"instantiator\" (which, roughly 276 VALUE is usually what is called an \"instantiator\" (which, roughly
277 speaking, corresponds to the \"value\" of the property governed by 277 speaking, corresponds to the \"value\" of the property governed by
278 SPECIFIER). The valid instantiators for SPECIFIER depend on the 278 SPECIFIER). The valid instantiators for SPECIFIER depend on the type
279 type of SPECIFIER (which you can determine using `specifier-type'). 279 of SPECIFIER (which you can determine using `specifier-type'). The
280 The specifier `scrollbar-width', for example, is of type `integer', 280 specifier `scrollbar-width', for example, is of type `integer',
281 meaning its valid instantiators are integers. The specifier 281 meaning its valid instantiators are integers. The specifier governing
282 governing the background color of the `default' face (you can 282 the background color of the `default' face (you can retrieve this
283 retrieve this specifier using `(face-background 'default)') is 283 specifier using `(face-background 'default)') is of type `color',
284 of type `color', meaning its valid instantiators are strings naming 284 meaning its valid instantiators are strings naming colors and
285 colors and color-instance objects. For some types of specifiers, 285 color-instance objects. For some types of specifiers, such as `image'
286 such as `image' and `toolbar', the instantiators can be very 286 and `toolbar', the instantiators can be very complex. Generally this
287 complex. Generally this is documented in the appropriate predicate 287 is documented in the appropriate creation function --
288 function -- `color-specifier-p', `image-specifier-p', 288 e.g. `make-color-specifier', `make-font-specifier',
289 `toolbar-specifier-p', etc. 289 `make-image-specifier' -- or in the global variable holding the most
290 common specifier for that type (`default-toolbar', `default-gutter',
291 `current-display-table').
290 292
291 NOTE: It does *not* work to give a VALUE of nil as a way of 293 NOTE: It does *not* work to give a VALUE of nil as a way of
292 removing the specifications for a locale. Use `remove-specifier' 294 removing the specifications for a locale. Use `remove-specifier'
293 instead. (And keep in mind that, if you omit the LOCALE argument 295 instead. (And keep in mind that, if you omit the LOCALE argument
294 to `remove-specifier', it removes *all* specifications! If you 296 to `remove-specifier', it removes *all* specifications! If you
400 (add-spec-list-to-specifier 402 (add-spec-list-to-specifier
401 specifier 403 specifier
402 (canonicalize-spec-list nval (specifier-type specifier)) 404 (canonicalize-spec-list nval (specifier-type specifier))
403 how-to-add)))) 405 how-to-add))))
404 value) 406 value)
407
408 (defun modify-specifier-instances (specifier func &optional args force default
409 locale tag-set)
410 "Modify all specifications that match LOCALE and TAG-SET by FUNC.
411
412 For each specification that exists for SPECIFIER, in locale LOCALE
413 that matches TAG-SET, call the function FUNC with the instance as its
414 first argument and with optional arguments ARGS. The result is then
415 used as the new value of the instantiator.
416
417 If there is no specification in the domain LOCALE matching TAG-SET and
418 FORCE is non-nil, an explicit one is created from the matching
419 specifier instance if that exists or DEFAULT otherwise. If LOCALE is
420 not a domain (i.e. a buffer), DEFAULT is always used. FUNC is then
421 applied like above and the resulting specification is added."
422
423 (let ((spec-list (specifier-spec-list specifier locale tag-set)))
424 (cond
425 (spec-list
426 ;; Destructively edit the spec-list
427 (mapc #'(lambda (spec)
428 (mapc #'(lambda (inst-pair)
429 (setcdr inst-pair
430 (apply func (cdr inst-pair) args)))
431 (cdr spec)))
432 spec-list)
433 (add-spec-list-to-specifier specifier spec-list))
434 (force
435 (set-specifier specifier
436 (apply func
437 (or (and (valid-specifier-domain-p locale)
438 (specifier-instance specifier))
439 default) args)
440 locale tag-set)))))
405 441
406 (defmacro let-specifier (specifier-list &rest body) 442 (defmacro let-specifier (specifier-list &rest body)
407 "Add specifier specs, evaluate forms in BODY and restore the specifiers. 443 "Add specifier specs, evaluate forms in BODY and restore the specifiers.
408 \(let-specifier SPECIFIER-LIST BODY...) 444 \(let-specifier SPECIFIER-LIST BODY...)
409 445
490 (add-spec-list-to-specifier 526 (add-spec-list-to-specifier
491 ,(car (nth 0 varel)) 527 ,(car (nth 0 varel))
492 ,(car oldval)))) 528 ,(car oldval))))
493 oldvallist varlist)))))))) 529 oldvallist varlist))))))))
494 530
531 (defun make-integer-specifier (spec-list)
532 "Return a new `integer' specifier object with the given specification list.
533 SPEC-LIST can be a list of specifications (each of which is a cons of a
534 locale and a list of instantiators), a single instantiator, or a list
535 of instantiators. See `make-specifier' for more information about
536 specifiers.
537
538 Valid instantiators for integer specifiers are integers."
539 (make-specifier-and-init 'integer spec-list))
540
541 (defun make-boolean-specifier (spec-list)
542 "Return a new `boolean' specifier object with the given specification list.
543 SPEC-LIST can be a list of specifications (each of which is a cons of a
544 locale and a list of instantiators), a single instantiator, or a list
545 of instantiators. See `make-specifier' for more information about
546 specifiers.
547
548 Valid instantiators for boolean specifiers are t and nil."
549 (make-specifier-and-init 'boolean spec-list))
550
551 (defun make-natnum-specifier (spec-list)
552 "Return a new `natnum' specifier object with the given specification list.
553 SPEC-LIST can be a list of specifications (each of which is a cons of a
554 locale and a list of instantiators), a single instantiator, or a list
555 of instantiators. See `make-specifier' for more information about
556 specifiers.
557
558 Valid instantiators for natnum specifiers are non-negative integers."
559 (make-specifier-and-init 'natnum spec-list))
560
561 (defun make-generic-specifier (spec-list)
562 "Return a new `generic' specifier object with the given specification list.
563 SPEC-LIST can be a list of specifications (each of which is a cons of a
564 locale and a list of instantiators), a single instantiator, or a list
565 of instantiators. See `make-specifier' for more information about
566 specifiers.
567
568 Valid instantiators for generic specifiers are all Lisp values.
569 They are returned back unchanged when a specifier is instantiated."
570 (make-specifier-and-init 'generic spec-list))
571
572 (defun make-display-table-specifier (spec-list)
573 "Return a new `display-table' specifier object with the given spec list.
574 SPEC-LIST can be a list of specifications (each of which is a cons of a
575 locale and a list of instantiators), a single instantiator, or a list
576 of instantiators. See `make-specifier' for more information about
577 specifiers.
578
579 Valid instantiators for display-table specifiers are described in
580 detail in the doc string for `current-display-table'."
581 (make-specifier-and-init 'display-table spec-list))
582
495 ;; Evaluate this for testing: 583 ;; Evaluate this for testing:
496 ; (cl-prettyexpand '(let-specifier ((modeline-shadow-thickness 0 (selected-window) 'x) (fubar (value) baz)) (sit-for 1))) 584 ; (cl-prettyexpand '(let-specifier ((modeline-shadow-thickness 0 (selected-window) 'x) (fubar (value) baz)) (sit-for 1)))
497 585
498 (define-specifier-tag 'win 'device-on-window-system-p) 586 (define-specifier-tag 'win 'device-on-window-system-p)
499 587