Make kbd usable during bootstrap
* lisp/subr.el (kbd): Make 'kbd' usable during bootstrap by copying the definition of 'read-kbd-macro' into it, and adjusting it to no longer use CL-Lib functions. This change was discussed in: https://lists.gnu.org/r/emacs-devel/2021-10/msg00909.html
This commit is contained in:
Stefan Kangas
parent
a232821c51
commit
e082a16284
2 changed files with 111 additions and 3 deletions
4
etc/NEWS
4
etc/NEWS
|
|
@ -205,6 +205,10 @@ This function allows defining a number of keystrokes with one form.
|
|||
** New macro 'defvar-keymap'.
|
||||
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.
|
||||
|
||||
|
||||
* Changes in Emacs 29.1 on Non-Free Operating Systems
|
||||
|
||||
|
|
|
|||
110
lisp/subr.el
110
lisp/subr.el
|
|
@ -933,11 +933,115 @@ This is the same format used for saving keyboard macros (see
|
|||
`edmacro-mode').
|
||||
|
||||
For an approximate inverse of this, see `key-description'."
|
||||
;; Don't use a defalias, since the `pure' property is true only for
|
||||
;; the calling convention of `kbd'.
|
||||
(declare (pure t) (side-effect-free t))
|
||||
;; A pure function is expected to preserve the match data.
|
||||
(save-match-data (read-kbd-macro keys)))
|
||||
(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 (let ((ret t))
|
||||
(dolist (ch (append res nil))
|
||||
(unless (and (characterp ch)
|
||||
(let ((ch2 (logand ch (lognot ?\M-\^@))))
|
||||
(and (>= ch2 0) (<= ch2 127))))
|
||||
(setq ret nil)))
|
||||
ret)
|
||||
(concat (mapcar (lambda (ch)
|
||||
(if (= (logand ch ?\M-\^@) 0)
|
||||
ch (+ ch 128)))
|
||||
(append res nil)))
|
||||
res))))
|
||||
|
||||
(defun undefined ()
|
||||
"Beep to tell the user this binding is undefined."
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue