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