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

   1 /* Keyboard macros.
   2    Copyright (C) 1985, 1986, 1993 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;
  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 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 Lisp_Object Fexecute_kbd_macro ();
  55 \f
  56 DEFUN ("start-kbd-macro", Fstart_kbd_macro, Sstart_kbd_macro, 1, 1, "P",
  57   "Record subsequent keyboard input, defining a keyboard macro.\n\
  58 The commands are recorded even as they are executed.\n\
  59 Use \\[end-kbd-macro] to finish recording and make the macro available.\n\
  60 Use \\[name-last-kbd-macro] to give it a permanent name.\n\
  61 Non-nil arg (prefix arg) means append to last macro defined;\n\
  62  This begins by re-executing that macro as if you typed it again.")
  63   (append)
  64      Lisp_Object append;
  65 {
  66   if (!NILP (current_kboard->defining_kbd_macro))
  67     error ("Already defining kbd macro");
  68
  69   if (!current_kboard->kbd_macro_buffer)
  70     {
  71       current_kboard->kbd_macro_bufsize = 30;
  72       current_kboard->kbd_macro_buffer
  73         = (Lisp_Object *)xmalloc (30 * sizeof (Lisp_Object));
  74     }
  75   update_mode_lines++;
  76   if (NILP (append))
  77     {
  78       if (current_kboard->kbd_macro_bufsize > 200)
  79         {
  80           current_kboard->kbd_macro_bufsize = 30;
  81           current_kboard->kbd_macro_buffer
  82             = (Lisp_Object *)xrealloc (current_kboard->kbd_macro_buffer,
  83                                        30 * sizeof (Lisp_Object));
  84         }
  85       current_kboard->kbd_macro_ptr = current_kboard->kbd_macro_buffer;
  86       current_kboard->kbd_macro_end = current_kboard->kbd_macro_buffer;
  87       message ("Defining kbd macro...");
  88     }
  89   else
  90     {
  91       message ("Appending to kbd macro...");
  92       current_kboard->kbd_macro_ptr = current_kboard->kbd_macro_end;
  93       Fexecute_kbd_macro (current_kboard->Vlast_kbd_macro,
  94                           make_number (1));
  95     }
  96   current_kboard->defining_kbd_macro = Qt;
  97
  98   return Qnil;
  99 }
 100
 101 DEFUN ("end-kbd-macro", Fend_kbd_macro, Send_kbd_macro, 0, 1, "p",
 102   "Finish defining a keyboard macro.\n\
 103 The definition was started by \\[start-kbd-macro].\n\
 104 The macro is now available for use via \\[call-last-kbd-macro],\n\
 105 or it can be given a name with \\[name-last-kbd-macro] and then invoked\n\
 106 under that name.\n\
 107 \n\
 108 With numeric arg, repeat macro now that many times,\n\
 109 counting the definition just completed as the first repetition.\n\
 110 An argument of zero means repeat until error.")
 111   (repeat)
 112      Lisp_Object repeat;
 113 {
 114   if (NILP (current_kboard->defining_kbd_macro))
 115     error ("Not defining kbd macro");
 116
 117   if (NILP (repeat))
 118     XSETFASTINT (repeat, 1);
 119   else
 120     CHECK_NUMBER (repeat, 0);
 121
 122   if (!NILP (current_kboard->defining_kbd_macro))
 123     {
 124       current_kboard->defining_kbd_macro = Qnil;
 125       update_mode_lines++;
 126       current_kboard->Vlast_kbd_macro
 127         = make_event_array ((current_kboard->kbd_macro_end
 128                              - current_kboard->kbd_macro_buffer),
 129                             current_kboard->kbd_macro_buffer);
 130       message ("Keyboard macro defined");
 131     }
 132
 133   if (XFASTINT (repeat) == 0)
 134     Fexecute_kbd_macro (current_kboard->Vlast_kbd_macro, repeat);
 135   else
 136     {
 137       XSETINT (repeat, XINT (repeat)-1);
 138       if (XINT (repeat) > 0)
 139         Fexecute_kbd_macro (current_kboard->Vlast_kbd_macro, repeat);
 140     }
 141   return Qnil;
 142 }
 143
 144 /* Store character c into kbd macro being defined */
 145
 146 void
 147 store_kbd_macro_char (c)
 148      Lisp_Object c;
 149 {
 150   if (!NILP (current_kboard->defining_kbd_macro))
 151     {
 152       if ((current_kboard->kbd_macro_ptr
 153            - current_kboard->kbd_macro_buffer)
 154           == current_kboard->kbd_macro_bufsize)
 155         {
 156           register Lisp_Object *new;
 157           current_kboard->kbd_macro_bufsize *= 2;
 158           new = (Lisp_Object *)xrealloc (current_kboard->kbd_macro_buffer,
 159                                          (current_kboard->kbd_macro_bufsize
 160                                           * sizeof (Lisp_Object)));
 161           current_kboard->kbd_macro_ptr
 162             += new - current_kboard->kbd_macro_buffer;
 163           current_kboard->kbd_macro_end
 164             += new - current_kboard->kbd_macro_buffer;
 165           current_kboard->kbd_macro_buffer = new;
 166         }
 167       *current_kboard->kbd_macro_ptr++ = c;
 168     }
 169 }
 170
 171 /* Declare that all chars stored so far in the kbd macro being defined
 172  really belong to it.  This is done in between editor commands.  */
 173
 174 void
 175 finalize_kbd_macro_chars ()
 176 {
 177   current_kboard->kbd_macro_end = current_kboard->kbd_macro_ptr;
 178 }
 179
 180 DEFUN ("cancel-kbd-macro-events", Fcancel_kbd_macro_events,
 181        Scancel_kbd_macro_events, 0, 0, 0,
 182   "Cancel the events added to a keyboard macro for this command.")
 183   ()
 184 {
 185   current_kboard->kbd_macro_ptr = current_kboard->kbd_macro_end;
 186 }
 187
 188 DEFUN ("store-kbd-macro-event", Fstore_kbd_macro_event,
 189        Sstore_kbd_macro_event, 1, 1, 0,
 190   "Store EVENT into the keyboard macro being defined.")
 191   (event)
 192      Lisp_Object event;
 193 {
 194   store_kbd_macro_char (event);
 195   return Qnil;
 196 }
 197 \f
 198 DEFUN ("call-last-kbd-macro", Fcall_last_kbd_macro, Scall_last_kbd_macro,
 199   0, 1, "p",
 200   "Call the last keyboard macro that you defined with \\[start-kbd-macro].\n\
 201 \n\
 202 A prefix argument serves as a repeat count.  Zero means repeat until error.\n\
 203 \n\
 204 To make a macro permanent so you can call it even after\n\
 205 defining others, use \\[name-last-kbd-macro].")
 206   (prefix)
 207      Lisp_Object prefix;
 208 {
 209   /* Don't interfere with recognition of the previous command
 210      from before this macro started.  */
 211   Vthis_command = current_kboard->Vlast_command;
 212
 213   if (! NILP (current_kboard->defining_kbd_macro))
 214     error ("Can't execute anonymous macro while defining one");
 215   else if (NILP (current_kboard->Vlast_kbd_macro))
 216     error ("No kbd macro has been defined");
 217   else
 218     Fexecute_kbd_macro (current_kboard->Vlast_kbd_macro, prefix);
 219
 220   /* command_loop_1 sets this to nil before it returns;
 221      get back the last command within the macro
 222      so that it can be last, again, after we return.  */
 223   Vthis_command = current_kboard->Vlast_command;
 224
 225   return Qnil;
 226 }
 227
 228 /* Restore Vexecuting_macro and executing_macro_index - called when
 229    the unwind-protect in Fexecute_kbd_macro gets invoked.  */
 230
 231 static Lisp_Object
 232 pop_kbd_macro (info)
 233      Lisp_Object info;
 234 {
 235   Lisp_Object tem;
 236   Vexecuting_macro = Fcar (info);
 237   tem = Fcdr (info);
 238   executing_macro_index = XINT (tem);
 239   return Qnil;
 240 }
 241
 242 DEFUN ("execute-kbd-macro", Fexecute_kbd_macro, Sexecute_kbd_macro, 1, 2, 0,
 243   "Execute MACRO as string of editor command characters.\n\
 244 If MACRO is a symbol, its function definition is used.\n\
 245 COUNT is a repeat count, or nil for once, or 0 for infinite loop.")
 246   (macro, count)
 247      Lisp_Object macro, count;
 248 {
 249   Lisp_Object final;
 250   Lisp_Object tem;
 251   int pdlcount = specpdl_ptr - specpdl;
 252   int repeat = 1;
 253   struct gcpro gcpro1;
 254   int success_count = 0;
 255
 256   if (!NILP (count))
 257     {
 258       count = Fprefix_numeric_value (count);
 259       repeat = XINT (count);
 260     }
 261
 262   final = indirect_function (macro);
 263   if (!STRINGP (final) && !VECTORP (final))
 264     error ("Keyboard macros must be strings or vectors");
 265
 266   XSETFASTINT (tem, executing_macro_index);
 267   tem = Fcons (Vexecuting_macro, tem);
 268   record_unwind_protect (pop_kbd_macro, tem);
 269
 270   GCPRO1 (final);
 271   do
 272     {
 273       Vexecuting_macro = final;
 274       executing_macro = final;
 275       executing_macro_index = 0;
 276
 277       current_kboard->Vprefix_arg = Qnil;
 278       command_loop_1 ();
 279
 280       executing_macro_iterations = ++success_count;
 281
 282       QUIT;
 283     }
 284   while (--repeat
 285          && (STRINGP (Vexecuting_macro) || VECTORP (Vexecuting_macro)));
 286
 287   executing_macro = Qnil;
 288
 289   UNGCPRO;
 290   return unbind_to (pdlcount, Qnil);
 291 }
 292 \f
 293 void
 294 init_macros ()
 295 {
 296   Vexecuting_macro = Qnil;
 297   executing_macro = Qnil;
 298 }
 299
 300 void
 301 syms_of_macros ()
 302 {
 303   Qexecute_kbd_macro = intern ("execute-kbd-macro");
 304   staticpro (&Qexecute_kbd_macro);
 305
 306   defsubr (&Sstart_kbd_macro);
 307   defsubr (&Send_kbd_macro);
 308   defsubr (&Scall_last_kbd_macro);
 309   defsubr (&Sexecute_kbd_macro);
 310   defsubr (&Scancel_kbd_macro_events);
 311   defsubr (&Sstore_kbd_macro_event);
 312
 313   DEFVAR_KBOARD ("defining-kbd-macro", defining_kbd_macro,
 314     "Non-nil while a keyboard macro is being defined.  Don't set this!");
 315
 316   DEFVAR_LISP ("executing-macro", &Vexecuting_macro,
 317     "Currently executing keyboard macro (string or vector); nil if none executing.");
 318
 319   DEFVAR_LISP_NOPRO ("executing-kbd-macro", &Vexecuting_macro,
 320     "Currently executing keyboard macro (string or vector); nil if none executing.");
 321
 322   DEFVAR_KBOARD ("last-kbd-macro", Vlast_kbd_macro,
 323     "Last kbd macro defined, as a string or vector; nil if none defined.");
 324 }
 325
 326 void
 327 keys_of_macros ()
 328 {
 329   initial_define_key (control_x_map, ('e'), "call-last-kbd-macro");
 330   initial_define_key (control_x_map, ('('), "start-kbd-macro");
 331   initial_define_key (control_x_map, (')'), "end-kbd-macro");
 332 }