(Finteractive): Add usage to doc-string.
[bpt/emacs.git] / src / callint.c
CommitLineData
ec28a64d 1/* Call a Lisp function interactively.
4f895918
GM
2 Copyright (C) 1985, 86, 93, 94, 95, 1997, 2000
3 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
3b7ad313
EN
19the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20Boston, MA 02111-1307, 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
MB
29#include "window.h"
30#include "mocklisp.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
RS
37extern Lisp_Object Qcursor_in_echo_area;
38
1e0c5826 39Lisp_Object Vcurrent_prefix_arg, Qminus, Qplus;
ec28a64d
MB
40Lisp_Object Qcall_interactively;
41Lisp_Object Vcommand_history;
42
225c2157
RS
43extern Lisp_Object Vhistory_length;
44
ec28a64d 45Lisp_Object Vcommand_debug_status, Qcommand_debug_status;
52614803 46Lisp_Object Qenable_recursive_minibuffers;
ec28a64d 47
9f315aeb
RS
48/* Non-nil means treat the mark as active
49 even if mark_active is 0. */
50Lisp_Object Vmark_even_if_inactive;
51
ef2515c0
RS
52Lisp_Object Vmouse_leave_buffer_hook, Qmouse_leave_buffer_hook;
53
8450690a 54Lisp_Object Qlist, Qlet, Qletx, Qsave_excursion;
824977b6
RS
55static Lisp_Object preserved_fns;
56
57/* Marker used within call-interactively to refer to point. */
58static Lisp_Object point_marker;
03e130d5 59
df31bc64
RS
60/* Buffer for the prompt text used in Fcall_interactively. */
61static char *callint_message;
62
63/* Allocated length of that buffer. */
64static int callint_message_size;
1cf9cfc6 65
ec28a64d
MB
66/* ARGSUSED */
67DEFUN ("interactive", Finteractive, Sinteractive, 0, UNEVALLED, 0,
fdb82f93
PJ
68 doc: /* Specify a way of parsing arguments for interactive use of a function.
69For example, write
70 (defun foo (arg) "Doc string" (interactive "p") ...use arg...)
71to make ARG be the prefix argument when `foo' is called as a command.
72The "call" to `interactive' is actually a declaration rather than a function;
73 it tells `call-interactively' how to read arguments
74 to pass to the function.
75When actually called, `interactive' just returns nil.
76
77The argument of `interactive' is usually a string containing a code letter
78 followed by a prompt. (Some code letters do not use I/O to get
79 the argument and do not need prompts.) To prompt for multiple arguments,
80 give a code letter, its prompt, a newline, and another code letter, etc.
81 Prompts are passed to format, and may use % escapes to print the
82 arguments that have already been read.
83If the argument is not a string, it is evaluated to get a list of
84 arguments to pass to the function.
85Just `(interactive)' means pass no args when calling interactively.
86
87Code letters available are:
88a -- Function name: symbol with a function definition.
89b -- Name of existing buffer.
90B -- Name of buffer, possibly nonexistent.
91c -- Character (no input method is used).
92C -- Command name: symbol with interactive function definition.
93d -- Value of point as number. Does not do I/O.
94D -- Directory name.
95e -- Parametrized event (i.e., one that's a list) that invoked this command.
96 If used more than once, the Nth `e' returns the Nth parameterized event.
97 This skips events that are integers or symbols.
98f -- Existing file name.
99F -- Possibly nonexistent file name.
100i -- Ignored, i.e. always nil. Does not do I/O.
101k -- Key sequence (downcase the last event if needed to get a definition).
102K -- Key sequence to be redefined (do not downcase the last event).
103m -- Value of mark as number. Does not do I/O.
104M -- Any string. Inherits the current input method.
105n -- Number read using minibuffer.
106N -- Raw prefix arg, or if none, do like code `n'.
107p -- Prefix arg converted to number. Does not do I/O.
108P -- Prefix arg in raw form. Does not do I/O.
109r -- Region: point and mark as 2 numeric args, smallest first. Does no I/O.
110s -- Any string. Does not inherit the current input method.
111S -- Any symbol.
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
164check_mark ()
165{
86c1cf23
KH
166 Lisp_Object tem;
167 tem = Fmarker_buffer (current_buffer->mark);
265a9e55 168 if (NILP (tem) || (XBUFFER (tem) != current_buffer))
ec28a64d 169 error ("The mark is not set now");
6497d2d8
RM
170 if (!NILP (Vtransient_mark_mode) && NILP (Vmark_even_if_inactive)
171 && NILP (current_buffer->mark_active))
172 Fsignal (Qmark_inactive, Qnil);
ec28a64d
MB
173}
174
175
d455db8e 176DEFUN ("call-interactively", Fcall_interactively, Scall_interactively, 1, 3, 0,
fdb82f93
PJ
177 doc: /* Call FUNCTION, reading args according to its interactive calling specs.
178Return the value FUNCTION returns.
179The function contains a specification of how to do the argument reading.
180In the case of user-defined functions, this is specified by placing a call
181to the function `interactive' at the top level of the function body.
182See `interactive'.
183
184Optional second arg RECORD-FLAG non-nil
185means unconditionally put this command in the command-history.
186Otherwise, this is done only if an arg is read using the minibuffer.
187Optional third arg KEYS, if given, specifies the sequence of events to
188supply if the command inquires which events were used to invoke it. */)
189 (function, record_flag, keys)
7868a977 190 Lisp_Object function, record_flag, keys;
ec28a64d
MB
191{
192 Lisp_Object *args, *visargs;
193 unsigned char **argstrings;
194 Lisp_Object fun;
195 Lisp_Object funcar;
196 Lisp_Object specs;
197 Lisp_Object teml;
52614803
RS
198 Lisp_Object enable;
199 int speccount = specpdl_ptr - specpdl;
ec28a64d 200
bc78232c
JB
201 /* The index of the next element of this_command_keys to examine for
202 the 'e' interactive code. */
dbc4e1c1 203 int next_event;
bc78232c 204
ec28a64d
MB
205 Lisp_Object prefix_arg;
206 unsigned char *string;
207 unsigned char *tem;
63007de2
JB
208
209 /* If varies[i] > 0, the i'th argument shouldn't just have its value
210 in this call quoted in the command history. It should be
211 recorded as a call to the function named callint_argfuns[varies[i]]. */
ec28a64d 212 int *varies;
63007de2 213
ec28a64d
MB
214 register int i, j;
215 int count, foo;
ec28a64d
MB
216 char prompt1[100];
217 char *tem1;
218 int arg_from_tty = 0;
219 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
d455db8e
RS
220 int key_count;
221
222 if (NILP (keys))
223 keys = this_command_keys, key_count = this_command_key_count;
224 else
225 {
226 CHECK_VECTOR (keys, 3);
227 key_count = XVECTOR (keys)->size;
228 }
ec28a64d 229
e5d77022 230 /* Save this now, since use of minibuffer will clobber it. */
8c917bf2 231 prefix_arg = Vcurrent_prefix_arg;
ec28a64d 232
46947372 233 retry:
ec28a64d 234
6e54b3de 235 if (SYMBOLP (function))
afa4c0f3 236 enable = Fget (function, Qenable_recursive_minibuffers);
4f895918
GM
237 else
238 enable = Qnil;
52614803 239
ffd56f97 240 fun = indirect_function (function);
ec28a64d
MB
241
242 specs = Qnil;
243 string = 0;
244
245 /* Decode the kind of function. Either handle it and return,
246 or go to `lose' if not interactive, or go to `retry'
247 to specify a different function, or set either STRING or SPECS. */
248
6e54b3de 249 if (SUBRP (fun))
ec28a64d
MB
250 {
251 string = (unsigned char *) XSUBR (fun)->prompt;
252 if (!string)
253 {
254 lose:
b37902c8 255 function = wrong_type_argument (Qcommandp, function);
ec28a64d
MB
256 goto retry;
257 }
ec28a64d 258 }
6e54b3de 259 else if (COMPILEDP (fun))
ec28a64d 260 {
f9b4aacf 261 if ((XVECTOR (fun)->size & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_INTERACTIVE)
ec28a64d
MB
262 goto lose;
263 specs = XVECTOR (fun)->contents[COMPILED_INTERACTIVE];
264 }
265 else if (!CONSP (fun))
266 goto lose;
01e85d61 267 else if (funcar = XCAR (fun), EQ (funcar, Qautoload))
ec28a64d
MB
268 {
269 GCPRO2 (function, prefix_arg);
270 do_autoload (fun, function);
271 UNGCPRO;
272 goto retry;
273 }
274 else if (EQ (funcar, Qlambda))
275 {
01e85d61 276 specs = Fassq (Qinteractive, Fcdr (XCDR (fun)));
265a9e55 277 if (NILP (specs))
ec28a64d
MB
278 goto lose;
279 specs = Fcar (Fcdr (specs));
280 }
281 else if (EQ (funcar, Qmocklisp))
887e0cba 282 {
652e2240 283 single_kboard_state ();
887e0cba
KH
284 return ml_apply (fun, Qinteractive);
285 }
ec28a64d
MB
286 else
287 goto lose;
288
46947372 289 /* If either specs or string is set to a string, use it. */
6e54b3de 290 if (STRINGP (specs))
46947372
JB
291 {
292 /* Make a copy of string so that if a GC relocates specs,
293 `string' will still be valid. */
fc932ac6
RS
294 string = (unsigned char *) alloca (STRING_BYTES (XSTRING (specs)) + 1);
295 bcopy (XSTRING (specs)->data, string,
296 STRING_BYTES (XSTRING (specs)) + 1);
46947372 297 }
ec28a64d
MB
298 else if (string == 0)
299 {
03e130d5 300 Lisp_Object input;
91a6ba78 301 i = num_input_events;
03e130d5
RS
302 input = specs;
303 /* Compute the arg values using the user's expression. */
6bc1abf2 304 specs = Feval (specs);
91a6ba78 305 if (i != num_input_events || !NILP (record_flag))
03e130d5
RS
306 {
307 /* We should record this command on the command history. */
308 Lisp_Object values, car;
309 /* Make a copy of the list of values, for the command history,
310 and turn them into things we can eval. */
311 values = quotify_args (Fcopy_sequence (specs));
312 /* If the list of args was produced with an explicit call to `list',
313 look for elements that were computed with (region-beginning)
314 or (region-end), and put those expressions into VALUES
315 instead of the present values. */
8450690a 316 if (CONSP (input))
03e130d5 317 {
70949dac 318 car = XCAR (input);
8450690a
RS
319 /* Skip through certain special forms. */
320 while (EQ (car, Qlet) || EQ (car, Qletx)
321 || EQ (car, Qsave_excursion))
03e130d5 322 {
70949dac
KR
323 while (CONSP (XCDR (input)))
324 input = XCDR (input);
325 input = XCAR (input);
8450690a
RS
326 if (!CONSP (input))
327 break;
70949dac 328 car = XCAR (input);
8450690a
RS
329 }
330 if (EQ (car, Qlist))
331 {
332 Lisp_Object intail, valtail;
333 for (intail = Fcdr (input), valtail = values;
334 CONSP (valtail);
335 intail = Fcdr (intail), valtail = Fcdr (valtail))
03e130d5 336 {
8450690a
RS
337 Lisp_Object elt;
338 elt = Fcar (intail);
339 if (CONSP (elt))
340 {
341 Lisp_Object presflag;
342 presflag = Fmemq (Fcar (elt), preserved_fns);
343 if (!NILP (presflag))
344 Fsetcar (valtail, Fcar (intail));
345 }
03e130d5
RS
346 }
347 }
348 }
349 Vcommand_history
350 = Fcons (Fcons (function, values), Vcommand_history);
225c2157
RS
351
352 /* Don't keep command history around forever. */
353 if (NUMBERP (Vhistory_length) && XINT (Vhistory_length) > 0)
354 {
355 teml = Fnthcdr (Vhistory_length, Vcommand_history);
356 if (CONSP (teml))
f3fbd155 357 XSETCDR (teml, Qnil);
225c2157 358 }
03e130d5 359 }
652e2240 360 single_kboard_state ();
ec28a64d
MB
361 return apply1 (function, specs);
362 }
363
364 /* Here if function specifies a string to control parsing the defaults */
365
dbc4e1c1 366 /* Set next_event to point to the first event with parameters. */
d455db8e
RS
367 for (next_event = 0; next_event < key_count; next_event++)
368 if (EVENT_HAS_PARAMETERS (XVECTOR (keys)->contents[next_event]))
dbc4e1c1
JB
369 break;
370
42bb2790 371 /* Handle special starting chars `*' and `@'. Also `-'. */
e92d107b 372 /* Note that `+' is reserved for user extensions. */
ec28a64d
MB
373 while (1)
374 {
fb775602 375 if (*string == '+')
e92d107b
RS
376 error ("`+' is not used in `interactive' for ordinary commands");
377 else if (*string == '*')
ec28a64d
MB
378 {
379 string++;
265a9e55 380 if (!NILP (current_buffer->read_only))
ec28a64d
MB
381 Fbarf_if_buffer_read_only ();
382 }
42bb2790
RS
383 /* Ignore this for semi-compatibility with Lucid. */
384 else if (*string == '-')
385 string++;
ec28a64d
MB
386 else if (*string == '@')
387 {
86c1cf23 388 Lisp_Object event;
dbc4e1c1 389
d455db8e 390 event = XVECTOR (keys)->contents[next_event];
dbc4e1c1 391 if (EVENT_HAS_PARAMETERS (event)
70949dac
KR
392 && (event = XCDR (event), CONSP (event))
393 && (event = XCAR (event), CONSP (event))
394 && (event = XCAR (event), WINDOWP (event)))
d1fa2e8a 395 {
d68807fc 396 if (MINI_WINDOW_P (XWINDOW (event))
42bb2790 397 && ! (minibuf_level > 0 && EQ (event, minibuf_window)))
d1fa2e8a 398 error ("Attempt to select inactive minibuffer window");
ef2515c0
RS
399
400 /* If the current buffer wants to clean up, let it. */
401 if (!NILP (Vmouse_leave_buffer_hook))
402 call1 (Vrun_hooks, Qmouse_leave_buffer_hook);
403
d1fa2e8a
KH
404 Fselect_window (event);
405 }
ec28a64d 406 string++;
ec28a64d
MB
407 }
408 else break;
409 }
410
411 /* Count the number of arguments the interactive spec would have
412 us give to the function. */
413 tem = string;
414 for (j = 0; *tem; j++)
415 {
416 /* 'r' specifications ("point and mark as 2 numeric args")
417 produce *two* arguments. */
418 if (*tem == 'r') j++;
419 tem = (unsigned char *) index (tem, '\n');
420 if (tem)
421 tem++;
422 else
423 tem = (unsigned char *) "";
424 }
6bc1abf2 425 count = j;
ec28a64d
MB
426
427 args = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object));
428 visargs = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object));
429 argstrings = (unsigned char **) alloca ((count + 1) * sizeof (char *));
430 varies = (int *) alloca ((count + 1) * sizeof (int));
431
432 for (i = 0; i < (count + 1); i++)
433 {
434 args[i] = Qnil;
435 visargs[i] = Qnil;
436 varies[i] = 0;
437 }
438
439 GCPRO4 (prefix_arg, function, *args, *visargs);
440 gcpro3.nvars = (count + 1);
441 gcpro4.nvars = (count + 1);
442
52614803
RS
443 if (!NILP (enable))
444 specbind (Qenable_recursive_minibuffers, Qt);
445
ec28a64d 446 tem = string;
6bc1abf2 447 for (i = 1; *tem; i++)
ec28a64d
MB
448 {
449 strncpy (prompt1, tem + 1, sizeof prompt1 - 1);
450 prompt1[sizeof prompt1 - 1] = 0;
a847af86 451 tem1 = (char *) index (prompt1, '\n');
ec28a64d
MB
452 if (tem1) *tem1 = 0;
453 /* Fill argstrings with a vector of C strings
454 corresponding to the Lisp strings in visargs. */
455 for (j = 1; j < i; j++)
456 argstrings[j]
dc330139
RS
457 = (EQ (visargs[j], Qnil)
458 ? (unsigned char *) ""
459 : XSTRING (visargs[j])->data);
ec28a64d 460
df31bc64
RS
461 /* Process the format-string in prompt1, putting the output
462 into callint_message. Make callint_message bigger if necessary.
463 We don't use a buffer on the stack, because the contents
464 need to stay stable for a while. */
465 while (1)
466 {
467 int nchars = doprnt (callint_message, callint_message_size,
468 prompt1, (char *)0,
dc330139 469 j - 1, (char **) argstrings + 1);
df31bc64
RS
470 if (nchars < callint_message_size)
471 break;
472 callint_message_size *= 2;
473 callint_message
474 = (char *) xrealloc (callint_message, callint_message_size);
475 }
ec28a64d
MB
476
477 switch (*tem)
478 {
479 case 'a': /* Symbol defined as a function */
df31bc64 480 visargs[i] = Fcompleting_read (build_string (callint_message),
ff9cd111 481 Vobarray, Qfboundp, Qt,
93fb51ae 482 Qnil, Qnil, Qnil, Qnil);
ec28a64d
MB
483 /* Passing args[i] directly stimulates compiler bug */
484 teml = visargs[i];
485 args[i] = Fintern (teml, Qnil);
486 break;
487
488 case 'b': /* Name of existing buffer */
489 args[i] = Fcurrent_buffer ();
490 if (EQ (selected_window, minibuf_window))
34c5d0ed 491 args[i] = Fother_buffer (args[i], Qnil, Qnil);
df31bc64 492 args[i] = Fread_buffer (build_string (callint_message), args[i], Qt);
ec28a64d
MB
493 break;
494
495 case 'B': /* Name of buffer, possibly nonexistent */
df31bc64 496 args[i] = Fread_buffer (build_string (callint_message),
34c5d0ed 497 Fother_buffer (Fcurrent_buffer (), Qnil, Qnil),
9262fcb6 498 Qnil);
ec28a64d
MB
499 break;
500
501 case 'c': /* Character */
562e4a4f 502 args[i] = Fread_char (build_string (callint_message), Qnil);
453ed650 503 message1_nolog ((char *) 0);
ec28a64d
MB
504 /* Passing args[i] directly stimulates compiler bug */
505 teml = args[i];
506 visargs[i] = Fchar_to_string (teml);
507 break;
508
509 case 'C': /* Command: symbol with interactive function */
df31bc64 510 visargs[i] = Fcompleting_read (build_string (callint_message),
ff9cd111 511 Vobarray, Qcommandp,
93fb51ae 512 Qt, Qnil, Qnil, Qnil, Qnil);
ec28a64d
MB
513 /* Passing args[i] directly stimulates compiler bug */
514 teml = visargs[i];
515 args[i] = Fintern (teml, Qnil);
516 break;
517
518 case 'd': /* Value of point. Does not do I/O. */
dc330139 519 set_marker_both (point_marker, Qnil, PT, PT_BYTE);
824977b6 520 args[i] = point_marker;
ec28a64d
MB
521 /* visargs[i] = Qnil; */
522 varies[i] = 1;
523 break;
524
ec28a64d 525 case 'D': /* Directory name. */
df31bc64 526 args[i] = Fread_file_name (build_string (callint_message), Qnil,
ec28a64d
MB
527 current_buffer->directory, Qlambda, Qnil);
528 break;
529
530 case 'f': /* Existing file name. */
df31bc64 531 args[i] = Fread_file_name (build_string (callint_message),
ec28a64d
MB
532 Qnil, Qnil, Qlambda, Qnil);
533 break;
534
535 case 'F': /* Possibly nonexistent file name. */
df31bc64 536 args[i] = Fread_file_name (build_string (callint_message),
ec28a64d
MB
537 Qnil, Qnil, Qnil, Qnil);
538 break;
539
40b2421c
KH
540 case 'i': /* Ignore an argument -- Does not do I/O */
541 varies[i] = -1;
542 break;
543
1989e7bc 544 case 'k': /* Key sequence. */
c631c234
RS
545 {
546 int speccount1 = specpdl_ptr - specpdl;
547 specbind (Qcursor_in_echo_area, Qt);
548 args[i] = Fread_key_sequence (build_string (callint_message),
ad4ac475 549 Qnil, Qnil, Qnil, Qnil);
c631c234
RS
550 unbind_to (speccount1, Qnil);
551 teml = args[i];
552 visargs[i] = Fkey_description (teml);
cdfac812
RS
553
554 /* If the key sequence ends with a down-event,
555 discard the following up-event. */
556 teml = Faref (args[i], make_number (XINT (Flength (args[i])) - 1));
557 if (CONSP (teml))
70949dac 558 teml = XCAR (teml);
cdfac812
RS
559 if (SYMBOLP (teml))
560 {
561 Lisp_Object tem2;
562
563 teml = Fget (teml, intern ("event-symbol-elements"));
4b27f17c
AS
564 /* Ignore first element, which is the base key. */
565 tem2 = Fmemq (intern ("down"), Fcdr (teml));
cdfac812 566 if (! NILP (tem2))
7a983715 567 Fread_event (Qnil, Qnil);
cdfac812 568 }
c631c234 569 }
1989e7bc
RS
570 break;
571
572 case 'K': /* Key sequence to be defined. */
c631c234
RS
573 {
574 int speccount1 = specpdl_ptr - specpdl;
575 specbind (Qcursor_in_echo_area, Qt);
576 args[i] = Fread_key_sequence (build_string (callint_message),
ad4ac475 577 Qnil, Qt, Qnil, Qnil);
c631c234
RS
578 teml = args[i];
579 visargs[i] = Fkey_description (teml);
580 unbind_to (speccount1, Qnil);
cdfac812
RS
581
582 /* If the key sequence ends with a down-event,
583 discard the following up-event. */
584 teml = Faref (args[i], make_number (XINT (Flength (args[i])) - 1));
585 if (CONSP (teml))
70949dac 586 teml = XCAR (teml);
cdfac812
RS
587 if (SYMBOLP (teml))
588 {
589 Lisp_Object tem2;
590
591 teml = Fget (teml, intern ("event-symbol-elements"));
4b27f17c
AS
592 /* Ignore first element, which is the base key. */
593 tem2 = Fmemq (intern ("down"), Fcdr (teml));
cdfac812 594 if (! NILP (tem2))
7a983715 595 Fread_event (Qnil, Qnil);
cdfac812 596 }
c631c234 597 }
ec28a64d
MB
598 break;
599
bc78232c 600 case 'e': /* The invoking event. */
d455db8e 601 if (next_event >= key_count)
bc78232c 602 error ("%s must be bound to an event with parameters",
6e54b3de 603 (SYMBOLP (function)
63007de2 604 ? (char *) XSYMBOL (function)->name->data
bc78232c 605 : "command"));
d455db8e 606 args[i] = XVECTOR (keys)->contents[next_event++];
e5d77022 607 varies[i] = -1;
dbc4e1c1
JB
608
609 /* Find the next parameterized event. */
d455db8e 610 while (next_event < key_count
dbc4e1c1 611 && ! (EVENT_HAS_PARAMETERS
d455db8e 612 (XVECTOR (keys)->contents[next_event])))
dbc4e1c1
JB
613 next_event++;
614
63007de2
JB
615 break;
616
ec28a64d
MB
617 case 'm': /* Value of mark. Does not do I/O. */
618 check_mark ();
619 /* visargs[i] = Qnil; */
824977b6 620 args[i] = current_buffer->mark;
ec28a64d
MB
621 varies[i] = 2;
622 break;
623
93fb51ae
KH
624 case 'M': /* String read via minibuffer with
625 inheriting the current input method. */
626 args[i] = Fread_string (build_string (callint_message),
627 Qnil, Qnil, Qnil, Qt);
628 break;
629
ec28a64d 630 case 'N': /* Prefix arg, else number from minibuffer */
265a9e55 631 if (!NILP (prefix_arg))
ec28a64d
MB
632 goto have_prefix_arg;
633 case 'n': /* Read number from minibuffer. */
f0490a0b
RS
634 {
635 int first = 1;
636 do
637 {
638 Lisp_Object tem;
639 if (! first)
640 {
641 message ("Please enter a number.");
56fe6fc0 642 sit_for (1, 0, 0, 0, 0);
f0490a0b
RS
643 }
644 first = 0;
645
646 tem = Fread_from_minibuffer (build_string (callint_message),
93fb51ae
KH
647 Qnil, Qnil, Qnil, Qnil, Qnil,
648 Qnil);
f0490a0b
RS
649 if (! STRINGP (tem) || XSTRING (tem)->size == 0)
650 args[i] = Qnil;
651 else
652 args[i] = Fread (tem);
653 }
654 while (! NUMBERP (args[i]));
655 }
ec28a64d
MB
656 visargs[i] = last_minibuf_string;
657 break;
658
659 case 'P': /* Prefix arg in raw form. Does no I/O. */
ec28a64d
MB
660 args[i] = prefix_arg;
661 /* visargs[i] = Qnil; */
662 varies[i] = -1;
663 break;
664
665 case 'p': /* Prefix arg converted to number. No I/O. */
71eda2d5 666 have_prefix_arg:
ec28a64d
MB
667 args[i] = Fprefix_numeric_value (prefix_arg);
668 /* visargs[i] = Qnil; */
669 varies[i] = -1;
670 break;
671
672 case 'r': /* Region, point and mark as 2 args. */
673 check_mark ();
dc330139 674 set_marker_both (point_marker, Qnil, PT, PT_BYTE);
ec28a64d
MB
675 /* visargs[i+1] = Qnil; */
676 foo = marker_position (current_buffer->mark);
677 /* visargs[i] = Qnil; */
6ec8bbd2 678 args[i] = PT < foo ? point_marker : current_buffer->mark;
ec28a64d 679 varies[i] = 3;
6ec8bbd2 680 args[++i] = PT > foo ? point_marker : current_buffer->mark;
ec28a64d
MB
681 varies[i] = 4;
682 break;
683
93fb51ae
KH
684 case 's': /* String read via minibuffer without
685 inheriting the current input method. */
55c4d99f 686 args[i] = Fread_string (build_string (callint_message),
93fb51ae 687 Qnil, Qnil, Qnil, Qnil);
ec28a64d
MB
688 break;
689
690 case 'S': /* Any symbol. */
df31bc64 691 visargs[i] = Fread_string (build_string (callint_message),
93fb51ae 692 Qnil, Qnil, Qnil, Qnil);
ec28a64d
MB
693 /* Passing args[i] directly stimulates compiler bug */
694 teml = visargs[i];
695 args[i] = Fintern (teml, Qnil);
696 break;
697
698 case 'v': /* Variable name: symbol that is
699 user-variable-p. */
ff9cd111 700 args[i] = Fread_variable (build_string (callint_message), Qnil);
ec28a64d
MB
701 visargs[i] = last_minibuf_string;
702 break;
703
704 case 'x': /* Lisp expression read but not evaluated */
df31bc64 705 args[i] = Fread_minibuffer (build_string (callint_message), Qnil);
ec28a64d
MB
706 visargs[i] = last_minibuf_string;
707 break;
708
709 case 'X': /* Lisp expression read and evaluated */
df31bc64 710 args[i] = Feval_minibuffer (build_string (callint_message), Qnil);
ec28a64d
MB
711 visargs[i] = last_minibuf_string;
712 break;
713
40b2421c
KH
714 case 'Z': /* Coding-system symbol, or ignore the
715 argument if no prefix */
716 if (NILP (prefix_arg))
717 {
718 args[i] = Qnil;
719 varies[i] = -1;
720 }
721 else
722 {
723 args[i]
724 = Fread_non_nil_coding_system (build_string (callint_message));
725 visargs[i] = last_minibuf_string;
726 }
727 break;
728
729 case 'z': /* Coding-system symbol or nil */
024d8713 730 args[i] = Fread_coding_system (build_string (callint_message), Qnil);
40b2421c
KH
731 visargs[i] = last_minibuf_string;
732 break;
733
e92d107b
RS
734 /* We have a case for `+' so we get an error
735 if anyone tries to define one here. */
736 case '+':
ec28a64d 737 default:
e92d107b 738 error ("Invalid control letter `%c' (%03o) in interactive calling string",
ec28a64d
MB
739 *tem, *tem);
740 }
741
742 if (varies[i] == 0)
743 arg_from_tty = 1;
744
6e54b3de 745 if (NILP (visargs[i]) && STRINGP (args[i]))
ec28a64d
MB
746 visargs[i] = args[i];
747
748 tem = (unsigned char *) index (tem, '\n');
749 if (tem) tem++;
750 else tem = (unsigned char *) "";
751 }
52614803 752 unbind_to (speccount, Qnil);
ec28a64d
MB
753
754 QUIT;
755
756 args[0] = function;
757
7868a977 758 if (arg_from_tty || !NILP (record_flag))
ec28a64d
MB
759 {
760 visargs[0] = function;
63007de2 761 for (i = 1; i < count + 1; i++)
824977b6
RS
762 {
763 if (varies[i] > 0)
764 visargs[i] = Fcons (intern (callint_argfuns[varies[i]]), Qnil);
765 else
766 visargs[i] = quotify_arg (args[i]);
767 }
ec28a64d
MB
768 Vcommand_history = Fcons (Flist (count + 1, visargs),
769 Vcommand_history);
225c2157
RS
770 /* Don't keep command history around forever. */
771 if (NUMBERP (Vhistory_length) && XINT (Vhistory_length) > 0)
772 {
773 teml = Fnthcdr (Vhistory_length, Vcommand_history);
774 if (CONSP (teml))
f3fbd155 775 XSETCDR (teml, Qnil);
225c2157 776 }
ec28a64d
MB
777 }
778
824977b6
RS
779 /* If we used a marker to hold point, mark, or an end of the region,
780 temporarily, convert it to an integer now. */
f4c8ded2 781 for (i = 1; i <= count; i++)
824977b6
RS
782 if (varies[i] >= 1 && varies[i] <= 4)
783 XSETINT (args[i], marker_position (args[i]));
784
652e2240 785 single_kboard_state ();
ebfbe249 786
ec28a64d
MB
787 {
788 Lisp_Object val;
ec28a64d
MB
789 specbind (Qcommand_debug_status, Qnil);
790
791 val = Ffuncall (count + 1, args);
792 UNGCPRO;
793 return unbind_to (speccount, val);
794 }
795}
796
797DEFUN ("prefix-numeric-value", Fprefix_numeric_value, Sprefix_numeric_value,
fdb82f93
PJ
798 1, 1, 0,
799 doc: /* Return numeric meaning of raw prefix argument RAW.
800A raw prefix argument is what you get from `(interactive "P")'.
801Its numeric meaning is what you would get from `(interactive "p")'. */)
802 (raw)
ec28a64d
MB
803 Lisp_Object raw;
804{
805 Lisp_Object val;
806
265a9e55 807 if (NILP (raw))
acab6442 808 XSETFASTINT (val, 1);
fd5285f3 809 else if (EQ (raw, Qminus))
ec28a64d 810 XSETINT (val, -1);
70949dac
KR
811 else if (CONSP (raw) && INTEGERP (XCAR (raw)))
812 XSETINT (val, XINT (XCAR (raw)));
6e54b3de 813 else if (INTEGERP (raw))
ec28a64d
MB
814 val = raw;
815 else
acab6442 816 XSETFASTINT (val, 1);
ec28a64d
MB
817
818 return val;
819}
820
dfcf069d 821void
ec28a64d
MB
822syms_of_callint ()
823{
824977b6
RS
824 point_marker = Fmake_marker ();
825 staticpro (&point_marker);
826
03e130d5
RS
827 preserved_fns = Fcons (intern ("region-beginning"),
828 Fcons (intern ("region-end"),
829 Fcons (intern ("point"),
830 Fcons (intern ("mark"), Qnil))));
831 staticpro (&preserved_fns);
832
833 Qlist = intern ("list");
834 staticpro (&Qlist);
8450690a
RS
835 Qlet = intern ("let");
836 staticpro (&Qlet);
837 Qletx = intern ("let*");
838 staticpro (&Qletx);
839 Qsave_excursion = intern ("save-excursion");
840 staticpro (&Qsave_excursion);
03e130d5 841
ec28a64d
MB
842 Qminus = intern ("-");
843 staticpro (&Qminus);
844
fdb4a38c
RS
845 Qplus = intern ("+");
846 staticpro (&Qplus);
847
ec28a64d
MB
848 Qcall_interactively = intern ("call-interactively");
849 staticpro (&Qcall_interactively);
850
851 Qcommand_debug_status = intern ("command-debug-status");
852 staticpro (&Qcommand_debug_status);
853
52614803
RS
854 Qenable_recursive_minibuffers = intern ("enable-recursive-minibuffers");
855 staticpro (&Qenable_recursive_minibuffers);
856
ef2515c0
RS
857 Qmouse_leave_buffer_hook = intern ("mouse-leave-buffer-hook");
858 staticpro (&Qmouse_leave_buffer_hook);
859
df31bc64
RS
860 callint_message_size = 100;
861 callint_message = (char *) xmalloc (callint_message_size);
862
863
1e0c5826 864 DEFVAR_KBOARD ("prefix-arg", Vprefix_arg,
fdb82f93
PJ
865 doc: /* The value of the prefix argument for the next editing command.
866It may be a number, or the symbol `-' for just a minus sign as arg,
867or a list whose car is a number for just one or more C-u's
868or nil if no argument has been specified.
869
870You cannot examine this variable to find the argument for this command
871since it has been set to nil by the time you can look.
872Instead, you should use the variable `current-prefix-arg', although
873normally commands can get this prefix argument with (interactive "P"). */);
8c917bf2 874
fe3fbdcc 875 DEFVAR_KBOARD ("last-prefix-arg", Vlast_prefix_arg,
fdb82f93
PJ
876 doc: /* The value of the prefix argument for the previous editing command.
877See `prefix-arg' for the meaning of the value. */);
fe3fbdcc 878
8c917bf2 879 DEFVAR_LISP ("current-prefix-arg", &Vcurrent_prefix_arg,
fdb82f93
PJ
880 doc: /* The value of the prefix argument for this editing command.
881It may be a number, or the symbol `-' for just a minus sign as arg,
882or a list whose car is a number for just one or more C-u's
883or nil if no argument has been specified.
884This is what `(interactive \"P\")' returns. */);
8c917bf2
KH
885 Vcurrent_prefix_arg = Qnil;
886
ec28a64d 887 DEFVAR_LISP ("command-history", &Vcommand_history,
fdb82f93
PJ
888 doc: /* List of recent commands that read arguments from terminal.
889Each command is represented as a form to evaluate. */);
ec28a64d
MB
890 Vcommand_history = Qnil;
891
892 DEFVAR_LISP ("command-debug-status", &Vcommand_debug_status,
fdb82f93
PJ
893 doc: /* Debugging status of current interactive command.
894Bound each time `call-interactively' is called;
895may be set by the debugger as a reminder for itself. */);
ec28a64d
MB
896 Vcommand_debug_status = Qnil;
897
2ad6c959 898 DEFVAR_LISP ("mark-even-if-inactive", &Vmark_even_if_inactive,
fdb82f93
PJ
899 doc: /* *Non-nil means you can use the mark even when inactive.
900This option makes a difference in Transient Mark mode.
901When the option is non-nil, deactivation of the mark
902turns off region highlighting, but commands that use the mark
903behave as if the mark were still active. */);
9f315aeb
RS
904 Vmark_even_if_inactive = Qnil;
905
ef2515c0 906 DEFVAR_LISP ("mouse-leave-buffer-hook", &Vmouse_leave_buffer_hook,
fdb82f93
PJ
907 doc: /* Hook to run when about to switch windows with a mouse command.
908Its purpose is to give temporary modes such as Isearch mode
909a way to turn themselves off when a mouse command switches windows. */);
ef2515c0
RS
910 Vmouse_leave_buffer_hook = Qnil;
911
ec28a64d
MB
912 defsubr (&Sinteractive);
913 defsubr (&Scall_interactively);
914 defsubr (&Sprefix_numeric_value);
915}