src/macros.c

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