(Fdo_auto_save): Update/simplify sit_for calls.
[bpt/emacs.git] / src / callint.c
CommitLineData
ec28a64d 1/* Call a Lisp function interactively.
0b5538bd 2 Copyright (C) 1985, 1986, 1993, 1994, 1995, 1997, 2000, 2002, 2003,
aaef169d 3 2004, 2005, 2006 Free Software Foundation, Inc.
ec28a64d
MB
4
5This file is part of GNU Emacs.
6
7GNU Emacs is free software; you can redistribute it and/or modify
8it under the terms of the GNU General Public License as published by
dbc4e1c1 9the Free Software Foundation; either version 2, or (at your option)
ec28a64d
MB
10any later version.
11
12GNU Emacs is distributed in the hope that it will be useful,
13but WITHOUT ANY WARRANTY; without even the implied warranty of
14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15GNU General Public License for more details.
16
17You should have received a copy of the GNU General Public License
18along with GNU Emacs; see the file COPYING. If not, write to
4fc5845f
LK
19the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
20Boston, MA 02110-1301, USA. */
ec28a64d
MB
21
22
18160b98 23#include <config.h>
fdb82f93 24
ec28a64d
MB
25#include "lisp.h"
26#include "buffer.h"
27#include "commands.h"
760cbdd3 28#include "keyboard.h"
ec28a64d 29#include "window.h"
8feddab4 30#include "keymap.h"
ec28a64d 31
8892f40b
GM
32#ifdef HAVE_INDEX
33extern char *index P_ ((const char *, int));
a847af86 34#endif
ec28a64d 35
c631c234 36extern Lisp_Object Qcursor_in_echo_area;
93ed5f9d 37extern Lisp_Object Qfile_directory_p;
c631c234 38
1e0c5826 39Lisp_Object Vcurrent_prefix_arg, Qminus, Qplus;
ec28a64d
MB
40Lisp_Object Qcall_interactively;
41Lisp_Object Vcommand_history;
42
225c2157 43extern Lisp_Object Vhistory_length;
0605dd79 44extern Lisp_Object Vthis_original_command, real_this_command;
225c2157 45
ec28a64d 46Lisp_Object Vcommand_debug_status, Qcommand_debug_status;
52614803 47Lisp_Object Qenable_recursive_minibuffers;
ec28a64d 48
9f315aeb
RS
49/* Non-nil means treat the mark as active
50 even if mark_active is 0. */
51Lisp_Object Vmark_even_if_inactive;
52
ef2515c0
RS
53Lisp_Object Vmouse_leave_buffer_hook, Qmouse_leave_buffer_hook;
54
120d0a23 55Lisp_Object Qlist, Qlet, Qletx, Qsave_excursion, Qprogn, Qif, Qwhen;
824977b6
RS
56static Lisp_Object preserved_fns;
57
58/* Marker used within call-interactively to refer to point. */
59static Lisp_Object point_marker;
03e130d5 60
df31bc64
RS
61/* Buffer for the prompt text used in Fcall_interactively. */
62static char *callint_message;
63
64/* Allocated length of that buffer. */
65static int callint_message_size;
1cf9cfc6 66
ec28a64d
MB
67/* ARGSUSED */
68DEFUN ("interactive", Finteractive, Sinteractive, 0, UNEVALLED, 0,
fdb82f93
PJ
69 doc: /* Specify a way of parsing arguments for interactive use of a function.
70For example, write
71 (defun foo (arg) "Doc string" (interactive "p") ...use arg...)
72to make ARG be the prefix argument when `foo' is called as a command.
73The "call" to `interactive' is actually a declaration rather than a function;
74 it tells `call-interactively' how to read arguments
75 to pass to the function.
76When actually called, `interactive' just returns nil.
77
78The argument of `interactive' is usually a string containing a code letter
79 followed by a prompt. (Some code letters do not use I/O to get
80 the argument and do not need prompts.) To prompt for multiple arguments,
81 give a code letter, its prompt, a newline, and another code letter, etc.
82 Prompts are passed to format, and may use % escapes to print the
83 arguments that have already been read.
84If the argument is not a string, it is evaluated to get a list of
85 arguments to pass to the function.
86Just `(interactive)' means pass no args when calling interactively.
87
88Code letters available are:
89a -- Function name: symbol with a function definition.
90b -- Name of existing buffer.
91B -- Name of buffer, possibly nonexistent.
92c -- Character (no input method is used).
93C -- Command name: symbol with interactive function definition.
94d -- Value of point as number. Does not do I/O.
95D -- Directory name.
96e -- Parametrized event (i.e., one that's a list) that invoked this command.
97 If used more than once, the Nth `e' returns the Nth parameterized event.
98 This skips events that are integers or symbols.
99f -- Existing file name.
100F -- Possibly nonexistent file name.
75f9fbe8 101G -- Possibly nonexistent file name, defaulting to just directory name.
fdb82f93
PJ
102i -- Ignored, i.e. always nil. Does not do I/O.
103k -- Key sequence (downcase the last event if needed to get a definition).
104K -- Key sequence to be redefined (do not downcase the last event).
105m -- Value of mark as number. Does not do I/O.
106M -- Any string. Inherits the current input method.
107n -- Number read using minibuffer.
108N -- Raw prefix arg, or if none, do like code `n'.
109p -- Prefix arg converted to number. Does not do I/O.
110P -- Prefix arg in raw form. Does not do I/O.
111r -- Region: point and mark as 2 numeric args, smallest first. Does no I/O.
112s -- Any string. Does not inherit the current input method.
113S -- Any symbol.
39900c4e 114U -- Mouse up event discarded by a previous k or K argument.
fdb82f93
PJ
115v -- Variable name: symbol that is user-variable-p.
116x -- Lisp expression read but not evaluated.
117X -- Lisp expression read and evaluated.
118z -- Coding system.
119Z -- Coding system, nil if no prefix arg.
120In addition, if the string begins with `*'
121 then an error is signaled if the buffer is read-only.
122 This happens before reading any arguments.
123If the string begins with `@', then Emacs searches the key sequence
124 which invoked the command for its first mouse click (or any other
125 event which specifies a window), and selects that window before
126 reading any arguments. You may use both `@' and `*'; they are
84cc45a7
PJ
127 processed in the order that they appear.
128usage: (interactive ARGS) */)
fdb82f93 129 (args)
ec28a64d
MB
130 Lisp_Object args;
131{
132 return Qnil;
133}
134
135/* Quotify EXP: if EXP is constant, return it.
136 If EXP is not constant, return (quote EXP). */
137Lisp_Object
138quotify_arg (exp)
139 register Lisp_Object exp;
140{
6e54b3de 141 if (!INTEGERP (exp) && !STRINGP (exp)
265a9e55 142 && !NILP (exp) && !EQ (exp, Qt))
ec28a64d
MB
143 return Fcons (Qquote, Fcons (exp, Qnil));
144
145 return exp;
146}
147
148/* Modify EXP by quotifying each element (except the first). */
149Lisp_Object
150quotify_args (exp)
151 Lisp_Object exp;
152{
153 register Lisp_Object tail;
7539e11f
KR
154 Lisp_Object next;
155 for (tail = exp; CONSP (tail); tail = next)
ec28a64d 156 {
7539e11f 157 next = XCDR (tail);
f3fbd155 158 XSETCAR (tail, quotify_arg (XCAR (tail)));
ec28a64d
MB
159 }
160 return exp;
161}
162
163char *callint_argfuns[]
164 = {"", "point", "mark", "region-beginning", "region-end"};
165
166static void
f203cf07
RS
167check_mark (for_region)
168 int for_region;
ec28a64d 169{
86c1cf23
KH
170 Lisp_Object tem;
171 tem = Fmarker_buffer (current_buffer->mark);
265a9e55 172 if (NILP (tem) || (XBUFFER (tem) != current_buffer))
f203cf07
RS
173 error (for_region ? "The mark is not set now, so there is no region"
174 : "The mark is not set now");
6497d2d8
RM
175 if (!NILP (Vtransient_mark_mode) && NILP (Vmark_even_if_inactive)
176 && NILP (current_buffer->mark_active))
177 Fsignal (Qmark_inactive, Qnil);
ec28a64d
MB
178}
179
64ea14d3
RS
180/* If the list of args INPUT was produced with an explicit call to
181 `list', look for elements that were computed with
182 (region-beginning) or (region-end), and put those expressions into
183 VALUES instead of the present values.
184
185 This function doesn't return a value because it modifies elements
186 of VALUES to do its job. */
187
d1135afc
JB
188static void
189fix_command (input, values)
190 Lisp_Object input, values;
191{
d1135afc
JB
192 if (CONSP (input))
193 {
194 Lisp_Object car;
195
196 car = XCAR (input);
197 /* Skip through certain special forms. */
198 while (EQ (car, Qlet) || EQ (car, Qletx)
199 || EQ (car, Qsave_excursion)
200 || EQ (car, Qprogn))
201 {
202 while (CONSP (XCDR (input)))
203 input = XCDR (input);
204 input = XCAR (input);
205 if (!CONSP (input))
206 break;
207 car = XCAR (input);
208 }
209 if (EQ (car, Qlist))
210 {
211 Lisp_Object intail, valtail;
212 for (intail = Fcdr (input), valtail = values;
213 CONSP (valtail);
5dc05618 214 intail = Fcdr (intail), valtail = XCDR (valtail))
d1135afc
JB
215 {
216 Lisp_Object elt;
217 elt = Fcar (intail);
218 if (CONSP (elt))
219 {
220 Lisp_Object presflag, carelt;
221 carelt = Fcar (elt);
222 /* If it is (if X Y), look at Y. */
223 if (EQ (carelt, Qif)
224 && EQ (Fnthcdr (make_number (3), elt), Qnil))
225 elt = Fnth (make_number (2), elt);
226 /* If it is (when ... Y), look at Y. */
227 else if (EQ (carelt, Qwhen))
228 {
229 while (CONSP (XCDR (elt)))
230 elt = XCDR (elt);
231 elt = Fcar (elt);
232 }
233
234 /* If the function call we're looking at
235 is a special preserved one, copy the
236 whole expression for this argument. */
237 if (CONSP (elt))
238 {
239 presflag = Fmemq (Fcar (elt), preserved_fns);
240 if (!NILP (presflag))
241 Fsetcar (valtail, Fcar (intail));
242 }
243 }
244 }
245 }
246 }
247}
ec28a64d 248
d455db8e 249DEFUN ("call-interactively", Fcall_interactively, Scall_interactively, 1, 3, 0,
fdb82f93
PJ
250 doc: /* Call FUNCTION, reading args according to its interactive calling specs.
251Return the value FUNCTION returns.
252The function contains a specification of how to do the argument reading.
253In the case of user-defined functions, this is specified by placing a call
254to the function `interactive' at the top level of the function body.
255See `interactive'.
256
257Optional second arg RECORD-FLAG non-nil
258means unconditionally put this command in the command-history.
259Otherwise, this is done only if an arg is read using the minibuffer.
260Optional third arg KEYS, if given, specifies the sequence of events to
5581edf5
LT
261supply if the command inquires which events were used to invoke it.
262If KEYS is omitted or nil, the return value of `this-command-keys' is used. */)
fdb82f93 263 (function, record_flag, keys)
7868a977 264 Lisp_Object function, record_flag, keys;
ec28a64d
MB
265{
266 Lisp_Object *args, *visargs;
267 unsigned char **argstrings;
268 Lisp_Object fun;
ec28a64d 269 Lisp_Object specs;
079e479f 270 Lisp_Object filter_specs;
ec28a64d 271 Lisp_Object teml;
39900c4e 272 Lisp_Object up_event;
52614803 273 Lisp_Object enable;
aed13378 274 int speccount = SPECPDL_INDEX ();
ec28a64d 275
bc78232c
JB
276 /* The index of the next element of this_command_keys to examine for
277 the 'e' interactive code. */
dbc4e1c1 278 int next_event;
bc78232c 279
ec28a64d
MB
280 Lisp_Object prefix_arg;
281 unsigned char *string;
282 unsigned char *tem;
63007de2
JB
283
284 /* If varies[i] > 0, the i'th argument shouldn't just have its value
285 in this call quoted in the command history. It should be
286 recorded as a call to the function named callint_argfuns[varies[i]]. */
ec28a64d 287 int *varies;
63007de2 288
ec28a64d
MB
289 register int i, j;
290 int count, foo;
ec28a64d
MB
291 char prompt1[100];
292 char *tem1;
293 int arg_from_tty = 0;
39900c4e 294 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
d455db8e 295 int key_count;
09c886dc 296 int record_then_fail = 0;
d455db8e 297
0605dd79
RS
298 Lisp_Object save_this_command, save_last_command;
299 Lisp_Object save_this_original_command, save_real_this_command;
300
301 save_this_command = Vthis_command;
302 save_this_original_command = Vthis_original_command;
303 save_real_this_command = real_this_command;
304 save_last_command = current_kboard->Vlast_command;
305
d455db8e
RS
306 if (NILP (keys))
307 keys = this_command_keys, key_count = this_command_key_count;
308 else
309 {
b7826503 310 CHECK_VECTOR (keys);
d455db8e
RS
311 key_count = XVECTOR (keys)->size;
312 }
ec28a64d 313
e5d77022 314 /* Save this now, since use of minibuffer will clobber it. */
8c917bf2 315 prefix_arg = Vcurrent_prefix_arg;
ec28a64d 316
46947372 317 retry:
ec28a64d 318
6e54b3de 319 if (SYMBOLP (function))
afa4c0f3 320 enable = Fget (function, Qenable_recursive_minibuffers);
4f895918
GM
321 else
322 enable = Qnil;
52614803 323
ffd56f97 324 fun = indirect_function (function);
ec28a64d
MB
325
326 specs = Qnil;
327 string = 0;
079e479f
RS
328 /* The idea of FILTER_SPECS is to provide away to
329 specify how to represent the arguments in command history.
330 The feature is not fully implemented. */
331 filter_specs = Qnil;
ec28a64d 332
39900c4e
KS
333 /* If k or K discard an up-event, save it here so it can be retrieved with U */
334 up_event = Qnil;
335
ec28a64d
MB
336 /* Decode the kind of function. Either handle it and return,
337 or go to `lose' if not interactive, or go to `retry'
338 to specify a different function, or set either STRING or SPECS. */
339
6e54b3de 340 if (SUBRP (fun))
ec28a64d
MB
341 {
342 string = (unsigned char *) XSUBR (fun)->prompt;
343 if (!string)
344 {
345 lose:
b37902c8 346 function = wrong_type_argument (Qcommandp, function);
ec28a64d
MB
347 goto retry;
348 }
ec28a64d 349 }
6e54b3de 350 else if (COMPILEDP (fun))
ec28a64d 351 {
f9b4aacf 352 if ((XVECTOR (fun)->size & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_INTERACTIVE)
ec28a64d
MB
353 goto lose;
354 specs = XVECTOR (fun)->contents[COMPILED_INTERACTIVE];
355 }
1e0b36be 356 else
ec28a64d 357 {
1e0b36be 358 Lisp_Object form;
ec28a64d 359 GCPRO2 (function, prefix_arg);
f817f028 360 form = Finteractive_form (function);
ec28a64d 361 UNGCPRO;
1e0b36be
SM
362 if (CONSP (form))
363 specs = filter_specs = Fcar (XCDR (form));
364 else
ec28a64d 365 goto lose;
ec28a64d 366 }
ec28a64d 367
09c886dc 368 /* If either SPECS or STRING is set to a string, use it. */
6e54b3de 369 if (STRINGP (specs))
46947372
JB
370 {
371 /* Make a copy of string so that if a GC relocates specs,
372 `string' will still be valid. */
d5db4077
KR
373 string = (unsigned char *) alloca (SBYTES (specs) + 1);
374 bcopy (SDATA (specs), string,
375 SBYTES (specs) + 1);
46947372 376 }
ec28a64d
MB
377 else if (string == 0)
378 {
03e130d5 379 Lisp_Object input;
91a6ba78 380 i = num_input_events;
03e130d5
RS
381 input = specs;
382 /* Compute the arg values using the user's expression. */
079e479f 383 GCPRO2 (input, filter_specs);
6bc1abf2 384 specs = Feval (specs);
079e479f 385 UNGCPRO;
91a6ba78 386 if (i != num_input_events || !NILP (record_flag))
03e130d5
RS
387 {
388 /* We should record this command on the command history. */
f1321dc3 389 Lisp_Object values;
03e130d5
RS
390 /* Make a copy of the list of values, for the command history,
391 and turn them into things we can eval. */
392 values = quotify_args (Fcopy_sequence (specs));
120d0a23 393 fix_command (input, values);
03e130d5
RS
394 Vcommand_history
395 = Fcons (Fcons (function, values), Vcommand_history);
225c2157
RS
396
397 /* Don't keep command history around forever. */
b9f0b172 398 if (INTEGERP (Vhistory_length) && XINT (Vhistory_length) > 0)
225c2157
RS
399 {
400 teml = Fnthcdr (Vhistory_length, Vcommand_history);
401 if (CONSP (teml))
f3fbd155 402 XSETCDR (teml, Qnil);
225c2157 403 }
03e130d5 404 }
0605dd79
RS
405
406 Vthis_command = save_this_command;
407 Vthis_original_command = save_this_original_command;
408 real_this_command= save_real_this_command;
409 current_kboard->Vlast_command = save_last_command;
410
652e2240 411 single_kboard_state ();
ec28a64d
MB
412 return apply1 (function, specs);
413 }
414
415 /* Here if function specifies a string to control parsing the defaults */
416
dbc4e1c1 417 /* Set next_event to point to the first event with parameters. */
d455db8e
RS
418 for (next_event = 0; next_event < key_count; next_event++)
419 if (EVENT_HAS_PARAMETERS (XVECTOR (keys)->contents[next_event]))
dbc4e1c1 420 break;
09c886dc 421
42bb2790 422 /* Handle special starting chars `*' and `@'. Also `-'. */
e92d107b 423 /* Note that `+' is reserved for user extensions. */
ec28a64d
MB
424 while (1)
425 {
fb775602 426 if (*string == '+')
e92d107b
RS
427 error ("`+' is not used in `interactive' for ordinary commands");
428 else if (*string == '*')
ec28a64d
MB
429 {
430 string++;
265a9e55 431 if (!NILP (current_buffer->read_only))
09c886dc
RS
432 {
433 if (!NILP (record_flag))
434 {
435 unsigned char *p = string;
436 while (*p)
437 {
438 if (! (*p == 'r' || *p == 'p' || *p == 'P'
439 || *p == '\n'))
440 Fbarf_if_buffer_read_only ();
441 p++;
442 }
443 record_then_fail = 1;
444 }
445 else
446 Fbarf_if_buffer_read_only ();
447 }
ec28a64d 448 }
42bb2790
RS
449 /* Ignore this for semi-compatibility with Lucid. */
450 else if (*string == '-')
451 string++;
ec28a64d
MB
452 else if (*string == '@')
453 {
c9aa6a41 454 Lisp_Object event, tem;
dbc4e1c1 455
170d3006
AS
456 event = (next_event < key_count
457 ? XVECTOR (keys)->contents[next_event]
458 : Qnil);
dbc4e1c1 459 if (EVENT_HAS_PARAMETERS (event)
c9aa6a41
RS
460 && (tem = XCDR (event), CONSP (tem))
461 && (tem = XCAR (tem), CONSP (tem))
462 && (tem = XCAR (tem), WINDOWP (tem)))
d1fa2e8a 463 {
c9aa6a41
RS
464 if (MINI_WINDOW_P (XWINDOW (tem))
465 && ! (minibuf_level > 0 && EQ (tem, minibuf_window)))
d1fa2e8a 466 error ("Attempt to select inactive minibuffer window");
ef2515c0
RS
467
468 /* If the current buffer wants to clean up, let it. */
469 if (!NILP (Vmouse_leave_buffer_hook))
470 call1 (Vrun_hooks, Qmouse_leave_buffer_hook);
471
c9aa6a41 472 Fselect_window (tem, Qnil);
d1fa2e8a 473 }
ec28a64d 474 string++;
ec28a64d
MB
475 }
476 else break;
477 }
478
479 /* Count the number of arguments the interactive spec would have
480 us give to the function. */
481 tem = string;
482 for (j = 0; *tem; j++)
483 {
484 /* 'r' specifications ("point and mark as 2 numeric args")
485 produce *two* arguments. */
486 if (*tem == 'r') j++;
487 tem = (unsigned char *) index (tem, '\n');
488 if (tem)
489 tem++;
490 else
491 tem = (unsigned char *) "";
492 }
6bc1abf2 493 count = j;
ec28a64d
MB
494
495 args = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object));
496 visargs = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object));
497 argstrings = (unsigned char **) alloca ((count + 1) * sizeof (char *));
498 varies = (int *) alloca ((count + 1) * sizeof (int));
499
500 for (i = 0; i < (count + 1); i++)
501 {
502 args[i] = Qnil;
503 visargs[i] = Qnil;
504 varies[i] = 0;
505 }
506
39900c4e 507 GCPRO5 (prefix_arg, function, *args, *visargs, up_event);
ec28a64d
MB
508 gcpro3.nvars = (count + 1);
509 gcpro4.nvars = (count + 1);
510
52614803
RS
511 if (!NILP (enable))
512 specbind (Qenable_recursive_minibuffers, Qt);
513
ec28a64d 514 tem = string;
6bc1abf2 515 for (i = 1; *tem; i++)
ec28a64d
MB
516 {
517 strncpy (prompt1, tem + 1, sizeof prompt1 - 1);
518 prompt1[sizeof prompt1 - 1] = 0;
a847af86 519 tem1 = (char *) index (prompt1, '\n');
ec28a64d
MB
520 if (tem1) *tem1 = 0;
521 /* Fill argstrings with a vector of C strings
522 corresponding to the Lisp strings in visargs. */
523 for (j = 1; j < i; j++)
524 argstrings[j]
dc330139
RS
525 = (EQ (visargs[j], Qnil)
526 ? (unsigned char *) ""
d5db4077 527 : SDATA (visargs[j]));
ec28a64d 528
df31bc64
RS
529 /* Process the format-string in prompt1, putting the output
530 into callint_message. Make callint_message bigger if necessary.
531 We don't use a buffer on the stack, because the contents
532 need to stay stable for a while. */
533 while (1)
534 {
535 int nchars = doprnt (callint_message, callint_message_size,
536 prompt1, (char *)0,
dc330139 537 j - 1, (char **) argstrings + 1);
c2b736ca 538 if (nchars < callint_message_size - 1)
df31bc64
RS
539 break;
540 callint_message_size *= 2;
541 callint_message
542 = (char *) xrealloc (callint_message, callint_message_size);
543 }
ec28a64d
MB
544
545 switch (*tem)
546 {
547 case 'a': /* Symbol defined as a function */
df31bc64 548 visargs[i] = Fcompleting_read (build_string (callint_message),
ff9cd111 549 Vobarray, Qfboundp, Qt,
93fb51ae 550 Qnil, Qnil, Qnil, Qnil);
ec28a64d
MB
551 /* Passing args[i] directly stimulates compiler bug */
552 teml = visargs[i];
553 args[i] = Fintern (teml, Qnil);
554 break;
555
556 case 'b': /* Name of existing buffer */
557 args[i] = Fcurrent_buffer ();
558 if (EQ (selected_window, minibuf_window))
34c5d0ed 559 args[i] = Fother_buffer (args[i], Qnil, Qnil);
df31bc64 560 args[i] = Fread_buffer (build_string (callint_message), args[i], Qt);
ec28a64d
MB
561 break;
562
563 case 'B': /* Name of buffer, possibly nonexistent */
df31bc64 564 args[i] = Fread_buffer (build_string (callint_message),
34c5d0ed 565 Fother_buffer (Fcurrent_buffer (), Qnil, Qnil),
9262fcb6 566 Qnil);
ec28a64d
MB
567 break;
568
569 case 'c': /* Character */
562e4a4f 570 args[i] = Fread_char (build_string (callint_message), Qnil);
453ed650 571 message1_nolog ((char *) 0);
ec28a64d
MB
572 /* Passing args[i] directly stimulates compiler bug */
573 teml = args[i];
574 visargs[i] = Fchar_to_string (teml);
575 break;
576
577 case 'C': /* Command: symbol with interactive function */
df31bc64 578 visargs[i] = Fcompleting_read (build_string (callint_message),
ff9cd111 579 Vobarray, Qcommandp,
93fb51ae 580 Qt, Qnil, Qnil, Qnil, Qnil);
ec28a64d
MB
581 /* Passing args[i] directly stimulates compiler bug */
582 teml = visargs[i];
583 args[i] = Fintern (teml, Qnil);
584 break;
585
586 case 'd': /* Value of point. Does not do I/O. */
dc330139 587 set_marker_both (point_marker, Qnil, PT, PT_BYTE);
824977b6 588 args[i] = point_marker;
ec28a64d
MB
589 /* visargs[i] = Qnil; */
590 varies[i] = 1;
591 break;
592
ec28a64d 593 case 'D': /* Directory name. */
df31bc64 594 args[i] = Fread_file_name (build_string (callint_message), Qnil,
93ed5f9d
KS
595 current_buffer->directory, Qlambda, Qnil,
596 Qfile_directory_p);
ec28a64d
MB
597 break;
598
599 case 'f': /* Existing file name. */
df31bc64 600 args[i] = Fread_file_name (build_string (callint_message),
93ed5f9d 601 Qnil, Qnil, Qlambda, Qnil, Qnil);
ec28a64d
MB
602 break;
603
604 case 'F': /* Possibly nonexistent file name. */
df31bc64 605 args[i] = Fread_file_name (build_string (callint_message),
93ed5f9d 606 Qnil, Qnil, Qnil, Qnil, Qnil);
ec28a64d
MB
607 break;
608
75f9fbe8
RS
609 case 'G': /* Possibly nonexistent file name,
610 default to directory alone. */
611 args[i] = Fread_file_name (build_string (callint_message),
612 Qnil, Qnil, Qnil, build_string (""), Qnil);
613 break;
614
40b2421c
KH
615 case 'i': /* Ignore an argument -- Does not do I/O */
616 varies[i] = -1;
617 break;
618
1989e7bc 619 case 'k': /* Key sequence. */
c631c234 620 {
aed13378 621 int speccount1 = SPECPDL_INDEX ();
c631c234
RS
622 specbind (Qcursor_in_echo_area, Qt);
623 args[i] = Fread_key_sequence (build_string (callint_message),
ad4ac475 624 Qnil, Qnil, Qnil, Qnil);
c631c234
RS
625 unbind_to (speccount1, Qnil);
626 teml = args[i];
a1bfe073 627 visargs[i] = Fkey_description (teml, Qnil);
cdfac812
RS
628
629 /* If the key sequence ends with a down-event,
630 discard the following up-event. */
631 teml = Faref (args[i], make_number (XINT (Flength (args[i])) - 1));
632 if (CONSP (teml))
70949dac 633 teml = XCAR (teml);
cdfac812
RS
634 if (SYMBOLP (teml))
635 {
636 Lisp_Object tem2;
637
638 teml = Fget (teml, intern ("event-symbol-elements"));
4b27f17c
AS
639 /* Ignore first element, which is the base key. */
640 tem2 = Fmemq (intern ("down"), Fcdr (teml));
cdfac812 641 if (! NILP (tem2))
39900c4e 642 up_event = Fread_event (Qnil, Qnil);
cdfac812 643 }
c631c234 644 }
1989e7bc
RS
645 break;
646
647 case 'K': /* Key sequence to be defined. */
c631c234 648 {
aed13378 649 int speccount1 = SPECPDL_INDEX ();
c631c234
RS
650 specbind (Qcursor_in_echo_area, Qt);
651 args[i] = Fread_key_sequence (build_string (callint_message),
ad4ac475 652 Qnil, Qt, Qnil, Qnil);
c631c234 653 teml = args[i];
a1bfe073 654 visargs[i] = Fkey_description (teml, Qnil);
c631c234 655 unbind_to (speccount1, Qnil);
cdfac812
RS
656
657 /* If the key sequence ends with a down-event,
658 discard the following up-event. */
659 teml = Faref (args[i], make_number (XINT (Flength (args[i])) - 1));
660 if (CONSP (teml))
70949dac 661 teml = XCAR (teml);
cdfac812
RS
662 if (SYMBOLP (teml))
663 {
664 Lisp_Object tem2;
665
666 teml = Fget (teml, intern ("event-symbol-elements"));
4b27f17c
AS
667 /* Ignore first element, which is the base key. */
668 tem2 = Fmemq (intern ("down"), Fcdr (teml));
cdfac812 669 if (! NILP (tem2))
39900c4e 670 up_event = Fread_event (Qnil, Qnil);
cdfac812 671 }
c631c234 672 }
ec28a64d
MB
673 break;
674
39900c4e
KS
675 case 'U': /* Up event from last k or K */
676 if (!NILP (up_event))
677 {
678 args[i] = Fmake_vector (make_number (1), up_event);
679 up_event = Qnil;
680 teml = args[i];
681 visargs[i] = Fkey_description (teml, Qnil);
682 }
683 break;
684
bc78232c 685 case 'e': /* The invoking event. */
d455db8e 686 if (next_event >= key_count)
bc78232c 687 error ("%s must be bound to an event with parameters",
6e54b3de 688 (SYMBOLP (function)
d5db4077 689 ? (char *) SDATA (SYMBOL_NAME (function))
bc78232c 690 : "command"));
d455db8e 691 args[i] = XVECTOR (keys)->contents[next_event++];
e5d77022 692 varies[i] = -1;
dbc4e1c1
JB
693
694 /* Find the next parameterized event. */
d455db8e 695 while (next_event < key_count
dbc4e1c1 696 && ! (EVENT_HAS_PARAMETERS
d455db8e 697 (XVECTOR (keys)->contents[next_event])))
dbc4e1c1
JB
698 next_event++;
699
63007de2
JB
700 break;
701
ec28a64d 702 case 'm': /* Value of mark. Does not do I/O. */
f203cf07 703 check_mark (0);
ec28a64d 704 /* visargs[i] = Qnil; */
824977b6 705 args[i] = current_buffer->mark;
ec28a64d
MB
706 varies[i] = 2;
707 break;
708
93fb51ae
KH
709 case 'M': /* String read via minibuffer with
710 inheriting the current input method. */
711 args[i] = Fread_string (build_string (callint_message),
712 Qnil, Qnil, Qnil, Qt);
713 break;
714
ec28a64d 715 case 'N': /* Prefix arg, else number from minibuffer */
265a9e55 716 if (!NILP (prefix_arg))
ec28a64d
MB
717 goto have_prefix_arg;
718 case 'n': /* Read number from minibuffer. */
f0490a0b
RS
719 {
720 int first = 1;
721 do
722 {
723 Lisp_Object tem;
724 if (! first)
725 {
726 message ("Please enter a number.");
56fe6fc0 727 sit_for (1, 0, 0, 0, 0);
f0490a0b
RS
728 }
729 first = 0;
730
731 tem = Fread_from_minibuffer (build_string (callint_message),
93fb51ae 732 Qnil, Qnil, Qnil, Qnil, Qnil,
ae4c2a3b 733 Qnil);
d5db4077 734 if (! STRINGP (tem) || SCHARS (tem) == 0)
f0490a0b
RS
735 args[i] = Qnil;
736 else
737 args[i] = Fread (tem);
738 }
739 while (! NUMBERP (args[i]));
740 }
ec28a64d
MB
741 visargs[i] = last_minibuf_string;
742 break;
743
744 case 'P': /* Prefix arg in raw form. Does no I/O. */
ec28a64d
MB
745 args[i] = prefix_arg;
746 /* visargs[i] = Qnil; */
747 varies[i] = -1;
748 break;
749
750 case 'p': /* Prefix arg converted to number. No I/O. */
71eda2d5 751 have_prefix_arg:
ec28a64d
MB
752 args[i] = Fprefix_numeric_value (prefix_arg);
753 /* visargs[i] = Qnil; */
754 varies[i] = -1;
755 break;
756
757 case 'r': /* Region, point and mark as 2 args. */
f203cf07 758 check_mark (1);
dc330139 759 set_marker_both (point_marker, Qnil, PT, PT_BYTE);
ec28a64d
MB
760 /* visargs[i+1] = Qnil; */
761 foo = marker_position (current_buffer->mark);
762 /* visargs[i] = Qnil; */
6ec8bbd2 763 args[i] = PT < foo ? point_marker : current_buffer->mark;
ec28a64d 764 varies[i] = 3;
6ec8bbd2 765 args[++i] = PT > foo ? point_marker : current_buffer->mark;
ec28a64d
MB
766 varies[i] = 4;
767 break;
768
93fb51ae
KH
769 case 's': /* String read via minibuffer without
770 inheriting the current input method. */
55c4d99f 771 args[i] = Fread_string (build_string (callint_message),
93fb51ae 772 Qnil, Qnil, Qnil, Qnil);
ec28a64d
MB
773 break;
774
775 case 'S': /* Any symbol. */
df31bc64 776 visargs[i] = Fread_string (build_string (callint_message),
93fb51ae 777 Qnil, Qnil, Qnil, Qnil);
ec28a64d
MB
778 /* Passing args[i] directly stimulates compiler bug */
779 teml = visargs[i];
780 args[i] = Fintern (teml, Qnil);
781 break;
782
783 case 'v': /* Variable name: symbol that is
784 user-variable-p. */
ff9cd111 785 args[i] = Fread_variable (build_string (callint_message), Qnil);
ec28a64d
MB
786 visargs[i] = last_minibuf_string;
787 break;
788
789 case 'x': /* Lisp expression read but not evaluated */
df31bc64 790 args[i] = Fread_minibuffer (build_string (callint_message), Qnil);
ec28a64d
MB
791 visargs[i] = last_minibuf_string;
792 break;
793
794 case 'X': /* Lisp expression read and evaluated */
df31bc64 795 args[i] = Feval_minibuffer (build_string (callint_message), Qnil);
ec28a64d
MB
796 visargs[i] = last_minibuf_string;
797 break;
798
40b2421c
KH
799 case 'Z': /* Coding-system symbol, or ignore the
800 argument if no prefix */
801 if (NILP (prefix_arg))
802 {
803 args[i] = Qnil;
804 varies[i] = -1;
805 }
177c0ea7 806 else
40b2421c
KH
807 {
808 args[i]
809 = Fread_non_nil_coding_system (build_string (callint_message));
810 visargs[i] = last_minibuf_string;
811 }
812 break;
813
814 case 'z': /* Coding-system symbol or nil */
024d8713 815 args[i] = Fread_coding_system (build_string (callint_message), Qnil);
40b2421c
KH
816 visargs[i] = last_minibuf_string;
817 break;
818
e92d107b
RS
819 /* We have a case for `+' so we get an error
820 if anyone tries to define one here. */
821 case '+':
ec28a64d 822 default:
e92d107b 823 error ("Invalid control letter `%c' (%03o) in interactive calling string",
ec28a64d
MB
824 *tem, *tem);
825 }
826
827 if (varies[i] == 0)
828 arg_from_tty = 1;
829
6e54b3de 830 if (NILP (visargs[i]) && STRINGP (args[i]))
ec28a64d
MB
831 visargs[i] = args[i];
832
833 tem = (unsigned char *) index (tem, '\n');
834 if (tem) tem++;
835 else tem = (unsigned char *) "";
836 }
52614803 837 unbind_to (speccount, Qnil);
ec28a64d
MB
838
839 QUIT;
840
841 args[0] = function;
842
7868a977 843 if (arg_from_tty || !NILP (record_flag))
ec28a64d
MB
844 {
845 visargs[0] = function;
63007de2 846 for (i = 1; i < count + 1; i++)
824977b6
RS
847 {
848 if (varies[i] > 0)
849 visargs[i] = Fcons (intern (callint_argfuns[varies[i]]), Qnil);
850 else
851 visargs[i] = quotify_arg (args[i]);
852 }
ec28a64d
MB
853 Vcommand_history = Fcons (Flist (count + 1, visargs),
854 Vcommand_history);
225c2157 855 /* Don't keep command history around forever. */
b9f0b172 856 if (INTEGERP (Vhistory_length) && XINT (Vhistory_length) > 0)
225c2157
RS
857 {
858 teml = Fnthcdr (Vhistory_length, Vcommand_history);
859 if (CONSP (teml))
f3fbd155 860 XSETCDR (teml, Qnil);
225c2157 861 }
ec28a64d
MB
862 }
863
824977b6
RS
864 /* If we used a marker to hold point, mark, or an end of the region,
865 temporarily, convert it to an integer now. */
f4c8ded2 866 for (i = 1; i <= count; i++)
824977b6
RS
867 if (varies[i] >= 1 && varies[i] <= 4)
868 XSETINT (args[i], marker_position (args[i]));
869
09c886dc
RS
870 if (record_then_fail)
871 Fbarf_if_buffer_read_only ();
872
0605dd79
RS
873 Vthis_command = save_this_command;
874 Vthis_original_command = save_this_original_command;
875 real_this_command= save_real_this_command;
876 current_kboard->Vlast_command = save_last_command;
877
652e2240 878 single_kboard_state ();
ebfbe249 879
ec28a64d
MB
880 {
881 Lisp_Object val;
ec28a64d
MB
882 specbind (Qcommand_debug_status, Qnil);
883
884 val = Ffuncall (count + 1, args);
885 UNGCPRO;
886 return unbind_to (speccount, val);
887 }
177c0ea7 888}
ec28a64d
MB
889
890DEFUN ("prefix-numeric-value", Fprefix_numeric_value, Sprefix_numeric_value,
fdb82f93
PJ
891 1, 1, 0,
892 doc: /* Return numeric meaning of raw prefix argument RAW.
893A raw prefix argument is what you get from `(interactive "P")'.
894Its numeric meaning is what you would get from `(interactive "p")'. */)
895 (raw)
ec28a64d
MB
896 Lisp_Object raw;
897{
898 Lisp_Object val;
177c0ea7 899
265a9e55 900 if (NILP (raw))
acab6442 901 XSETFASTINT (val, 1);
fd5285f3 902 else if (EQ (raw, Qminus))
ec28a64d 903 XSETINT (val, -1);
70949dac
KR
904 else if (CONSP (raw) && INTEGERP (XCAR (raw)))
905 XSETINT (val, XINT (XCAR (raw)));
6e54b3de 906 else if (INTEGERP (raw))
ec28a64d
MB
907 val = raw;
908 else
acab6442 909 XSETFASTINT (val, 1);
ec28a64d
MB
910
911 return val;
912}
913
dfcf069d 914void
ec28a64d
MB
915syms_of_callint ()
916{
824977b6
RS
917 point_marker = Fmake_marker ();
918 staticpro (&point_marker);
919
03e130d5
RS
920 preserved_fns = Fcons (intern ("region-beginning"),
921 Fcons (intern ("region-end"),
922 Fcons (intern ("point"),
923 Fcons (intern ("mark"), Qnil))));
924 staticpro (&preserved_fns);
925
926 Qlist = intern ("list");
927 staticpro (&Qlist);
8450690a
RS
928 Qlet = intern ("let");
929 staticpro (&Qlet);
120d0a23
RS
930 Qif = intern ("if");
931 staticpro (&Qif);
932 Qwhen = intern ("when");
933 staticpro (&Qwhen);
8450690a
RS
934 Qletx = intern ("let*");
935 staticpro (&Qletx);
936 Qsave_excursion = intern ("save-excursion");
937 staticpro (&Qsave_excursion);
079e479f
RS
938 Qprogn = intern ("progn");
939 staticpro (&Qprogn);
03e130d5 940
ec28a64d
MB
941 Qminus = intern ("-");
942 staticpro (&Qminus);
943
fdb4a38c
RS
944 Qplus = intern ("+");
945 staticpro (&Qplus);
946
ec28a64d
MB
947 Qcall_interactively = intern ("call-interactively");
948 staticpro (&Qcall_interactively);
949
950 Qcommand_debug_status = intern ("command-debug-status");
951 staticpro (&Qcommand_debug_status);
952
52614803
RS
953 Qenable_recursive_minibuffers = intern ("enable-recursive-minibuffers");
954 staticpro (&Qenable_recursive_minibuffers);
955
ef2515c0
RS
956 Qmouse_leave_buffer_hook = intern ("mouse-leave-buffer-hook");
957 staticpro (&Qmouse_leave_buffer_hook);
958
df31bc64
RS
959 callint_message_size = 100;
960 callint_message = (char *) xmalloc (callint_message_size);
961
962
1e0c5826 963 DEFVAR_KBOARD ("prefix-arg", Vprefix_arg,
fdb82f93
PJ
964 doc: /* The value of the prefix argument for the next editing command.
965It may be a number, or the symbol `-' for just a minus sign as arg,
966or a list whose car is a number for just one or more C-u's
967or nil if no argument has been specified.
968
969You cannot examine this variable to find the argument for this command
970since it has been set to nil by the time you can look.
971Instead, you should use the variable `current-prefix-arg', although
972normally commands can get this prefix argument with (interactive "P"). */);
8c917bf2 973
fe3fbdcc 974 DEFVAR_KBOARD ("last-prefix-arg", Vlast_prefix_arg,
fdb82f93
PJ
975 doc: /* The value of the prefix argument for the previous editing command.
976See `prefix-arg' for the meaning of the value. */);
fe3fbdcc 977
8c917bf2 978 DEFVAR_LISP ("current-prefix-arg", &Vcurrent_prefix_arg,
fdb82f93
PJ
979 doc: /* The value of the prefix argument for this editing command.
980It may be a number, or the symbol `-' for just a minus sign as arg,
981or a list whose car is a number for just one or more C-u's
982or nil if no argument has been specified.
983This is what `(interactive \"P\")' returns. */);
8c917bf2
KH
984 Vcurrent_prefix_arg = Qnil;
985
ec28a64d 986 DEFVAR_LISP ("command-history", &Vcommand_history,
fdb82f93
PJ
987 doc: /* List of recent commands that read arguments from terminal.
988Each command is represented as a form to evaluate. */);
ec28a64d
MB
989 Vcommand_history = Qnil;
990
991 DEFVAR_LISP ("command-debug-status", &Vcommand_debug_status,
fdb82f93
PJ
992 doc: /* Debugging status of current interactive command.
993Bound each time `call-interactively' is called;
994may be set by the debugger as a reminder for itself. */);
ec28a64d
MB
995 Vcommand_debug_status = Qnil;
996
2ad6c959 997 DEFVAR_LISP ("mark-even-if-inactive", &Vmark_even_if_inactive,
fdb82f93
PJ
998 doc: /* *Non-nil means you can use the mark even when inactive.
999This option makes a difference in Transient Mark mode.
1000When the option is non-nil, deactivation of the mark
1001turns off region highlighting, but commands that use the mark
1002behave as if the mark were still active. */);
9f315aeb
RS
1003 Vmark_even_if_inactive = Qnil;
1004
ef2515c0 1005 DEFVAR_LISP ("mouse-leave-buffer-hook", &Vmouse_leave_buffer_hook,
fdb82f93
PJ
1006 doc: /* Hook to run when about to switch windows with a mouse command.
1007Its purpose is to give temporary modes such as Isearch mode
1008a way to turn themselves off when a mouse command switches windows. */);
ef2515c0
RS
1009 Vmouse_leave_buffer_hook = Qnil;
1010
ec28a64d
MB
1011 defsubr (&Sinteractive);
1012 defsubr (&Scall_interactively);
1013 defsubr (&Sprefix_numeric_value);
1014}
ab5796a9
MB
1015
1016/* arch-tag: a3a7cad7-bcac-42ce-916e-1bd2546ebf37
1017 (do not change this comment) */