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