From: Stefan Kangas Date: Sun, 2 Jan 2022 22:27:16 +0000 (+0100) Subject: Move define-keymap and defvar-keymap to keymap.el X-Git-Tag: emacs-29.0.90~3294 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=7ddfe1cab2156db4cb1da1968e6d6dabb533ff33;p=emacs.git Move define-keymap and defvar-keymap to keymap.el These functions deal with the "new" keymap binding interface, so they belong in keymap.el rather than in subr.el. * lisp/subr.el (define-keymap--compile, define-keymap) (defvar-keymap): Move from here ... * lisp/keymap.el (define-keymap--compile, define-keymap) (defvar-keymap): ... to here. --- 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." (message "%s is bound to %s globally" keys def)) def)) + +;;; define-keymap and defvar-keymap + +(defun define-keymap--compile (form &rest args) + ;; This compiler macro is only there for compile-time + ;; error-checking; it does not change the call in any way. + (while (and args + (keywordp (car args)) + (not (eq (car args) :menu))) + (unless (memq (car args) '(:full :keymap :parent :suppress :name :prefix)) + (byte-compile-warn "Invalid keyword: %s" (car args))) + (setq args (cdr args)) + (when (null args) + (byte-compile-warn "Uneven number of keywords in %S" form)) + (setq args (cdr args))) + ;; Bindings. + (while args + (let ((key (pop args))) + (when (and (stringp key) (not (key-valid-p key))) + (byte-compile-warn "Invalid `kbd' syntax: %S" key))) + (when (null args) + (byte-compile-warn "Uneven number of key bindings in %S" form)) + (setq args (cdr args))) + form) + +(defun define-keymap (&rest definitions) + "Create a new keymap and define KEY/DEFINITION pairs as key bindings. +The new keymap is returned. + +Options can be given as keywords before the KEY/DEFINITION +pairs. Available keywords are: + +:full If non-nil, create a chartable alist (see `make-keymap'). + If nil (i.e., the default), create a sparse keymap (see + `make-sparse-keymap'). + +:suppress If non-nil, the keymap will be suppressed (see `suppress-keymap'). + If `nodigits', treat digits like other chars. + +:parent If non-nil, this should be a keymap to use as the parent + (see `set-keymap-parent'). + +:keymap If non-nil, instead of creating a new keymap, the given keymap + will be destructively modified instead. + +:name If non-nil, this should be a string to use as the menu for + the keymap in case you use it as a menu with `x-popup-menu'. + +:prefix If non-nil, this should be a symbol to be used as a prefix + command (see `define-prefix-command'). If this is the case, + this symbol is returned instead of the map itself. + +KEY/DEFINITION pairs are as KEY and DEF in `keymap-set'. KEY can +also be the special symbol `:menu', in which case DEFINITION +should be a MENU form as accepted by `easy-menu-define'. + +\(fn &key FULL PARENT SUPPRESS NAME PREFIX KEYMAP &rest [KEY DEFINITION]...)" + (declare (indent defun) + (compiler-macro define-keymap--compile)) + (let (full suppress parent name prefix keymap) + ;; Handle keywords. + (while (and definitions + (keywordp (car definitions)) + (not (eq (car definitions) :menu))) + (let ((keyword (pop definitions))) + (unless definitions + (error "Missing keyword value for %s" keyword)) + (let ((value (pop definitions))) + (pcase keyword + (:full (setq full value)) + (:keymap (setq keymap value)) + (:parent (setq parent value)) + (:suppress (setq suppress value)) + (:name (setq name value)) + (:prefix (setq prefix value)) + (_ (error "Invalid keyword: %s" keyword)))))) + + (when (and prefix + (or full parent suppress keymap)) + (error "A prefix keymap can't be defined with :full/:parent/:suppress/:keymap keywords")) + + (when (and keymap full) + (error "Invalid combination: :keymap with :full")) + + (let ((keymap (cond + (keymap keymap) + (prefix (define-prefix-command prefix nil name)) + (full (make-keymap name)) + (t (make-sparse-keymap name))))) + (when suppress + (suppress-keymap keymap (eq suppress 'nodigits))) + (when parent + (set-keymap-parent keymap parent)) + + ;; Do the bindings. + (while definitions + (let ((key (pop definitions))) + (unless definitions + (error "Uneven number of key/definition pairs")) + (let ((def (pop definitions))) + (if (eq key :menu) + (easy-menu-define nil keymap "" def) + (keymap-set keymap key def))))) + keymap))) + +(defmacro defvar-keymap (variable-name &rest defs) + "Define VARIABLE-NAME as a variable with a keymap definition. +See `define-keymap' for an explanation of the keywords and KEY/DEFINITION. + +In addition to the keywords accepted by `define-keymap', this +macro also accepts a `:doc' keyword, which (if present) is used +as the variable documentation string. + +\(fn VARIABLE-NAME &key DOC FULL PARENT SUPPRESS NAME PREFIX KEYMAP &rest [KEY DEFINITION]...)" + (declare (indent 1)) + (let ((opts nil) + doc) + (while (and defs + (keywordp (car defs)) + (not (eq (car defs) :menu))) + (let ((keyword (pop defs))) + (unless defs + (error "Uneven number of keywords")) + (if (eq keyword :doc) + (setq doc (pop defs)) + (push keyword opts) + (push (pop defs) opts)))) + (unless (zerop (% (length defs) 2)) + (error "Uneven number of key/definition pairs: %s" defs)) + `(defvar ,variable-name + (define-keymap ,@(nreverse opts) ,@defs) + ,@(and doc (list doc))))) + (provide 'keymap) ;;; 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." object (list object))) -(defun define-keymap--compile (form &rest args) - ;; This compiler macro is only there for compile-time - ;; error-checking; it does not change the call in any way. - (while (and args - (keywordp (car args)) - (not (eq (car args) :menu))) - (unless (memq (car args) '(:full :keymap :parent :suppress :name :prefix)) - (byte-compile-warn "Invalid keyword: %s" (car args))) - (setq args (cdr args)) - (when (null args) - (byte-compile-warn "Uneven number of keywords in %S" form)) - (setq args (cdr args))) - ;; Bindings. - (while args - (let ((key (pop args))) - (when (and (stringp key) (not (key-valid-p key))) - (byte-compile-warn "Invalid `kbd' syntax: %S" key))) - (when (null args) - (byte-compile-warn "Uneven number of key bindings in %S" form)) - (setq args (cdr args))) - form) - -(defun define-keymap (&rest definitions) - "Create a new keymap and define KEY/DEFINITION pairs as key bindings. -The new keymap is returned. - -Options can be given as keywords before the KEY/DEFINITION -pairs. Available keywords are: - -:full If non-nil, create a chartable alist (see `make-keymap'). - If nil (i.e., the default), create a sparse keymap (see - `make-sparse-keymap'). - -:suppress If non-nil, the keymap will be suppressed (see `suppress-keymap'). - If `nodigits', treat digits like other chars. - -:parent If non-nil, this should be a keymap to use as the parent - (see `set-keymap-parent'). - -:keymap If non-nil, instead of creating a new keymap, the given keymap - will be destructively modified instead. - -:name If non-nil, this should be a string to use as the menu for - the keymap in case you use it as a menu with `x-popup-menu'. - -:prefix If non-nil, this should be a symbol to be used as a prefix - command (see `define-prefix-command'). If this is the case, - this symbol is returned instead of the map itself. - -KEY/DEFINITION pairs are as KEY and DEF in `keymap-set'. KEY can -also be the special symbol `:menu', in which case DEFINITION -should be a MENU form as accepted by `easy-menu-define'. - -\(fn &key FULL PARENT SUPPRESS NAME PREFIX KEYMAP &rest [KEY DEFINITION]...)" - (declare (indent defun) - (compiler-macro define-keymap--compile)) - (let (full suppress parent name prefix keymap) - ;; Handle keywords. - (while (and definitions - (keywordp (car definitions)) - (not (eq (car definitions) :menu))) - (let ((keyword (pop definitions))) - (unless definitions - (error "Missing keyword value for %s" keyword)) - (let ((value (pop definitions))) - (pcase keyword - (:full (setq full value)) - (:keymap (setq keymap value)) - (:parent (setq parent value)) - (:suppress (setq suppress value)) - (:name (setq name value)) - (:prefix (setq prefix value)) - (_ (error "Invalid keyword: %s" keyword)))))) - - (when (and prefix - (or full parent suppress keymap)) - (error "A prefix keymap can't be defined with :full/:parent/:suppress/:keymap keywords")) - - (when (and keymap full) - (error "Invalid combination: :keymap with :full")) - - (let ((keymap (cond - (keymap keymap) - (prefix (define-prefix-command prefix nil name)) - (full (make-keymap name)) - (t (make-sparse-keymap name))))) - (when suppress - (suppress-keymap keymap (eq suppress 'nodigits))) - (when parent - (set-keymap-parent keymap parent)) - - ;; Do the bindings. - (while definitions - (let ((key (pop definitions))) - (unless definitions - (error "Uneven number of key/definition pairs")) - (let ((def (pop definitions))) - (if (eq key :menu) - (easy-menu-define nil keymap "" def) - (keymap-set keymap key def))))) - keymap))) - -(defmacro defvar-keymap (variable-name &rest defs) - "Define VARIABLE-NAME as a variable with a keymap definition. -See `define-keymap' for an explanation of the keywords and KEY/DEFINITION. - -In addition to the keywords accepted by `define-keymap', this -macro also accepts a `:doc' keyword, which (if present) is used -as the variable documentation string. - -\(fn VARIABLE-NAME &key DOC FULL PARENT SUPPRESS NAME PREFIX KEYMAP &rest [KEY DEFINITION]...)" - (declare (indent 1)) - (let ((opts nil) - doc) - (while (and defs - (keywordp (car defs)) - (not (eq (car defs) :menu))) - (let ((keyword (pop defs))) - (unless defs - (error "Uneven number of keywords")) - (if (eq keyword :doc) - (setq doc (pop defs)) - (push keyword opts) - (push (pop defs) opts)))) - (unless (zerop (% (length defs) 2)) - (error "Uneven number of key/definition pairs: %s" defs)) - `(defvar ,variable-name - (define-keymap ,@(nreverse opts) ,@defs) - ,@(and doc (list doc))))) - (defmacro with-delayed-message (args &rest body) "Like `progn', but display MESSAGE if BODY takes longer than TIMEOUT seconds. The MESSAGE form will be evaluated immediately, but the resulting