aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lisp/keymap.el133
-rw-r--r--lisp/subr.el130
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.
482The new keymap is returned.
483
484Options can be given as keywords before the KEY/DEFINITION
485pairs. 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
507KEY/DEFINITION pairs are as KEY and DEF in `keymap-set'. KEY can
508also be the special symbol `:menu', in which case DEFINITION
509should 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.
562See `define-keymap' for an explanation of the keywords and KEY/DEFINITION.
563
564In addition to the keywords accepted by `define-keymap', this
565macro also accepts a `:doc' keyword, which (if present) is used
566as 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.
6553The new keymap is returned.
6554
6555Options can be given as keywords before the KEY/DEFINITION
6556pairs. 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
6578KEY/DEFINITION pairs are as KEY and DEF in `keymap-set'. KEY can
6579also be the special symbol `:menu', in which case DEFINITION
6580should 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.
6633See `define-keymap' for an explanation of the keywords and KEY/DEFINITION.
6634
6635In addition to the keywords accepted by `define-keymap', this
6636macro also accepts a `:doc' keyword, which (if present) is used
6637as 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.
6661The MESSAGE form will be evaluated immediately, but the resulting 6531The MESSAGE form will be evaluated immediately, but the resulting