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