Mercurial > hg > xemacs-beta

comparison lisp/specifier.el @ 412:697ef44129c6 r21-2-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-14
author cvs
date Mon, 13 Aug 2007 11:20:41 +0200
parents 501cfd01ee6d
children
comparison
equal deleted inserted replaced
411:12e008d41344 412:697ef44129c6
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, 2000 Ben Wing. 4 ;; Copyright (C) 1995, 1996 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 type 278 SPECIFIER). The valid instantiators for SPECIFIER depend on the
279 of SPECIFIER (which you can determine using `specifier-type'). The 279 type of SPECIFIER (which you can determine using `specifier-type').
280 specifier `scrollbar-width', for example, is of type `integer', 280 The specifier `scrollbar-width', for example, is of type `integer',
281 meaning its valid instantiators are integers. The specifier governing 281 meaning its valid instantiators are integers. The specifier
282 the background color of the `default' face (you can retrieve this 282 governing the background color of the `default' face (you can
283 specifier using `(face-background 'default)') is of type `color', 283 retrieve this specifier using `(face-background 'default)') is
284 meaning its valid instantiators are strings naming colors and 284 of type `color', meaning its valid instantiators are strings naming
285 color-instance objects. For some types of specifiers, such as `image' 285 colors and color-instance objects. For some types of specifiers,
286 and `toolbar', the instantiators can be very complex. Generally this 286 such as `image' and `toolbar', the instantiators can be very
287 is documented in the appropriate creation function -- 287 complex. Generally this is documented in the appropriate predicate
288 e.g. `make-color-specifier', `make-font-specifier', 288 function -- `color-specifier-p', `image-specifier-p',
289 `make-image-specifier' -- or in the global variable holding the most 289 `toolbar-specifier-p', etc.
290 common specifier for that type (`default-toolbar', `default-gutter',
291 `current-display-table').
292 290
293 NOTE: It does *not* work to give a VALUE of nil as a way of 291 NOTE: It does *not* work to give a VALUE of nil as a way of
294 removing the specifications for a locale. Use `remove-specifier' 292 removing the specifications for a locale. Use `remove-specifier'
295 instead. (And keep in mind that, if you omit the LOCALE argument 293 instead. (And keep in mind that, if you omit the LOCALE argument
296 to `remove-specifier', it removes *all* specifications! If you 294 to `remove-specifier', it removes *all* specifications! If you
402 (add-spec-list-to-specifier 400 (add-spec-list-to-specifier
403 specifier 401 specifier
404 (canonicalize-spec-list nval (specifier-type specifier)) 402 (canonicalize-spec-list nval (specifier-type specifier))
405 how-to-add)))) 403 how-to-add))))
406 value) 404 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)))))
441 405
442 (defmacro let-specifier (specifier-list &rest body) 406 (defmacro let-specifier (specifier-list &rest body)
443 "Add specifier specs, evaluate forms in BODY and restore the specifiers. 407 "Add specifier specs, evaluate forms in BODY and restore the specifiers.
444 \(let-specifier SPECIFIER-LIST BODY...) 408 \(let-specifier SPECIFIER-LIST BODY...)
445 409
526 (add-spec-list-to-specifier 490 (add-spec-list-to-specifier
527 ,(car (nth 0 varel)) 491 ,(car (nth 0 varel))
528 ,(car oldval)))) 492 ,(car oldval))))
529 oldvallist varlist)))))))) 493 oldvallist varlist))))))))
530 494
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
583 ;; Evaluate this for testing: 495 ;; Evaluate this for testing:
584 ; (cl-prettyexpand '(let-specifier ((modeline-shadow-thickness 0 (selected-window) 'x) (fubar (value) baz)) (sit-for 1))) 496 ; (cl-prettyexpand '(let-specifier ((modeline-shadow-thickness 0 (selected-window) 'x) (fubar (value) baz)) (sit-for 1)))
585 497
586 (define-specifier-tag 'win 'device-on-window-system-p) 498 (define-specifier-tag 'win 'device-on-window-system-p)
587 499