Re: Moving kbd to subr.el

[Stefan Kangas <stefankangas@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 457 bytes --]

Lars Ingebrigtsen <larsi@gnus.org> writes:

> A NEWS entry saying "kbd can be used in built-in files" would be nice,
> perhaps?

Sure, I'm happy to add that.

> Yeah, I think kbd could just take the optional parameter.

OK, let's do that.  Please see the attached updated patch.

(If we really wanted to not have the parameter, I suppose we could use
`set-advertised-calling-convention' and `with-suppressed-warnings' but
that might be too much of a hack.)

[-- Attachment #2: 0001-Make-kbd-usable-during-bootstrap.patch --]
[-- Type: text/x-diff, Size: 7503 bytes --]

From 2424a213e79940eae9dd6c0f612590c3d309a1da Mon Sep 17 00:00:00 2001
From: Stefan Kangas <stefan@marxist.se>
Date: Wed, 13 Oct 2021 01:40:14 +0200
Subject: [PATCH 1/2] 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 is 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 7dd4d14274..9412c62aa4 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -189,6 +189,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.
+
 \f
 * Changes in Emacs 29.1 on Non-Free Operating Systems
 
diff --git a/lisp/subr.el b/lisp/subr.el
index a1858e5911..1c3dc26a4d 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -933,11 +933,115 @@ kbd
 `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."
-- 
2.30.2


[-- Attachment #3: 0002-Remove-duplicate-code-in-edmacro-parse-keys.patch --]
[-- Type: text/x-diff, Size: 6734 bytes --]

From cdafa2120e5dd52ea4db0620f81fe7181c33f9a8 Mon Sep 17 00:00:00 2001
From: Stefan Kangas <stefan@marxist.se>
Date: Wed, 13 Oct 2021 22:54:47 +0200
Subject: [PATCH 2/2] Remove duplicate code in edmacro-parse-keys

* lisp/subr.el (kbd): Add argument NEED-VECTOR and make it suitable
for calling from 'edmacro-parse-keys'.
* lisp/edmacro.el (edmacro-parse-keys): Replace definition with a
call to 'kbd'.

This change is discussed in
https://lists.gnu.org/r/emacs-devel/2021-10/msg00909.html
---
 lisp/edmacro.el | 96 +------------------------------------------------
 lisp/subr.el    | 23 +++++++-----
 2 files changed, 15 insertions(+), 104 deletions(-)

diff --git a/lisp/edmacro.el b/lisp/edmacro.el
index a4eb574a4c..decb8edbb1 100644
--- a/lisp/edmacro.el
+++ b/lisp/edmacro.el
@@ -640,101 +640,7 @@ edmacro-fix-menu-commands
 ;;; Parsing a human-readable keyboard macro.
 
 (defun edmacro-parse-keys (string &optional need-vector)
-  (let ((case-fold-search nil)
-	(len (length string)) ; We won't alter string in the loop below.
-	(pos 0)
-	(res []))
-    (while (and (< pos len)
-		(string-match "[^ \t\n\f]+" string pos))
-      (let* ((word-beg (match-beginning 0))
-	     (word-end (match-end 0))
-	     (word (substring string 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 string 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 "$" string pos)))
-	      (t
-	       (let ((orig-word word) (prefix 0) (bits 0))
-		 (while (string-match "^[ACHMsS]-." word)
-		   (cl-incf bits (cdr (assq (aref word 0)
-					 '((?A . ?\A-\^@) (?C . ?\C-\^@)
-					   (?H . ?\H-\^@) (?M . ?\M-\^@)
-					   (?s . ?\s-\^@) (?S . ?\S-\^@)))))
-		   (cl-incf prefix 2)
-		   (cl-callf substring word 2))
-		 (when (string-match "^\\^.$" word)
-		   (cl-incf bits ?\C-\^@)
-		   (cl-incf prefix)
-		   (cl-callf 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)
-		   (cl-loop for ch across word
-                            for n = 0 then (+ (* n 8) ch -48)
-                            finally do (setq word (vector n))))
-		 (cond ((= bits 0)
-			(setq key word))
-		       ((and (= bits ?\M-\^@) (stringp word)
-			     (string-match "^-?[0-9]+$" word))
-			(setq key (cl-loop for x across word
-                                           collect (+ x bits))))
-		       ((/= (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
-	  (cl-loop repeat times do (cl-callf 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 (cl-subseq res 2 -2)))
-    (if (and (not need-vector)
-	     (cl-loop for ch across res
-                      always (and (characterp ch)
-                                  (let ((ch2 (logand ch (lognot ?\M-\^@))))
-                                    (and (>= ch2 0) (<= ch2 127))))))
-	(concat (cl-loop for ch across res
-                         collect (if (= (logand ch ?\M-\^@) 0)
-                                     ch (+ ch 128))))
-      res)))
+  (kbd string need-vector))
 
 (provide 'edmacro)
 
diff --git a/lisp/subr.el b/lisp/subr.el
index 1c3dc26a4d..93ec76e290 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -925,14 +925,18 @@ remq
 \f
 ;;;; Keymap support.
 
-(defun kbd (keys)
+(defun kbd (keys &optional need-vector)
   "Convert KEYS to the internal Emacs key representation.
 KEYS should be a string in the format returned by commands such
 as `C-h k' (`describe-key').
 This is the same format used for saving keyboard macros (see
 `edmacro-mode').
 
-For an approximate inverse of this, see `key-description'."
+For an approximate inverse of this, see `key-description'.
+
+If NEED-VECTOR is non-nil, always return a vector instead of a
+string.  This is mainly intended for use by `edmacro-parse-keys',
+and should normally not be needed."
   (declare (pure t) (side-effect-free t))
   ;; A pure function is expected to preserve the match data.
   (save-match-data
@@ -1030,13 +1034,14 @@ kbd
                                     (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)
+      (if (and (not need-vector)
+               (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)))
-- 
2.30.2