mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-11-24 07:20:37 +00:00
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.
This commit is contained in:
Lars Ingebrigtsen
parent
560c921ed8
commit
de477ec683
66
etc/NEWS
66
etc/NEWS
@ -593,12 +593,62 @@ Use 'exif-parse-file' and 'exif-field' instead.
|
||||
|
||||
* Lisp Changes in Emacs 29.1
|
||||
|
||||
** Keymaps and key definitions
|
||||
|
||||
+++
|
||||
** 'define-key' now takes an optional REMOVE argument.
|
||||
*** 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'.
|
||||
|
||||
+++
|
||||
*** 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.
|
||||
@ -691,13 +741,6 @@ The 'tabulated-list-entries' variable now supports using an image
|
||||
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
|
||||
@ -734,13 +777,6 @@ 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.
|
||||
|
||||
+++
|
||||
** New function 'image-at-point-p'.
|
||||
This function returns t if point is on a valid image, and nil
|
||||
|
||||
@ -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,
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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.
|
||||
|
||||
437
lisp/keymap.el
Normal file
437
lisp/keymap.el
Normal file
@ -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
|
||||
@ -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.
|
||||
|
||||
207
lisp/subr.el
207
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)
|
||||
|
||||
16
src/keymap.c
16
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");
|
||||
}
|
||||
|
||||
@ -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")))
|
||||
(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 (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 >")))
|
||||
(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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (kbd-valid-p "C-M-a"))
|
||||
(should (kbd-valid-p "C-M-<up>"))
|
||||
(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 (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 (kbd-valid-p "<mouse-1>"))
|
||||
(should (kbd-valid-p "<Scroll_Lock>"))
|
||||
(should (key-valid-p "<mouse-1>"))
|
||||
(should (key-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 (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)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user