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