code.delx.au - gnu-emacs/blob - src/macros.c

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