master d50e0bd 2/2: Use compiler macros for the key syntax checks

[Mattias Engdegård]

branch: master
commit d50e0bdbac8e6683c6af4efa172c1b801d250486
Author: Mattias Engdegård <mattiase@acm.org>
Commit: Mattias Engdegård <mattiase@acm.org>

    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.
---
 lisp/emacs-lisp/bytecomp.el | 63 ---------------------------------------------
 lisp/keymap.el              | 22 +++++++++++++++-
 lisp/subr.el                | 30 +++++++++++++++++----
 3 files changed, 46 insertions(+), 69 deletions(-)

diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 566a3fd..5ce5b29 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -5051,69 +5051,6 @@ binding slots have been popped."
 
 
 
-;; 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
 
 ;; Note: Most operations will strip off the 'TAG, but it speeds up
diff --git a/lisp/keymap.el b/lisp/keymap.el
index a9331e1..770a6ed 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 06ea503..78c7283 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)