macros.el 9.48 KB
Newer Older
1
;;; macros.el --- non-primitive commands for keyboard macros -*- lexical-binding:t -*-
Eric S. Raymond's avatar
Eric S. Raymond committed
2

Paul Eggert's avatar
Paul Eggert committed
3
;; Copyright (C) 1985-1987, 1992, 1994-1995, 2001-2019 Free Software
4
;; Foundation, Inc.
Joseph Arceneaux's avatar
Joseph Arceneaux committed
5

6
;; Maintainer: emacs-devel@gnu.org
Eric S. Raymond's avatar
Eric S. Raymond committed
7
;; Keywords: abbrev
8
;; Package: emacs
Eric S. Raymond's avatar
Eric S. Raymond committed
9

Joseph Arceneaux's avatar
Joseph Arceneaux committed
10 11
;; This file is part of GNU Emacs.

12
;; GNU Emacs is free software: you can redistribute it and/or modify
Joseph Arceneaux's avatar
Joseph Arceneaux committed
13
;; it under the terms of the GNU General Public License as published by
14 15
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
Joseph Arceneaux's avatar
Joseph Arceneaux committed
16 17 18 19 20 21 22

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
23
;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
Joseph Arceneaux's avatar
Joseph Arceneaux committed
24

25 26 27 28 29 30 31
;;; Commentary:

;; Extension commands for keyboard macros.  These permit you to assign
;; a name to the last-defined keyboard macro, expand and insert the
;; lisp corresponding to a macro, query the user from within a macro,
;; or apply a macro to each line in the reason.

Eric S. Raymond's avatar
Eric S. Raymond committed
32
;;; Code:
Joseph Arceneaux's avatar
Joseph Arceneaux committed
33

34 35
(require 'kmacro)

Roland McGrath's avatar
Roland McGrath committed
36
;;;###autoload
37
(defalias 'name-last-kbd-macro #'kmacro-name-last-macro)
Joseph Arceneaux's avatar
Joseph Arceneaux committed
38

39 40 41 42 43 44 45 46 47 48
(defun macros--insert-vector-macro (definition)
  "Print DEFINITION, a vector, into the current buffer."
  (dotimes (i (length definition))
    (let ((char (aref definition i)))
      (insert (if (zerop i) ?\[ ?\s))
      (if (characterp char)
          (princ (prin1-char char) (current-buffer))
        (prin1 char (current-buffer)))))
  (insert ?\]))

Roland McGrath's avatar
Roland McGrath committed
49
;;;###autoload
Joseph Arceneaux's avatar
Joseph Arceneaux committed
50
(defun insert-kbd-macro (macroname &optional keys)
51 52
  "Insert in buffer the definition of kbd macro MACRONAME, as Lisp code.
MACRONAME should be a symbol.
53
Optional second arg KEYS means also record the keys it is on
54
\(this is the prefix argument, when calling interactively).
Joseph Arceneaux's avatar
Joseph Arceneaux committed
55

56 57 58 59 60
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.
Joseph Arceneaux's avatar
Joseph Arceneaux committed
61

62
To save a kbd macro, visit a file of Lisp code such as your `~/.emacs',
Joseph Arceneaux's avatar
Joseph Arceneaux committed
63
use this command, and then save the file."
64 65
  (interactive (list (intern (completing-read "Insert kbd macro (name): "
					      obarray
66
                                              #'kmacro-keyboard-macro-p
67 68
					      t))
		     current-prefix-arg))
69 70 71 72 73 74 75 76 77
  (let (definition)
    (if (string= (symbol-name macroname) "")
	(progn
	  (setq macroname 'last-kbd-macro definition last-kbd-macro)
	  (insert "(setq "))
      (setq definition (symbol-function macroname))
      (insert "(fset '"))
    (prin1 macroname (current-buffer))
    (insert "\n   ")
78 79 80 81 82
    (if (stringp definition)
	(let ((beg (point)) end)
	  (prin1 definition (current-buffer))
	  (setq end (point-marker))
	  (goto-char beg)
83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121
	  (while (< (point) end)
	    (let ((char (following-char)))
	      (cond ((= char 0)
		     (delete-region (point) (1+ (point)))
		     (insert "\\C-@"))
		    ((< char 27)
		     (delete-region (point) (1+ (point)))
		     (insert "\\C-" (+ 96 char)))
		    ((= char ?\C-\\)
		     (delete-region (point) (1+ (point)))
		     (insert "\\C-\\\\"))
		    ((< char 32)
		     (delete-region (point) (1+ (point)))
		     (insert "\\C-" (+ 64 char)))
		    ((< char 127)
		     (forward-char 1))
		    ((= char 127)
		     (delete-region (point) (1+ (point)))
		     (insert "\\C-?"))
		    ((= char 128)
		     (delete-region (point) (1+ (point)))
		     (insert "\\M-\\C-@"))
		    ((= char (aref "\M-\C-\\" 0))
		     (delete-region (point) (1+ (point)))
		     (insert "\\M-\\C-\\\\"))
		    ((< char 155)
		     (delete-region (point) (1+ (point)))
		     (insert "\\M-\\C-" (- char 32)))
		    ((< char 160)
		     (delete-region (point) (1+ (point)))
		     (insert "\\M-\\C-" (- char 64)))
		    ((= char (aref "\M-\\" 0))
		     (delete-region (point) (1+ (point)))
		     (insert "\\M-\\\\"))
		    ((< char 255)
		     (delete-region (point) (1+ (point)))
		     (insert "\\M-" (- char 128)))
		    ((= char 255)
		     (delete-region (point) (1+ (point)))
122 123
		     (insert "\\M-\\C-?"))))))
      (if (vectorp definition)
124 125 126 127 128 129 130 131 132 133 134
          (macros--insert-vector-macro definition)
        (pcase (kmacro-extract-lambda definition)
          (`(,vecdef ,counter ,format)
           (insert "(kmacro-lambda-form ")
           (macros--insert-vector-macro vecdef)
           (insert " ")
           (prin1 counter (current-buffer))
           (insert " ")
           (prin1 format (current-buffer))
           (insert ")"))
          (_ (prin1 definition (current-buffer))))))
135 136
    (insert ")\n")
    (if keys
137 138 139
        (let ((keys (or (where-is-internal (symbol-function macroname)
                                           '(keymap))
                        (where-is-internal macroname '(keymap)))))
140 141 142 143 144 145 146
	  (while keys
	    (insert "(global-set-key ")
	    (prin1 (car keys) (current-buffer))
	    (insert " '")
	    (prin1 macroname (current-buffer))
	    (insert ")\n")
	    (setq keys (cdr keys)))))))
Joseph Arceneaux's avatar
Joseph Arceneaux committed
147

Roland McGrath's avatar
Roland McGrath committed
148
;;;###autoload
Joseph Arceneaux's avatar
Joseph Arceneaux committed
149 150
(defun kbd-macro-query (flag)
  "Query user during kbd macro execution.
151 152 153
  With prefix argument, enters recursive edit, reading keyboard
commands even within a kbd macro.  You can give different commands
each time the macro executes.
Richard M. Stallman's avatar
Richard M. Stallman committed
154 155 156 157 158 159 160
  Without prefix argument, asks whether to continue running the macro.
Your options are: \\<query-replace-map>
\\[act]	Finish this iteration normally and continue with the next.
\\[skip]	Skip the rest of this iteration, and start the next.
\\[exit]	Stop the macro entirely right now.
\\[recenter]	Redisplay the screen, then ask again.
\\[edit]	Enter recursive edit; ask again when you exit from that."
Joseph Arceneaux's avatar
Joseph Arceneaux committed
161
  (interactive "P")
162
  (or executing-kbd-macro
Joseph Arceneaux's avatar
Joseph Arceneaux committed
163
      defining-kbd-macro
164
      (user-error "Not defining or executing kbd macro"))
Joseph Arceneaux's avatar
Joseph Arceneaux committed
165
  (if flag
166
      (let (executing-kbd-macro defining-kbd-macro)
Joseph Arceneaux's avatar
Joseph Arceneaux committed
167
	(recursive-edit))
168
    (if (not executing-kbd-macro)
Joseph Arceneaux's avatar
Joseph Arceneaux committed
169
	nil
170 171 172
      (let ((loop t)
	    (msg (substitute-command-keys
		  "Proceed with macro?\\<query-replace-map>\
173
 (\\[act], \\[skip], \\[exit], \\[recenter], \\[edit]) ")))
Joseph Arceneaux's avatar
Joseph Arceneaux committed
174
	(while loop
175
	  (let ((key (let ((executing-kbd-macro nil)
176
			   (defining-kbd-macro nil))
177
		       (message "%s" msg)
178 179 180 181 182
		       (read-event)))
		def)
	    (setq key (vector key))
	    (setq def (lookup-key query-replace-map key))
	    (cond ((eq def 'act)
Joseph Arceneaux's avatar
Joseph Arceneaux committed
183
		   (setq loop nil))
184
		  ((eq def 'skip)
Joseph Arceneaux's avatar
Joseph Arceneaux committed
185
		   (setq loop nil)
186
		   (setq executing-kbd-macro ""))
187
		  ((eq def 'exit)
Joseph Arceneaux's avatar
Joseph Arceneaux committed
188
		   (setq loop nil)
189
		   (setq executing-kbd-macro t))
190
		  ((eq def 'recenter)
Joseph Arceneaux's avatar
Joseph Arceneaux committed
191
		   (recenter nil))
192
		  ((eq def 'edit)
193
		   (let (executing-kbd-macro defining-kbd-macro)
194 195 196 197 198 199 200 201 202
		     (recursive-edit)))
		  ((eq def 'quit)
		   (setq quit-flag t))
		  (t
		   (or (eq def 'help)
		       (ding))
		   (with-output-to-temp-buffer "*Help*"
		     (princ
		      (substitute-command-keys
203
		       "Specify how to proceed with keyboard macro execution.
204 205 206 207 208
Possibilities: \\<query-replace-map>
\\[act]	Finish this iteration normally and continue with the next.
\\[skip]	Skip the rest of this iteration, and start the next.
\\[exit]	Stop the macro entirely right now.
\\[recenter]	Redisplay the screen, then ask again.
209
\\[edit]	Enter recursive edit; ask again when you exit from that."))
210
		     (with-current-buffer standard-output
211
		       (help-mode)))))))))))
Roland McGrath's avatar
Roland McGrath committed
212

Jim Blandy's avatar
Jim Blandy committed
213 214
;;;###autoload
(defun apply-macro-to-region-lines (top bottom &optional macro)
215 216 217
  "Apply last keyboard macro to all lines in the region.
For each line that begins in the region, move to the beginning of
the line, and run the last keyboard macro.
Jim Blandy's avatar
Jim Blandy committed
218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235

When called from lisp, this function takes two arguments TOP and
BOTTOM, describing the current region.  TOP must be before BOTTOM.
The optional third argument MACRO specifies a keyboard macro to
execute.

This is useful for quoting or unquoting included text, adding and
removing comments, or producing tables where the entries are regular.

For example, in Usenet articles, sections of text quoted from another
author are indented, or have each line start with `>'.  To quote a
section of text, define a keyboard macro which inserts `>', put point
and mark at opposite ends of the quoted section, and use
`\\[apply-macro-to-region-lines]' to mark the entire section.

Suppose you wanted to build a keyword table in C where each entry
looked like this:

236
    { \"foo\", foo_data, foo_function },
Jim Blandy's avatar
Jim Blandy committed
237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252
    { \"bar\", bar_data, bar_function },
    { \"baz\", baz_data, baz_function },

You could enter the names in this format:

    foo
    bar
    baz

and write a macro to massage a word into a table entry:

    \\C-x (
       \\M-d { \"\\C-y\", \\C-y_data, \\C-y_function },
    \\C-x )

and then select the region of un-tablified names and use
253
`\\[apply-macro-to-region-lines]' to build the table from the names."
Jim Blandy's avatar
Jim Blandy committed
254
  (interactive "r")
Jim Blandy's avatar
Jim Blandy committed
255 256 257
  (or macro
      (progn
	(if (null last-kbd-macro)
258
	    (user-error "No keyboard macro has been defined"))
Jim Blandy's avatar
Jim Blandy committed
259
	(setq macro last-kbd-macro)))
Jim Blandy's avatar
Jim Blandy committed
260
  (save-excursion
261
    (let ((end-marker (copy-marker bottom))
Jim Blandy's avatar
Jim Blandy committed
262
	  next-line-marker)
Jim Blandy's avatar
Jim Blandy committed
263 264 265
      (goto-char top)
      (if (not (bolp))
	  (forward-line 1))
Jim Blandy's avatar
Jim Blandy committed
266 267 268
      (setq next-line-marker (point-marker))
      (while (< next-line-marker end-marker)
	(goto-char next-line-marker)
Jim Blandy's avatar
Jim Blandy committed
269
	(save-excursion
Jim Blandy's avatar
Jim Blandy committed
270 271 272
	  (forward-line 1)
	  (set-marker next-line-marker (point)))
	(save-excursion
273
	  (let ((mark-active nil))
David Burger's avatar
David Burger committed
274
	    (execute-kbd-macro macro))))
Jim Blandy's avatar
Jim Blandy committed
275 276
      (set-marker end-marker nil)
      (set-marker next-line-marker nil))))
Jim Blandy's avatar
Jim Blandy committed
277

278
;;;###autoload (define-key ctl-x-map "q" 'kbd-macro-query)
Eric S. Raymond's avatar
Eric S. Raymond committed
279

Richard M. Stallman's avatar
Richard M. Stallman committed
280 281
(provide 'macros)

Eric S. Raymond's avatar
Eric S. Raymond committed
282
;;; macros.el ends here