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