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