3 Copyright (C) 1985-1986, 1993, 2000-2015 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
26 #include "character.h"
31 static Lisp_Object Qexecute_kbd_macro
;
32 static Lisp_Object Qkbd_macro_termination_hook
;
34 /* Number of successful iterations so far
35 for innermost keyboard macro.
36 This is not bound at each level,
37 so after an error, it describes the innermost interrupted macro. */
39 EMACS_INT executing_kbd_macro_iterations
;
41 /* This is the macro that was executing.
42 This is not bound at each level,
43 so after an error, it describes the innermost interrupted macro.
44 We use it only as a kind of flag, so no need to protect it. */
46 Lisp_Object executing_kbd_macro
;
48 Lisp_Object
Fexecute_kbd_macro (Lisp_Object macro
, Lisp_Object count
, Lisp_Object loopfunc
);
50 DEFUN ("start-kbd-macro", Fstart_kbd_macro
, Sstart_kbd_macro
, 1, 2, "P",
51 doc
: /* Record subsequent keyboard input, defining a keyboard macro.
52 The commands are recorded even as they are executed.
53 Use \\[end-kbd-macro] to finish recording and make the macro available.
54 Use \\[name-last-kbd-macro] to give it a permanent name.
55 Non-nil arg (prefix arg) means append to last macro defined;
56 this begins by re-executing that macro as if you typed it again.
57 If optional second arg, NO-EXEC, is non-nil, do not re-execute last
58 macro before appending to it. */)
59 (Lisp_Object append
, Lisp_Object no_exec
)
61 if (!NILP (KVAR (current_kboard
, defining_kbd_macro
)))
62 error ("Already defining kbd macro");
64 if (!current_kboard
->kbd_macro_buffer
)
66 current_kboard
->kbd_macro_buffer
= xmalloc (30 * word_size
);
67 current_kboard
->kbd_macro_bufsize
= 30;
68 current_kboard
->kbd_macro_ptr
= current_kboard
->kbd_macro_buffer
;
69 current_kboard
->kbd_macro_end
= current_kboard
->kbd_macro_buffer
;
71 update_mode_lines
= 19;
74 if (current_kboard
->kbd_macro_bufsize
> 200)
76 current_kboard
->kbd_macro_buffer
77 = xrealloc (current_kboard
->kbd_macro_buffer
,
79 current_kboard
->kbd_macro_bufsize
= 30;
81 current_kboard
->kbd_macro_ptr
= current_kboard
->kbd_macro_buffer
;
82 current_kboard
->kbd_macro_end
= current_kboard
->kbd_macro_buffer
;
83 message1 ("Defining kbd macro...");
91 /* Check the type of last-kbd-macro in case Lisp code changed it. */
92 CHECK_VECTOR_OR_STRING (KVAR (current_kboard
, Vlast_kbd_macro
));
94 len
= XINT (Flength (KVAR (current_kboard
, Vlast_kbd_macro
)));
96 /* Copy last-kbd-macro into the buffer, in case the Lisp code
97 has put another macro there. */
98 if (current_kboard
->kbd_macro_bufsize
< len
+ 30)
100 if (PTRDIFF_MAX
< MOST_POSITIVE_FIXNUM
+ 30
101 && PTRDIFF_MAX
< len
+ 30)
102 memory_full (SIZE_MAX
);
103 current_kboard
->kbd_macro_buffer
=
104 xpalloc (current_kboard
->kbd_macro_buffer
,
105 ¤t_kboard
->kbd_macro_bufsize
,
106 len
+ 30 - current_kboard
->kbd_macro_bufsize
, -1,
107 sizeof *current_kboard
->kbd_macro_buffer
);
110 /* Must convert meta modifier when copying string to vector. */
111 cvt
= STRINGP (KVAR (current_kboard
, Vlast_kbd_macro
));
112 for (i
= 0; i
< len
; i
++)
115 c
= Faref (KVAR (current_kboard
, Vlast_kbd_macro
), make_number (i
));
116 if (cvt
&& NATNUMP (c
) && (XFASTINT (c
) & 0x80))
117 XSETFASTINT (c
, CHAR_META
| (XFASTINT (c
) & ~0x80));
118 current_kboard
->kbd_macro_buffer
[i
] = c
;
121 current_kboard
->kbd_macro_ptr
= current_kboard
->kbd_macro_buffer
+ len
;
122 current_kboard
->kbd_macro_end
= current_kboard
->kbd_macro_ptr
;
124 /* Re-execute the macro we are appending to,
125 for consistency of behavior. */
127 Fexecute_kbd_macro (KVAR (current_kboard
, Vlast_kbd_macro
),
128 make_number (1), Qnil
);
130 message1 ("Appending to kbd macro...");
132 kset_defining_kbd_macro (current_kboard
, Qt
);
137 /* Finish defining the current keyboard macro. */
142 kset_defining_kbd_macro (current_kboard
, Qnil
);
143 update_mode_lines
= 20;
146 make_event_array ((current_kboard
->kbd_macro_end
147 - current_kboard
->kbd_macro_buffer
),
148 current_kboard
->kbd_macro_buffer
));
151 DEFUN ("end-kbd-macro", Fend_kbd_macro
, Send_kbd_macro
, 0, 2, "p",
152 doc
: /* Finish defining a keyboard macro.
153 The definition was started by \\[start-kbd-macro].
154 The macro is now available for use via \\[call-last-kbd-macro],
155 or it can be given a name with \\[name-last-kbd-macro] and then invoked
158 With numeric arg, repeat macro now that many times,
159 counting the definition just completed as the first repetition.
160 An argument of zero means repeat until error.
162 In Lisp, optional second arg LOOPFUNC may be a function that is called prior to
163 each iteration of the macro. Iteration stops if LOOPFUNC returns nil. */)
164 (Lisp_Object repeat
, Lisp_Object loopfunc
)
166 if (NILP (KVAR (current_kboard
, defining_kbd_macro
)))
167 error ("Not defining kbd macro");
170 XSETFASTINT (repeat
, 1);
172 CHECK_NUMBER (repeat
);
174 if (!NILP (KVAR (current_kboard
, defining_kbd_macro
)))
177 message1 ("Keyboard macro defined");
180 if (XFASTINT (repeat
) == 0)
181 Fexecute_kbd_macro (KVAR (current_kboard
, Vlast_kbd_macro
), repeat
, loopfunc
);
182 else if (XINT (repeat
) > 1)
184 XSETINT (repeat
, XINT (repeat
) - 1);
185 Fexecute_kbd_macro (KVAR (current_kboard
, Vlast_kbd_macro
),
191 /* Store character c into kbd macro being defined. */
194 store_kbd_macro_char (Lisp_Object c
)
196 struct kboard
*kb
= current_kboard
;
198 if (!NILP (KVAR (kb
, defining_kbd_macro
)))
200 if (kb
->kbd_macro_ptr
- kb
->kbd_macro_buffer
== kb
->kbd_macro_bufsize
)
202 ptrdiff_t ptr_offset
, end_offset
, nbytes
;
204 ptr_offset
= kb
->kbd_macro_ptr
- kb
->kbd_macro_buffer
;
205 end_offset
= kb
->kbd_macro_end
- kb
->kbd_macro_buffer
;
206 if (min (PTRDIFF_MAX
, SIZE_MAX
) / sizeof *kb
->kbd_macro_buffer
/ 2
207 < kb
->kbd_macro_bufsize
)
208 memory_full (SIZE_MAX
);
209 nbytes
= kb
->kbd_macro_bufsize
* (2 * sizeof *kb
->kbd_macro_buffer
);
210 kb
->kbd_macro_buffer
= xrealloc (kb
->kbd_macro_buffer
, nbytes
);
211 kb
->kbd_macro_bufsize
*= 2;
212 kb
->kbd_macro_ptr
= kb
->kbd_macro_buffer
+ ptr_offset
;
213 kb
->kbd_macro_end
= kb
->kbd_macro_buffer
+ end_offset
;
216 *kb
->kbd_macro_ptr
++ = c
;
220 /* Declare that all chars stored so far in the kbd macro being defined
221 really belong to it. This is done in between editor commands. */
224 finalize_kbd_macro_chars (void)
226 current_kboard
->kbd_macro_end
= current_kboard
->kbd_macro_ptr
;
229 DEFUN ("cancel-kbd-macro-events", Fcancel_kbd_macro_events
,
230 Scancel_kbd_macro_events
, 0, 0, 0,
231 doc
: /* Cancel the events added to a keyboard macro for this command. */)
234 current_kboard
->kbd_macro_ptr
= current_kboard
->kbd_macro_end
;
238 DEFUN ("store-kbd-macro-event", Fstore_kbd_macro_event
,
239 Sstore_kbd_macro_event
, 1, 1, 0,
240 doc
: /* Store EVENT into the keyboard macro being defined. */)
243 store_kbd_macro_char (event
);
247 DEFUN ("call-last-kbd-macro", Fcall_last_kbd_macro
, Scall_last_kbd_macro
,
249 doc
: /* Call the last keyboard macro that you defined with \\[start-kbd-macro].
251 A prefix argument serves as a repeat count. Zero means repeat until error.
253 To make a macro permanent so you can call it even after
254 defining others, use \\[name-last-kbd-macro].
256 In Lisp, optional second arg LOOPFUNC may be a function that is called prior to
257 each iteration of the macro. Iteration stops if LOOPFUNC returns nil. */)
258 (Lisp_Object prefix
, Lisp_Object loopfunc
)
260 /* Don't interfere with recognition of the previous command
261 from before this macro started. */
262 Vthis_command
= KVAR (current_kboard
, Vlast_command
);
263 /* C-x z after the macro should repeat the macro. */
264 Vreal_this_command
= KVAR (current_kboard
, Vlast_kbd_macro
);
266 if (! NILP (KVAR (current_kboard
, defining_kbd_macro
)))
267 error ("Can't execute anonymous macro while defining one");
268 else if (NILP (KVAR (current_kboard
, Vlast_kbd_macro
)))
269 error ("No kbd macro has been defined");
271 Fexecute_kbd_macro (KVAR (current_kboard
, Vlast_kbd_macro
), prefix
, loopfunc
);
273 /* command_loop_1 sets this to nil before it returns;
274 get back the last command within the macro
275 so that it can be last, again, after we return. */
276 Vthis_command
= KVAR (current_kboard
, Vlast_command
);
281 /* Restore Vexecuting_kbd_macro and executing_kbd_macro_index.
282 Called when the unwind-protect in Fexecute_kbd_macro gets invoked. */
285 pop_kbd_macro (Lisp_Object info
)
288 Vexecuting_kbd_macro
= XCAR (info
);
290 executing_kbd_macro_index
= XINT (XCAR (tem
));
291 Vreal_this_command
= XCDR (tem
);
292 Frun_hooks (1, &Qkbd_macro_termination_hook
);
295 DEFUN ("execute-kbd-macro", Fexecute_kbd_macro
, Sexecute_kbd_macro
, 1, 3, 0,
296 doc
: /* Execute MACRO as string of editor command characters.
297 MACRO can also be a vector of keyboard events. If MACRO is a symbol,
298 its function definition is used.
299 COUNT is a repeat count, or nil for once, or 0 for infinite loop.
301 Optional third arg LOOPFUNC may be a function that is called prior to
302 each iteration of the macro. Iteration stops if LOOPFUNC returns nil. */)
303 (Lisp_Object macro
, Lisp_Object count
, Lisp_Object loopfunc
)
307 ptrdiff_t pdlcount
= SPECPDL_INDEX ();
308 EMACS_INT repeat
= 1;
309 struct gcpro gcpro1
, gcpro2
;
310 EMACS_INT success_count
= 0;
312 executing_kbd_macro_iterations
= 0;
316 count
= Fprefix_numeric_value (count
);
317 repeat
= XINT (count
);
320 final
= indirect_function (macro
);
321 if (!STRINGP (final
) && !VECTORP (final
))
322 error ("Keyboard macros must be strings or vectors");
324 tem
= Fcons (Vexecuting_kbd_macro
,
325 Fcons (make_number (executing_kbd_macro_index
),
326 Vreal_this_command
));
327 record_unwind_protect (pop_kbd_macro
, tem
);
329 GCPRO2 (final
, loopfunc
);
332 Vexecuting_kbd_macro
= final
;
333 executing_kbd_macro
= final
;
334 executing_kbd_macro_index
= 0;
336 kset_prefix_arg (current_kboard
, Qnil
);
338 if (!NILP (loopfunc
))
341 cont
= call0 (loopfunc
);
348 executing_kbd_macro_iterations
= ++success_count
;
353 && (STRINGP (Vexecuting_kbd_macro
) || VECTORP (Vexecuting_kbd_macro
)));
355 executing_kbd_macro
= Qnil
;
357 Vreal_this_command
= Vexecuting_kbd_macro
;
360 return unbind_to (pdlcount
, Qnil
);
366 Vexecuting_kbd_macro
= Qnil
;
367 executing_kbd_macro
= Qnil
;
371 syms_of_macros (void)
373 DEFSYM (Qexecute_kbd_macro
, "execute-kbd-macro");
375 DEFVAR_LISP ("kbd-macro-termination-hook", Vkbd_macro_termination_hook
,
376 doc
: /* Normal hook run whenever a keyboard macro terminates.
377 This is run whether the macro ends normally or prematurely due to an error. */);
378 Vkbd_macro_termination_hook
= Qnil
;
379 DEFSYM (Qkbd_macro_termination_hook
, "kbd-macro-termination-hook");
381 defsubr (&Sstart_kbd_macro
);
382 defsubr (&Send_kbd_macro
);
383 defsubr (&Scall_last_kbd_macro
);
384 defsubr (&Sexecute_kbd_macro
);
385 defsubr (&Scancel_kbd_macro_events
);
386 defsubr (&Sstore_kbd_macro_event
);
388 DEFVAR_KBOARD ("defining-kbd-macro", defining_kbd_macro
,
389 doc
: /* Non-nil while a keyboard macro is being defined. Don't set this!
390 The value is the symbol `append' while appending to the definition of
391 an existing macro. */);
393 DEFVAR_LISP ("executing-kbd-macro", Vexecuting_kbd_macro
,
394 doc
: /* Currently executing keyboard macro (string or vector).
395 This is nil when not executing a keyboard macro. */);
397 DEFVAR_INT ("executing-kbd-macro-index", executing_kbd_macro_index
,
398 doc
: /* Index in currently executing keyboard macro; undefined if none executing. */);
400 DEFVAR_KBOARD ("last-kbd-macro", Vlast_kbd_macro
,
401 doc
: /* Last kbd macro defined, as a string or vector; nil if none defined. */);