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