From 4c468c6b3c12c12a96a6efce7a49c9b77e73bbd0 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sat, 16 Oct 2021 17:50:36 +0200 Subject: [PATCH] Add new function 'kbd-valid-p' * doc/lispref/keymaps.texi (Key Sequences): New function 'kbd-valid-p'. * lisp/subr.el (kbd-valid-p): Document it. --- doc/lispref/keymaps.texi | 7 +++ etc/NEWS | 7 +++ lisp/subr.el | 33 ++++++++++++ test/lisp/subr-tests.el | 114 +++++++++++++++++++++++++++++++++++++++ 4 files changed, 161 insertions(+) diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi index 066d8b3693a..4277c718fea 100644 --- a/doc/lispref/keymaps.texi +++ b/doc/lispref/keymaps.texi @@ -94,8 +94,15 @@ Manual}. (kbd " SPC") @result{} [f1 32] (kbd "C-M-") @result{} [C-M-down] @end example + +@findex kbd-valid-p +The @code{kbd} function is very permissive, and will try to return +something sensible even if the syntax used isn't completely +conforming. To check whether the syntax is actually valid, use the +@code{kbd-valid-p} function. @end defun + @node Keymap Basics @section Keymap Basics @cindex key binding diff --git a/etc/NEWS b/etc/NEWS index e7d3de77986..fcc9b4ad32f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -209,6 +209,13 @@ This macro allows defining keymap variables more conveniently. ** 'kbd' can now be used in built-in, preloaded libraries. It no longer depends on edmacro.el and cl-lib.el. ++++ +** New function 'kbd-valid-p'. +The 'kbd' function is quite permissive, and will try to return +something usable even if the syntax of the argument isn't completely +correct. The 'kbd-valid-p' predicate does a stricter check of the +syntax. + * Changes in Emacs 29.1 on Non-Free Operating Systems diff --git a/lisp/subr.el b/lisp/subr.el index 93ec76e290f..e55c94a9f82 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -925,6 +925,39 @@ side-effects, and the argument LIST is not modified." ;;;; Keymap support. +(defun kbd-valid-p (keys) + "Say whether KEYS is a valid `kbd' sequence. +In particular, this checks the order of the modifiers, and they +have to be specified in this order: + + A-C-H-M-S-s + +which is + + Alt-Control-Hyper-Meta-Shift-super" + (declare (pure t) (side-effect-free t)) + (and (stringp keys) + (string-match-p "\\`[^ ]+\\( [^ ]+\\)*\\'" keys) + (save-match-data + (seq-every-p + (lambda (key) + ;; 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)))) + (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))) + (split-string keys " "))))) + (defun kbd (keys &optional need-vector) "Convert KEYS to the internal Emacs key representation. KEYS should be a string in the format returned by commands such diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index da46646d397..8380e8abfd3 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -198,6 +198,120 @@ ;; These should be equivalent: (should (equal (kbd "\C-xf") (kbd "C-x f")))) +(ert-deftest subr-test-kbd-valid-p () + (should (not (kbd-valid-p ""))) + (should (kbd-valid-p "f")) + (should (kbd-valid-p "X")) + (should (not (kbd-valid-p " X"))) + (should (kbd-valid-p "X f")) + (should (not (kbd-valid-p "a b"))) + (should (not (kbd-valid-p "foobar"))) + (should (not (kbd-valid-p "return"))) + + (should (kbd-valid-p "")) + (should (kbd-valid-p " TAB")) + (should (kbd-valid-p " RET")) + (should (kbd-valid-p " SPC")) + (should (kbd-valid-p "")) + (should (not (kbd-valid-p "[f1]"))) + (should (kbd-valid-p "")) + (should (not (kbd-valid-p "< right >"))) + + ;; Modifiers: + (should (kbd-valid-p "C-x")) + (should (kbd-valid-p "C-x a")) + (should (kbd-valid-p "C-;")) + (should (kbd-valid-p "C-a")) + (should (kbd-valid-p "C-c SPC")) + (should (kbd-valid-p "C-c TAB")) + (should (kbd-valid-p "C-c c")) + (should (kbd-valid-p "C-x 4 C-f")) + (should (kbd-valid-p "C-x C-f")) + (should (kbd-valid-p "C-M-")) + (should (not (kbd-valid-p ""))) + (should (kbd-valid-p "C-RET")) + (should (kbd-valid-p "C-SPC")) + (should (kbd-valid-p "C-TAB")) + (should (kbd-valid-p "C-")) + (should (kbd-valid-p "C-c C-c C-c")) + + (should (kbd-valid-p "M-a")) + (should (kbd-valid-p "M-")) + (should (not (kbd-valid-p "M-C-a"))) + (should (kbd-valid-p "C-M-a")) + (should (kbd-valid-p "M-ESC")) + (should (kbd-valid-p "M-RET")) + (should (kbd-valid-p "M-SPC")) + (should (kbd-valid-p "M-TAB")) + (should (kbd-valid-p "M-x a")) + (should (kbd-valid-p "M-")) + (should (kbd-valid-p "M-c M-c M-c")) + + (should (kbd-valid-p "s-SPC")) + (should (kbd-valid-p "s-a")) + (should (kbd-valid-p "s-x a")) + (should (kbd-valid-p "s-c s-c s-c")) + + (should (not (kbd-valid-p "S-H-a"))) + (should (kbd-valid-p "S-a")) + (should (kbd-valid-p "S-x a")) + (should (kbd-valid-p "S-c S-c S-c")) + + (should (kbd-valid-p "H-")) + (should (kbd-valid-p "H-DEL")) + (should (kbd-valid-p "H-a")) + (should (kbd-valid-p "H-x a")) + (should (kbd-valid-p "H-c H-c H-c")) + + (should (kbd-valid-p "A-H-a")) + (should (kbd-valid-p "A-SPC")) + (should (kbd-valid-p "A-TAB")) + (should (kbd-valid-p "A-a")) + (should (kbd-valid-p "A-c A-c A-c")) + + (should (kbd-valid-p "C-M-a")) + (should (kbd-valid-p "C-M-")) + + ;; Special characters. + (should (kbd-valid-p "DEL")) + (should (kbd-valid-p "ESC C-a")) + (should (kbd-valid-p "ESC")) + (should (kbd-valid-p "LFD")) + (should (kbd-valid-p "NUL")) + (should (kbd-valid-p "RET")) + (should (kbd-valid-p "SPC")) + (should (kbd-valid-p "TAB")) + (should (not (kbd-valid-p "\^i"))) + (should (not (kbd-valid-p "^M"))) + + ;; With numbers. + (should (not (kbd-valid-p "\177"))) + (should (not (kbd-valid-p "\000"))) + (should (not (kbd-valid-p "\\177"))) + (should (not (kbd-valid-p "\\000"))) + (should (not (kbd-valid-p "C-x \\150"))) + + ;; Multibyte + (should (kbd-valid-p "ñ")) + (should (kbd-valid-p "ü")) + (should (kbd-valid-p "ö")) + (should (kbd-valid-p "ğ")) + (should (kbd-valid-p "ա")) + (should (not (kbd-valid-p "üüöö"))) + (should (kbd-valid-p "C-ü")) + (should (kbd-valid-p "M-ü")) + (should (kbd-valid-p "H-ü")) + + ;; Handle both new and old style key descriptions (bug#45536). + (should (kbd-valid-p "s-")) + (should (not (kbd-valid-p ""))) + (should (kbd-valid-p "C-M-")) + (should (not (kbd-valid-p ""))) + + (should (not (kbd-valid-p "C-xx"))) + (should (not (kbd-valid-p "M-xx"))) + (should (not (kbd-valid-p "M-x")))) + (ert-deftest subr-test-define-prefix-command () (define-prefix-command 'foo-prefix-map) (defvar foo-prefix-map) -- 2.39.5