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