andros/emacs-gpu
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Use compiler macros for the key syntax checks

Browse source 
Compile-time key string syntax checks are better written using
compiler macros than with byte-hunk-handlers inside the compiler
proper.

* lisp/emacs-lisp/bytecomp.el (byte-compile-define-keymap)
(byte-compile-define-keymap--define): Remove.
* lisp/keymap.el (keymap--compile-check): New.
(keymap-set, keymap-global-set, keymap-local-set, keymap-global-unset)
(keymap-local-unset, keymap-unset, keymap-substitute)
(keymap-set-after, key-translate, keymap-lookup, keymap-local-lookup)
(keymap-global-lookup): Use compiler-macro for argument checks.
* lisp/subr.el (define-keymap--compile): New.
(define-keymap--define): Fold into define-keymap.
(define-keymap): Use compiler-macro.
(defvar-keymap): Use define-keymap.
This commit is contained in:
Mattias Engdegård 2021-11-28 18:04:06 +01:00
parent 1e8074f5ea
commit d50e0bdbac
3 changed files with 46 additions and 69 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

63
lisp/emacs-lisp/bytecomp.el
View file

@ -5050,69 +5050,6 @@ binding slots have been popped."
(_ (byte-compile-keep-pending form))))
;; Key syntax warnings.
(mapc
(lambda (elem)
(put (car elem) 'byte-hunk-handler
(lambda (form)
(dolist (idx (cdr elem))
(let ((key (elt form idx)))
(when (or (vectorp key)
(and (stringp key)
(not (key-valid-p key))))
(byte-compile-warn "Invalid `kbd' syntax: %S" key))))
form)))
;; Functions and the place(s) for the key definition(s).
'((keymap-set 2)
(keymap-global-set 1)
(keymap-local-set 1)
(keymap-unset 2)
(keymap-global-unset 1)
(keymap-local-unset 1)
(keymap-substitute 2 3)
(keymap-set-after 2)
(key-translate 1 2)
(keymap-lookup 2)
(keymap-global-lookup 1)
(keymap-local-lookup 1)))
(put 'define-keymap 'byte-hunk-handler #'byte-compile-define-keymap)
(defun byte-compile-define-keymap (form)
(let ((result nil)
(orig-form form))
(push (pop form) result)
(while (and form
(keywordp (car form))
(not (eq (car form) :menu)))
(unless (memq (car form)
'(:full :keymap :parent :suppress :name :prefix))
(byte-compile-warn "Invalid keyword: %s" (car form)))
(push (pop form) result)
(when (null form)
(byte-compile-warn "Uneven number of keywords in %S" form))
(push (pop form) result))
;; Bindings.
(while form
(let ((key (pop form)))
(when (stringp key)
(unless (key-valid-p key)
(byte-compile-warn "Invalid `kbd' syntax: %S" key)))
;; No improvement.
(push key result))
(when (null form)
(byte-compile-warn "Uneven number of key bindings in %S" form))
(push (pop form) result))
orig-form))
(put 'define-keymap--define 'byte-hunk-handler
#'byte-compile-define-keymap--define)
(defun byte-compile-define-keymap--define (form)
(when (consp (nth 1 form))
(byte-compile-define-keymap (nth 1 form)))
form)
;;; tags

22
lisp/keymap.el
View file

@ -31,6 +31,12 @@
(unless (key-valid-p key)
(error "%S is not a valid key definition; see `key-valid-p'" key)))
(defun keymap--compile-check (&rest keys)
(dolist (key keys)
(when (or (vectorp key)
(and (stringp key) (not (key-valid-p key))))
(byte-compile-warn "Invalid `kbd' syntax: %S" key))))
(defun keymap-set (keymap key definition)
"Set key sequence KEY to DEFINITION in KEYMAP.
KEY is a string that satisfies `key-valid-p'.
@ -50,6 +56,7 @@ DEFINITION is anything that can be a key's definition:
or a cons (MAP . CHAR), meaning use definition of CHAR in keymap MAP,
or an extended menu item definition.
(See info node `(elisp)Extended Menu Items'.)"
(declare (compiler-macro (lambda (form) (keymap--compile-check key) form)))
(keymap--check key)
(define-key keymap (key-parse key) definition))
@ -63,6 +70,7 @@ KEY is a string that satisfies `key-valid-p'.
Note that if KEY has a local binding in the current buffer,
that local binding will continue to shadow any global binding
that you make with this function."
(declare (compiler-macro (lambda (form) (keymap--compile-check key) form)))
(interactive
(let* ((menu-prompting nil)
(key (read-key-sequence "Set key globally: " nil t)))
@ -80,6 +88,7 @@ KEY is a string that satisfies `key-valid-p'.
The binding goes in the current buffer's local map, which in most
cases is shared with all other buffers in the same major mode."
(declare (compiler-macro (lambda (form) (keymap--compile-check key) form)))
(interactive "KSet key locally: \nCSet key %s locally to command: ")
(let ((map (current-local-map)))
(unless map
@ -92,6 +101,7 @@ KEY is a string that satisfies `key-valid-p'.
If REMOVE (interactively, the prefix arg), remove the binding
instead of unsetting it. See `keymap-unset' for details."
(declare (compiler-macro (lambda (form) (keymap--compile-check key) form)))
(interactive
(list (key-description (read-key-sequence "Set key locally: "))
current-prefix-arg))
@ -103,6 +113,7 @@ KEY is a string that satisfies `key-valid-p'.
If REMOVE (interactively, the prefix arg), remove the binding
instead of unsetting it. See `keymap-unset' for details."
(declare (compiler-macro (lambda (form) (keymap--compile-check key) form)))
(interactive
(list (key-description (read-key-sequence "Unset key locally: "))
current-prefix-arg))
@ -118,6 +129,7 @@ makes a difference when there's a parent keymap. When unsetting
a key in a child map, it will still shadow the same key in the
parent keymap. Removing the binding will allow the key in the
parent keymap to be used."
(declare (compiler-macro (lambda (form) (keymap--compile-check key) form)))
(keymap--check key)
(define-key keymap (key-parse key) nil remove))
@ -131,6 +143,8 @@ If you don't specify OLDMAP, you can usually get the same results
in a cleaner way with command remapping, like this:
(define-key KEYMAP [remap OLDDEF] NEWDEF)
\n(fn OLDDEF NEWDEF KEYMAP &optional OLDMAP)"
(declare (compiler-macro
(lambda (form) (keymap--compile-check olddef newdef) form)))
;; Don't document PREFIX in the doc string because we don't want to
;; advertise it. It's meant for recursive calls only. Here's its
;; meaning
@ -170,7 +184,8 @@ Bindings are always added before any inherited map.
The order of bindings in a keymap matters only when it is used as
a menu, so this function is not useful for non-menu keymaps."
(declare (indent defun))
(declare (indent defun)
(compiler-macro (lambda (form) (keymap--compile-check key) form)))
(keymap--check key)
(when after
(keymap--check after))
@ -350,6 +365,8 @@ This function creates a `keyboard-translate-table' if necessary
and then modifies one entry in it.
Both KEY and TO are strings that satisfy `key-valid-p'."
(declare (compiler-macro
(lambda (form) (keymap--compile-check from to) form)))
(keymap--check from)
(keymap--check to)
(or (char-table-p keyboard-translate-table)
@ -389,6 +406,7 @@ position as returned by `event-start' and `event-end', and the lookup
occurs in the keymaps associated with it instead of KEY. It can also
be a number or marker, in which case the keymap properties at the
specified buffer position instead of point are used."
(declare (compiler-macro (lambda (form) (keymap--compile-check key) form)))
(keymap--check key)
(when (and keymap (not position))
(error "Can't pass in both keymap and position"))
@ -408,6 +426,7 @@ The binding is probably a symbol with a function definition.
If optional argument ACCEPT-DEFAULT is non-nil, recognize default
bindings; see the description of `keymap-lookup' for more details
about this."
(declare (compiler-macro (lambda (form) (keymap--compile-check keys) form)))
(when-let ((map (current-local-map)))
(keymap-lookup map keys accept-default)))
@ -424,6 +443,7 @@ bindings; see the description of `keymap-lookup' for more details
about this.
If MESSAGE (and interactively), message the result."
(declare (compiler-macro (lambda (form) (keymap--compile-check keys) form)))
(interactive
(list (key-description (read-key-sequence "Look up key in global keymap: "))
nil t))

30
lisp/subr.el
View file

@ -6525,6 +6525,28 @@ 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/DEFEFINITION pairs as key sequences.
The new keymap is returned.
@ -6557,10 +6579,8 @@ 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))
(define-keymap--define definitions))
(defun define-keymap--define (definitions)
(declare (indent defun)
(compiler-macro define-keymap--compile))
(let (full suppress parent name prefix keymap)
;; Handle keywords.
(while (and definitions
@ -6632,7 +6652,7 @@ as the variable documentation string.
(unless (zerop (% (length defs) 2))
(error "Uneven number of key/definition pairs: %s" defs))
`(defvar ,variable-name
(define-keymap--define (list ,@(nreverse opts) ,@defs))
(define-keymap ,@(nreverse opts) ,@defs)
,@(and doc (list doc)))))
(defmacro with-delayed-message (args &rest body)