From: Mattias Engdegård Date: Sun, 28 Nov 2021 17:04:06 +0000 (+0100) Subject: Use compiler macros for the key syntax checks X-Git-Tag: emacs-29.0.90~3649^2~10 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=d50e0bdbac8e6683c6af4efa172c1b801d250486;p=emacs.git Use compiler macros for the key syntax checks 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. --- diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 566a3fdf99c..5ce5b2952b8 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -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 diff --git a/lisp/keymap.el b/lisp/keymap.el index a9331e16049..770a6ed20d1 100644 --- a/lisp/keymap.el +++ b/lisp/keymap.el @@ -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)) diff --git a/lisp/subr.el b/lisp/subr.el index 06ea503da6a..78c72838f3f 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -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)