master c0f5987: Allow <mouse-1> in kbd-valid-p

[Lars Ingebrigtsen]

branch: master
commit c0f5987ffd4374f152197d1f8d0e6efcbcf99d11
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>

    Allow <mouse-1> in kbd-valid-p
    
    * lisp/subr.el (kbd-valid-p): Allow (kbd-valid-p "<mouse-1>").
---
 lisp/subr.el            | 46 ++++++++++++++++++++++++++--------------------
 test/lisp/subr-tests.el |  3 +++
 2 files changed, 29 insertions(+), 20 deletions(-)

diff --git a/lisp/subr.el b/lisp/subr.el
index 6359422..1da453b 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 8380e8a..3e6a7a8 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>"))))