[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master de477ec 3/5: Add new 'keymap-*' functions
|
From: |
Lars Ingebrigtsen |
|
Subject: |
master de477ec 3/5: Add new 'keymap-*' functions |
|
Date: |
Tue, 16 Nov 2021 02:26:34 -0500 (EST) |
branch: master
commit de477ec683482a5dd27d791d7fdcfc4021ed3cb7
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>
Add new 'keymap-*' functions
* lisp/keymap.el: New file with all the new keymap-* functions.
* lisp/loadup.el ("keymap"): Load.
* lisp/subr.el (kbd): Refactor out all the code to key-parse.
(define-key-after, keyboard-translate, global-set-key)
(local-set-key, global-unset-key, local-unset-key)
(local-key-binding, global-key-binding)
(substitute-key-definition): Note in doc strings that these are
legacy functions.
(define-keymap--define): Use keymap-set.
* lisp/emacs-lisp/byte-opt.el: Remove the optimizations for
defvar-keymap and define-keymap since the macros now only
understand the kbd syntax.
* lisp/emacs-lisp/bytecomp.el (byte-compile-define-keymap)
(byte-compile-define-keymap--define): Warn about invalid key
definitions in all keymap-* functions.
* lisp/emacs-lisp/shortdoc.el (keymaps): Add shortdocs form
keymap* functions.
* src/keymap.c (possibly_translate_key_sequence): Adjust callers
to key-valid-p and key-parse.
(syms_of_keymap): Adjust defs.
---
etc/NEWS | 66 +++++--
lisp/emacs-lisp/byte-opt.el | 66 -------
lisp/emacs-lisp/bytecomp.el | 65 +++++++
lisp/emacs-lisp/shortdoc.el | 33 ++++
lisp/keymap.el | 437 ++++++++++++++++++++++++++++++++++++++++++++
lisp/loadup.el | 1 +
lisp/subr.el | 207 ++++-----------------
src/keymap.c | 16 +-
test/lisp/subr-tests.el | 214 +++++++++++-----------
9 files changed, 740 insertions(+), 365 deletions(-)
diff --git a/etc/NEWS b/etc/NEWS
index ed95f89..68b5cc8 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -593,13 +593,63 @@ Use 'exif-parse-file' and 'exif-field' instead.
* Lisp Changes in Emacs 29.1
+** Keymaps and key definitions
+
++++
+*** New functions for defining and manipulating keystrokes have been added.
+These all take just the syntax defined by 'key-valid-p'. None of the
+older functions have been depreciated or altered, but are deemphasised
+in the documentation.
+
++++
+*** Use 'keymap-set' instead of 'define-key'.
+
++++
+*** Use 'keymap-global-set' instead of 'global-set-key'.
+
++++
+*** Use 'keymap-local-set' instead of 'local-set-key'.
+
++++
+*** Use 'keymap-global-unset' instead of 'global-unset-key'.
+
++++
+*** Use 'keymap-local-unset' instead of 'local-unset-key'.
+
++++
+*** Use 'keymap-substitute' instead of 'substitute-key-definition'.
+
++++
+*** Use 'keymap-set-after' instead of 'define-key-after'.
+
++++
+*** Use 'keymap-lookup' instead of 'lookup-keymap' and 'key-binding'.
+
+++
-** 'define-key' now takes an optional REMOVE argument.
+*** Use 'keymap-local-lookup' instead of 'local-key-binding'.
+
++++
+*** Use 'keymap-global-lookup' instead of 'global-key-binding'.
+
++++
+*** 'define-key' now takes an optional REMOVE argument.
If non-nil, remove the definition from the keymap. This is subtly
different from setting a definition to nil (when the keymap has a
parent).
+++
+*** New function 'key-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 'key-valid-p' predicate does a stricter check of the
+syntax.
+
+---
+*** New function 'key-parse'.
+This is like 'kbd', but only returns vectors instead of a mix of
+vectors and strings.
+
++++
** New function 'file-name-split'.
This returns a list of all the components of a file name.
@@ -692,13 +742,6 @@ descriptor, which means to insert an image in that column
instead of
text. See the documentation string of that variable for details.
+++
-** 'define-key' now understands a new strict 'kbd' representation for keys.
-The '(define-key map ["C-c M-f"] #'some-command)' syntax is now
-supported, and is like the 'kbd' representation, but is stricter. If
-the string doesn't represent a valid key sequence, an error is
-signalled (both when evaluating and byte compiling).
-
-+++
** :keys in 'menu-item' can now be a function.
If so, it is called whenever the menu is computed, and can be used to
calculate the keys dynamically.
@@ -735,13 +778,6 @@ This macro allows defining keymap variables more
conveniently.
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.
-
-+++
** New function 'image-at-point-p'.
This function returns t if point is on a valid image, and nil
otherwise.
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 9c64083..f6db803 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -1186,72 +1186,6 @@ See Info node `(elisp) Integer Basics'."
(put 'concat 'byte-optimizer #'byte-optimize-concat)
-(defun byte-optimize-define-key (form)
- "Expand key bindings in FORM."
- (let ((key (nth 2 form)))
- (if (and (vectorp key)
- (= (length key) 1)
- (stringp (aref key 0)))
- ;; We have key on the form ["C-c C-c"].
- (if (not (kbd-valid-p (aref key 0)))
- (error "Invalid `kbd' syntax: %S" key)
- (list (nth 0 form) (nth 1 form)
- (kbd (aref key 0)) (nth 4 form)))
- ;; No improvement.
- form)))
-
-(put 'define-key 'byte-optimizer #'byte-optimize-define-key)
-
-(defun byte-optimize-define-keymap (form)
- "Expand key bindings in FORM."
- (let ((result nil)
- (orig-form form)
- improved)
- (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))
- (error "Invalid keyword: %s" (car form)))
- (push (pop form) result)
- (when (null form)
- (error "Uneven number of keywords in %S" form))
- (push (pop form) result))
- ;; Bindings.
- (while form
- (let ((key (pop form)))
- (if (and (vectorp key)
- (= (length key) 1)
- (stringp (aref key 0)))
- (progn
- (unless (kbd-valid-p (aref key 0))
- (error "Invalid `kbd' syntax: %S" key))
- (push (kbd (aref key 0)) result)
- (setq improved t))
- ;; No improvement.
- (push key result)))
- (when (null form)
- (error "Uneven number of key bindings in %S" form))
- (push (pop form) result))
- (if improved
- (nreverse result)
- orig-form)))
-
-(defun byte-optimize-define-keymap--define (form)
- "Expand key bindings in FORM."
- (if (not (consp (nth 1 form)))
- form
- (let ((optimized (byte-optimize-define-keymap (nth 1 form))))
- (if (eq optimized (nth 1 form))
- ;; No improvement.
- form
- (list (car form) optimized)))))
-
-(put 'define-keymap 'byte-optimizer #'byte-optimize-define-keymap)
-(put 'define-keymap--define 'byte-optimizer
- #'byte-optimize-define-keymap--define)
-
;; I'm not convinced that this is necessary. Doesn't the optimizer loop
;; take care of this? - Jamie
;; I think this may some times be necessary to reduce ie (quote 5) to 5,
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 471a0b6..4078a73 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -5043,6 +5043,71 @@ binding slots have been popped."
nil))
(_ (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 1 2)
+ (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/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el
index a9f548b..228d1e0 100644
--- a/lisp/emacs-lisp/shortdoc.el
+++ b/lisp/emacs-lisp/shortdoc.el
@@ -1222,6 +1222,39 @@ There can be any number of :example/:result elements."
(text-property-search-backward
:no-eval (text-property-search-backward 'face nil t)))
+(define-short-documentation-group keymaps
+ "Defining keymaps"
+ (define-keymap
+ :no-eval (define-keymap "C-c C-c" #'quit-buffer))
+ (defvar-keymap
+ :no-eval (defvar-keymap my-keymap "C-c C-c" map #'quit-buffer))
+ "Setting keys"
+ (keymap-set
+ :no-eval (keymap-set map "C-c C-c" #'quit-buffer))
+ (keymap-local-set
+ :no-eval (keymap-local-set "C-c C-c" #'quit-buffer))
+ (keymap-global-set
+ :no-eval (keymap-global-set "C-c C-c" #'quit-buffer))
+ (keymap-unset
+ :no-eval (keymap-unset map "C-c C-c"))
+ (keymap-local-unset
+ :no-eval (keymap-local-unset "C-c C-c"))
+ (keymap-global-unset
+ :no-eval (keymap-global-unset "C-c C-c"))
+ (keymap-substitute
+ :no-eval (keymap-substitute "C-c C-c" "M-a" map))
+ (keymap-set-after
+ :no-eval (keymap-set-after map "<separator-2>" menu-bar-separator))
+ "Predicates"
+ (keymapp
+ :eval (keymapp (define-keymap)))
+ (key-valid-p
+ :eval (key-valid-p "C-c C-c")
+ :eval (key-valid-p "C-cC-c"))
+ "Lookup"
+ (keymap-lookup
+ :eval (keymap-lookup (current-global-map) "C-x x g")))
+
;;;###autoload
(defun shortdoc-display-group (group &optional function)
"Pop to a buffer with short documentation summary for functions in GROUP.
diff --git a/lisp/keymap.el b/lisp/keymap.el
new file mode 100644
index 0000000..8938197
--- /dev/null
+++ b/lisp/keymap.el
@@ -0,0 +1,437 @@
+;;; keymap.el --- Keymap functions -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This library deals with the "new" keymap binding interface: The
+;; only key syntax allowed by these functions is the `kbd' one.
+
+;;; Code:
+
+
+
+(defun keymap--check (key)
+ "Signal an error if KEY doesn't have a valid syntax."
+ (unless (key-valid-p key)
+ (error "%S is not a valid key definition; see `key-valid-p'" key)))
+
+(defun keymap-set (keymap key definition)
+ "Set key sequence KEY to DEFINITION in KEYMAP.
+KEY is a string that satisfies `key-valid-p'.
+
+DEFINITION is anything that can be a key's definition:
+ nil (means key is undefined in this keymap),
+ a command (a Lisp function suitable for interactive calling),
+ a string (treated as a keyboard macro),
+ a keymap (to define a prefix key),
+ a symbol (when the key is looked up, the symbol will stand for its
+ function definition, which should at that time be one of the above,
+ or another symbol whose function definition is used, etc.),
+ a cons (STRING . DEFN), meaning that DEFN is the definition
+ (DEFN should be a valid definition in its own right) and
+ STRING is the menu item name (which is used only if the containing
+ keymap has been created with a menu name, see `make-keymap'),
+ 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'.)"
+ (keymap--check key)
+ (define-key keymap (key-parse key) definition))
+
+(defun keymap-global-set (key command)
+ "Give KEY a global binding as COMMAND.
+COMMAND is the command definition to use; usually it is
+a symbol naming an interactively-callable function.
+
+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."
+ (interactive
+ (let* ((menu-prompting nil)
+ (key (read-key-sequence "Set key globally: " nil t)))
+ (list key
+ (read-command (format "Set key %s to command: "
+ (key-description key))))))
+ (keymap-set (current-global-map) key command))
+
+(defun keymap-local-set (key command)
+ "Give KEY a local binding as COMMAND.
+COMMAND is the command definition to use; usually it is
+a symbol naming an interactively-callable function.
+
+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."
+ (interactive "KSet key locally: \nCSet key %s locally to command: ")
+ (let ((map (current-local-map)))
+ (unless map
+ (use-local-map (setq map (make-sparse-keymap))))
+ (keymap-set map key command)))
+
+(defun keymap-global-unset (key &optional remove)
+ "Remove global binding of KEY (if any).
+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."
+ (interactive
+ (list (key-description (read-key-sequence "Set key locally: "))
+ current-prefix-arg))
+ (keymap-unset (current-global-map) key remove))
+
+(defun keymap-local-unset (key &optional remove)
+ "Remove local binding of KEY (if any).
+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."
+ (interactive
+ (list (key-description (read-key-sequence "Unset key locally: "))
+ current-prefix-arg))
+ (when (current-local-map)
+ (keymap-unset (current-local-map) key remove)))
+
+(defun keymap-unset (keymap key &optional remove)
+ "Remove key sequence KEY from KEYMAP.
+KEY is a string that satisfies `key-valid-p'.
+
+If REMOVE, remove the binding instead of unsetting it. This only
+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."
+ (keymap--check key)
+ (define-key keymap key nil remove))
+
+(defun keymap-substitute (olddef newdef keymap &optional oldmap prefix)
+ "Replace OLDDEF with NEWDEF for any keys in KEYMAP now defined as OLDDEF.
+In other words, OLDDEF is replaced with NEWDEF wherever it appears.
+Alternatively, if optional fourth argument OLDMAP is specified, we redefine
+in KEYMAP as NEWDEF those keys that are defined as OLDDEF in OLDMAP.
+
+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)"
+ ;; 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
+
+ ;; If optional argument PREFIX is specified, it should be a key
+ ;; prefix, a string. Redefined bindings will then be bound to the
+ ;; original key, with PREFIX added at the front.
+ (unless prefix
+ (setq prefix ""))
+ (keymap--check olddef)
+ (keymap--check newdef)
+ (setq olddef (key-parse olddef))
+ (setq newdef (key-parse newdef))
+ (let* ((scan (or oldmap keymap))
+ (prefix1 (vconcat prefix [nil]))
+ (key-substitution-in-progress
+ (cons scan key-substitution-in-progress)))
+ ;; Scan OLDMAP, finding each char or event-symbol that
+ ;; has any definition, and act on it with hack-key.
+ (map-keymap
+ (lambda (char defn)
+ (aset prefix1 (length prefix) char)
+ (substitute-key-definition-key defn olddef newdef prefix1 keymap))
+ scan)))
+
+(defun keymap-set-after (keymap key definition &optional after)
+ "Add binding in KEYMAP for KEY => DEFINITION, right after AFTER's binding.
+This is like `keymap-set' except that the binding for KEY is placed
+just after the binding for the event AFTER, instead of at the beginning
+of the map. Note that AFTER must be an event type (like KEY), NOT a command
+\(like DEFINITION).
+
+If AFTER is t or omitted, the new binding goes at the end of the keymap.
+AFTER should be a single event type--a symbol or a character, not a sequence.
+
+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))
+ (keymap--check key)
+ (when after
+ (keymap--check after))
+ (define-key-after keymap (key-parse key) definition
+ (and after (key-parse after))))
+
+(defun key-parse (keys)
+ "Convert KEYS to the internal Emacs key representation.
+See `kbd' for a descripion of KEYS."
+ (declare (pure t) (side-effect-free t))
+ ;; A pure function is expected to preserve the match data.
+ (save-match-data
+ (let ((case-fold-search nil)
+ (len (length keys)) ; We won't alter keys in the loop below.
+ (pos 0)
+ (res []))
+ (while (and (< pos len)
+ (string-match "[^ \t\n\f]+" keys pos))
+ (let* ((word-beg (match-beginning 0))
+ (word-end (match-end 0))
+ (word (substring keys word-beg len))
+ (times 1)
+ key)
+ ;; Try to catch events of the form "<as df>".
+ (if (string-match "\\`<[^ <>\t\n\f][^>\t\n\f]*>" word)
+ (setq word (match-string 0 word)
+ pos (+ word-beg (match-end 0)))
+ (setq word (substring keys word-beg word-end)
+ pos word-end))
+ (when (string-match "\\([0-9]+\\)\\*." word)
+ (setq times (string-to-number (substring word 0 (match-end 1))))
+ (setq word (substring word (1+ (match-end 1)))))
+ (cond ((string-match "^<<.+>>$" word)
+ (setq key (vconcat (if (eq (key-binding [?\M-x])
+ 'execute-extended-command)
+ [?\M-x]
+ (or (car (where-is-internal
+ 'execute-extended-command))
+ [?\M-x]))
+ (substring word 2 -2) "\r")))
+ ((and (string-match "^\\(\\([ACHMsS]-\\)*\\)<\\(.+\\)>$" word)
+ (progn
+ (setq word (concat (match-string 1 word)
+ (match-string 3 word)))
+ (not (string-match
+ "\\<\\(NUL\\|RET\\|LFD\\|ESC\\|SPC\\|DEL\\)$"
+ word))))
+ (setq key (list (intern word))))
+ ((or (equal word "REM") (string-match "^;;" word))
+ (setq pos (string-match "$" keys pos)))
+ (t
+ (let ((orig-word word) (prefix 0) (bits 0))
+ (while (string-match "^[ACHMsS]-." word)
+ (setq bits (+ bits
+ (cdr
+ (assq (aref word 0)
+ '((?A . ?\A-\^@) (?C . ?\C-\^@)
+ (?H . ?\H-\^@) (?M . ?\M-\^@)
+ (?s . ?\s-\^@) (?S . ?\S-\^@))))))
+ (setq prefix (+ prefix 2))
+ (setq word (substring word 2)))
+ (when (string-match "^\\^.$" word)
+ (setq bits (+ bits ?\C-\^@))
+ (setq prefix (1+ prefix))
+ (setq word (substring word 1)))
+ (let ((found (assoc word '(("NUL" . "\0") ("RET" . "\r")
+ ("LFD" . "\n") ("TAB" . "\t")
+ ("ESC" . "\e") ("SPC" . " ")
+ ("DEL" . "\177")))))
+ (when found (setq word (cdr found))))
+ (when (string-match "^\\\\[0-7]+$" word)
+ (let ((n 0))
+ (dolist (ch (cdr (string-to-list word)))
+ (setq n (+ (* n 8) ch -48)))
+ (setq word (vector n))))
+ (cond ((= bits 0)
+ (setq key word))
+ ((and (= bits ?\M-\^@) (stringp word)
+ (string-match "^-?[0-9]+$" word))
+ (setq key (mapcar (lambda (x) (+ x bits))
+ (append word nil))))
+ ((/= (length word) 1)
+ (error "%s must prefix a single character, not %s"
+ (substring orig-word 0 prefix) word))
+ ((and (/= (logand bits ?\C-\^@) 0) (stringp word)
+ ;; We used to accept . and ? here,
+ ;; but . is simply wrong,
+ ;; and C-? is not used (we use DEL instead).
+ (string-match "[@-_a-z]" word))
+ (setq key (list (+ bits (- ?\C-\^@)
+ (logand (aref word 0) 31)))))
+ (t
+ (setq key (list (+ bits (aref word 0)))))))))
+ (when key
+ (dolist (_ (number-sequence 1 times))
+ (setq res (vconcat res key))))))
+ (if (and (>= (length res) 4)
+ (eq (aref res 0) ?\C-x)
+ (eq (aref res 1) ?\()
+ (eq (aref res (- (length res) 2)) ?\C-x)
+ (eq (aref res (- (length res) 1)) ?\)))
+ (apply #'vector (let ((lres (append res nil)))
+ ;; Remove the first and last two elements.
+ (setq lres (cdr (cdr lres)))
+ (nreverse lres)
+ (setq lres (cdr (cdr lres)))
+ (nreverse lres)))
+ res))))
+
+(defun key-valid-p (keys)
+ "Say whether KEYS is a valid `kbd' sequence.
+A `kbd' sequence is a string consisting of one and more key
+strokes. The key strokes are separated by a space character.
+
+Each key stroke is either a single character, or the name of an
+event, surrounded by angle brackets. In addition, any key stroke
+may be preceded by one or more modifier keys. Finally, a limited
+number of characters have a special shorthand syntax.
+
+Here's some example key sequences.
+
+ \"f\" (the key 'f')
+ \"S o m\" (a three key sequence of the keys 'S', 'o' and 'm')
+ \"C-c o\" (a two key sequence of the keys 'c' with the control modifier
+ and then the key 'o')
+ \"H-<left>\" (the key named \"left\" with the hyper modifier)
+ \"M-RET\" (the \"return\" key with a meta modifier)
+ \"C-M-<space>\" (the \"space\" key with both the control and meta modifiers)
+
+These are the characters that have shorthand syntax:
+NUL, RET, TAB, LFD, ESC, SPC, DEL.
+
+Modifiers 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
+ (catch 'exit
+ (let ((prefixes
+ "\\(A-\\)?\\(C-\\)?\\(H-\\)?\\(M-\\)?\\(S-\\)?\\(s-\\)?")
+ (case-fold-search nil))
+ (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 key-translate (from to)
+ "Translate character FROM to TO on the current terminal.
+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'."
+ (keymap--check from)
+ (keymap--check to)
+ (or (char-table-p keyboard-translate-table)
+ (setq keyboard-translate-table
+ (make-char-table 'keyboard-translate-table nil)))
+ (aset keyboard-translate-table (key-parse from) (key-parse to)))
+
+(defun keymap-lookup (keymap key &optional accept-default no-remap position)
+ "Return the binding for command KEY.
+KEY is a string that satisfies `key-valid-p'.
+
+If KEYMAP is nil, look up in the current keymaps. If non-nil, it
+should either be a keymap or a list of keymaps, and only these
+keymap(s) will be consulted.
+
+The binding is probably a symbol with a function definition.
+
+Normally, `keymap-lookup' ignores bindings for t, which act as
+default bindings, used when nothing else in the keymap applies;
+this makes it usable as a general function for probing keymaps.
+However, if the optional second argument ACCEPT-DEFAULT is
+non-nil, `keymap-lookup' does recognize the default bindings,
+just as `read-key-sequence' does.
+
+Like the normal command loop, `keymap-lookup' will remap the
+command resulting from looking up KEY by looking up the command
+in the current keymaps. However, if the optional third argument
+NO-REMAP is non-nil, `keymap-lookup' returns the unmapped
+command.
+
+If KEY is a key sequence initiated with the mouse, the used keymaps
+will depend on the clicked mouse position with regard to the buffer
+and possible local keymaps on strings.
+
+If the optional argument POSITION is non-nil, it specifies a mouse
+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."
+ (keymap--check key)
+ (when (and keymap (not position))
+ (error "Can't pass in both keymap and position"))
+ (if keymap
+ (let ((value (lookup-key (key-parse key) keymap accept-default)))
+ (when (and (not no-remap)
+ (symbolp value))
+ (or (command-remapping value) value)))
+ (key-binding (kbd key) accept-default no-remap position)))
+
+(defun keymap-local-lookup (keys &optional accept-default)
+ "Return the binding for command KEYS in current local keymap only.
+KEY is a string that satisfies `key-valid-p'.
+
+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."
+ (when-let ((map (current-local-map)))
+ (keymap-lookup map keys accept-default)))
+
+(defun keymap-global-lookup (keys &optional accept-default message)
+ "Return the binding for command KEYS in current global keymap only.
+KEY is a string that satisfies `key-valid-p'.
+
+The binding is probably a symbol with a function definition.
+This function's return values are the same as those of `keymap-lookup'
+\(which see).
+
+If optional argument ACCEPT-DEFAULT is non-nil, recognize default
+bindings; see the description of `keymap-lookup' for more details
+about this.
+
+If MESSAGE (and interactively), message the result."
+ (interactive
+ (list (key-description (read-key-sequence "Look up key in global keymap: "))
+ nil t))
+ (let ((def (keymap-lookup (current-global-map) keys accept-default)))
+ (when message
+ (message "%s is bound to %s globally" keys def))
+ def))
+
+(provide 'keymap)
+
+;;; keymap.el ends here
diff --git a/lisp/loadup.el b/lisp/loadup.el
index e8ecb67..15a71ef 100644
--- a/lisp/loadup.el
+++ b/lisp/loadup.el
@@ -131,6 +131,7 @@
(load "emacs-lisp/byte-run")
(load "emacs-lisp/backquote")
(load "subr")
+(load "keymap")
;; Do it after subr, since both after-load-functions and add-hook are
;; implemented in subr.el.
diff --git a/lisp/subr.el b/lisp/subr.el
index 3902251..7ba7648 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -925,69 +925,6 @@ side-effects, and the argument LIST is not modified."
;;;; Keymap support.
-(defun kbd-valid-p (keys)
- "Say whether KEYS is a valid `kbd' sequence.
-A `kbd' sequence is a string consisting of one and more key
-strokes. The key strokes are separated by a space character.
-
-Each key stroke is either a single character, or the name of an
-event, surrounded by angle brackets. In addition, any key stroke
-may be preceded by one or more modifier keys. Finally, a limited
-number of characters have a special shorthand syntax.
-
-Here's some example key sequences.
-
- \"f\" (the key 'f')
- \"S o m\" (a three key sequence of the keys 'S', 'o' and 'm')
- \"C-c o\" (a two key sequence of the keys 'c' with the control modifier
- and then the key 'o')
- \"H-<left>\" (the key named \"left\" with the hyper modifier)
- \"M-RET\" (the \"return\" key with a meta modifier)
- \"C-M-<space>\" (the \"space\" key with both the control and meta modifiers)
-
-These are the characters that have shorthand syntax:
-NUL, RET, TAB, LFD, ESC, SPC, DEL.
-
-Modifiers 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
- (catch 'exit
- (let ((prefixes
- "\\(A-\\)?\\(C-\\)?\\(H-\\)?\\(M-\\)?\\(S-\\)?\\(s-\\)?")
- (case-fold-search nil))
- (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)
"Convert KEYS to the internal Emacs key representation.
KEYS should be a string in the format returned by commands such
@@ -1006,110 +943,15 @@ Here's some example key sequences:
For an approximate inverse of this, see `key-description'."
(declare (pure t) (side-effect-free t))
- ;; A pure function is expected to preserve the match data.
- (save-match-data
- (let ((case-fold-search nil)
- (len (length keys)) ; We won't alter keys in the loop below.
- (pos 0)
- (res []))
- (while (and (< pos len)
- (string-match "[^ \t\n\f]+" keys pos))
- (let* ((word-beg (match-beginning 0))
- (word-end (match-end 0))
- (word (substring keys word-beg len))
- (times 1)
- key)
- ;; Try to catch events of the form "<as df>".
- (if (string-match "\\`<[^ <>\t\n\f][^>\t\n\f]*>" word)
- (setq word (match-string 0 word)
- pos (+ word-beg (match-end 0)))
- (setq word (substring keys word-beg word-end)
- pos word-end))
- (when (string-match "\\([0-9]+\\)\\*." word)
- (setq times (string-to-number (substring word 0 (match-end 1))))
- (setq word (substring word (1+ (match-end 1)))))
- (cond ((string-match "^<<.+>>$" word)
- (setq key (vconcat (if (eq (key-binding [?\M-x])
- 'execute-extended-command)
- [?\M-x]
- (or (car (where-is-internal
- 'execute-extended-command))
- [?\M-x]))
- (substring word 2 -2) "\r")))
- ((and (string-match "^\\(\\([ACHMsS]-\\)*\\)<\\(.+\\)>$" word)
- (progn
- (setq word (concat (match-string 1 word)
- (match-string 3 word)))
- (not (string-match
- "\\<\\(NUL\\|RET\\|LFD\\|ESC\\|SPC\\|DEL\\)$"
- word))))
- (setq key (list (intern word))))
- ((or (equal word "REM") (string-match "^;;" word))
- (setq pos (string-match "$" keys pos)))
- (t
- (let ((orig-word word) (prefix 0) (bits 0))
- (while (string-match "^[ACHMsS]-." word)
- (setq bits (+ bits (cdr (assq (aref word 0)
- '((?A . ?\A-\^@) (?C .
?\C-\^@)
- (?H . ?\H-\^@) (?M .
?\M-\^@)
- (?s . ?\s-\^@) (?S .
?\S-\^@))))))
- (setq prefix (+ prefix 2))
- (setq word (substring word 2)))
- (when (string-match "^\\^.$" word)
- (setq bits (+ bits ?\C-\^@))
- (setq prefix (1+ prefix))
- (setq word (substring word 1)))
- (let ((found (assoc word '(("NUL" . "\0") ("RET" . "\r")
- ("LFD" . "\n") ("TAB" . "\t")
- ("ESC" . "\e") ("SPC" . " ")
- ("DEL" . "\177")))))
- (when found (setq word (cdr found))))
- (when (string-match "^\\\\[0-7]+$" word)
- (let ((n 0))
- (dolist (ch (cdr (string-to-list word)))
- (setq n (+ (* n 8) ch -48)))
- (setq word (vector n))))
- (cond ((= bits 0)
- (setq key word))
- ((and (= bits ?\M-\^@) (stringp word)
- (string-match "^-?[0-9]+$" word))
- (setq key (mapcar (lambda (x) (+ x bits))
- (append word nil))))
- ((/= (length word) 1)
- (error "%s must prefix a single character, not %s"
- (substring orig-word 0 prefix) word))
- ((and (/= (logand bits ?\C-\^@) 0) (stringp word)
- ;; We used to accept . and ? here,
- ;; but . is simply wrong,
- ;; and C-? is not used (we use DEL instead).
- (string-match "[@-_a-z]" word))
- (setq key (list (+ bits (- ?\C-\^@)
- (logand (aref word 0) 31)))))
- (t
- (setq key (list (+ bits (aref word 0)))))))))
- (when key
- (dolist (_ (number-sequence 1 times))
- (setq res (vconcat res key))))))
- (when (and (>= (length res) 4)
- (eq (aref res 0) ?\C-x)
- (eq (aref res 1) ?\()
- (eq (aref res (- (length res) 2)) ?\C-x)
- (eq (aref res (- (length res) 1)) ?\)))
- (setq res (apply #'vector (let ((lres (append res nil)))
- ;; Remove the first and last two elements.
- (setq lres (cdr (cdr lres)))
- (nreverse lres)
- (setq lres (cdr (cdr lres)))
- (nreverse lres)
- lres))))
- (if (not (memq nil (mapcar (lambda (ch)
- (and (numberp ch)
- (<= 0 ch 127)))
- res)))
- ;; Return a string.
- (concat (mapcar #'identity res))
- ;; Return a vector.
- res))))
+ (let ((res (key-parse keys)))
+ (if (not (memq nil (mapcar (lambda (ch)
+ (and (numberp ch)
+ (<= 0 ch 127)))
+ res)))
+ ;; Return a string.
+ (concat (mapcar #'identity res))
+ ;; Return a vector.
+ res)))
(defun undefined ()
"Beep to tell the user this binding is undefined."
@@ -1160,6 +1002,9 @@ PARENT if non-nil should be a keymap."
(defun define-key-after (keymap key definition &optional after)
"Add binding in KEYMAP for KEY => DEFINITION, right after AFTER's binding.
+This is a legacy function; see `keymap-set-after' for the
+recommended function to use instead.
+
This is like `define-key' except that the binding for KEY is placed
just after the binding for the event AFTER, instead of at the beginning
of the map. Note that AFTER must be an event type (like KEY), NOT a command
@@ -1330,6 +1175,9 @@ Subkeymaps may be modified but are not canonicalized."
(defun keyboard-translate (from to)
"Translate character FROM to TO on the current terminal.
+This is a legacy function; see `keymap-translate' for the
+recommended function to use instead.
+
This function creates a `keyboard-translate-table' if necessary
and then modifies one entry in it."
(or (char-table-p keyboard-translate-table)
@@ -1341,6 +1189,9 @@ and then modifies one entry in it."
(defun global-set-key (key command)
"Give KEY a global binding as COMMAND.
+This is a legacy function; see `keymap-global-set' for the
+recommended function to use instead.
+
COMMAND is the command definition to use; usually it is
a symbol naming an interactively-callable function.
KEY is a key sequence; noninteractively, it is a string or vector
@@ -1362,6 +1213,9 @@ that you make with this function."
(defun local-set-key (key command)
"Give KEY a local binding as COMMAND.
+This is a legacy function; see `keymap-local-set' for the
+recommended function to use instead.
+
COMMAND is the command definition to use; usually it is
a symbol naming an interactively-callable function.
KEY is a key sequence; noninteractively, it is a string or vector
@@ -1380,12 +1234,18 @@ cases is shared with all other buffers in the same
major mode."
(defun global-unset-key (key)
"Remove global binding of KEY.
+This is a legacy function; see `keymap-global-unset' for the
+recommended function to use instead.
+
KEY is a string or vector representing a sequence of keystrokes."
(interactive "kUnset key globally: ")
(global-set-key key nil))
(defun local-unset-key (key)
"Remove local binding of KEY.
+This is a legacy function; see `keymap-local-unset' for the
+recommended function to use instead.
+
KEY is a string or vector representing a sequence of keystrokes."
(interactive "kUnset key locally: ")
(if (current-local-map)
@@ -1394,6 +1254,9 @@ KEY is a string or vector representing a sequence of
keystrokes."
(defun local-key-binding (keys &optional accept-default)
"Return the binding for command KEYS in current local keymap only.
+This is a legacy function; see `keymap-local-binding' for the
+recommended function to use instead.
+
KEYS is a string or vector, a sequence of keystrokes.
The binding is probably a symbol with a function definition.
@@ -1405,6 +1268,9 @@ about this."
(defun global-key-binding (keys &optional accept-default)
"Return the binding for command KEYS in current global keymap only.
+This is a legacy function; see `keymap-global-binding' for the
+recommended function to use instead.
+
KEYS is a string or vector, a sequence of keystrokes.
The binding is probably a symbol with a function definition.
This function's return values are the same as those of `lookup-key'
@@ -1423,6 +1289,9 @@ about this."
(defun substitute-key-definition (olddef newdef keymap &optional oldmap prefix)
"Replace OLDDEF with NEWDEF for any keys in KEYMAP now defined as OLDDEF.
+This is a legacy function; see `keymap-substitute' for the
+recommended function to use instead.
+
In other words, OLDDEF is replaced with NEWDEF wherever it appears.
Alternatively, if optional fourth argument OLDMAP is specified, we redefine
in KEYMAP as NEWDEF those keys that are defined as OLDDEF in OLDMAP.
@@ -6683,7 +6552,7 @@ pairs. Available keywords are:
command (see `define-prefix-command'). If this is the case,
this symbol is returned instead of the map itself.
-KEY/DEFINITION pairs are as KEY and DEF in `define-key'. KEY can
+KEY/DEFINITION pairs are as KEY and DEF in `keymap-set'. KEY can
also be the special symbol `:menu', in which case DEFINITION
should be a MENU form as accepted by `easy-menu-define'.
@@ -6735,7 +6604,7 @@ should be a MENU form as accepted by `easy-menu-define'.
(let ((def (pop definitions)))
(if (eq key :menu)
(easy-menu-define nil keymap "" def)
- (define-key keymap key def)))))
+ (keymap-set keymap key def)))))
keymap)))
(defmacro defvar-keymap (variable-name &rest defs)
diff --git a/src/keymap.c b/src/keymap.c
index c6990cf..7993e31 100644
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -1053,16 +1053,16 @@ possibly_translate_key_sequence (Lisp_Object key,
ptrdiff_t *length)
{
/* KEY is on the ["C-c"] format, so translate to internal
format. */
- if (NILP (Ffboundp (Qkbd_valid_p)))
+ if (NILP (Ffboundp (Qkey_valid_p)))
xsignal2 (Qerror,
- build_string ("`kbd-valid-p' is not defined, so this syntax
can't be used: %s"),
+ build_string ("`key-valid-p' is not defined, so this syntax
can't be used: %s"),
key);
- if (NILP (call1 (Qkbd_valid_p, AREF (key, 0))))
- xsignal2 (Qerror, build_string ("Invalid `kbd' syntax: %S"), key);
- key = call1 (Qkbd, AREF (key, 0));
+ if (NILP (call1 (Qkey_valid_p, AREF (key, 0))))
+ xsignal2 (Qerror, build_string ("Invalid `key-parse' syntax: %S"), key);
+ key = call1 (Qkey_parse, AREF (key, 0));
*length = CHECK_VECTOR_OR_STRING (key);
if (*length == 0)
- xsignal2 (Qerror, build_string ("Invalid `kbd' syntax: %S"), key);
+ xsignal2 (Qerror, build_string ("Invalid `key-parse' syntax: %S"), key);
}
return key;
@@ -3458,6 +3458,6 @@ that describe key bindings. That is why the default is
nil. */);
defsubr (&Swhere_is_internal);
defsubr (&Sdescribe_buffer_bindings);
- DEFSYM (Qkbd, "kbd");
- DEFSYM (Qkbd_valid_p, "kbd-valid-p");
+ DEFSYM (Qkey_parse, "key-parse");
+ DEFSYM (Qkey_valid_p, "key-valid-p");
}
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index 238c9be..ca0ded1 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -198,123 +198,123 @@
;; 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 "<F2>"))
- (should (kbd-valid-p "<f1> <f2> TAB"))
- (should (kbd-valid-p "<f1> RET"))
- (should (kbd-valid-p "<f1> SPC"))
- (should (kbd-valid-p "<f1>"))
- (should (not (kbd-valid-p "[f1]")))
- (should (kbd-valid-p "<return>"))
- (should (not (kbd-valid-p "< right >")))
+(ert-deftest subr-test-key-valid-p ()
+ (should (not (key-valid-p "")))
+ (should (key-valid-p "f"))
+ (should (key-valid-p "X"))
+ (should (not (key-valid-p " X")))
+ (should (key-valid-p "X f"))
+ (should (not (key-valid-p "a b")))
+ (should (not (key-valid-p "foobar")))
+ (should (not (key-valid-p "return")))
+
+ (should (key-valid-p "<F2>"))
+ (should (key-valid-p "<f1> <f2> TAB"))
+ (should (key-valid-p "<f1> RET"))
+ (should (key-valid-p "<f1> SPC"))
+ (should (key-valid-p "<f1>"))
+ (should (not (key-valid-p "[f1]")))
+ (should (key-valid-p "<return>"))
+ (should (not (key-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-<down>"))
- (should (not (kbd-valid-p "<C-M-down>")))
- (should (kbd-valid-p "C-RET"))
- (should (kbd-valid-p "C-SPC"))
- (should (kbd-valid-p "C-TAB"))
- (should (kbd-valid-p "C-<down>"))
- (should (kbd-valid-p "C-c C-c C-c"))
-
- (should (kbd-valid-p "M-a"))
- (should (kbd-valid-p "M-<DEL>"))
- (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-<up>"))
- (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-<RET>"))
- (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-<up>"))
+ (should (key-valid-p "C-x"))
+ (should (key-valid-p "C-x a"))
+ (should (key-valid-p "C-;"))
+ (should (key-valid-p "C-a"))
+ (should (key-valid-p "C-c SPC"))
+ (should (key-valid-p "C-c TAB"))
+ (should (key-valid-p "C-c c"))
+ (should (key-valid-p "C-x 4 C-f"))
+ (should (key-valid-p "C-x C-f"))
+ (should (key-valid-p "C-M-<down>"))
+ (should (not (key-valid-p "<C-M-down>")))
+ (should (key-valid-p "C-RET"))
+ (should (key-valid-p "C-SPC"))
+ (should (key-valid-p "C-TAB"))
+ (should (key-valid-p "C-<down>"))
+ (should (key-valid-p "C-c C-c C-c"))
+
+ (should (key-valid-p "M-a"))
+ (should (key-valid-p "M-<DEL>"))
+ (should (not (key-valid-p "M-C-a")))
+ (should (key-valid-p "C-M-a"))
+ (should (key-valid-p "M-ESC"))
+ (should (key-valid-p "M-RET"))
+ (should (key-valid-p "M-SPC"))
+ (should (key-valid-p "M-TAB"))
+ (should (key-valid-p "M-x a"))
+ (should (key-valid-p "M-<up>"))
+ (should (key-valid-p "M-c M-c M-c"))
+
+ (should (key-valid-p "s-SPC"))
+ (should (key-valid-p "s-a"))
+ (should (key-valid-p "s-x a"))
+ (should (key-valid-p "s-c s-c s-c"))
+
+ (should (not (key-valid-p "S-H-a")))
+ (should (key-valid-p "S-a"))
+ (should (key-valid-p "S-x a"))
+ (should (key-valid-p "S-c S-c S-c"))
+
+ (should (key-valid-p "H-<RET>"))
+ (should (key-valid-p "H-DEL"))
+ (should (key-valid-p "H-a"))
+ (should (key-valid-p "H-x a"))
+ (should (key-valid-p "H-c H-c H-c"))
+
+ (should (key-valid-p "A-H-a"))
+ (should (key-valid-p "A-SPC"))
+ (should (key-valid-p "A-TAB"))
+ (should (key-valid-p "A-a"))
+ (should (key-valid-p "A-c A-c A-c"))
+
+ (should (key-valid-p "C-M-a"))
+ (should (key-valid-p "C-M-<up>"))
;; 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")))
+ (should (key-valid-p "DEL"))
+ (should (key-valid-p "ESC C-a"))
+ (should (key-valid-p "ESC"))
+ (should (key-valid-p "LFD"))
+ (should (key-valid-p "NUL"))
+ (should (key-valid-p "RET"))
+ (should (key-valid-p "SPC"))
+ (should (key-valid-p "TAB"))
+ (should (not (key-valid-p "\^i")))
+ (should (not (key-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")))
+ (should (not (key-valid-p "\177")))
+ (should (not (key-valid-p "\000")))
+ (should (not (key-valid-p "\\177")))
+ (should (not (key-valid-p "\\000")))
+ (should (not (key-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-ü"))
+ (should (key-valid-p "ñ"))
+ (should (key-valid-p "ü"))
+ (should (key-valid-p "ö"))
+ (should (key-valid-p "ğ"))
+ (should (key-valid-p "ա"))
+ (should (not (key-valid-p "üüöö")))
+ (should (key-valid-p "C-ü"))
+ (should (key-valid-p "M-ü"))
+ (should (key-valid-p "H-ü"))
;; Handle both new and old style key descriptions (bug#45536).
- (should (kbd-valid-p "s-<return>"))
- (should (not (kbd-valid-p "<s-return>")))
- (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-x")))
- (should (not (kbd-valid-p "C-xx")))
- (should (not (kbd-valid-p "M-xx")))
- (should (not (kbd-valid-p "M-x<TAB>"))))
+ (should (key-valid-p "s-<return>"))
+ (should (not (key-valid-p "<s-return>")))
+ (should (key-valid-p "C-M-<return>"))
+ (should (not (key-valid-p "<C-M-return>")))
+
+ (should (key-valid-p "<mouse-1>"))
+ (should (key-valid-p "<Scroll_Lock>"))
+
+ (should (not (key-valid-p "c-x")))
+ (should (not (key-valid-p "C-xx")))
+ (should (not (key-valid-p "M-xx")))
+ (should (not (key-valid-p "M-x<TAB>"))))
(ert-deftest subr-test-define-prefix-command ()
(define-prefix-command 'foo-prefix-map)