Mercurial > hg > xemacs-beta
comparison lisp/specifier.el @ 286:57709be46d1b r21-0b41
Import from CVS: tag r21-0b41
| author | cvs |
|---|---|
| date | Mon, 13 Aug 2007 10:35:03 +0200 |
| parents | 727739f917cb |
| children | e11d67e05968 |
comparison
equal
deleted
inserted
replaced
| 285:9a3756523c1b | 286:57709be46d1b |
|---|---|
| 401 specifier | 401 specifier |
| 402 (canonicalize-spec-list nval (specifier-type specifier)) | 402 (canonicalize-spec-list nval (specifier-type specifier)) |
| 403 how-to-add)))) | 403 how-to-add)))) |
| 404 value) | 404 value) |
| 405 | 405 |
| 406 ;; Note: you cannot replace the following macro with `letf' because | |
| 407 ;; `specifier-instance' does not have a setf method defined. (I tried | |
| 408 ;; to use `set-specifier' as the setf method for `specifier-instance', | |
| 409 ;; but it doesn't work for `letf' because set-specifier to the old | |
| 410 ;; value cannot be used to "undo" a previous set-specifier, as letf | |
| 411 ;; expects.) | |
| 412 ;; | |
| 413 ;; This macro might perhaps be made simpler, with an addition to | |
| 414 ;; `remove-specifier'. Example (modulo gensyms for clarity): | |
| 415 ;; | |
| 416 ;; (defmacro with-specifier-instance (specifier value domain &rest body) | |
| 417 ;; `(unwind-protect | |
| 418 ;; (progn | |
| 419 ;; (add-spec-to-specifier ,specifier ,value ,domain nil 'prepend) | |
| 420 ;; ,@body) | |
| 421 ;; (remove-specifier ,specifier ,domain))) | |
| 422 ;; | |
| 423 ;; So, the idea is to unconditionally prepend a specification for | |
| 424 ;; DOMAIN, and unconditionally remove it. This does not work because | |
| 425 ;; `remove-specifier' removes *all* the specifications of DOMAIN, | |
| 426 ;; nuking the old ones, in the process. (for this purpose, it might | |
| 427 ;; make sense for `remove-specifier' to have a HOW-TO-REMOVE | |
| 428 ;; argument.) | |
| 429 ;; | |
| 430 ;; The following version remembers the old speclist and returns it | |
| 431 ;; later. It's probably less error-prone anyway. | |
| 432 | |
| 433 (defmacro with-specifier-instance (specifier value domain &rest body) | |
| 434 "Evaluate forms in BODY with SPECIFIER instantiating to VALUE in DOMAIN. | |
| 435 The value returned is the value of the last form in BODY. | |
| 436 For meaning of DOMAIN, see `specifier-instance'." | |
| 437 (let ((specvar (gensym "wsi-")) | |
| 438 (valvar (gensym "wsi-")) | |
| 439 (domvar (gensym "wsi-")) | |
| 440 (oldvar (gensym "wsi-"))) | |
| 441 ;; Remember the arguments to prevent multiple evaluation. | |
| 442 `(let* ((,specvar ,specifier) | |
| 443 (,valvar ,value) | |
| 444 (,domvar ,domain) | |
| 445 (,oldvar (specifier-spec-list ,specvar ,domvar))) | |
| 446 (unwind-protect | |
| 447 (progn | |
| 448 (add-spec-to-specifier ,specvar ,valvar ,domvar nil 'prepend) | |
| 449 ,@body) | |
| 450 (remove-specifier ,specvar ,domvar nil t) | |
| 451 (add-spec-list-to-specifier ,specvar ,oldvar))))) | |
| 452 | |
| 406 (define-specifier-tag 'win 'device-on-window-system-p) | 453 (define-specifier-tag 'win 'device-on-window-system-p) |
| 407 | 454 |
| 408 ;; Add tags for device types that don't have support compiled | 455 ;; Add tags for device types that don't have support compiled |
| 409 ;; into the binary that we're about to dump. This will prevent | 456 ;; into the binary that we're about to dump. This will prevent |
| 410 ;; code like | 457 ;; code like |