X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/b578f267af27af50e3c091f8c9c9eee939b69978..937640a621a4ce2e5e56eaecca37a2a28a584318:/lisp/edmacro.el?ds=sidebyside diff --git a/lisp/edmacro.el b/lisp/edmacro.el index 7f2d8d47fc..0db09d7eeb 100644 --- a/lisp/edmacro.el +++ b/lisp/edmacro.el @@ -32,7 +32,7 @@ ;; in a special buffer. It prompts you to type a key sequence, ;; which should be one of: ;; -;; * RET or `C-x e' (call-last-kbd-macro), to edit the most +;; * RET or `C-x e' (call-last-kbd-macro), to edit the most ;; recently defined keyboard macro. ;; ;; * `M-x' followed by a command name, to edit a named command @@ -73,9 +73,9 @@ (eval-when-compile (require 'cl)) -;;; The user-level commands for editing macros. +(require 'kmacro) -;;;###autoload (define-key ctl-x-map "\C-k" 'edit-kbd-macro) +;;; The user-level commands for editing macros. ;;;###autoload (defvar edmacro-eight-bits nil @@ -88,6 +88,10 @@ Default nil means to write characters above \\177 in octal notation.") (define-key edmacro-mode-map "\C-c\C-c" 'edmacro-finish-edit) (define-key edmacro-mode-map "\C-c\C-q" 'edmacro-insert-key)) +(defvar edmacro-store-hook) +(defvar edmacro-finish-hook) +(defvar edmacro-original-buffer) + ;;;###autoload (defun edit-kbd-macro (keys &optional prefix finish-hook store-hook) "Edit a keyboard macro. @@ -99,22 +103,29 @@ With a prefix argument, format the macro in a more concise way." (interactive "kKeyboard macro to edit (C-x e, M-x, C-h l, or keys): \nP") (when keys (let ((cmd (if (arrayp keys) (key-binding keys) keys)) - (mac nil)) + (mac nil) (mac-counter nil) (mac-format nil) + kmacro) (cond (store-hook (setq mac keys) (setq cmd nil)) - ((or (eq cmd 'call-last-kbd-macro) + ((or (memq cmd '(call-last-kbd-macro kmacro-call-macro + kmacro-end-or-call-macro kmacro-end-and-call-macro)) (member keys '("\r" [return]))) (or last-kbd-macro (y-or-n-p "No keyboard macro defined. Create one? ") (keyboard-quit)) (setq mac (or last-kbd-macro "")) + (setq keys nil) (setq cmd 'last-kbd-macro)) ((eq cmd 'execute-extended-command) (setq cmd (read-command "Name of keyboard macro to edit: ")) + (if (string-equal cmd "") + (error "No command name given")) + (setq keys nil) (setq mac (symbol-function cmd))) - ((eq cmd 'view-lossage) + ((memq cmd '(view-lossage electric-view-lossage)) (setq mac (recent-keys)) + (setq keys nil) (setq cmd 'last-kbd-macro)) ((null cmd) (error "Key sequence %s is not defined" (key-description keys))) @@ -123,6 +134,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))) (unless (arrayp mac) (error "Key sequence %s is not a keyboard macro" (key-description keys))) @@ -148,11 +163,15 @@ With a prefix argument, format the macro in a more concise way." (insert ";; Original keys: " fmt "\n") (unless store-hook (insert "\nCommand: " (if cmd (symbol-name cmd) "none") "\n") - (let ((keys (where-is-internal (or cmd mac) '(keymap)))) - (if keys - (while keys - (insert "Key: " (edmacro-format-keys (pop keys) 1) "\n")) - (insert "Key: none\n")))) + (let ((gkeys (where-is-internal (or cmd mac) '(keymap)))) + (if (and keys (not (member keys gkeys))) + (setq gkeys (cons keys gkeys))) + (if gkeys + (while gkeys + (insert "Key: " (edmacro-format-keys (pop gkeys) 1) "\n")) + (insert "Key: none\n"))) + (when (and mac-counter mac-format) + (insert (format "Counter: %d\nFormat: \"%s\"\n" mac-counter mac-format)))) (insert "\nMacro:\n\n") (save-excursion (insert fmtv "\n")) @@ -212,6 +231,7 @@ or nil, use a compact 80-column format." "This command is valid only in buffers created by `edit-kbd-macro'")) (run-hooks 'edmacro-finish-hook) (let ((cmd nil) (keys nil) (no-keys nil) + (mac-counter nil) (mac-format nil) (kmacro nil) (top (point-min))) (goto-char top) (let ((case-fold-search nil)) @@ -226,6 +246,7 @@ or nil, use a compact 80-column format." (setq cmd (and (not (equal str "none")) (intern str))) (and (fboundp cmd) (not (arrayp (symbol-function cmd))) + (not (setq kmacro (get cmd 'kmacro))) (not (y-or-n-p (format "Command %s is already defined; %s" cmd "proceed? "))) @@ -243,6 +264,7 @@ or nil, use a compact 80-column format." (push key keys) (let ((b (key-binding key))) (and b (commandp b) (not (arrayp b)) + (not (kmacro-extract-lambda b)) (or (not (fboundp b)) (not (arrayp (symbol-function b)))) (not (y-or-n-p @@ -251,6 +273,22 @@ or nil, use a compact 80-column format." "proceed? "))) (keyboard-quit)))))) t) + ((looking-at "Counter:[ \t]*\\([^ \t\n]*\\)[ \t]*$") + (when edmacro-store-hook + (error "\"Counter\" line not allowed in this context")) + (let ((str (buffer-substring (match-beginning 1) + (match-end 1)))) + (unless (equal str "") + (setq mac-counter (string-to-int str)))) + t) + ((looking-at "Format:[ \t]*\"\\([^\n]*\\)\"[ \t]*$") + (when edmacro-store-hook + (error "\"Format\" line not allowed in this context")) + (let ((str (buffer-substring (match-beginning 1) + (match-end 1)))) + (unless (equal str "") + (setq mac-format str))) + t) ((looking-at "Macro:[ \t\n]*") (goto-char (match-end 0)) nil) @@ -280,7 +318,10 @@ or nil, use a compact 80-column format." (when cmd (if (= (length mac) 0) (fmakunbound cmd) - (fset cmd mac))) + (fset cmd + (if (and mac-counter mac-format) + (kmacro-lambda-form mac mac-counter mac-format) + mac)))) (if no-keys (when cmd (loop for key in (where-is-internal cmd '(keymap)) do @@ -289,7 +330,11 @@ or nil, use a compact 80-column format." (if (= (length mac) 0) (loop for key in keys do (global-unset-key key)) (loop for key in keys do - (global-set-key key (or cmd mac))))))))) + (global-set-key key + (or cmd + (if (and mac-counter mac-format) + (kmacro-lambda-form mac mac-counter mac-format) + mac)))))))))) (kill-buffer buf) (when (buffer-name obuf) (switch-to-buffer obuf)) @@ -413,7 +458,7 @@ doubt, use whitespace." (while (memq (aref rest-mac i) (cdr mdigs)) (incf i)) (and (not (memq (aref rest-mac i) pkeys)) - (prog1 (concat "M-" (edmacro-subseq rest-mac 0 i) " ") + (prog1 (vconcat "M-" (edmacro-subseq rest-mac 0 i) " ") (callf edmacro-subseq rest-mac i))))) (and (eq (aref rest-mac 0) ?\C-u) (eq (key-binding [?\C-u]) 'universal-argument) @@ -432,7 +477,7 @@ doubt, use whitespace." '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)) (incf i)) (and (not (memq (aref rest-mac i) pkeys)) - (prog1 (concat "C-u " (edmacro-subseq rest-mac 1 i) " ") + (prog1 (vconcat "C-u " (edmacro-subseq rest-mac 1 i) " ") (callf edmacro-subseq rest-mac i))))))) (bind-len (apply 'max 1 (loop for map in maps @@ -520,7 +565,8 @@ doubt, use whitespace." (t (error "Unrecognized item in macro: %s" ch))))) (or fkey key) " ")))) - (if prefix (setq desc (concat prefix desc))) + (if prefix + (setq desc (concat (edmacro-sanitize-for-string prefix) desc))) (unless (string-match " " desc) (let ((times 1) (pos bind-len)) (while (not (edmacro-mismatch rest-mac rest-mac @@ -591,7 +637,7 @@ If START or END is negative, it counts from the end." (if end (let ((res nil)) (while (>= (setq end (1- end)) start) - (cl-push (cl-pop seq) res)) + (push (pop seq) res)) (nreverse res)) (copy-sequence seq))) (t @@ -603,23 +649,40 @@ If START or END is negative, it counts from the end." (setq i (1+ i) start (1+ start))) res)))))) -(defun edmacro-fix-menu-commands (macro) - (when (vectorp macro) - (let ((i 0) ev) - (while (< i (length macro)) - (when (consp (setq ev (aref macro i))) - (cond ((equal (cadadr ev) '(menu-bar)) - (setq macro (vconcat (edmacro-subseq macro 0 i) - (vector 'menu-bar (car ev)) - (edmacro-subseq macro (1+ i)))) - (incf i)) +(defun edmacro-sanitize-for-string (seq) + "Convert a key sequence vector into a string. +The string represents the same events; Meta is indicated by bit 7. +This function assumes that the events can be stored in a string." + (setq seq (copy-sequence seq)) + (loop for i below (length seq) do + (when (< (aref seq i) 0) + (setf (aref seq i) (logand (aref seq i) 127)))) + seq) + +(defun edmacro-fix-menu-commands (macro &optional noerror) + (if (vectorp macro) + (let (result) + ;; Make a list of the elements. + (setq macro (append macro nil)) + (dolist (ev macro) + (cond ((atom ev) + (push ev result)) + ((eq (car ev) 'help-echo)) + ((equal ev '(menu-bar)) + (push 'menu-bar result)) + ((equal (cadadr ev) '(menu-bar)) + (push (vector 'menu-bar (car ev)) result)) ;; It would be nice to do pop-up menus, too, but not enough ;; info is recorded in macros to make this possible. + (noerror + ;; Just ignore mouse events. + nil) (t (error "Macros with mouse clicks are not %s" "supported by this command")))) - (incf i)))) - macro) + ;; Reverse them again and make them back into a vector. + (vconcat (nreverse result))) + macro)) ;;; Parsing a human-readable keyboard macro. @@ -687,10 +750,12 @@ If START or END is negative, it counts from the end." (error "%s must prefix a single character, not %s" (substring orig-word 0 prefix) word)) ((and (/= (logand bits ?\C-\^@) 0) (stringp word) - (string-match "[@-_.a-z?]" 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-\^@) - (if (equal word "?") 127 - (logand (aref word 0) 31)))))) + (logand (aref word 0) 31))))) (t (setq key (list (+ bits (aref word 0))))))))) (when key @@ -703,50 +768,15 @@ If START or END is negative, it counts from the end." (setq res (edmacro-subseq res 2 -2))) (if (and (not need-vector) (loop for ch across res - always (and (integerp ch) + always (and (char-valid-p ch) (let ((ch2 (logand ch (lognot ?\M-\^@)))) (and (>= ch2 0) (<= ch2 127)))))) (concat (loop for ch across res collect (if (= (logand ch ?\M-\^@) 0) ch (+ ch 128)))) res))) - -;;; The following probably ought to go in macros.el: - -;;;###autoload -(defun insert-kbd-macro (macroname &optional keys) - "Insert in buffer the definition of kbd macro NAME, as Lisp code. -Optional second arg KEYS means also record the keys it is on -\(this is the prefix argument, when calling interactively). - -This Lisp code will, when executed, define the kbd macro with the same -definition it has now. If you say to record the keys, the Lisp code -will also rebind those keys to the macro. Only global key bindings -are recorded since executing this Lisp code always makes global -bindings. - -To save a kbd macro, visit a file of Lisp code such as your `~/.emacs', -use this command, and then save the file." - (interactive "CInsert kbd macro (name): \nP") - (let (definition) - (if (string= (symbol-name macroname) "") - (progn - (setq definition (format-kbd-macro)) - (insert "(setq last-kbd-macro")) - (setq definition (format-kbd-macro macroname)) - (insert (format "(defalias '%s" macroname))) - (if (> (length definition) 50) - (insert " (read-kbd-macro\n") - (insert "\n (read-kbd-macro ")) - (prin1 definition (current-buffer)) - (insert "))\n") - (if keys - (let ((keys (where-is-internal macroname '(keymap)))) - (while keys - (insert (format "(global-set-key %S '%s)\n" (car keys) macroname)) - (setq keys (cdr keys))))))) (provide 'edmacro) +;;; arch-tag: 726807b4-3ae6-49de-b0ae-b9590973e0d7 ;;; edmacro.el ends here -