Switch license to GPLv3 or later.
[bpt/emacs.git] / src / callint.c
CommitLineData
ec28a64d 1/* Call a Lisp function interactively.
429ab54e
GM
2 Copyright (C) 1985, 1986, 1993, 1994, 1995, 1997, 2000, 2001, 2002,
3 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
ec28a64d
MB
4
5This file is part of GNU Emacs.
6
7GNU Emacs is free software; you can redistribute it and/or modify
8it under the terms of the GNU General Public License as published by
dbc4e1c1 9the Free Software Foundation; either version 2, or (at your option)
ec28a64d
MB
10any later version.
11
12GNU Emacs is distributed in the hope that it will be useful,
13but WITHOUT ANY WARRANTY; without even the implied warranty of
14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15GNU General Public License for more details.
16
17You should have received a copy of the GNU General Public License
18along with GNU Emacs; see the file COPYING. If not, write to
4fc5845f
LK
19the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
20Boston, MA 02110-1301, USA. */
ec28a64d
MB
21
22
18160b98 23#include <config.h>
fdb82f93 24
ec28a64d
MB
25#include "lisp.h"
26#include "buffer.h"
27#include "commands.h"
760cbdd3 28#include "keyboard.h"
ec28a64d 29#include "window.h"
8feddab4 30#include "keymap.h"
ec28a64d 31
8892f40b
GM
32#ifdef HAVE_INDEX
33extern char *index P_ ((const char *, int));
a847af86 34#endif
ec28a64d 35
c631c234 36extern Lisp_Object Qcursor_in_echo_area;
93ed5f9d 37extern Lisp_Object Qfile_directory_p;
c631c234 38
1e0c5826 39Lisp_Object Vcurrent_prefix_arg, Qminus, Qplus;
ec28a64d
MB
40Lisp_Object Qcall_interactively;
41Lisp_Object Vcommand_history;
42
225c2157 43extern Lisp_Object Vhistory_length;
0605dd79 44extern Lisp_Object Vthis_original_command, real_this_command;
225c2157 45
ec28a64d 46Lisp_Object Vcommand_debug_status, Qcommand_debug_status;
52614803 47Lisp_Object Qenable_recursive_minibuffers;
ec28a64d 48
9f315aeb
RS
49/* Non-nil means treat the mark as active
50 even if mark_active is 0. */
51Lisp_Object Vmark_even_if_inactive;
52
ef2515c0
RS
53Lisp_Object Vmouse_leave_buffer_hook, Qmouse_leave_buffer_hook;
54
120d0a23 55Lisp_Object Qlist, Qlet, Qletx, Qsave_excursion, Qprogn, Qif, Qwhen;
824977b6
RS
56static Lisp_Object preserved_fns;
57
58/* Marker used within call-interactively to refer to point. */
59static Lisp_Object point_marker;
03e130d5 60
55b41ef5
CY
61/* String for the prompt text used in Fcall_interactively. */
62static Lisp_Object callint_message;
425b457e 63\f
ec28a64d
MB
64/* ARGSUSED */
65DEFUN ("interactive", Finteractive, Sinteractive, 0, UNEVALLED, 0,
fdb82f93
PJ
66 doc: /* Specify a way of parsing arguments for interactive use of a function.
67For example, write
68 (defun foo (arg) "Doc string" (interactive "p") ...use arg...)
69to make ARG be the prefix argument when `foo' is called as a command.
70The "call" to `interactive' is actually a declaration rather than a function;
71 it tells `call-interactively' how to read arguments
72 to pass to the function.
73When actually called, `interactive' just returns nil.
74
75The argument of `interactive' is usually a string containing a code letter
76 followed by a prompt. (Some code letters do not use I/O to get
77 the argument and do not need prompts.) To prompt for multiple arguments,
78 give a code letter, its prompt, a newline, and another code letter, etc.
79 Prompts are passed to format, and may use % escapes to print the
80 arguments that have already been read.
81If the argument is not a string, it is evaluated to get a list of
82 arguments to pass to the function.
83Just `(interactive)' means pass no args when calling interactively.
84
85Code letters available are:
86a -- Function name: symbol with a function definition.
87b -- Name of existing buffer.
88B -- Name of buffer, possibly nonexistent.
89c -- Character (no input method is used).
90C -- Command name: symbol with interactive function definition.
91d -- Value of point as number. Does not do I/O.
92D -- Directory name.
93e -- Parametrized event (i.e., one that's a list) that invoked this command.
94 If used more than once, the Nth `e' returns the Nth parameterized event.
95 This skips events that are integers or symbols.
96f -- Existing file name.
97F -- Possibly nonexistent file name.
75f9fbe8 98G -- Possibly nonexistent file name, defaulting to just directory name.
fdb82f93
PJ
99i -- Ignored, i.e. always nil. Does not do I/O.
100k -- Key sequence (downcase the last event if needed to get a definition).
101K -- Key sequence to be redefined (do not downcase the last event).
102m -- Value of mark as number. Does not do I/O.
103M -- Any string. Inherits the current input method.
104n -- Number read using minibuffer.
425b457e 105N -- Numeric prefix arg, or if none, do like code `n'.
fdb82f93
PJ
106p -- Prefix arg converted to number. Does not do I/O.
107P -- Prefix arg in raw form. Does not do I/O.
108r -- Region: point and mark as 2 numeric args, smallest first. Does no I/O.
109s -- Any string. Does not inherit the current input method.
110S -- Any symbol.
39900c4e 111U -- Mouse up event discarded by a previous k or K argument.
fdb82f93
PJ
112v -- Variable name: symbol that is user-variable-p.
113x -- Lisp expression read but not evaluated.
114X -- Lisp expression read and evaluated.
115z -- Coding system.
116Z -- Coding system, nil if no prefix arg.
117In addition, if the string begins with `*'
118 then an error is signaled if the buffer is read-only.
119 This happens before reading any arguments.
120If the string begins with `@', then Emacs searches the key sequence
121 which invoked the command for its first mouse click (or any other
122 event which specifies a window), and selects that window before
123 reading any arguments. You may use both `@' and `*'; they are
84cc45a7
PJ
124 processed in the order that they appear.
125usage: (interactive ARGS) */)
fdb82f93 126 (args)
ec28a64d
MB
127 Lisp_Object args;
128{
129 return Qnil;
130}
131
132/* Quotify EXP: if EXP is constant, return it.
133 If EXP is not constant, return (quote EXP). */
134Lisp_Object
135quotify_arg (exp)
136 register Lisp_Object exp;
137{
6e54b3de 138 if (!INTEGERP (exp) && !STRINGP (exp)
265a9e55 139 && !NILP (exp) && !EQ (exp, Qt))
ec28a64d
MB
140 return Fcons (Qquote, Fcons (exp, Qnil));
141
142 return exp;
143}
144
145/* Modify EXP by quotifying each element (except the first). */
146Lisp_Object
147quotify_args (exp)
148 Lisp_Object exp;
149{
150 register Lisp_Object tail;
7539e11f
KR
151 Lisp_Object next;
152 for (tail = exp; CONSP (tail); tail = next)
ec28a64d 153 {
7539e11f 154 next = XCDR (tail);
f3fbd155 155 XSETCAR (tail, quotify_arg (XCAR (tail)));
ec28a64d
MB
156 }
157 return exp;
158}
159
160char *callint_argfuns[]
161 = {"", "point", "mark", "region-beginning", "region-end"};
162
163static void
f203cf07
RS
164check_mark (for_region)
165 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
JB
185static void
186fix_command (input, values)
187 Lisp_Object input, values;
188{
d1135afc
JB
189 if (CONSP (input))
190 {
191 Lisp_Object car;
192
193 car = XCAR (input);
194 /* Skip through certain special forms. */
195 while (EQ (car, Qlet) || EQ (car, Qletx)
196 || EQ (car, Qsave_excursion)
197 || EQ (car, Qprogn))
198 {
199 while (CONSP (XCDR (input)))
200 input = XCDR (input);
201 input = XCAR (input);
202 if (!CONSP (input))
203 break;
204 car = XCAR (input);
205 }
206 if (EQ (car, Qlist))
207 {
208 Lisp_Object intail, valtail;
209 for (intail = Fcdr (input), valtail = values;
210 CONSP (valtail);
5dc05618 211 intail = Fcdr (intail), valtail = XCDR (valtail))
d1135afc
JB
212 {
213 Lisp_Object elt;
214 elt = Fcar (intail);
215 if (CONSP (elt))
216 {
217 Lisp_Object presflag, carelt;
218 carelt = Fcar (elt);
219 /* If it is (if X Y), look at Y. */
220 if (EQ (carelt, Qif)
221 && EQ (Fnthcdr (make_number (3), elt), Qnil))
222 elt = Fnth (make_number (2), elt);
223 /* If it is (when ... Y), look at Y. */
224 else if (EQ (carelt, Qwhen))
225 {
226 while (CONSP (XCDR (elt)))
227 elt = XCDR (elt);
228 elt = Fcar (elt);
229 }
230
231 /* If the function call we're looking at
232 is a special preserved one, copy the
233 whole expression for this argument. */
234 if (CONSP (elt))
235 {
236 presflag = Fmemq (Fcar (elt), preserved_fns);
237 if (!NILP (presflag))
238 Fsetcar (valtail, Fcar (intail));
239 }
240 }
241 }
242 }
243 }
244}
ec28a64d 245
d455db8e 246DEFUN ("call-interactively", Fcall_interactively, Scall_interactively, 1, 3, 0,
fdb82f93
PJ
247 doc: /* Call FUNCTION, reading args according to its interactive calling specs.
248Return the value FUNCTION returns.
249The function contains a specification of how to do the argument reading.
250In the case of user-defined functions, this is specified by placing a call
251to the function `interactive' at the top level of the function body.
252See `interactive'.
253
254Optional second arg RECORD-FLAG non-nil
255means unconditionally put this command in the command-history.
256Otherwise, this is done only if an arg is read using the minibuffer.
2a95a27c 257
fdb82f93 258Optional third arg KEYS, if given, specifies the sequence of events to
2a95a27c
CY
259supply, as a vector, if the command inquires which events were used to
260invoke it. If KEYS is omitted or nil, the return value of
261`this-command-keys-vector' is used. */)
fdb82f93 262 (function, record_flag, keys)
7868a977 263 Lisp_Object function, record_flag, keys;
ec28a64d
MB
264{
265 Lisp_Object *args, *visargs;
ec28a64d 266 Lisp_Object fun;
ec28a64d 267 Lisp_Object specs;
079e479f 268 Lisp_Object filter_specs;
ec28a64d 269 Lisp_Object teml;
39900c4e 270 Lisp_Object up_event;
52614803 271 Lisp_Object enable;
aed13378 272 int speccount = SPECPDL_INDEX ();
ec28a64d 273
bc78232c
JB
274 /* The index of the next element of this_command_keys to examine for
275 the 'e' interactive code. */
dbc4e1c1 276 int next_event;
bc78232c 277
ec28a64d
MB
278 Lisp_Object prefix_arg;
279 unsigned char *string;
280 unsigned char *tem;
63007de2
JB
281
282 /* If varies[i] > 0, the i'th argument shouldn't just have its value
283 in this call quoted in the command history. It should be
284 recorded as a call to the function named callint_argfuns[varies[i]]. */
ec28a64d 285 int *varies;
63007de2 286
ec28a64d
MB
287 register int i, j;
288 int count, foo;
ec28a64d
MB
289 char prompt1[100];
290 char *tem1;
291 int arg_from_tty = 0;
39900c4e 292 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
d455db8e 293 int key_count;
09c886dc 294 int record_then_fail = 0;
d455db8e 295
0605dd79
RS
296 Lisp_Object save_this_command, save_last_command;
297 Lisp_Object save_this_original_command, save_real_this_command;
298
299 save_this_command = Vthis_command;
300 save_this_original_command = Vthis_original_command;
301 save_real_this_command = real_this_command;
302 save_last_command = current_kboard->Vlast_command;
303
d455db8e
RS
304 if (NILP (keys))
305 keys = this_command_keys, key_count = this_command_key_count;
306 else
307 {
b7826503 308 CHECK_VECTOR (keys);
d455db8e
RS
309 key_count = XVECTOR (keys)->size;
310 }
ec28a64d 311
e5d77022 312 /* Save this now, since use of minibuffer will clobber it. */
8c917bf2 313 prefix_arg = Vcurrent_prefix_arg;
ec28a64d 314
6e54b3de 315 if (SYMBOLP (function))
afa4c0f3 316 enable = Fget (function, Qenable_recursive_minibuffers);
4f895918
GM
317 else
318 enable = Qnil;
52614803 319
ffd56f97 320 fun = indirect_function (function);
ec28a64d
MB
321
322 specs = Qnil;
323 string = 0;
079e479f
RS
324 /* The idea of FILTER_SPECS is to provide away to
325 specify how to represent the arguments in command history.
326 The feature is not fully implemented. */
327 filter_specs = Qnil;
ec28a64d 328
39900c4e
KS
329 /* If k or K discard an up-event, save it here so it can be retrieved with U */
330 up_event = Qnil;
331
ec28a64d 332 /* Decode the kind of function. Either handle it and return,
b08b1fc9 333 or go to `lose' if not interactive, or set either STRING or SPECS. */
ec28a64d 334
6e54b3de 335 if (SUBRP (fun))
ec28a64d
MB
336 {
337 string = (unsigned char *) XSUBR (fun)->prompt;
338 if (!string)
339 {
340 lose:
b08b1fc9 341 wrong_type_argument (Qcommandp, function);
ec28a64d 342 }
ec28a64d 343 }
6e54b3de 344 else if (COMPILEDP (fun))
ec28a64d 345 {
f9b4aacf 346 if ((XVECTOR (fun)->size & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_INTERACTIVE)
ec28a64d
MB
347 goto lose;
348 specs = XVECTOR (fun)->contents[COMPILED_INTERACTIVE];
349 }
1e0b36be 350 else
ec28a64d 351 {
1e0b36be 352 Lisp_Object form;
ec28a64d 353 GCPRO2 (function, prefix_arg);
f817f028 354 form = Finteractive_form (function);
ec28a64d 355 UNGCPRO;
1e0b36be
SM
356 if (CONSP (form))
357 specs = filter_specs = Fcar (XCDR (form));
358 else
ec28a64d 359 goto lose;
ec28a64d 360 }
ec28a64d 361
09c886dc 362 /* If either SPECS or STRING is set to a string, use it. */
6e54b3de 363 if (STRINGP (specs))
46947372
JB
364 {
365 /* Make a copy of string so that if a GC relocates specs,
366 `string' will still be valid. */
d5db4077
KR
367 string = (unsigned char *) alloca (SBYTES (specs) + 1);
368 bcopy (SDATA (specs), string,
369 SBYTES (specs) + 1);
46947372 370 }
ec28a64d
MB
371 else if (string == 0)
372 {
03e130d5 373 Lisp_Object input;
91a6ba78 374 i = num_input_events;
03e130d5
RS
375 input = specs;
376 /* Compute the arg values using the user's expression. */
079e479f 377 GCPRO2 (input, filter_specs);
6bc1abf2 378 specs = Feval (specs);
079e479f 379 UNGCPRO;
91a6ba78 380 if (i != num_input_events || !NILP (record_flag))
03e130d5
RS
381 {
382 /* We should record this command on the command history. */
f1321dc3 383 Lisp_Object values;
03e130d5
RS
384 /* Make a copy of the list of values, for the command history,
385 and turn them into things we can eval. */
386 values = quotify_args (Fcopy_sequence (specs));
120d0a23 387 fix_command (input, values);
03e130d5
RS
388 Vcommand_history
389 = Fcons (Fcons (function, values), Vcommand_history);
225c2157
RS
390
391 /* Don't keep command history around forever. */
b9f0b172 392 if (INTEGERP (Vhistory_length) && XINT (Vhistory_length) > 0)
225c2157
RS
393 {
394 teml = Fnthcdr (Vhistory_length, Vcommand_history);
395 if (CONSP (teml))
f3fbd155 396 XSETCDR (teml, Qnil);
225c2157 397 }
03e130d5 398 }
0605dd79
RS
399
400 Vthis_command = save_this_command;
401 Vthis_original_command = save_this_original_command;
402 real_this_command= save_real_this_command;
403 current_kboard->Vlast_command = save_last_command;
404
652e2240 405 single_kboard_state ();
ec28a64d
MB
406 return apply1 (function, specs);
407 }
408
409 /* Here if function specifies a string to control parsing the defaults */
410
dbc4e1c1 411 /* Set next_event to point to the first event with parameters. */
d455db8e
RS
412 for (next_event = 0; next_event < key_count; next_event++)
413 if (EVENT_HAS_PARAMETERS (XVECTOR (keys)->contents[next_event]))
dbc4e1c1 414 break;
09c886dc 415
42bb2790 416 /* Handle special starting chars `*' and `@'. Also `-'. */
e92d107b 417 /* Note that `+' is reserved for user extensions. */
ec28a64d
MB
418 while (1)
419 {
fb775602 420 if (*string == '+')
e92d107b
RS
421 error ("`+' is not used in `interactive' for ordinary commands");
422 else if (*string == '*')
ec28a64d
MB
423 {
424 string++;
265a9e55 425 if (!NILP (current_buffer->read_only))
09c886dc
RS
426 {
427 if (!NILP (record_flag))
428 {
429 unsigned char *p = string;
430 while (*p)
431 {
432 if (! (*p == 'r' || *p == 'p' || *p == 'P'
433 || *p == '\n'))
434 Fbarf_if_buffer_read_only ();
435 p++;
436 }
437 record_then_fail = 1;
438 }
439 else
440 Fbarf_if_buffer_read_only ();
441 }
ec28a64d 442 }
42bb2790
RS
443 /* Ignore this for semi-compatibility with Lucid. */
444 else if (*string == '-')
445 string++;
ec28a64d
MB
446 else if (*string == '@')
447 {
c9aa6a41 448 Lisp_Object event, tem;
dbc4e1c1 449
170d3006
AS
450 event = (next_event < key_count
451 ? XVECTOR (keys)->contents[next_event]
452 : Qnil);
dbc4e1c1 453 if (EVENT_HAS_PARAMETERS (event)
c9aa6a41
RS
454 && (tem = XCDR (event), CONSP (tem))
455 && (tem = XCAR (tem), CONSP (tem))
456 && (tem = XCAR (tem), WINDOWP (tem)))
d1fa2e8a 457 {
c9aa6a41
RS
458 if (MINI_WINDOW_P (XWINDOW (tem))
459 && ! (minibuf_level > 0 && EQ (tem, minibuf_window)))
d1fa2e8a 460 error ("Attempt to select inactive minibuffer window");
ef2515c0
RS
461
462 /* If the current buffer wants to clean up, let it. */
463 if (!NILP (Vmouse_leave_buffer_hook))
464 call1 (Vrun_hooks, Qmouse_leave_buffer_hook);
465
c9aa6a41 466 Fselect_window (tem, Qnil);
d1fa2e8a 467 }
ec28a64d 468 string++;
ec28a64d
MB
469 }
470 else break;
471 }
472
473 /* Count the number of arguments the interactive spec would have
474 us give to the function. */
475 tem = string;
476 for (j = 0; *tem; j++)
477 {
478 /* 'r' specifications ("point and mark as 2 numeric args")
479 produce *two* arguments. */
480 if (*tem == 'r') j++;
481 tem = (unsigned char *) index (tem, '\n');
482 if (tem)
483 tem++;
484 else
485 tem = (unsigned char *) "";
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 */
533 args[i] = Fcurrent_buffer ();
534 if (EQ (selected_window, minibuf_window))
34c5d0ed 535 args[i] = Fother_buffer (args[i], Qnil, Qnil);
55b41ef5 536 args[i] = Fread_buffer (callint_message, args[i], Qt);
ec28a64d
MB
537 break;
538
539 case 'B': /* Name of buffer, possibly nonexistent */
55b41ef5 540 args[i] = Fread_buffer (callint_message,
34c5d0ed 541 Fother_buffer (Fcurrent_buffer (), Qnil, Qnil),
9262fcb6 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,
75f9fbe8
RS
588 Qnil, Qnil, Qnil, build_string (""), Qnil);
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"));
d455db8e 667 args[i] = XVECTOR (keys)->contents[next_event++];
e5d77022 668 varies[i] = -1;
dbc4e1c1
JB
669
670 /* Find the next parameterized event. */
d455db8e 671 while (next_event < key_count
dbc4e1c1 672 && ! (EVENT_HAS_PARAMETERS
d455db8e 673 (XVECTOR (keys)->contents[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
652e2240 854 single_kboard_state ();
ebfbe249 855
ec28a64d
MB
856 {
857 Lisp_Object val;
ec28a64d
MB
858 specbind (Qcommand_debug_status, Qnil);
859
860 val = Ffuncall (count + 1, args);
861 UNGCPRO;
862 return unbind_to (speccount, val);
863 }
177c0ea7 864}
ec28a64d
MB
865
866DEFUN ("prefix-numeric-value", Fprefix_numeric_value, Sprefix_numeric_value,
fdb82f93
PJ
867 1, 1, 0,
868 doc: /* Return numeric meaning of raw prefix argument RAW.
869A raw prefix argument is what you get from `(interactive "P")'.
870Its numeric meaning is what you would get from `(interactive "p")'. */)
871 (raw)
ec28a64d
MB
872 Lisp_Object raw;
873{
874 Lisp_Object val;
177c0ea7 875
265a9e55 876 if (NILP (raw))
acab6442 877 XSETFASTINT (val, 1);
fd5285f3 878 else if (EQ (raw, Qminus))
ec28a64d 879 XSETINT (val, -1);
70949dac
KR
880 else if (CONSP (raw) && INTEGERP (XCAR (raw)))
881 XSETINT (val, XINT (XCAR (raw)));
6e54b3de 882 else if (INTEGERP (raw))
ec28a64d
MB
883 val = raw;
884 else
acab6442 885 XSETFASTINT (val, 1);
ec28a64d
MB
886
887 return val;
888}
889
dfcf069d 890void
ec28a64d
MB
891syms_of_callint ()
892{
824977b6
RS
893 point_marker = Fmake_marker ();
894 staticpro (&point_marker);
895
55b41ef5
CY
896 callint_message = Qnil;
897 staticpro (&callint_message);
898
03e130d5
RS
899 preserved_fns = Fcons (intern ("region-beginning"),
900 Fcons (intern ("region-end"),
901 Fcons (intern ("point"),
902 Fcons (intern ("mark"), Qnil))));
903 staticpro (&preserved_fns);
904
905 Qlist = intern ("list");
906 staticpro (&Qlist);
8450690a
RS
907 Qlet = intern ("let");
908 staticpro (&Qlet);
120d0a23
RS
909 Qif = intern ("if");
910 staticpro (&Qif);
911 Qwhen = intern ("when");
912 staticpro (&Qwhen);
8450690a
RS
913 Qletx = intern ("let*");
914 staticpro (&Qletx);
915 Qsave_excursion = intern ("save-excursion");
916 staticpro (&Qsave_excursion);
079e479f
RS
917 Qprogn = intern ("progn");
918 staticpro (&Qprogn);
03e130d5 919
ec28a64d
MB
920 Qminus = intern ("-");
921 staticpro (&Qminus);
922
fdb4a38c
RS
923 Qplus = intern ("+");
924 staticpro (&Qplus);
925
ec28a64d
MB
926 Qcall_interactively = intern ("call-interactively");
927 staticpro (&Qcall_interactively);
928
929 Qcommand_debug_status = intern ("command-debug-status");
930 staticpro (&Qcommand_debug_status);
931
52614803
RS
932 Qenable_recursive_minibuffers = intern ("enable-recursive-minibuffers");
933 staticpro (&Qenable_recursive_minibuffers);
934
ef2515c0
RS
935 Qmouse_leave_buffer_hook = intern ("mouse-leave-buffer-hook");
936 staticpro (&Qmouse_leave_buffer_hook);
937
1e0c5826 938 DEFVAR_KBOARD ("prefix-arg", Vprefix_arg,
fdb82f93
PJ
939 doc: /* The value of the prefix argument for the next editing command.
940It may be a number, or the symbol `-' for just a minus sign as arg,
941or a list whose car is a number for just one or more C-u's
942or nil if no argument has been specified.
943
944You cannot examine this variable to find the argument for this command
945since it has been set to nil by the time you can look.
946Instead, you should use the variable `current-prefix-arg', although
947normally commands can get this prefix argument with (interactive "P"). */);
8c917bf2 948
fe3fbdcc 949 DEFVAR_KBOARD ("last-prefix-arg", Vlast_prefix_arg,
fdb82f93
PJ
950 doc: /* The value of the prefix argument for the previous editing command.
951See `prefix-arg' for the meaning of the value. */);
fe3fbdcc 952
8c917bf2 953 DEFVAR_LISP ("current-prefix-arg", &Vcurrent_prefix_arg,
fdb82f93
PJ
954 doc: /* The value of the prefix argument for this editing command.
955It may be a number, or the symbol `-' for just a minus sign as arg,
956or a list whose car is a number for just one or more C-u's
957or nil if no argument has been specified.
958This is what `(interactive \"P\")' returns. */);
8c917bf2
KH
959 Vcurrent_prefix_arg = Qnil;
960
ec28a64d 961 DEFVAR_LISP ("command-history", &Vcommand_history,
fdb82f93
PJ
962 doc: /* List of recent commands that read arguments from terminal.
963Each command is represented as a form to evaluate. */);
ec28a64d
MB
964 Vcommand_history = Qnil;
965
966 DEFVAR_LISP ("command-debug-status", &Vcommand_debug_status,
fdb82f93
PJ
967 doc: /* Debugging status of current interactive command.
968Bound each time `call-interactively' is called;
969may be set by the debugger as a reminder for itself. */);
ec28a64d
MB
970 Vcommand_debug_status = Qnil;
971
2ad6c959 972 DEFVAR_LISP ("mark-even-if-inactive", &Vmark_even_if_inactive,
fdb82f93
PJ
973 doc: /* *Non-nil means you can use the mark even when inactive.
974This option makes a difference in Transient Mark mode.
975When the option is non-nil, deactivation of the mark
976turns off region highlighting, but commands that use the mark
977behave as if the mark were still active. */);
9f315aeb
RS
978 Vmark_even_if_inactive = Qnil;
979
ef2515c0 980 DEFVAR_LISP ("mouse-leave-buffer-hook", &Vmouse_leave_buffer_hook,
fdb82f93
PJ
981 doc: /* Hook to run when about to switch windows with a mouse command.
982Its purpose is to give temporary modes such as Isearch mode
983a way to turn themselves off when a mouse command switches windows. */);
ef2515c0
RS
984 Vmouse_leave_buffer_hook = Qnil;
985
ec28a64d
MB
986 defsubr (&Sinteractive);
987 defsubr (&Scall_interactively);
988 defsubr (&Sprefix_numeric_value);
989}
ab5796a9
MB
990
991/* arch-tag: a3a7cad7-bcac-42ce-916e-1bd2546ebf37
992 (do not change this comment) */