Variadic C functions now count arguments with ptrdiff_t.
[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"
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.
81e -- Parametrized event (i.e., one that's a list) that invoked this command.
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.
108If the string begins with `@', Emacs searches the key sequence which
109 invoked the command for its first mouse click (or any other event
110 which specifies a window).
111If the string begins with `^' and `shift-select-mode' is non-nil,
2a4f8d3d 112 Emacs first calls the function `handle-shift-selection'.
9bdb1538
CY
113You may use `@', `*', and `^' together. They are processed in the
114 order that they appear, before reading any arguments.
d88bee5a 115usage: (interactive &optional ARGS) */)
5842a27b 116 (Lisp_Object args)
ec28a64d
MB
117{
118 return Qnil;
119}
120
121/* Quotify EXP: if EXP is constant, return it.
122 If EXP is not constant, return (quote EXP). */
b1349114 123static Lisp_Object
971de7fb 124quotify_arg (register Lisp_Object exp)
ec28a64d 125{
d032d5e7
SM
126 if (CONSP (exp)
127 || (SYMBOLP (exp)
128 && !NILP (exp) && !EQ (exp, Qt)))
ec28a64d
MB
129 return Fcons (Qquote, Fcons (exp, Qnil));
130
131 return exp;
132}
133
134/* Modify EXP by quotifying each element (except the first). */
b1349114 135static Lisp_Object
971de7fb 136quotify_args (Lisp_Object exp)
ec28a64d
MB
137{
138 register Lisp_Object tail;
7539e11f
KR
139 Lisp_Object next;
140 for (tail = exp; CONSP (tail); tail = next)
ec28a64d 141 {
7539e11f 142 next = XCDR (tail);
f3fbd155 143 XSETCAR (tail, quotify_arg (XCAR (tail)));
ec28a64d
MB
144 }
145 return exp;
146}
147
648801d1 148static const char *callint_argfuns[]
ec28a64d
MB
149 = {"", "point", "mark", "region-beginning", "region-end"};
150
151static void
971de7fb 152check_mark (int for_region)
ec28a64d 153{
86c1cf23 154 Lisp_Object tem;
4b4deea2 155 tem = Fmarker_buffer (BVAR (current_buffer, mark));
265a9e55 156 if (NILP (tem) || (XBUFFER (tem) != current_buffer))
f203cf07
RS
157 error (for_region ? "The mark is not set now, so there is no region"
158 : "The mark is not set now");
6497d2d8 159 if (!NILP (Vtransient_mark_mode) && NILP (Vmark_even_if_inactive)
4b4deea2 160 && NILP (BVAR (current_buffer, mark_active)))
f439241f 161 xsignal0 (Qmark_inactive);
ec28a64d
MB
162}
163
64ea14d3
RS
164/* If the list of args INPUT was produced with an explicit call to
165 `list', look for elements that were computed with
166 (region-beginning) or (region-end), and put those expressions into
167 VALUES instead of the present values.
168
169 This function doesn't return a value because it modifies elements
170 of VALUES to do its job. */
171
d1135afc 172static void
971de7fb 173fix_command (Lisp_Object input, Lisp_Object values)
d1135afc 174{
d032d5e7 175 /* FIXME: Instead of this ugly hack, we should provide a way for an
7200d79c
SM
176 interactive spec to return an expression/function that will re-build the
177 args without user intervention. */
d1135afc
JB
178 if (CONSP (input))
179 {
180 Lisp_Object car;
181
182 car = XCAR (input);
183 /* Skip through certain special forms. */
184 while (EQ (car, Qlet) || EQ (car, Qletx)
185 || EQ (car, Qsave_excursion)
186 || EQ (car, Qprogn))
187 {
188 while (CONSP (XCDR (input)))
189 input = XCDR (input);
190 input = XCAR (input);
191 if (!CONSP (input))
192 break;
193 car = XCAR (input);
194 }
195 if (EQ (car, Qlist))
196 {
197 Lisp_Object intail, valtail;
198 for (intail = Fcdr (input), valtail = values;
199 CONSP (valtail);
5dc05618 200 intail = Fcdr (intail), valtail = XCDR (valtail))
d1135afc
JB
201 {
202 Lisp_Object elt;
203 elt = Fcar (intail);
204 if (CONSP (elt))
205 {
206 Lisp_Object presflag, carelt;
207 carelt = Fcar (elt);
208 /* If it is (if X Y), look at Y. */
209 if (EQ (carelt, Qif)
210 && EQ (Fnthcdr (make_number (3), elt), Qnil))
211 elt = Fnth (make_number (2), elt);
212 /* If it is (when ... Y), look at Y. */
213 else if (EQ (carelt, Qwhen))
214 {
215 while (CONSP (XCDR (elt)))
216 elt = XCDR (elt);
217 elt = Fcar (elt);
218 }
219
220 /* If the function call we're looking at
221 is a special preserved one, copy the
222 whole expression for this argument. */
223 if (CONSP (elt))
224 {
225 presflag = Fmemq (Fcar (elt), preserved_fns);
226 if (!NILP (presflag))
227 Fsetcar (valtail, Fcar (intail));
228 }
229 }
230 }
231 }
232 }
233}
ec28a64d 234
d455db8e 235DEFUN ("call-interactively", Fcall_interactively, Scall_interactively, 1, 3, 0,
fdb82f93
PJ
236 doc: /* Call FUNCTION, reading args according to its interactive calling specs.
237Return the value FUNCTION returns.
238The function contains a specification of how to do the argument reading.
239In the case of user-defined functions, this is specified by placing a call
240to the function `interactive' at the top level of the function body.
241See `interactive'.
242
243Optional second arg RECORD-FLAG non-nil
244means unconditionally put this command in the command-history.
245Otherwise, this is done only if an arg is read using the minibuffer.
2a95a27c 246
fdb82f93 247Optional third arg KEYS, if given, specifies the sequence of events to
2a95a27c
CY
248supply, as a vector, if the command inquires which events were used to
249invoke it. If KEYS is omitted or nil, the return value of
250`this-command-keys-vector' is used. */)
5842a27b 251 (Lisp_Object function, Lisp_Object record_flag, Lisp_Object keys)
ec28a64d
MB
252{
253 Lisp_Object *args, *visargs;
ec28a64d 254 Lisp_Object specs;
079e479f 255 Lisp_Object filter_specs;
ec28a64d 256 Lisp_Object teml;
39900c4e 257 Lisp_Object up_event;
52614803 258 Lisp_Object enable;
aed13378 259 int speccount = SPECPDL_INDEX ();
ec28a64d 260
bc78232c
JB
261 /* The index of the next element of this_command_keys to examine for
262 the 'e' interactive code. */
dbc4e1c1 263 int next_event;
bc78232c 264
ec28a64d 265 Lisp_Object prefix_arg;
a2db9982 266 char *string;
b0e80955 267 const char *tem;
63007de2
JB
268
269 /* If varies[i] > 0, the i'th argument shouldn't just have its value
270 in this call quoted in the command history. It should be
271 recorded as a call to the function named callint_argfuns[varies[i]]. */
f66c7cf8 272 signed char *varies;
63007de2 273
f66c7cf8 274 ptrdiff_t i, 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);
77b37c05 296 key_count = ASIZE (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);
a1759b76 341 size_t events = 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;
a1759b76 349 if (events != 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
f66c7cf8
PE
467 if (min (MOST_POSITIVE_FIXNUM,
468 min (PTRDIFF_MAX, SIZE_MAX) / sizeof (Lisp_Object))
469 < nargs)
470 memory_full (SIZE_MAX);
471
becfa255
PE
472 args = (Lisp_Object *) alloca (nargs * sizeof (Lisp_Object));
473 visargs = (Lisp_Object *) alloca (nargs * sizeof (Lisp_Object));
f66c7cf8 474 varies = (signed char *) alloca (nargs);
ec28a64d 475
becfa255 476 for (i = 0; i < nargs; i++)
ec28a64d
MB
477 {
478 args[i] = Qnil;
479 visargs[i] = Qnil;
480 varies[i] = 0;
481 }
482
39900c4e 483 GCPRO5 (prefix_arg, function, *args, *visargs, up_event);
becfa255
PE
484 gcpro3.nvars = nargs;
485 gcpro4.nvars = nargs;
ec28a64d 486
52614803
RS
487 if (!NILP (enable))
488 specbind (Qenable_recursive_minibuffers, Qt);
489
ec28a64d 490 tem = string;
6bc1abf2 491 for (i = 1; *tem; i++)
ec28a64d
MB
492 {
493 strncpy (prompt1, tem + 1, sizeof prompt1 - 1);
494 prompt1[sizeof prompt1 - 1] = 0;
8966b757 495 tem1 = strchr (prompt1, '\n');
ec28a64d 496 if (tem1) *tem1 = 0;
55b41ef5
CY
497
498 visargs[0] = build_string (prompt1);
8966b757 499 if (strchr (prompt1, '%'))
55b41ef5
CY
500 callint_message = Fformat (i, visargs);
501 else
502 callint_message = visargs[0];
ec28a64d
MB
503
504 switch (*tem)
505 {
506 case 'a': /* Symbol defined as a function */
55b41ef5 507 visargs[i] = Fcompleting_read (callint_message,
ff9cd111 508 Vobarray, Qfboundp, Qt,
93fb51ae 509 Qnil, Qnil, Qnil, Qnil);
ec28a64d
MB
510 /* Passing args[i] directly stimulates compiler bug */
511 teml = visargs[i];
512 args[i] = Fintern (teml, Qnil);
513 break;
514
515 case 'b': /* Name of existing buffer */
f03f8f2c
JL
516 args[i] = Fcurrent_buffer ();
517 if (EQ (selected_window, minibuf_window))
518 args[i] = Fother_buffer (args[i], Qnil, Qnil);
519 args[i] = Fread_buffer (callint_message, args[i], Qt);
520 break;
521
ec28a64d 522 case 'B': /* Name of buffer, possibly nonexistent */
f03f8f2c
JL
523 args[i] = Fread_buffer (callint_message,
524 Fother_buffer (Fcurrent_buffer (), Qnil, Qnil),
525 Qnil);
ec28a64d
MB
526 break;
527
528 case 'c': /* Character */
54b33868
MR
529 /* Prompt in `minibuffer-prompt' face. */
530 Fput_text_property (make_number (0),
531 make_number (SCHARS (callint_message)),
532 Qface, Qminibuffer_prompt, callint_message);
55b41ef5 533 args[i] = Fread_char (callint_message, Qnil, Qnil);
453ed650 534 message1_nolog ((char *) 0);
ec28a64d
MB
535 /* Passing args[i] directly stimulates compiler bug */
536 teml = args[i];
537 visargs[i] = Fchar_to_string (teml);
538 break;
539
540 case 'C': /* Command: symbol with interactive function */
55b41ef5 541 visargs[i] = Fcompleting_read (callint_message,
ff9cd111 542 Vobarray, Qcommandp,
93fb51ae 543 Qt, Qnil, Qnil, Qnil, Qnil);
ec28a64d
MB
544 /* Passing args[i] directly stimulates compiler bug */
545 teml = visargs[i];
546 args[i] = Fintern (teml, Qnil);
547 break;
548
549 case 'd': /* Value of point. Does not do I/O. */
dc330139 550 set_marker_both (point_marker, Qnil, PT, PT_BYTE);
824977b6 551 args[i] = point_marker;
ec28a64d
MB
552 /* visargs[i] = Qnil; */
553 varies[i] = 1;
554 break;
555
ec28a64d 556 case 'D': /* Directory name. */
55b41ef5 557 args[i] = Fread_file_name (callint_message, Qnil,
4b4deea2 558 BVAR (current_buffer, directory), Qlambda, Qnil,
93ed5f9d 559 Qfile_directory_p);
ec28a64d
MB
560 break;
561
562 case 'f': /* Existing file name. */
55b41ef5 563 args[i] = Fread_file_name (callint_message,
93ed5f9d 564 Qnil, Qnil, Qlambda, Qnil, Qnil);
ec28a64d
MB
565 break;
566
567 case 'F': /* Possibly nonexistent file name. */
55b41ef5 568 args[i] = Fread_file_name (callint_message,
93ed5f9d 569 Qnil, Qnil, Qnil, Qnil, Qnil);
ec28a64d
MB
570 break;
571
75f9fbe8
RS
572 case 'G': /* Possibly nonexistent file name,
573 default to directory alone. */
55b41ef5 574 args[i] = Fread_file_name (callint_message,
977f6cfb 575 Qnil, Qnil, Qnil, empty_unibyte_string, Qnil);
75f9fbe8
RS
576 break;
577
40b2421c
KH
578 case 'i': /* Ignore an argument -- Does not do I/O */
579 varies[i] = -1;
580 break;
581
1989e7bc 582 case 'k': /* Key sequence. */
c631c234 583 {
aed13378 584 int speccount1 = SPECPDL_INDEX ();
c631c234 585 specbind (Qcursor_in_echo_area, Qt);
54b33868
MR
586 /* Prompt in `minibuffer-prompt' face. */
587 Fput_text_property (make_number (0),
588 make_number (SCHARS (callint_message)),
589 Qface, Qminibuffer_prompt, callint_message);
55b41ef5 590 args[i] = Fread_key_sequence (callint_message,
ad4ac475 591 Qnil, Qnil, Qnil, Qnil);
c631c234
RS
592 unbind_to (speccount1, Qnil);
593 teml = args[i];
a1bfe073 594 visargs[i] = Fkey_description (teml, Qnil);
cdfac812
RS
595
596 /* If the key sequence ends with a down-event,
597 discard the following up-event. */
598 teml = Faref (args[i], make_number (XINT (Flength (args[i])) - 1));
599 if (CONSP (teml))
70949dac 600 teml = XCAR (teml);
cdfac812
RS
601 if (SYMBOLP (teml))
602 {
603 Lisp_Object tem2;
604
605 teml = Fget (teml, intern ("event-symbol-elements"));
4b27f17c
AS
606 /* Ignore first element, which is the base key. */
607 tem2 = Fmemq (intern ("down"), Fcdr (teml));
cdfac812 608 if (! NILP (tem2))
43811b4e 609 up_event = Fread_event (Qnil, Qnil, Qnil);
cdfac812 610 }
c631c234 611 }
1989e7bc
RS
612 break;
613
614 case 'K': /* Key sequence to be defined. */
c631c234 615 {
aed13378 616 int speccount1 = SPECPDL_INDEX ();
c631c234 617 specbind (Qcursor_in_echo_area, Qt);
54b33868
MR
618 /* Prompt in `minibuffer-prompt' face. */
619 Fput_text_property (make_number (0),
620 make_number (SCHARS (callint_message)),
621 Qface, Qminibuffer_prompt, callint_message);
55b41ef5 622 args[i] = Fread_key_sequence (callint_message,
ad4ac475 623 Qnil, Qt, Qnil, Qnil);
c631c234 624 teml = args[i];
a1bfe073 625 visargs[i] = Fkey_description (teml, Qnil);
c631c234 626 unbind_to (speccount1, Qnil);
cdfac812
RS
627
628 /* If the key sequence ends with a down-event,
629 discard the following up-event. */
630 teml = Faref (args[i], make_number (XINT (Flength (args[i])) - 1));
631 if (CONSP (teml))
70949dac 632 teml = XCAR (teml);
cdfac812
RS
633 if (SYMBOLP (teml))
634 {
635 Lisp_Object tem2;
636
637 teml = Fget (teml, intern ("event-symbol-elements"));
4b27f17c
AS
638 /* Ignore first element, which is the base key. */
639 tem2 = Fmemq (intern ("down"), Fcdr (teml));
cdfac812 640 if (! NILP (tem2))
43811b4e 641 up_event = Fread_event (Qnil, Qnil, Qnil);
cdfac812 642 }
c631c234 643 }
ec28a64d
MB
644 break;
645
39900c4e
KS
646 case 'U': /* Up event from last k or K */
647 if (!NILP (up_event))
648 {
649 args[i] = Fmake_vector (make_number (1), up_event);
650 up_event = Qnil;
651 teml = args[i];
652 visargs[i] = Fkey_description (teml, Qnil);
653 }
654 break;
655
bc78232c 656 case 'e': /* The invoking event. */
d455db8e 657 if (next_event >= key_count)
bc78232c 658 error ("%s must be bound to an event with parameters",
6e54b3de 659 (SYMBOLP (function)
51b59d79 660 ? SSDATA (SYMBOL_NAME (function))
bc78232c 661 : "command"));
1b511542
SM
662 args[i] = AREF (keys, next_event);
663 next_event++;
e5d77022 664 varies[i] = -1;
dbc4e1c1
JB
665
666 /* Find the next parameterized event. */
d455db8e 667 while (next_event < key_count
1b511542 668 && !(EVENT_HAS_PARAMETERS (AREF (keys, next_event))))
dbc4e1c1
JB
669 next_event++;
670
63007de2
JB
671 break;
672
ec28a64d 673 case 'm': /* Value of mark. Does not do I/O. */
f203cf07 674 check_mark (0);
ec28a64d 675 /* visargs[i] = Qnil; */
4b4deea2 676 args[i] = BVAR (current_buffer, mark);
ec28a64d
MB
677 varies[i] = 2;
678 break;
679
93fb51ae
KH
680 case 'M': /* String read via minibuffer with
681 inheriting the current input method. */
55b41ef5 682 args[i] = Fread_string (callint_message,
93fb51ae
KH
683 Qnil, Qnil, Qnil, Qt);
684 break;
685
425b457e 686 case 'N': /* Prefix arg as number, else number from minibuffer */
265a9e55 687 if (!NILP (prefix_arg))
ec28a64d
MB
688 goto have_prefix_arg;
689 case 'n': /* Read number from minibuffer. */
f0490a0b
RS
690 {
691 int first = 1;
692 do
693 {
a3e8cbda 694 Lisp_Object str;
e7c4e229 695 if (! first)
f0490a0b
RS
696 {
697 message ("Please enter a number.");
e7c4e229 698 sit_for (make_number (1), 0, 0);
f0490a0b
RS
699 }
700 first = 0;
701
a3e8cbda 702 str = Fread_from_minibuffer (callint_message,
93fb51ae 703 Qnil, Qnil, Qnil, Qnil, Qnil,
ae4c2a3b 704 Qnil);
a3e8cbda 705 if (! STRINGP (str) || SCHARS (str) == 0)
f0490a0b
RS
706 args[i] = Qnil;
707 else
a3e8cbda 708 args[i] = Fread (str);
f0490a0b
RS
709 }
710 while (! NUMBERP (args[i]));
711 }
55b41ef5 712 visargs[i] = args[i];
ec28a64d
MB
713 break;
714
715 case 'P': /* Prefix arg in raw form. Does no I/O. */
ec28a64d
MB
716 args[i] = prefix_arg;
717 /* visargs[i] = Qnil; */
718 varies[i] = -1;
719 break;
720
721 case 'p': /* Prefix arg converted to number. No I/O. */
71eda2d5 722 have_prefix_arg:
ec28a64d
MB
723 args[i] = Fprefix_numeric_value (prefix_arg);
724 /* visargs[i] = Qnil; */
725 varies[i] = -1;
726 break;
727
728 case 'r': /* Region, point and mark as 2 args. */
f203cf07 729 check_mark (1);
dc330139 730 set_marker_both (point_marker, Qnil, PT, PT_BYTE);
ec28a64d 731 /* visargs[i+1] = Qnil; */
4b4deea2 732 foo = marker_position (BVAR (current_buffer, mark));
ec28a64d 733 /* visargs[i] = Qnil; */
4b4deea2 734 args[i] = PT < foo ? point_marker : BVAR (current_buffer, mark);
ec28a64d 735 varies[i] = 3;
4b4deea2 736 args[++i] = PT > foo ? point_marker : BVAR (current_buffer, mark);
ec28a64d
MB
737 varies[i] = 4;
738 break;
739
93fb51ae
KH
740 case 's': /* String read via minibuffer without
741 inheriting the current input method. */
55b41ef5 742 args[i] = Fread_string (callint_message,
93fb51ae 743 Qnil, Qnil, Qnil, Qnil);
ec28a64d
MB
744 break;
745
746 case 'S': /* Any symbol. */
55b41ef5 747 visargs[i] = Fread_string (callint_message,
93fb51ae 748 Qnil, Qnil, Qnil, Qnil);
ec28a64d
MB
749 /* Passing args[i] directly stimulates compiler bug */
750 teml = visargs[i];
751 args[i] = Fintern (teml, Qnil);
752 break;
753
754 case 'v': /* Variable name: symbol that is
755 user-variable-p. */
55b41ef5 756 args[i] = Fread_variable (callint_message, Qnil);
ec28a64d
MB
757 visargs[i] = last_minibuf_string;
758 break;
759
760 case 'x': /* Lisp expression read but not evaluated */
55b41ef5 761 args[i] = Fread_minibuffer (callint_message, Qnil);
ec28a64d
MB
762 visargs[i] = last_minibuf_string;
763 break;
764
765 case 'X': /* Lisp expression read and evaluated */
55b41ef5 766 args[i] = Feval_minibuffer (callint_message, Qnil);
ec28a64d
MB
767 visargs[i] = last_minibuf_string;
768 break;
769
40b2421c
KH
770 case 'Z': /* Coding-system symbol, or ignore the
771 argument if no prefix */
772 if (NILP (prefix_arg))
773 {
774 args[i] = Qnil;
775 varies[i] = -1;
776 }
177c0ea7 777 else
40b2421c
KH
778 {
779 args[i]
55b41ef5 780 = Fread_non_nil_coding_system (callint_message);
40b2421c
KH
781 visargs[i] = last_minibuf_string;
782 }
783 break;
784
785 case 'z': /* Coding-system symbol or nil */
55b41ef5 786 args[i] = Fread_coding_system (callint_message, Qnil);
40b2421c
KH
787 visargs[i] = last_minibuf_string;
788 break;
789
e92d107b
RS
790 /* We have a case for `+' so we get an error
791 if anyone tries to define one here. */
792 case '+':
ec28a64d 793 default:
e6c3da20
EZ
794 error ("Invalid control letter `%c' (#o%03o, #x%04x) in interactive calling string",
795 STRING_CHAR ((unsigned char *) tem),
796 (unsigned) STRING_CHAR ((unsigned char *) tem),
797 (unsigned) STRING_CHAR ((unsigned char *) tem));
ec28a64d
MB
798 }
799
800 if (varies[i] == 0)
801 arg_from_tty = 1;
802
6e54b3de 803 if (NILP (visargs[i]) && STRINGP (args[i]))
ec28a64d
MB
804 visargs[i] = args[i];
805
a2db9982 806 tem = strchr (tem, '\n');
ec28a64d 807 if (tem) tem++;
a2db9982 808 else tem = "";
ec28a64d 809 }
52614803 810 unbind_to (speccount, Qnil);
ec28a64d
MB
811
812 QUIT;
813
814 args[0] = function;
815
7868a977 816 if (arg_from_tty || !NILP (record_flag))
ec28a64d
MB
817 {
818 visargs[0] = function;
becfa255 819 for (i = 1; i < nargs; i++)
824977b6
RS
820 {
821 if (varies[i] > 0)
822 visargs[i] = Fcons (intern (callint_argfuns[varies[i]]), Qnil);
823 else
824 visargs[i] = quotify_arg (args[i]);
825 }
becfa255 826 Vcommand_history = Fcons (Flist (nargs, visargs),
ec28a64d 827 Vcommand_history);
225c2157 828 /* Don't keep command history around forever. */
b9f0b172 829 if (INTEGERP (Vhistory_length) && XINT (Vhistory_length) > 0)
225c2157
RS
830 {
831 teml = Fnthcdr (Vhistory_length, Vcommand_history);
832 if (CONSP (teml))
f3fbd155 833 XSETCDR (teml, Qnil);
225c2157 834 }
ec28a64d
MB
835 }
836
824977b6
RS
837 /* If we used a marker to hold point, mark, or an end of the region,
838 temporarily, convert it to an integer now. */
becfa255 839 for (i = 1; i < nargs; i++)
824977b6
RS
840 if (varies[i] >= 1 && varies[i] <= 4)
841 XSETINT (args[i], marker_position (args[i]));
842
09c886dc
RS
843 if (record_then_fail)
844 Fbarf_if_buffer_read_only ();
845
0605dd79
RS
846 Vthis_command = save_this_command;
847 Vthis_original_command = save_this_original_command;
848 real_this_command= save_real_this_command;
1344aad4 849 KVAR (current_kboard, Vlast_command) = save_last_command;
0605dd79 850
ec28a64d
MB
851 {
852 Lisp_Object val;
ec28a64d
MB
853 specbind (Qcommand_debug_status, Qnil);
854
b3e6f69c 855 temporarily_switch_to_single_kboard (NULL);
becfa255 856 val = Ffuncall (nargs, args);
ec28a64d
MB
857 UNGCPRO;
858 return unbind_to (speccount, val);
859 }
177c0ea7 860}
ec28a64d 861
a7ca3326 862DEFUN ("prefix-numeric-value", Fprefix_numeric_value, Sprefix_numeric_value,
fdb82f93
PJ
863 1, 1, 0,
864 doc: /* Return numeric meaning of raw prefix argument RAW.
865A raw prefix argument is what you get from `(interactive "P")'.
866Its numeric meaning is what you would get from `(interactive "p")'. */)
5842a27b 867 (Lisp_Object raw)
ec28a64d
MB
868{
869 Lisp_Object val;
177c0ea7 870
265a9e55 871 if (NILP (raw))
acab6442 872 XSETFASTINT (val, 1);
fd5285f3 873 else if (EQ (raw, Qminus))
ec28a64d 874 XSETINT (val, -1);
70949dac
KR
875 else if (CONSP (raw) && INTEGERP (XCAR (raw)))
876 XSETINT (val, XINT (XCAR (raw)));
6e54b3de 877 else if (INTEGERP (raw))
ec28a64d
MB
878 val = raw;
879 else
acab6442 880 XSETFASTINT (val, 1);
ec28a64d
MB
881
882 return val;
883}
884
dfcf069d 885void
971de7fb 886syms_of_callint (void)
ec28a64d 887{
824977b6
RS
888 point_marker = Fmake_marker ();
889 staticpro (&point_marker);
890
55b41ef5
CY
891 callint_message = Qnil;
892 staticpro (&callint_message);
893
d67b4f80
DN
894 preserved_fns = pure_cons (intern_c_string ("region-beginning"),
895 pure_cons (intern_c_string ("region-end"),
896 pure_cons (intern_c_string ("point"),
897 pure_cons (intern_c_string ("mark"), Qnil))));
03e130d5 898
d67b4f80 899 Qlist = intern_c_string ("list");
03e130d5 900 staticpro (&Qlist);
d67b4f80 901 Qlet = intern_c_string ("let");
8450690a 902 staticpro (&Qlet);
d67b4f80 903 Qif = intern_c_string ("if");
120d0a23 904 staticpro (&Qif);
d67b4f80 905 Qwhen = intern_c_string ("when");
120d0a23 906 staticpro (&Qwhen);
d67b4f80 907 Qletx = intern_c_string ("let*");
8450690a 908 staticpro (&Qletx);
d67b4f80 909 Qsave_excursion = intern_c_string ("save-excursion");
8450690a 910 staticpro (&Qsave_excursion);
d67b4f80 911 Qprogn = intern_c_string ("progn");
079e479f 912 staticpro (&Qprogn);
03e130d5 913
d67b4f80 914 Qminus = intern_c_string ("-");
ec28a64d
MB
915 staticpro (&Qminus);
916
d67b4f80 917 Qplus = intern_c_string ("+");
fdb4a38c
RS
918 staticpro (&Qplus);
919
d67b4f80 920 Qhandle_shift_selection = intern_c_string ("handle-shift-selection");
9bdb1538
CY
921 staticpro (&Qhandle_shift_selection);
922
d67b4f80 923 Qcall_interactively = intern_c_string ("call-interactively");
ec28a64d
MB
924 staticpro (&Qcall_interactively);
925
d67b4f80 926 Qcommand_debug_status = intern_c_string ("command-debug-status");
ec28a64d
MB
927 staticpro (&Qcommand_debug_status);
928
d67b4f80 929 Qenable_recursive_minibuffers = intern_c_string ("enable-recursive-minibuffers");
52614803
RS
930 staticpro (&Qenable_recursive_minibuffers);
931
d67b4f80 932 Qmouse_leave_buffer_hook = intern_c_string ("mouse-leave-buffer-hook");
ef2515c0
RS
933 staticpro (&Qmouse_leave_buffer_hook);
934
1e0c5826 935 DEFVAR_KBOARD ("prefix-arg", Vprefix_arg,
fdb82f93
PJ
936 doc: /* The value of the prefix argument for the next editing command.
937It may be a number, or the symbol `-' for just a minus sign as arg,
938or a list whose car is a number for just one or more C-u's
939or nil if no argument has been specified.
940
941You cannot examine this variable to find the argument for this command
942since it has been set to nil by the time you can look.
943Instead, you should use the variable `current-prefix-arg', although
944normally commands can get this prefix argument with (interactive "P"). */);
8c917bf2 945
fe3fbdcc 946 DEFVAR_KBOARD ("last-prefix-arg", Vlast_prefix_arg,
fdb82f93
PJ
947 doc: /* The value of the prefix argument for the previous editing command.
948See `prefix-arg' for the meaning of the value. */);
fe3fbdcc 949
29208e82 950 DEFVAR_LISP ("current-prefix-arg", Vcurrent_prefix_arg,
fdb82f93
PJ
951 doc: /* The value of the prefix argument for this editing command.
952It may be a number, or the symbol `-' for just a minus sign as arg,
953or a list whose car is a number for just one or more C-u's
954or nil if no argument has been specified.
955This is what `(interactive \"P\")' returns. */);
8c917bf2
KH
956 Vcurrent_prefix_arg = Qnil;
957
29208e82 958 DEFVAR_LISP ("command-history", Vcommand_history,
fdb82f93 959 doc: /* List of recent commands that read arguments from terminal.
b014713c
EZ
960Each command is represented as a form to evaluate.
961
962Maximum length of the history list is determined by the value
963of `history-length', which see. */);
ec28a64d
MB
964 Vcommand_history = Qnil;
965
29208e82 966 DEFVAR_LISP ("command-debug-status", Vcommand_debug_status,
fdb82f93
PJ
967 doc: /* Debugging status of current interactive command.
968Bound each time `call-interactively' is called;
969may be set by the debugger as a reminder for itself. */);
ec28a64d
MB
970 Vcommand_debug_status = Qnil;
971
29208e82 972 DEFVAR_LISP ("mark-even-if-inactive", Vmark_even_if_inactive,
fdb82f93
PJ
973 doc: /* *Non-nil means you can use the mark even when inactive.
974This option makes a difference in Transient Mark mode.
975When the option is non-nil, deactivation of the mark
976turns off region highlighting, but commands that use the mark
977behave as if the mark were still active. */);
a2b84f35 978 Vmark_even_if_inactive = Qt;
9f315aeb 979
29208e82 980 DEFVAR_LISP ("mouse-leave-buffer-hook", Vmouse_leave_buffer_hook,
fdb82f93
PJ
981 doc: /* Hook to run when about to switch windows with a mouse command.
982Its purpose is to give temporary modes such as Isearch mode
983a way to turn themselves off when a mouse command switches windows. */);
ef2515c0
RS
984 Vmouse_leave_buffer_hook = Qnil;
985
ec28a64d
MB
986 defsubr (&Sinteractive);
987 defsubr (&Scall_interactively);
988 defsubr (&Sprefix_numeric_value);
989}