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 extern Lisp_Object real_this_command;
  55
  56 Lisp_Object Fexecute_kbd_macro (Lisp_Object macro, Lisp_Object count, Lisp_Object loopfunc);
  57 \f
  58 DEFUN ("start-kbd-macro", Fstart_kbd_macro, Sstart_kbd_macro, 1, 2, "P",
  59        doc: /* Record subsequent keyboard input, defining a keyboard macro.
  60 The commands are recorded even as they are executed.
  61 Use \\[end-kbd-macro] to finish recording and make the macro available.
  62 Use \\[name-last-kbd-macro] to give it a permanent name.
  63 Non-nil arg (prefix arg) means append to last macro defined;
  64 this begins by re-executing that macro as if you typed it again.
  65 If optional second arg, NO-EXEC, is non-nil, do not re-execute last
  66 macro before appending to it. */)
  67   (Lisp_Object append, Lisp_Object 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 (void)
 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   (Lisp_Object repeat, Lisp_Object loopfunc)
 166 {
 167   if (NILP (current_kboard->defining_kbd_macro))
 168     error ("Not defining kbd macro");
 169
 170   if (NILP (repeat))
 171     XSETFASTINT (repeat, 1);
 172   else
 173     CHECK_NUMBER (repeat);
 174
 175   if (!NILP (current_kboard->defining_kbd_macro))
 176     {
 177       end_kbd_macro ();
 178       message ("Keyboard macro defined");
 179     }
 180
 181   if (XFASTINT (repeat) == 0)
 182     Fexecute_kbd_macro (current_kboard->Vlast_kbd_macro, repeat, loopfunc);
 183   else
 184     {
 185       XSETINT (repeat, XINT (repeat)-1);
 186       if (XINT (repeat) > 0)
 187         Fexecute_kbd_macro (current_kboard->Vlast_kbd_macro, repeat, loopfunc);
 188     }
 189   return Qnil;
 190 }
 191
 192 /* Store character c into kbd macro being defined */
 193
 194 void
 195 store_kbd_macro_char (Lisp_Object c)
 196 {
 197   struct kboard *kb = current_kboard;
 198
 199   if (!NILP (kb->defining_kbd_macro))
 200     {
 201       if (kb->kbd_macro_ptr - kb->kbd_macro_buffer == kb->kbd_macro_bufsize)
 202         {
 203           int ptr_offset, end_offset, nbytes;
 204
 205           ptr_offset = kb->kbd_macro_ptr - kb->kbd_macro_buffer;
 206           end_offset = kb->kbd_macro_end - kb->kbd_macro_buffer;
 207           kb->kbd_macro_bufsize *= 2;
 208           nbytes = kb->kbd_macro_bufsize * sizeof *kb->kbd_macro_buffer;
 209           kb->kbd_macro_buffer
 210             = (Lisp_Object *) xrealloc (kb->kbd_macro_buffer, nbytes);
 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 = current_kboard->Vlast_command;
 262   /* C-x z after the macro should repeat the macro.  */
 263   real_this_command = current_kboard->Vlast_kbd_macro;
 264
 265   if (! NILP (current_kboard->defining_kbd_macro))
 266     error ("Can't execute anonymous macro while defining one");
 267   else if (NILP (current_kboard->Vlast_kbd_macro))
 268     error ("No kbd macro has been defined");
 269   else
 270     Fexecute_kbd_macro (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 = 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   real_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   int pdlcount = SPECPDL_INDEX ();
 307   int repeat = 1;
 308   struct gcpro gcpro1, gcpro2;
 309   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                       real_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       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   real_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   Qexecute_kbd_macro = intern_c_string ("execute-kbd-macro");
 373   staticpro (&Qexecute_kbd_macro);
 374   Qkbd_macro_termination_hook = intern_c_string ("kbd-macro-termination-hook");
 375   staticpro (&Qkbd_macro_termination_hook);
 376
 377   defsubr (&Sstart_kbd_macro);
 378   defsubr (&Send_kbd_macro);
 379   defsubr (&Scall_last_kbd_macro);
 380   defsubr (&Sexecute_kbd_macro);
 381   defsubr (&Scancel_kbd_macro_events);
 382   defsubr (&Sstore_kbd_macro_event);
 383
 384   DEFVAR_KBOARD ("defining-kbd-macro", defining_kbd_macro,
 385                  doc: /* Non-nil while a keyboard macro is being defined.  Don't set this!
 386 The value is the symbol `append' while appending to the definition of
 387 an existing macro.  */);
 388
 389   DEFVAR_LISP ("executing-kbd-macro", &Vexecuting_kbd_macro,
 390                doc: /* Currently executing keyboard macro (string or vector).
 391 This is nil when not executing a keyboard macro.  */);
 392
 393   DEFVAR_INT ("executing-kbd-macro-index", &executing_kbd_macro_index,
 394               doc: /* Index in currently executing keyboard macro; undefined if none executing.  */);
 395
 396   DEFVAR_KBOARD ("last-kbd-macro", Vlast_kbd_macro,
 397                  doc: /* Last kbd macro defined, as a string or vector; nil if none defined.  */);
 398 }
 399
 400 /* arch-tag: d293fcc9-2266-4163-9198-7fa0de12ec9e
 401    (do not change this comment) */