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