src/macros.c

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