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