From a1eec2ae1727c3fa6ccdceb3c74e22903f7d558d 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 (internal--kbd): Factor out from 'kbd'. Change this new function to be suitable for calling from both 'kbd' and 'edmacro-parse-keys'. * lisp/edmacro.el (edmacro-parse-keys): Replace definition with a call to 'internal-kbd'. --- lisp/edmacro.el | 96 +------------------------------------------------ lisp/subr.el | 46 ++++++++++++++---------- 2 files changed, 28 insertions(+), 114 deletions(-) diff --git a/lisp/edmacro.el b/lisp/edmacro.el index a4eb574a4c..5f8780847c 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))) + (internal--kbd string need-vector)) (provide 'edmacro) diff --git a/lisp/subr.el b/lisp/subr.el index 1c3dc26a4d..812ae962b7 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -925,33 +925,29 @@ remq ;;;; Keymap support. -(defun kbd (keys) +(defun internal--kbd (string &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'." +This is an internal function, and should not be used directly. +See instead `kbd'." (declare (pure t) (side-effect-free t)) ;; A pure function is expected to preserve the match data. (save-match-data (let ((case-fold-search nil) - (len (length keys)) ; We won't alter keys in the loop below. + (len (length string)) ; We won't alter string in the loop below. (pos 0) (res [])) (while (and (< pos len) - (string-match "[^ \t\n\f]+" keys pos)) + (string-match "[^ \t\n\f]+" string pos)) (let* ((word-beg (match-beginning 0)) (word-end (match-end 0)) - (word (substring keys word-beg len)) + (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 keys word-beg word-end) + (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)))) @@ -973,7 +969,7 @@ kbd word)))) (setq key (list (intern word)))) ((or (equal word "REM") (string-match "^;;" word)) - (setq pos (string-match "$" keys pos))) + (setq pos (string-match "$" string pos))) (t (let ((orig-word word) (prefix 0) (bits 0)) (while (string-match "^[ACHMsS]-." word) @@ -1030,19 +1026,31 @@ 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))) (append res nil))) res)))) +(defun kbd (keys) + "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'." + (declare (pure t) (side-effect-free t)) + (internal--kbd keys)) + (defun undefined () "Beep to tell the user this binding is undefined." (declare (completion ignore)) -- 2.30.2