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