src/macros.c

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