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 was discussed in:
https://lists.gnu.org/r/emacs-devel/2021-10/msg00909.html

diff --git a/lisp/edmacro.el b/lisp/edmacro.el
index a4eb574a4c2d535c73624a2eb34a92415de875da..decb8edbb1856494590fa54a21f4b838b31094d4 100644 (file)
--- a/lisp/edmacro.el
+++ b/lisp/edmacro.el
@@ -640,101 +640,7 @@ This function assumes that the events can be stored in a string."
 ;;; 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 1c3dc26a4d2b2dc480766c2f3d9c9577d4e14267..93ec76e290fc81a904df3979591f35780774f1fd 100644 (file)
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -925,14 +925,18 @@ side-effects, and the argument LIST is not modified."
 \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 @@ For an approximate inverse of this, see `key-description'."
                                     (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)))