code.delx.au - gnu-emacs/blob - 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
  97       /* Check the type of last-kbd-macro in case Lisp code changed it.  */
  98       if (!STRINGP (current_kboard->Vlast_kbd_macro)
  99           && !VECTORP (current_kboard->Vlast_kbd_macro))
 100         current_kboard->Vlast_kbd_macro
 101           = wrong_type_argument (Qarrayp, current_kboard->Vlast_kbd_macro);
 102
 103       len = XINT (Flength (current_kboard->Vlast_kbd_macro));
 104
 105       /* Copy last-kbd-macro into the buffer, in case the Lisp code
 106          has put another macro there.  */
 107       if (current_kboard->kbd_macro_bufsize < len + 30)
 108         {
 109           current_kboard->kbd_macro_bufsize = len + 30;
 110           current_kboard->kbd_macro_buffer
 111             = (Lisp_Object *)xrealloc (current_kboard->kbd_macro_buffer,
 112                                        (len + 30) * sizeof (Lisp_Object));
 113         }
 114       for (i = 0; i < len; i++)
 115         current_kboard->kbd_macro_buffer[i]
 116           = Faref (current_kboard->Vlast_kbd_macro, make_number (i));
 117
 118       current_kboard->kbd_macro_ptr = current_kboard->kbd_macro_buffer + len;
 119       current_kboard->kbd_macro_end = current_kboard->kbd_macro_ptr;
 120
 121       /* Re-execute the macro we are appending to,
 122          for consistency of behavior.  */
 123       if (NILP (no_exec))
 124         Fexecute_kbd_macro (current_kboard->Vlast_kbd_macro,
 125                             make_number (1), Qnil);
 126
 127       message ("Appending to kbd macro...");
 128     }
 129   current_kboard->defining_kbd_macro = Qt;
 130
 131   return Qnil;
 132 }
 133
 134 /* Finish defining the current keyboard macro.  */
 135
 136 void
 137 end_kbd_macro ()
 138 {
 139   current_kboard->defining_kbd_macro = Qnil;
 140   update_mode_lines++;
 141   current_kboard->Vlast_kbd_macro
 142     = make_event_array ((current_kboard->kbd_macro_end
 143                          - current_kboard->kbd_macro_buffer),
 144                         current_kboard->kbd_macro_buffer);
 145 }
 146
 147 DEFUN ("end-kbd-macro", Fend_kbd_macro, Send_kbd_macro, 0, 2, "p",
 148        doc: /* Finish defining a keyboard macro.
 149 The definition was started by \\[start-kbd-macro].
 150 The macro is now available for use via \\[call-last-kbd-macro],
 151 or it can be given a name with \\[name-last-kbd-macro] and then invoked
 152 under that name.
 153
 154 With numeric arg, repeat macro now that many times,
 155 counting the definition just completed as the first repetition.
 156 An argument of zero means repeat until error.
 157
 158 In Lisp, optional second arg LOOPFUNC may be a function that is called prior to
 159 each iteration of the macro.  Iteration stops if LOOPFUNC returns nil.  */)
 160      (repeat, loopfunc)
 161      Lisp_Object repeat, loopfunc;
 162 {
 163   if (NILP (current_kboard->defining_kbd_macro))
 164     error ("Not defining kbd macro");
 165
 166   if (NILP (repeat))
 167     XSETFASTINT (repeat, 1);
 168   else
 169     CHECK_NUMBER (repeat);
 170
 171   if (!NILP (current_kboard->defining_kbd_macro))
 172     {
 173       end_kbd_macro ();
 174       message ("Keyboard macro defined");
 175     }
 176
 177   if (XFASTINT (repeat) == 0)
 178     Fexecute_kbd_macro (current_kboard->Vlast_kbd_macro, repeat, loopfunc);
 179   else
 180     {
 181       XSETINT (repeat, XINT (repeat)-1);
 182       if (XINT (repeat) > 0)
 183         Fexecute_kbd_macro (current_kboard->Vlast_kbd_macro, repeat, loopfunc);
 184     }
 185   return Qnil;
 186 }
 187
 188 /* Store character c into kbd macro being defined */
 189
 190 void
 191 store_kbd_macro_char (c)
 192      Lisp_Object c;
 193 {
 194   struct kboard *kb = current_kboard;
 195
 196   if (!NILP (kb->defining_kbd_macro))
 197     {
 198       if (kb->kbd_macro_ptr - kb->kbd_macro_buffer == kb->kbd_macro_bufsize)
 199         {
 200           int 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           kb->kbd_macro_bufsize *= 2;
 205           nbytes = kb->kbd_macro_bufsize * sizeof *kb->kbd_macro_buffer;
 206           kb->kbd_macro_buffer
 207             = (Lisp_Object *) xrealloc (kb->kbd_macro_buffer, nbytes);
 208           kb->kbd_macro_ptr = kb->kbd_macro_buffer + ptr_offset;
 209           kb->kbd_macro_end = kb->kbd_macro_buffer + end_offset;
 210         }
 211
 212       *kb->kbd_macro_ptr++ = c;
 213     }
 214 }
 215
 216 /* Declare that all chars stored so far in the kbd macro being defined
 217  really belong to it.  This is done in between editor commands.  */
 218
 219 void
 220 finalize_kbd_macro_chars ()
 221 {
 222   current_kboard->kbd_macro_end = current_kboard->kbd_macro_ptr;
 223 }
 224
 225 DEFUN ("cancel-kbd-macro-events", Fcancel_kbd_macro_events,
 226        Scancel_kbd_macro_events, 0, 0, 0,
 227        doc: /* Cancel the events added to a keyboard macro for this command.  */)
 228      ()
 229 {
 230   current_kboard->kbd_macro_ptr = current_kboard->kbd_macro_end;
 231   return Qnil;
 232 }
 233
 234 DEFUN ("store-kbd-macro-event", Fstore_kbd_macro_event,
 235        Sstore_kbd_macro_event, 1, 1, 0,
 236        doc: /* Store EVENT into the keyboard macro being defined.  */)
 237      (event)
 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      (prefix, loopfunc)
 256      Lisp_Object prefix, loopfunc;
 257 {
 258   /* Don't interfere with recognition of the previous command
 259      from before this macro started.  */
 260   Vthis_command = current_kboard->Vlast_command;
 261   /* C-x z after the macro should repeat the macro.  */
 262   real_this_command = current_kboard->Vlast_kbd_macro;
 263
 264   if (! NILP (current_kboard->defining_kbd_macro))
 265     error ("Can't execute anonymous macro while defining one");
 266   else if (NILP (current_kboard->Vlast_kbd_macro))
 267     error ("No kbd macro has been defined");
 268   else
 269     Fexecute_kbd_macro (current_kboard->Vlast_kbd_macro, prefix, loopfunc);
 270
 271   /* command_loop_1 sets this to nil before it returns;
 272      get back the last command within the macro
 273      so that it can be last, again, after we return.  */
 274   Vthis_command = current_kboard->Vlast_command;
 275
 276   return Qnil;
 277 }
 278
 279 /* Restore Vexecuting_macro and executing_macro_index - called when
 280    the unwind-protect in Fexecute_kbd_macro gets invoked.  */
 281
 282 static Lisp_Object
 283 pop_kbd_macro (info)
 284      Lisp_Object info;
 285 {
 286   Lisp_Object tem;
 287   Vexecuting_macro = XCAR (info);
 288   tem = XCDR (info);
 289   executing_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      (macro, count, loopfunc)
 303      Lisp_Object macro, count, loopfunc;
 304 {
 305   Lisp_Object final;
 306   Lisp_Object tem;
 307   int pdlcount = SPECPDL_INDEX ();
 308   int repeat = 1;
 309   struct gcpro gcpro1, gcpro2;
 310   int success_count = 0;
 311
 312   executing_macro_iterations = 0;
 313
 314   if (!NILP (count))
 315     {
 316       count = Fprefix_numeric_value (count);
 317       repeat = XINT (count);
 318     }
 319
 320   final = indirect_function (macro);
 321   if (!STRINGP (final) && !VECTORP (final))
 322     error ("Keyboard macros must be strings or vectors");
 323
 324   tem = Fcons (Vexecuting_macro,
 325                Fcons (make_number (executing_macro_index),
 326                       real_this_command));
 327   record_unwind_protect (pop_kbd_macro, tem);
 328
 329   GCPRO2 (final, loopfunc);
 330   do
 331     {
 332       Vexecuting_macro = final;
 333       executing_macro = final;
 334       executing_macro_index = 0;
 335
 336       current_kboard->Vprefix_arg = Qnil;
 337
 338       if (!NILP (loopfunc))
 339         {
 340           Lisp_Object cont;
 341           cont = call0 (loopfunc);
 342           if (NILP (cont))
 343             break;
 344         }
 345
 346       command_loop_1 ();
 347
 348       executing_macro_iterations = ++success_count;
 349
 350       QUIT;
 351     }
 352   while (--repeat
 353          && (STRINGP (Vexecuting_macro) || VECTORP (Vexecuting_macro)));
 354
 355   executing_macro = Qnil;
 356
 357   real_this_command = Vexecuting_macro;
 358
 359   UNGCPRO;
 360   return unbind_to (pdlcount, Qnil);
 361 }
 362 \f
 363 void
 364 init_macros ()
 365 {
 366   Vexecuting_macro = Qnil;
 367   executing_macro = Qnil;
 368 }
 369
 370 void
 371 syms_of_macros ()
 372 {
 373   Qexecute_kbd_macro = intern ("execute-kbd-macro");
 374   staticpro (&Qexecute_kbd_macro);
 375   Qkbd_macro_termination_hook = intern ("kbd-macro-termination-hook");
 376   staticpro (&Qkbd_macro_termination_hook);
 377
 378   defsubr (&Sstart_kbd_macro);
 379   defsubr (&Send_kbd_macro);
 380   defsubr (&Scall_last_kbd_macro);
 381   defsubr (&Sexecute_kbd_macro);
 382   defsubr (&Scancel_kbd_macro_events);
 383   defsubr (&Sstore_kbd_macro_event);
 384
 385   DEFVAR_KBOARD ("defining-kbd-macro", defining_kbd_macro,
 386                  doc: /* Non-nil while a keyboard macro is being defined.  Don't set this!  */);
 387
 388   DEFVAR_LISP ("executing-macro", &Vexecuting_macro,
 389                doc: /* Currently executing keyboard macro (string or vector); nil if none executing.  */);
 390
 391   DEFVAR_INT ("executing-macro-index", &executing_macro_index,
 392               doc: /* Index in currently executing keyboard macro; undefined if none executing.  */);
 393
 394   DEFVAR_LISP_NOPRO ("executing-kbd-macro", &Vexecuting_macro,
 395                      doc: /* Currently executing keyboard macro (string or vector); nil if none executing.  */);
 396
 397   DEFVAR_KBOARD ("last-kbd-macro", Vlast_kbd_macro,
 398                  doc: /* Last kbd macro defined, as a string or vector; nil if none defined.  */);
 399 }