diff options
| -rw-r--r-- | lisp/keymap.el | 133 | ||||
| -rw-r--r-- | lisp/subr.el | 130 |
2 files changed, 133 insertions, 130 deletions
diff --git a/lisp/keymap.el b/lisp/keymap.el index a60efe18e14..6feb91a60be 100644 --- a/lisp/keymap.el +++ b/lisp/keymap.el | |||
| @@ -452,6 +452,139 @@ If MESSAGE (and interactively), message the result." | |||
| 452 | (message "%s is bound to %s globally" keys def)) | 452 | (message "%s is bound to %s globally" keys def)) |
| 453 | def)) | 453 | def)) |
| 454 | 454 | ||
| 455 | |||
| 456 | ;;; define-keymap and defvar-keymap | ||
| 457 | |||
| 458 | (defun define-keymap--compile (form &rest args) | ||
| 459 | ;; This compiler macro is only there for compile-time | ||
| 460 | ;; error-checking; it does not change the call in any way. | ||
| 461 | (while (and args | ||
| 462 | (keywordp (car args)) | ||
| 463 | (not (eq (car args) :menu))) | ||
| 464 | (unless (memq (car args) '(:full :keymap :parent :suppress :name :prefix)) | ||
| 465 | (byte-compile-warn "Invalid keyword: %s" (car args))) | ||
| 466 | (setq args (cdr args)) | ||
| 467 | (when (null args) | ||
| 468 | (byte-compile-warn "Uneven number of keywords in %S" form)) | ||
| 469 | (setq args (cdr args))) | ||
| 470 | ;; Bindings. | ||
| 471 | (while args | ||
| 472 | (let ((key (pop args))) | ||
| 473 | (when (and (stringp key) (not (key-valid-p key))) | ||
| 474 | (byte-compile-warn "Invalid `kbd' syntax: %S" key))) | ||
| 475 | (when (null args) | ||
| 476 | (byte-compile-warn "Uneven number of key bindings in %S" form)) | ||
| 477 | (setq args (cdr args))) | ||
| 478 | form) | ||
| 479 | |||
| 480 | (defun define-keymap (&rest definitions) | ||
| 481 | "Create a new keymap and define KEY/DEFINITION pairs as key bindings. | ||
| 482 | The new keymap is returned. | ||
| 483 | |||
| 484 | Options can be given as keywords before the KEY/DEFINITION | ||
| 485 | pairs. Available keywords are: | ||
| 486 | |||
| 487 | :full If non-nil, create a chartable alist (see `make-keymap'). | ||
| 488 | If nil (i.e., the default), create a sparse keymap (see | ||
| 489 | `make-sparse-keymap'). | ||
| 490 | |||
| 491 | :suppress If non-nil, the keymap will be suppressed (see `suppress-keymap'). | ||
| 492 | If `nodigits', treat digits like other chars. | ||
| 493 | |||
| 494 | :parent If non-nil, this should be a keymap to use as the parent | ||
| 495 | (see `set-keymap-parent'). | ||
| 496 | |||
| 497 | :keymap If non-nil, instead of creating a new keymap, the given keymap | ||
| 498 | will be destructively modified instead. | ||
| 499 | |||
| 500 | :name If non-nil, this should be a string to use as the menu for | ||
| 501 | the keymap in case you use it as a menu with `x-popup-menu'. | ||
| 502 | |||
| 503 | :prefix If non-nil, this should be a symbol to be used as a prefix | ||
| 504 | command (see `define-prefix-command'). If this is the case, | ||
| 505 | this symbol is returned instead of the map itself. | ||
| 506 | |||
| 507 | KEY/DEFINITION pairs are as KEY and DEF in `keymap-set'. KEY can | ||
| 508 | also be the special symbol `:menu', in which case DEFINITION | ||
| 509 | should be a MENU form as accepted by `easy-menu-define'. | ||
| 510 | |||
| 511 | \(fn &key FULL PARENT SUPPRESS NAME PREFIX KEYMAP &rest [KEY DEFINITION]...)" | ||
| 512 | (declare (indent defun) | ||
| 513 | (compiler-macro define-keymap--compile)) | ||
| 514 | (let (full suppress parent name prefix keymap) | ||
| 515 | ;; Handle keywords. | ||
| 516 | (while (and definitions | ||
| 517 | (keywordp (car definitions)) | ||
| 518 | (not (eq (car definitions) :menu))) | ||
| 519 | (let ((keyword (pop definitions))) | ||
| 520 | (unless definitions | ||
| 521 | (error "Missing keyword value for %s" keyword)) | ||
| 522 | (let ((value (pop definitions))) | ||
| 523 | (pcase keyword | ||
| 524 | (:full (setq full value)) | ||
| 525 | (:keymap (setq keymap value)) | ||
| 526 | (:parent (setq parent value)) | ||
| 527 | (:suppress (setq suppress value)) | ||
| 528 | (:name (setq name value)) | ||
| 529 | (:prefix (setq prefix value)) | ||
| 530 | (_ (error "Invalid keyword: %s" keyword)))))) | ||
| 531 | |||
| 532 | (when (and prefix | ||
| 533 | (or full parent suppress keymap)) | ||
| 534 | (error "A prefix keymap can't be defined with :full/:parent/:suppress/:keymap keywords")) | ||
| 535 | |||
| 536 | (when (and keymap full) | ||
| 537 | (error "Invalid combination: :keymap with :full")) | ||
| 538 | |||
| 539 | (let ((keymap (cond | ||
| 540 | (keymap keymap) | ||
| 541 | (prefix (define-prefix-command prefix nil name)) | ||
| 542 | (full (make-keymap name)) | ||
| 543 | (t (make-sparse-keymap name))))) | ||
| 544 | (when suppress | ||
| 545 | (suppress-keymap keymap (eq suppress 'nodigits))) | ||
| 546 | (when parent | ||
| 547 | (set-keymap-parent keymap parent)) | ||
| 548 | |||
| 549 | ;; Do the bindings. | ||
| 550 | (while definitions | ||
| 551 | (let ((key (pop definitions))) | ||
| 552 | (unless definitions | ||
| 553 | (error "Uneven number of key/definition pairs")) | ||
| 554 | (let ((def (pop definitions))) | ||
| 555 | (if (eq key :menu) | ||
| 556 | (easy-menu-define nil keymap "" def) | ||
| 557 | (keymap-set keymap key def))))) | ||
| 558 | keymap))) | ||
| 559 | |||
| 560 | (defmacro defvar-keymap (variable-name &rest defs) | ||
| 561 | "Define VARIABLE-NAME as a variable with a keymap definition. | ||
| 562 | See `define-keymap' for an explanation of the keywords and KEY/DEFINITION. | ||
| 563 | |||
| 564 | In addition to the keywords accepted by `define-keymap', this | ||
| 565 | macro also accepts a `:doc' keyword, which (if present) is used | ||
| 566 | as the variable documentation string. | ||
| 567 | |||
| 568 | \(fn VARIABLE-NAME &key DOC FULL PARENT SUPPRESS NAME PREFIX KEYMAP &rest [KEY DEFINITION]...)" | ||
| 569 | (declare (indent 1)) | ||
| 570 | (let ((opts nil) | ||
| 571 | doc) | ||
| 572 | (while (and defs | ||
| 573 | (keywordp (car defs)) | ||
| 574 | (not (eq (car defs) :menu))) | ||
| 575 | (let ((keyword (pop defs))) | ||
| 576 | (unless defs | ||
| 577 | (error "Uneven number of keywords")) | ||
| 578 | (if (eq keyword :doc) | ||
| 579 | (setq doc (pop defs)) | ||
| 580 | (push keyword opts) | ||
| 581 | (push (pop defs) opts)))) | ||
| 582 | (unless (zerop (% (length defs) 2)) | ||
| 583 | (error "Uneven number of key/definition pairs: %s" defs)) | ||
| 584 | `(defvar ,variable-name | ||
| 585 | (define-keymap ,@(nreverse opts) ,@defs) | ||
| 586 | ,@(and doc (list doc))))) | ||
| 587 | |||
| 455 | (provide 'keymap) | 588 | (provide 'keymap) |
| 456 | 589 | ||
| 457 | ;;; keymap.el ends here | 590 | ;;; keymap.el ends here |
diff --git a/lisp/subr.el b/lisp/subr.el index 11105c4aa6f..7906324f80c 100644 --- a/lisp/subr.el +++ b/lisp/subr.el | |||
| @@ -6526,136 +6526,6 @@ not a list, return a one-element list containing OBJECT." | |||
| 6526 | object | 6526 | object |
| 6527 | (list object))) | 6527 | (list object))) |
| 6528 | 6528 | ||
| 6529 | (defun define-keymap--compile (form &rest args) | ||
| 6530 | ;; This compiler macro is only there for compile-time | ||
| 6531 | ;; error-checking; it does not change the call in any way. | ||
| 6532 | (while (and args | ||
| 6533 | (keywordp (car args)) | ||
| 6534 | (not (eq (car args) :menu))) | ||
| 6535 | (unless (memq (car args) '(:full :keymap :parent :suppress :name :prefix)) | ||
| 6536 | (byte-compile-warn "Invalid keyword: %s" (car args))) | ||
| 6537 | (setq args (cdr args)) | ||
| 6538 | (when (null args) | ||
| 6539 | (byte-compile-warn "Uneven number of keywords in %S" form)) | ||
| 6540 | (setq args (cdr args))) | ||
| 6541 | ;; Bindings. | ||
| 6542 | (while args | ||
| 6543 | (let ((key (pop args))) | ||
| 6544 | (when (and (stringp key) (not (key-valid-p key))) | ||
| 6545 | (byte-compile-warn "Invalid `kbd' syntax: %S" key))) | ||
| 6546 | (when (null args) | ||
| 6547 | (byte-compile-warn "Uneven number of key bindings in %S" form)) | ||
| 6548 | (setq args (cdr args))) | ||
| 6549 | form) | ||
| 6550 | |||
| 6551 | (defun define-keymap (&rest definitions) | ||
| 6552 | "Create a new keymap and define KEY/DEFINITION pairs as key bindings. | ||
| 6553 | The new keymap is returned. | ||
| 6554 | |||
| 6555 | Options can be given as keywords before the KEY/DEFINITION | ||
| 6556 | pairs. Available keywords are: | ||
| 6557 | |||
| 6558 | :full If non-nil, create a chartable alist (see `make-keymap'). | ||
| 6559 | If nil (i.e., the default), create a sparse keymap (see | ||
| 6560 | `make-sparse-keymap'). | ||
| 6561 | |||
| 6562 | :suppress If non-nil, the keymap will be suppressed (see `suppress-keymap'). | ||
| 6563 | If `nodigits', treat digits like other chars. | ||
| 6564 | |||
| 6565 | :parent If non-nil, this should be a keymap to use as the parent | ||
| 6566 | (see `set-keymap-parent'). | ||
| 6567 | |||
| 6568 | :keymap If non-nil, instead of creating a new keymap, the given keymap | ||
| 6569 | will be destructively modified instead. | ||
| 6570 | |||
| 6571 | :name If non-nil, this should be a string to use as the menu for | ||
| 6572 | the keymap in case you use it as a menu with `x-popup-menu'. | ||
| 6573 | |||
| 6574 | :prefix If non-nil, this should be a symbol to be used as a prefix | ||
| 6575 | command (see `define-prefix-command'). If this is the case, | ||
| 6576 | this symbol is returned instead of the map itself. | ||
| 6577 | |||
| 6578 | KEY/DEFINITION pairs are as KEY and DEF in `keymap-set'. KEY can | ||
| 6579 | also be the special symbol `:menu', in which case DEFINITION | ||
| 6580 | should be a MENU form as accepted by `easy-menu-define'. | ||
| 6581 | |||
| 6582 | \(fn &key FULL PARENT SUPPRESS NAME PREFIX KEYMAP &rest [KEY DEFINITION]...)" | ||
| 6583 | (declare (indent defun) | ||
| 6584 | (compiler-macro define-keymap--compile)) | ||
| 6585 | (let (full suppress parent name prefix keymap) | ||
| 6586 | ;; Handle keywords. | ||
| 6587 | (while (and definitions | ||
| 6588 | (keywordp (car definitions)) | ||
| 6589 | (not (eq (car definitions) :menu))) | ||
| 6590 | (let ((keyword (pop definitions))) | ||
| 6591 | (unless definitions | ||
| 6592 | (error "Missing keyword value for %s" keyword)) | ||
| 6593 | (let ((value (pop definitions))) | ||
| 6594 | (pcase keyword | ||
| 6595 | (:full (setq full value)) | ||
| 6596 | (:keymap (setq keymap value)) | ||
| 6597 | (:parent (setq parent value)) | ||
| 6598 | (:suppress (setq suppress value)) | ||
| 6599 | (:name (setq name value)) | ||
| 6600 | (:prefix (setq prefix value)) | ||
| 6601 | (_ (error "Invalid keyword: %s" keyword)))))) | ||
| 6602 | |||
| 6603 | (when (and prefix | ||
| 6604 | (or full parent suppress keymap)) | ||
| 6605 | (error "A prefix keymap can't be defined with :full/:parent/:suppress/:keymap keywords")) | ||
| 6606 | |||
| 6607 | (when (and keymap full) | ||
| 6608 | (error "Invalid combination: :keymap with :full")) | ||
| 6609 | |||
| 6610 | (let ((keymap (cond | ||
| 6611 | (keymap keymap) | ||
| 6612 | (prefix (define-prefix-command prefix nil name)) | ||
| 6613 | (full (make-keymap name)) | ||
| 6614 | (t (make-sparse-keymap name))))) | ||
| 6615 | (when suppress | ||
| 6616 | (suppress-keymap keymap (eq suppress 'nodigits))) | ||
| 6617 | (when parent | ||
| 6618 | (set-keymap-parent keymap parent)) | ||
| 6619 | |||
| 6620 | ;; Do the bindings. | ||
| 6621 | (while definitions | ||
| 6622 | (let ((key (pop definitions))) | ||
| 6623 | (unless definitions | ||
| 6624 | (error "Uneven number of key/definition pairs")) | ||
| 6625 | (let ((def (pop definitions))) | ||
| 6626 | (if (eq key :menu) | ||
| 6627 | (easy-menu-define nil keymap "" def) | ||
| 6628 | (keymap-set keymap key def))))) | ||
| 6629 | keymap))) | ||
| 6630 | |||
| 6631 | (defmacro defvar-keymap (variable-name &rest defs) | ||
| 6632 | "Define VARIABLE-NAME as a variable with a keymap definition. | ||
| 6633 | See `define-keymap' for an explanation of the keywords and KEY/DEFINITION. | ||
| 6634 | |||
| 6635 | In addition to the keywords accepted by `define-keymap', this | ||
| 6636 | macro also accepts a `:doc' keyword, which (if present) is used | ||
| 6637 | as the variable documentation string. | ||
| 6638 | |||
| 6639 | \(fn VARIABLE-NAME &key DOC FULL PARENT SUPPRESS NAME PREFIX KEYMAP &rest [KEY DEFINITION]...)" | ||
| 6640 | (declare (indent 1)) | ||
| 6641 | (let ((opts nil) | ||
| 6642 | doc) | ||
| 6643 | (while (and defs | ||
| 6644 | (keywordp (car defs)) | ||
| 6645 | (not (eq (car defs) :menu))) | ||
| 6646 | (let ((keyword (pop defs))) | ||
| 6647 | (unless defs | ||
| 6648 | (error "Uneven number of keywords")) | ||
| 6649 | (if (eq keyword :doc) | ||
| 6650 | (setq doc (pop defs)) | ||
| 6651 | (push keyword opts) | ||
| 6652 | (push (pop defs) opts)))) | ||
| 6653 | (unless (zerop (% (length defs) 2)) | ||
| 6654 | (error "Uneven number of key/definition pairs: %s" defs)) | ||
| 6655 | `(defvar ,variable-name | ||
| 6656 | (define-keymap ,@(nreverse opts) ,@defs) | ||
| 6657 | ,@(and doc (list doc))))) | ||
| 6658 | |||
| 6659 | (defmacro with-delayed-message (args &rest body) | 6529 | (defmacro with-delayed-message (args &rest body) |
| 6660 | "Like `progn', but display MESSAGE if BODY takes longer than TIMEOUT seconds. | 6530 | "Like `progn', but display MESSAGE if BODY takes longer than TIMEOUT seconds. |
| 6661 | The MESSAGE form will be evaluated immediately, but the resulting | 6531 | The MESSAGE form will be evaluated immediately, but the resulting |