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