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

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