From: Lars Ingebrigtsen <larsi@gnus.org>
Date: Sun, 17 Oct 2021 19:49:43 +0000 (+0200)
Subject: Allow <mouse-1> in kbd-valid-p
X-Git-Tag: emacs-29.0.90~3671^2~527
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=c0f5987ffd4374f152197d1f8d0e6efcbcf99d11;p=emacs.git

Allow <mouse-1> in kbd-valid-p

* lisp/subr.el (kbd-valid-p): Allow (kbd-valid-p "<mouse-1>").
---

diff --git a/lisp/subr.el b/lisp/subr.el
index 635942205b4..1da453b30f5 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -940,26 +940,32 @@ which is
        (string-match-p "\\`[^ ]+\\( [^ ]+\\)*\\'" keys)
        (save-match-data
          (catch 'exit
-           (dolist (key (split-string keys " "))
-             ;; Every key might have these modifiers, and they should be
-             ;; in this order.
-             (when (string-match
-                    "\\`\\(A-\\)?\\(C-\\)?\\(H-\\)?\\(M-\\)?\\(S-\\)?\\(s-\\)?"
-                    key)
-               (setq key (substring key (match-end 0))))
-             (unless (or (and (= (length key) 1)
-                              ;; Don't accept control characters as keys.
-                              (not (< (aref key 0) ?\s))
-                              ;; Don't accept Meta'd characters as keys.
-                              (or (multibyte-string-p key)
-                                  (not (<= 127 (aref key 0) 255))))
-                         (string-match-p "\\`<[A-Za-z0-9]+>\\'" key)
-                         (string-match-p
-                          "\\`\\(NUL\\|RET\\|TAB\\|LFD\\|ESC\\|SPC\\|DEL\\)\\'"
-                          key))
-               ;; Invalid.
-               (throw 'exit nil)))
-           t))))
+           (let ((prefixes
+                  "\\(A-\\)?\\(C-\\)?\\(H-\\)?\\(M-\\)?\\(S-\\)?\\(s-\\)?"))
+             (dolist (key (split-string keys " "))
+               ;; Every key might have these modifiers, and they should be
+               ;; in this order.
+               (when (string-match (concat "\\`" prefixes) key)
+                 (setq key (substring key (match-end 0))))
+               (unless (or (and (= (length key) 1)
+                                ;; Don't accept control characters as keys.
+                                (not (< (aref key 0) ?\s))
+                                ;; Don't accept Meta'd characters as keys.
+                                (or (multibyte-string-p key)
+                                    (not (<= 127 (aref key 0) 255))))
+                           (and (string-match-p "\\`<[-_A-Za-z0-9]+>\\'" key)
+                                ;; Don't allow <M-C-down>.
+                                (= (progn
+                                     (string-match
+                                      (concat "\\`<" prefixes) key)
+                                     (match-end 0))
+                                   1))
+                           (string-match-p
+                            "\\`\\(NUL\\|RET\\|TAB\\|LFD\\|ESC\\|SPC\\|DEL\\)\\'"
+                            key))
+                 ;; Invalid.
+                 (throw 'exit nil)))
+             t)))))
 
 (defun kbd (keys &optional need-vector)
   "Convert KEYS to the internal Emacs key representation.
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index 8380e8abfd3..3e6a7a8bd88 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -308,6 +308,9 @@
   (should (kbd-valid-p "C-M-<return>"))
   (should (not (kbd-valid-p "<C-M-return>")))
 
+  (should (kbd-valid-p "<mouse-1>"))
+  (should (kbd-valid-p "<Scroll_Lock>"))
+
   (should (not (kbd-valid-p "C-xx")))
   (should (not (kbd-valid-p "M-xx")))
   (should (not (kbd-valid-p "M-x<TAB>"))))