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