src/macros.c

   1 /* Keyboard macros.
   2
   3 Copyright (C) 1985-1986, 1993, 2000-2014 Free Software Foundation, Inc.
   4
   5 This file is part of GNU Emacs.
   6
   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.
  11
  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.
  16
  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/>.  */
  19
  20
  21 #include <config.h>
  22
  23 #include "lisp.h"
  24 #include "macros.h"
  25 #include "commands.h"
  26 #include "character.h"
  27 #include "buffer.h"
  28 #include "window.h"
  29 #include "keyboard.h"
  30
  31 static Lisp_Object Qexecute_kbd_macro;
  32 static Lisp_Object Qkbd_macro_termination_hook;
  33
  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.  */
  38
  39 EMACS_INT executing_kbd_macro_iterations;
  40
  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.  */
  45
  46 Lisp_Object executing_kbd_macro;
  47
  48 DEFUN ("start-kbd-macro", Fstart_kbd_macro, Sstart_kbd_macro, 1, 2, "P",
  49        doc: /* Record subsequent keyboard input, defining a keyboard macro.
  50 The commands are recorded even as they are executed.
  51 Use \\[end-kbd-macro] to finish recording and make the macro available.
  52 Use \\[name-last-kbd-macro] to give it a permanent name.
  53 Non-nil arg (prefix arg) means append to last macro defined;
  54 this begins by re-executing that macro as if you typed it again.
  55 If optional second arg, NO-EXEC, is non-nil, do not re-execute last
  56 macro before appending to it.  */)
  57   (Lisp_Object append, Lisp_Object no_exec)
  58 {
  59   if (!NILP (KVAR (current_kboard, defining_kbd_macro)))
  60     error ("Already defining kbd macro");
  61
  62   if (!current_kboard->kbd_macro_buffer)
  63     {
  64       current_kboard->kbd_macro_buffer = xmalloc (30 * word_size);
  65       current_kboard->kbd_macro_bufsize = 30;
  66       current_kboard->kbd_macro_ptr = current_kboard->kbd_macro_buffer;
  67       current_kboard->kbd_macro_end = current_kboard->kbd_macro_buffer;
  68     }
  69   update_mode_lines = 19;
  70   if (NILP (append))
  71     {
  72       if (current_kboard->kbd_macro_bufsize > 200)
  73         {
  74           current_kboard->kbd_macro_buffer
  75             = xrealloc (current_kboard->kbd_macro_buffer,
  76                         30 * word_size);
  77           current_kboard->kbd_macro_bufsize = 30;
  78         }
  79       current_kboard->kbd_macro_ptr = current_kboard->kbd_macro_buffer;
  80       current_kboard->kbd_macro_end = current_kboard->kbd_macro_buffer;
  81       message1 ("Defining kbd macro...");
  82     }
  83   else
  84     {
  85       int incr = 30;
  86       ptrdiff_t i, len;
  87       bool cvt;
  88
  89       /* Check the type of last-kbd-macro in case Lisp code changed it.  */
  90       len = CHECK_VECTOR_OR_STRING (KVAR (current_kboard, Vlast_kbd_macro));
  91
  92       /* Copy last-kbd-macro into the buffer, in case the Lisp code
  93          has put another macro there.  */
  94       if (current_kboard->kbd_macro_bufsize - incr < len)
  95         current_kboard->kbd_macro_buffer =
  96           xpalloc (current_kboard->kbd_macro_buffer,
  97                    &current_kboard->kbd_macro_bufsize,
  98                    len - current_kboard->kbd_macro_bufsize + incr, -1,
  99                    sizeof *current_kboard->kbd_macro_buffer);
 100
 101       /* Must convert meta modifier when copying string to vector.  */
 102       cvt = STRINGP (KVAR (current_kboard, Vlast_kbd_macro));
 103       for (i = 0; i < len; i++)
 104         {
 105           Lisp_Object c;
 106           c = Faref (KVAR (current_kboard, Vlast_kbd_macro), make_number (i));
 107           if (cvt && NATNUMP (c) && (XFASTINT (c) & 0x80))
 108             XSETFASTINT (c, CHAR_META | (XFASTINT (c) & ~0x80));
 109           current_kboard->kbd_macro_buffer[i] = c;
 110         }
 111
 112       current_kboard->kbd_macro_ptr = current_kboard->kbd_macro_buffer + len;
 113       current_kboard->kbd_macro_end = current_kboard->kbd_macro_ptr;
 114
 115       /* Re-execute the macro we are appending to,
 116          for consistency of behavior.  */
 117       if (NILP (no_exec))
 118         Fexecute_kbd_macro (KVAR (current_kboard, Vlast_kbd_macro),
 119                             make_number (1), Qnil);
 120
 121       message1 ("Appending to kbd macro...");
 122     }
 123   kset_defining_kbd_macro (current_kboard, Qt);
 124
 125   return Qnil;
 126 }
 127
 128 /* Finish defining the current keyboard macro.  */
 129
 130 void
 131 end_kbd_macro (void)
 132 {
 133   kset_defining_kbd_macro (current_kboard, Qnil);
 134   update_mode_lines = 20;
 135   kset_last_kbd_macro
 136     (current_kboard,
 137      make_event_array ((current_kboard->kbd_macro_end
 138                         - current_kboard->kbd_macro_buffer),
 139                        current_kboard->kbd_macro_buffer));
 140 }
 141
 142 DEFUN ("end-kbd-macro", Fend_kbd_macro, Send_kbd_macro, 0, 2, "p",
 143        doc: /* Finish defining a keyboard macro.
 144 The definition was started by \\[start-kbd-macro].
 145 The macro is now available for use via \\[call-last-kbd-macro],
 146 or it can be given a name with \\[name-last-kbd-macro] and then invoked
 147 under that name.
 148
 149 With numeric arg, repeat macro now that many times,
 150 counting the definition just completed as the first repetition.
 151 An argument of zero means repeat until error.
 152
 153 In Lisp, optional second arg LOOPFUNC may be a function that is called prior to
 154 each iteration of the macro.  Iteration stops if LOOPFUNC returns nil.  */)
 155   (Lisp_Object repeat, Lisp_Object loopfunc)
 156 {
 157   if (NILP (KVAR (current_kboard, defining_kbd_macro)))
 158     error ("Not defining kbd macro");
 159
 160   if (NILP (repeat))
 161     XSETFASTINT (repeat, 1);
 162   else
 163     CHECK_NUMBER (repeat);
 164
 165   if (!NILP (KVAR (current_kboard, defining_kbd_macro)))
 166     {
 167       end_kbd_macro ();
 168       message1 ("Keyboard macro defined");
 169     }
 170
 171   if (XFASTINT (repeat) == 0)
 172     Fexecute_kbd_macro (KVAR (current_kboard, Vlast_kbd_macro), repeat, loopfunc);
 173   else if (XINT (repeat) > 1)
 174     {
 175       XSETINT (repeat, XINT (repeat) - 1);
 176       Fexecute_kbd_macro (KVAR (current_kboard, Vlast_kbd_macro),
 177                           repeat, loopfunc);
 178     }
 179   return Qnil;
 180 }
 181
 182 /* Store character c into kbd macro being defined.  */
 183
 184 void
 185 store_kbd_macro_char (Lisp_Object c)
 186 {
 187   struct kboard *kb = current_kboard;
 188
 189   if (!NILP (KVAR (kb, defining_kbd_macro)))
 190     {
 191       if (kb->kbd_macro_ptr - kb->kbd_macro_buffer == kb->kbd_macro_bufsize)
 192         {
 193           ptrdiff_t ptr_offset, end_offset, nbytes;
 194
 195           ptr_offset = kb->kbd_macro_ptr - kb->kbd_macro_buffer;
 196           end_offset = kb->kbd_macro_end - kb->kbd_macro_buffer;
 197           if (min (PTRDIFF_MAX, SIZE_MAX) / sizeof *kb->kbd_macro_buffer / 2
 198               < kb->kbd_macro_bufsize)
 199             memory_full (SIZE_MAX);
 200           nbytes = kb->kbd_macro_bufsize * (2 * sizeof *kb->kbd_macro_buffer);
 201           kb->kbd_macro_buffer = xrealloc (kb->kbd_macro_buffer, nbytes);
 202           kb->kbd_macro_bufsize *= 2;
 203           kb->kbd_macro_ptr = kb->kbd_macro_buffer + ptr_offset;
 204           kb->kbd_macro_end = kb->kbd_macro_buffer + end_offset;
 205         }
 206
 207       *kb->kbd_macro_ptr++ = c;
 208     }
 209 }
 210
 211 /* Declare that all chars stored so far in the kbd macro being defined
 212  really belong to it.  This is done in between editor commands.  */
 213
 214 void
 215 finalize_kbd_macro_chars (void)
 216 {
 217   current_kboard->kbd_macro_end = current_kboard->kbd_macro_ptr;
 218 }
 219
 220 DEFUN ("cancel-kbd-macro-events", Fcancel_kbd_macro_events,
 221        Scancel_kbd_macro_events, 0, 0, 0,
 222        doc: /* Cancel the events added to a keyboard macro for this command.  */)
 223   (void)
 224 {
 225   current_kboard->kbd_macro_ptr = current_kboard->kbd_macro_end;
 226   return Qnil;
 227 }
 228
 229 DEFUN ("store-kbd-macro-event", Fstore_kbd_macro_event,
 230        Sstore_kbd_macro_event, 1, 1, 0,
 231        doc: /* Store EVENT into the keyboard macro being defined.  */)
 232   (Lisp_Object event)
 233 {
 234   store_kbd_macro_char (event);
 235   return Qnil;
 236 }
 237 \f
 238 DEFUN ("call-last-kbd-macro", Fcall_last_kbd_macro, Scall_last_kbd_macro,
 239        0, 2, "p",
 240        doc: /* Call the last keyboard macro that you defined with \\[start-kbd-macro].
 241
 242 A prefix argument serves as a repeat count.  Zero means repeat until error.
 243
 244 To make a macro permanent so you can call it even after
 245 defining others, use \\[name-last-kbd-macro].
 246
 247 In Lisp, optional second arg LOOPFUNC may be a function that is called prior to
 248 each iteration of the macro.  Iteration stops if LOOPFUNC returns nil.  */)
 249   (Lisp_Object prefix, Lisp_Object loopfunc)
 250 {
 251   /* Don't interfere with recognition of the previous command
 252      from before this macro started.  */
 253   Vthis_command = KVAR (current_kboard, Vlast_command);
 254   /* C-x z after the macro should repeat the macro.  */
 255   Vreal_this_command = KVAR (current_kboard, Vlast_kbd_macro);
 256
 257   if (! NILP (KVAR (current_kboard, defining_kbd_macro)))
 258     error ("Can't execute anonymous macro while defining one");
 259   else if (NILP (KVAR (current_kboard, Vlast_kbd_macro)))
 260     error ("No kbd macro has been defined");
 261   else
 262     Fexecute_kbd_macro (KVAR (current_kboard, Vlast_kbd_macro), prefix, loopfunc);
 263
 264   /* command_loop_1 sets this to nil before it returns;
 265      get back the last command within the macro
 266      so that it can be last, again, after we return.  */
 267   Vthis_command = KVAR (current_kboard, Vlast_command);
 268
 269   return Qnil;
 270 }
 271
 272 /* Restore Vexecuting_kbd_macro and executing_kbd_macro_index.
 273    Called when the unwind-protect in Fexecute_kbd_macro gets invoked.  */
 274
 275 static void
 276 pop_kbd_macro (Lisp_Object info)
 277 {
 278   Lisp_Object tem;
 279   Vexecuting_kbd_macro = XCAR (info);
 280   tem = XCDR (info);
 281   executing_kbd_macro_index = XINT (XCAR (tem));
 282   Vreal_this_command = XCDR (tem);
 283   Frun_hooks (1, &Qkbd_macro_termination_hook);
 284 }
 285
 286 DEFUN ("execute-kbd-macro", Fexecute_kbd_macro, Sexecute_kbd_macro, 1, 3, 0,
 287        doc: /* Execute MACRO as string of editor command characters.
 288 MACRO can also be a vector of keyboard events.  If MACRO is a symbol,
 289 its function definition is used.
 290 COUNT is a repeat count, or nil for once, or 0 for infinite loop.
 291
 292 Optional third arg LOOPFUNC may be a function that is called prior to
 293 each iteration of the macro.  Iteration stops if LOOPFUNC returns nil.  */)
 294   (Lisp_Object macro, Lisp_Object count, Lisp_Object loopfunc)
 295 {
 296   Lisp_Object final;
 297   Lisp_Object tem;
 298   ptrdiff_t pdlcount = SPECPDL_INDEX ();
 299   EMACS_INT repeat = 1;
 300   struct gcpro gcpro1, gcpro2;
 301   EMACS_INT success_count = 0;
 302
 303   executing_kbd_macro_iterations = 0;
 304
 305   if (!NILP (count))
 306     {
 307       count = Fprefix_numeric_value (count);
 308       repeat = XINT (count);
 309     }
 310
 311   final = indirect_function (macro);
 312   if (!STRINGP (final) && !VECTORP (final))
 313     error ("Keyboard macros must be strings or vectors");
 314
 315   tem = Fcons (Vexecuting_kbd_macro,
 316                Fcons (make_number (executing_kbd_macro_index),
 317                       Vreal_this_command));
 318   record_unwind_protect (pop_kbd_macro, tem);
 319
 320   GCPRO2 (final, loopfunc);
 321   do
 322     {
 323       Vexecuting_kbd_macro = final;
 324       executing_kbd_macro = final;
 325       executing_kbd_macro_index = 0;
 326
 327       kset_prefix_arg (current_kboard, Qnil);
 328
 329       if (!NILP (loopfunc))
 330         {
 331           Lisp_Object cont;
 332           cont = call0 (loopfunc);
 333           if (NILP (cont))
 334             break;
 335         }
 336
 337       command_loop_1 ();
 338
 339       executing_kbd_macro_iterations = ++success_count;
 340
 341       QUIT;
 342     }
 343   while (--repeat
 344          && (STRINGP (Vexecuting_kbd_macro) || VECTORP (Vexecuting_kbd_macro)));
 345
 346   executing_kbd_macro = Qnil;
 347
 348   Vreal_this_command = Vexecuting_kbd_macro;
 349
 350   UNGCPRO;
 351   return unbind_to (pdlcount, Qnil);
 352 }
 353 \f
 354 void
 355 init_macros (void)
 356 {
 357   Vexecuting_kbd_macro = Qnil;
 358   executing_kbd_macro = Qnil;
 359 }
 360
 361 void
 362 syms_of_macros (void)
 363 {
 364   DEFSYM (Qexecute_kbd_macro, "execute-kbd-macro");
 365
 366   DEFVAR_LISP ("kbd-macro-termination-hook", Vkbd_macro_termination_hook,
 367                doc: /* Normal hook run whenever a keyboard macro terminates.
 368 This is run whether the macro ends normally or prematurely due to an error.  */);
 369   Vkbd_macro_termination_hook = Qnil;
 370   DEFSYM (Qkbd_macro_termination_hook, "kbd-macro-termination-hook");
 371
 372   defsubr (&Sstart_kbd_macro);
 373   defsubr (&Send_kbd_macro);
 374   defsubr (&Scall_last_kbd_macro);
 375   defsubr (&Sexecute_kbd_macro);
 376   defsubr (&Scancel_kbd_macro_events);
 377   defsubr (&Sstore_kbd_macro_event);
 378
 379   DEFVAR_KBOARD ("defining-kbd-macro", defining_kbd_macro,
 380                  doc: /* Non-nil while a keyboard macro is being defined.  Don't set this!
 381 The value is the symbol `append' while appending to the definition of
 382 an existing macro.  */);
 383
 384   DEFVAR_LISP ("executing-kbd-macro", Vexecuting_kbd_macro,
 385                doc: /* Currently executing keyboard macro (string or vector).
 386 This is nil when not executing a keyboard macro.  */);
 387
 388   DEFVAR_INT ("executing-kbd-macro-index", executing_kbd_macro_index,
 389               doc: /* Index in currently executing keyboard macro; undefined if none executing.  */);
 390
 391   DEFVAR_KBOARD ("last-kbd-macro", Vlast_kbd_macro,
 392                  doc: /* Last kbd macro defined, as a string or vector; nil if none defined.  */);
 393 }