From cdafa2120e5dd52ea4db0620f81fe7181c33f9a8 Mon Sep 17 00:00:00 2001 From: Stefan Kangas 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 "". - (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 ;;;; 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