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