[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master e082a16 1/2: Make kbd usable during bootstrap
|
From: |
Stefan Kangas |
|
Subject: |
master e082a16 1/2: Make kbd usable during bootstrap |
|
Date: |
Sat, 16 Oct 2021 10:31:12 -0400 (EDT) |
branch: master
commit e082a1628444125ca36c222d81bf5fe8a84ccbc5
Author: Stefan Kangas <stefan@marxist.se>
Commit: Stefan Kangas <stefan@marxist.se>
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
---
etc/NEWS | 4 +++
lisp/subr.el | 110 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++--
2 files changed, 111 insertions(+), 3 deletions(-)
diff --git a/etc/NEWS b/etc/NEWS
index 5a7b204..e7d3de7 100644
--- a/etc/NEWS
+++ b/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
diff --git a/lisp/subr.el b/lisp/subr.el
index a1858e5..1c3dc26 100644
--- a/lisp/subr.el
+++ b/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."