src/macros.c

   1 /* Keyboard macros.
   2    Copyright (C) 1985, 1986, 1993, 2000, 2001 Free Software Foundation, Inc.
   3
   4 This file is part of GNU Emacs.
   5
   6 GNU Emacs is free software; you can redistribute it and/or modify
   7 it under the terms of the GNU General Public License as published by
   8 the Free Software Foundation; either version 2, or (at your option)
   9 any later version.
  10
  11 GNU Emacs is distributed in the hope that it will be useful,
  12 but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 GNU General Public License for more details.
  15
  16 You should have received a copy of the GNU General Public License
  17 along with GNU Emacs; see the file COPYING.  If not, write to
  18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  19 Boston, MA 02111-1307, USA.  */
  20
  21
  22 #include <config.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_macro;
  35
  36 /* Index of next character to fetch from that macro.  */
  37
  38 EMACS_INT executing_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_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_macro;
  53
  54 extern Lisp_Object real_this_command;
  55
  56 Lisp_Object Fexecute_kbd_macro ();
  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      (append, no_exec)
  68      Lisp_Object append, no_exec;
  69 {
  70   if (!NILP (current_kboard->defining_kbd_macro))
  71     error ("Already defining kbd macro");
  72
  73   if (!current_kboard->kbd_macro_buffer)
  74     {
  75       current_kboard->kbd_macro_bufsize = 30;
  76       current_kboard->kbd_macro_buffer
  77         = (Lisp_Object *)xmalloc (30 * sizeof (Lisp_Object));
  78     }
  79   update_mode_lines++;
  80   if (NILP (append))
  81     {
  82       if (current_kboard->kbd_macro_bufsize > 200)
  83         {
  84           current_kboard->kbd_macro_bufsize = 30;
  85           current_kboard->kbd_macro_buffer
  86             = (Lisp_Object *)xrealloc (current_kboard->kbd_macro_buffer,
  87                                        30 * sizeof (Lisp_Object));
  88         }
  89       current_kboard->kbd_macro_ptr = current_kboard->kbd_macro_buffer;
  90       current_kboard->kbd_macro_end = current_kboard->kbd_macro_buffer;
  91       message ("Defining kbd macro...");
  92     }
  93   else
  94     {
  95       int i, len;
  96       int cvt;
  97
  98       /* Check the type of last-kbd-macro in case Lisp code changed it.  */
  99       if (!STRINGP (current_kboard->Vlast_kbd_macro)
 100           && !VECTORP (current_kboard->Vlast_kbd_macro))
 101         current_kboard->Vlast_kbd_macro
 102           = wrong_type_argument (Qarrayp, current_kboard->Vlast_kbd_macro);
 103
 104       len = XINT (Flength (current_kboard->Vlast_kbd_macro));
 105
 106       /* Copy last-kbd-macro into the buffer, in case the Lisp code
 107          has put another macro there.  */
 108       if (current_kboard->kbd_macro_bufsize < len + 30)
 109         {
 110           current_kboard->kbd_macro_bufsize = len + 30;
 111           current_kboard->kbd_macro_buffer
 112             = (Lisp_Object *)xrealloc (current_kboard->kbd_macro_buffer,
 113                                        (len + 30) * sizeof (Lisp_Object));
 114         }
 115
 116       /* Must convert meta modifier when copying string to vector.  */
 117       cvt = STRINGP (current_kboard->Vlast_kbd_macro);
 118       for (i = 0; i < len; i++)
 119         {
 120           Lisp_Object c;
 121           c = Faref (current_kboard->Vlast_kbd_macro, make_number (i));
 122           if (cvt && NATNUMP (c) && (XFASTINT (c) & 0x80))
 123             XSETFASTINT (c, CHAR_META | (XFASTINT (c) & ~0x80));
 124           current_kboard->kbd_macro_buffer[i] = c;
 125         }
 126
 127       current_kboard->kbd_macro_ptr = current_kboard->kbd_macro_buffer + len;
 128       current_kboard->kbd_macro_end = current_kboard->kbd_macro_ptr;
 129
 130       /* Re-execute the macro we are appending to,
 131          for consistency of behavior.  */
 132       if (NILP (no_exec))
 133         Fexecute_kbd_macro (current_kboard->Vlast_kbd_macro,
 134                             make_number (1), Qnil);
 135
 136       message ("Appending to kbd macro...");
 137     }
 138   current_kboard->defining_kbd_macro = Qt;
 139
 140   return Qnil;
 141 }
 142
 143 /* Finish defining the current keyboard macro.  */
 144
 145 void
 146 end_kbd_macro ()
 147 {
 148   current_kboard->defining_kbd_macro = Qnil;
 149   update_mode_lines++;
 150   current_kboard->Vlast_kbd_macro
 151     = make_event_array ((current_kboard->kbd_macro_end
 152                          - current_kboard->kbd_macro_buffer),
 153                         current_kboard->kbd_macro_buffer);
 154 }
 155
 156 DEFUN ("end-kbd-macro", Fend_kbd_macro, Send_kbd_macro, 0, 2, "p",
 157        doc: /* Finish defining a keyboard macro.
 158 The definition was started by \\[start-kbd-macro].
 159 The macro is now available for use via \\[call-last-kbd-macro],
 160 or it can be given a name with \\[name-last-kbd-macro] and then invoked
 161 under that name.
 162
 163 With numeric arg, repeat macro now that many times,
 164 counting the definition just completed as the first repetition.
 165 An argument of zero means repeat until error.
 166
 167 In Lisp, optional second arg LOOPFUNC may be a function that is called prior to
 168 each iteration of the macro.  Iteration stops if LOOPFUNC returns nil.  */)
 169      (repeat, loopfunc)
 170      Lisp_Object repeat, loopfunc;
 171 {
 172   if (NILP (current_kboard->defining_kbd_macro))
 173     error ("Not defining kbd macro");
 174
 175   if (NILP (repeat))
 176     XSETFASTINT (repeat, 1);
 177   else
 178     CHECK_NUMBER (repeat);
 179
 180   if (!NILP (current_kboard->defining_kbd_macro))
 181     {
 182       end_kbd_macro ();
 183       message ("Keyboard macro defined");
 184     }
 185
 186   if (XFASTINT (repeat) == 0)
 187     Fexecute_kbd_macro (current_kboard->Vlast_kbd_macro, repeat, loopfunc);
 188   else
 189     {
 190       XSETINT (repeat, XINT (repeat)-1);
 191       if (XINT (repeat) > 0)
 192         Fexecute_kbd_macro (current_kboard->Vlast_kbd_macro, repeat, loopfunc);
 193     }
 194   return Qnil;
 195 }
 196
 197 /* Store character c into kbd macro being defined */
 198
 199 void
 200 store_kbd_macro_char (c)
 201      Lisp_Object c;
 202 {
 203   struct kboard *kb = current_kboard;
 204
 205   if (!NILP (kb->defining_kbd_macro))
 206     {
 207       if (kb->kbd_macro_ptr - kb->kbd_macro_buffer == kb->kbd_macro_bufsize)
 208         {
 209           int ptr_offset, end_offset, nbytes;
 210
 211           ptr_offset = kb->kbd_macro_ptr - kb->kbd_macro_buffer;
 212           end_offset = kb->kbd_macro_end - kb->kbd_macro_buffer;
 213           kb->kbd_macro_bufsize *= 2;
 214           nbytes = kb->kbd_macro_bufsize * sizeof *kb->kbd_macro_buffer;
 215           kb->kbd_macro_buffer
 216             = (Lisp_Object *) xrealloc (kb->kbd_macro_buffer, nbytes);
 217           kb->kbd_macro_ptr = kb->kbd_macro_buffer + ptr_offset;
 218           kb->kbd_macro_end = kb->kbd_macro_buffer + end_offset;
 219         }
 220
 221       *kb->kbd_macro_ptr++ = c;
 222     }
 223 }
 224
 225 /* Declare that all chars stored so far in the kbd macro being defined
 226  really belong to it.  This is done in between editor commands.  */
 227
 228 void
 229 finalize_kbd_macro_chars ()
 230 {
 231   current_kboard->kbd_macro_end = current_kboard->kbd_macro_ptr;
 232 }
 233
 234 DEFUN ("cancel-kbd-macro-events", Fcancel_kbd_macro_events,
 235        Scancel_kbd_macro_events, 0, 0, 0,
 236        doc: /* Cancel the events added to a keyboard macro for this command.  */)
 237      ()
 238 {
 239   current_kboard->kbd_macro_ptr = current_kboard->kbd_macro_end;
 240   return Qnil;
 241 }
 242
 243 DEFUN ("store-kbd-macro-event", Fstore_kbd_macro_event,
 244        Sstore_kbd_macro_event, 1, 1, 0,
 245        doc: /* Store EVENT into the keyboard macro being defined.  */)
 246      (event)
 247      Lisp_Object event;
 248 {
 249   store_kbd_macro_char (event);
 250   return Qnil;
 251 }
 252 \f
 253 DEFUN ("call-last-kbd-macro", Fcall_last_kbd_macro, Scall_last_kbd_macro,
 254        0, 2, "p",
 255        doc: /* Call the last keyboard macro that you defined with \\[start-kbd-macro].
 256
 257 A prefix argument serves as a repeat count.  Zero means repeat until error.
 258
 259 To make a macro permanent so you can call it even after
 260 defining others, use \\[name-last-kbd-macro].
 261
 262 In Lisp, optional second arg LOOPFUNC may be a function that is called prior to
 263 each iteration of the macro.  Iteration stops if LOOPFUNC returns nil.  */)
 264      (prefix, loopfunc)
 265      Lisp_Object prefix, loopfunc;
 266 {
 267   /* Don't interfere with recognition of the previous command
 268      from before this macro started.  */
 269   Vthis_command = current_kboard->Vlast_command;
 270   /* C-x z after the macro should repeat the macro.  */
 271   real_this_command = current_kboard->Vlast_kbd_macro;
 272
 273   if (! NILP (current_kboard->defining_kbd_macro))
 274     error ("Can't execute anonymous macro while defining one");
 275   else if (NILP (current_kboard->Vlast_kbd_macro))
 276     error ("No kbd macro has been defined");
 277   else
 278     Fexecute_kbd_macro (current_kboard->Vlast_kbd_macro, prefix, loopfunc);
 279
 280   /* command_loop_1 sets this to nil before it returns;
 281      get back the last command within the macro
 282      so that it can be last, again, after we return.  */
 283   Vthis_command = current_kboard->Vlast_command;
 284
 285   return Qnil;
 286 }
 287
 288 /* Restore Vexecuting_macro and executing_macro_index - called when
 289    the unwind-protect in Fexecute_kbd_macro gets invoked.  */
 290
 291 static Lisp_Object
 292 pop_kbd_macro (info)
 293      Lisp_Object info;
 294 {
 295   Lisp_Object tem;
 296   Vexecuting_macro = XCAR (info);
 297   tem = XCDR (info);
 298   executing_macro_index = XINT (XCAR (tem));
 299   real_this_command = XCDR (tem);
 300   Frun_hooks (1, &Qkbd_macro_termination_hook);
 301   return Qnil;
 302 }
 303
 304 DEFUN ("execute-kbd-macro", Fexecute_kbd_macro, Sexecute_kbd_macro, 1, 3, 0,
 305        doc: /* Execute MACRO as string of editor command characters.
 306 If MACRO is a symbol, its function definition is used.
 307 COUNT is a repeat count, or nil for once, or 0 for infinite loop.
 308
 309 Optional third arg LOOPFUNC may be a function that is called prior to
 310 each iteration of the macro.  Iteration stops if LOOPFUNC returns nil.  */)
 311      (macro, count, loopfunc)
 312      Lisp_Object macro, count, loopfunc;
 313 {
 314   Lisp_Object final;
 315   Lisp_Object tem;
 316   int pdlcount = SPECPDL_INDEX ();
 317   int repeat = 1;
 318   struct gcpro gcpro1, gcpro2;
 319   int success_count = 0;
 320
 321   executing_macro_iterations = 0;
 322
 323   if (!NILP (count))
 324     {
 325       count = Fprefix_numeric_value (count);
 326       repeat = XINT (count);
 327     }
 328
 329   final = indirect_function (macro);
 330   if (!STRINGP (final) && !VECTORP (final))
 331     error ("Keyboard macros must be strings or vectors");
 332
 333   tem = Fcons (Vexecuting_macro,
 334                Fcons (make_number (executing_macro_index),
 335                       real_this_command));
 336   record_unwind_protect (pop_kbd_macro, tem);
 337
 338   GCPRO2 (final, loopfunc);
 339   do
 340     {
 341       Vexecuting_macro = final;
 342       executing_macro = final;
 343       executing_macro_index = 0;
 344
 345       current_kboard->Vprefix_arg = Qnil;
 346
 347       if (!NILP (loopfunc))
 348         {
 349           Lisp_Object cont;
 350           cont = call0 (loopfunc);
 351           if (NILP (cont))
 352             break;
 353         }
 354
 355       command_loop_1 ();
 356
 357       executing_macro_iterations = ++success_count;
 358
 359       QUIT;
 360     }
 361   while (--repeat
 362          && (STRINGP (Vexecuting_macro) || VECTORP (Vexecuting_macro)));
 363
 364   executing_macro = Qnil;
 365
 366   real_this_command = Vexecuting_macro;
 367
 368   UNGCPRO;
 369   return unbind_to (pdlcount, Qnil);
 370 }
 371 \f
 372 void
 373 init_macros ()
 374 {
 375   Vexecuting_macro = Qnil;
 376   executing_macro = Qnil;
 377 }
 378
 379 void
 380 syms_of_macros ()
 381 {
 382   Qexecute_kbd_macro = intern ("execute-kbd-macro");
 383   staticpro (&Qexecute_kbd_macro);
 384   Qkbd_macro_termination_hook = intern ("kbd-macro-termination-hook");
 385   staticpro (&Qkbd_macro_termination_hook);
 386
 387   defsubr (&Sstart_kbd_macro);
 388   defsubr (&Send_kbd_macro);
 389   defsubr (&Scall_last_kbd_macro);
 390   defsubr (&Sexecute_kbd_macro);
 391   defsubr (&Scancel_kbd_macro_events);
 392   defsubr (&Sstore_kbd_macro_event);
 393
 394   DEFVAR_KBOARD ("defining-kbd-macro", defining_kbd_macro,
 395                  doc: /* Non-nil while a keyboard macro is being defined.  Don't set this!  */);
 396
 397   DEFVAR_LISP ("executing-macro", &Vexecuting_macro,
 398                doc: /* Currently executing keyboard macro (string or vector); nil if none executing.  */);
 399
 400   DEFVAR_INT ("executing-macro-index", &executing_macro_index,
 401               doc: /* Index in currently executing keyboard macro; undefined if none executing.  */);
 402
 403   DEFVAR_LISP_NOPRO ("executing-kbd-macro", &Vexecuting_macro,
 404                      doc: /* Currently executing keyboard macro (string or vector); nil if none executing.  */);
 405
 406   DEFVAR_KBOARD ("last-kbd-macro", Vlast_kbd_macro,
 407                  doc: /* Last kbd macro defined, as a string or vector; nil if none defined.  */);
 408 }