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