mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-02-03 22:20:52 -08:00
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.
This commit is contained in:
Stefan Kangas
parent
04c0245d36
commit
7ddfe1cab2
2 changed files with 133 additions and 130 deletions
133
lisp/keymap.el
133
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
|
||||
|
|
|
|||
130
lisp/subr.el
130
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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue