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