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