diff options
Diffstat (limited to 'lisp/edmacro.el')
| -rw-r--r-- | lisp/edmacro.el | 134 |
1 files changed, 21 insertions, 113 deletions
diff --git a/lisp/edmacro.el b/lisp/edmacro.el index 11d5541203a..26f3ae02aba 100644 --- a/lisp/edmacro.el +++ b/lisp/edmacro.el @@ -99,8 +99,7 @@ With a prefix argument, format the macro in a more concise way." (when keys (let ((cmd (if (arrayp keys) (key-binding keys) keys)) (cmd-noremap (when (arrayp keys) (key-binding keys nil t))) - (mac nil) (mac-counter nil) (mac-format nil) - kmacro) + (mac nil) (mac-counter nil) (mac-format nil)) (cond (store-hook (setq mac keys) (setq cmd nil)) @@ -131,10 +130,10 @@ With a prefix argument, format the macro in a more concise way." (t (setq mac cmd) (setq cmd nil))) - (when (setq kmacro (kmacro-extract-lambda mac)) - (setq mac (car kmacro) - mac-counter (nth 1 kmacro) - mac-format (nth 2 kmacro))) + (when (kmacro-p mac) + (setq mac (kmacro--keys mac) + mac-counter (kmacro--counter mac) + mac-format (kmacro--format mac))) (unless (arrayp mac) (error "Key sequence %s is not a keyboard macro" (key-description keys))) @@ -252,15 +251,14 @@ or nil, use a compact 80-column format." ((looking-at "Key:\\(.*\\)$") (when edmacro-store-hook (error "\"Key\" line not allowed in this context")) - (let ((key (edmacro-parse-keys - (match-string 1)))) + (let ((key (kbd (match-string 1)))) (unless (equal key "") (if (equal key "none") (setq no-keys t) (push key keys) (let ((b (key-binding key))) (and b (commandp b) (not (arrayp b)) - (not (kmacro-extract-lambda b)) + (not (kmacro-p b)) (or (not (fboundp b)) (not (or (arrayp (symbol-function b)) (get b 'kmacro)))) @@ -313,10 +311,7 @@ or nil, use a compact 80-column format." (when cmd (if (= (length mac) 0) (fmakunbound cmd) - (fset cmd - (if (and mac-counter mac-format) - (kmacro-lambda-form mac mac-counter mac-format) - mac)))) + (fset cmd (kmacro mac mac-counter mac-format)))) (if no-keys (when cmd (cl-loop for key in (where-is-internal cmd '(keymap)) do @@ -327,10 +322,8 @@ or nil, use a compact 80-column format." (cl-loop for key in keys do (global-set-key key (or cmd - (if (and mac-counter mac-format) - (kmacro-lambda-form - mac mac-counter mac-format) - mac)))))))))) + (kmacro mac mac-counter + mac-format)))))))))) (kill-buffer buf) (when (buffer-name obuf) (switch-to-buffer obuf)) @@ -610,6 +603,12 @@ This function assumes that the events can be stored in a string." (defun edmacro-fix-menu-commands (macro &optional noerror) (if (vectorp macro) (let (result) + ;; Not preloaded in without-x builds. + (require 'mwheel) + (defvar mouse-wheel-down-event) + (defvar mouse-wheel-left-event) + (defvar mouse-wheel-right-event) + (defvar mouse-wheel-up-event) ;; Make a list of the elements. (setq macro (append macro nil)) (dolist (ev macro) @@ -639,102 +638,11 @@ 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))) +(defun edmacro-parse-keys (string &optional _need-vector) + (let ((result (kbd string))) + (if (stringp result) + (seq-into result 'vector) + result))) (provide 'edmacro) |