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