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