(jka-compr-insert-file-contents): Don't run
[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\
88c -- Character.\n\
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;
151 register struct Lisp_Cons *ptr;
152 for (tail = exp; CONSP (tail); tail = ptr->cdr)
153 {
154 ptr = XCONS (tail);
155 ptr->car = quotify_arg (ptr->car);
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 {
8450690a
RS
317 car = XCONS (input)->car;
318 /* Skip through certain special forms. */
319 while (EQ (car, Qlet) || EQ (car, Qletx)
320 || EQ (car, Qsave_excursion))
03e130d5 321 {
8450690a
RS
322 while (CONSP (XCONS (input)->cdr))
323 input = XCONS (input)->cdr;
324 input = XCONS (input)->car;
325 if (!CONSP (input))
326 break;
327 car = XCONS (input)->car;
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))
356 XCONS (teml)->cdr = Qnil;
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)
21ba0e68 391 && (event = XCONS (event)->cdr, CONSP (event))
6e54b3de 392 && (event = XCONS (event)->car, CONSP (event))
a6d1245e 393 && (event = XCONS (event)->car, 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 */
88bc3111 501 /* Use message_with_string rather than message1_nolog here,
491ee841
RS
502 so that nothing bad happens if callint_message is changed
503 within Fread_char (by a timer, for example). */
88bc3111 504 message_with_string ("%s", build_string (callint_message), 0);
ec28a64d 505 args[i] = Fread_char ();
453ed650 506 message1_nolog ((char *) 0);
ec28a64d
MB
507 /* Passing args[i] directly stimulates compiler bug */
508 teml = args[i];
509 visargs[i] = Fchar_to_string (teml);
510 break;
511
512 case 'C': /* Command: symbol with interactive function */
df31bc64 513 visargs[i] = Fcompleting_read (build_string (callint_message),
ff9cd111 514 Vobarray, Qcommandp,
93fb51ae 515 Qt, Qnil, Qnil, Qnil, Qnil);
ec28a64d
MB
516 /* Passing args[i] directly stimulates compiler bug */
517 teml = visargs[i];
518 args[i] = Fintern (teml, Qnil);
519 break;
520
521 case 'd': /* Value of point. Does not do I/O. */
dc330139 522 set_marker_both (point_marker, Qnil, PT, PT_BYTE);
824977b6 523 args[i] = point_marker;
ec28a64d
MB
524 /* visargs[i] = Qnil; */
525 varies[i] = 1;
526 break;
527
ec28a64d 528 case 'D': /* Directory name. */
df31bc64 529 args[i] = Fread_file_name (build_string (callint_message), Qnil,
ec28a64d
MB
530 current_buffer->directory, Qlambda, Qnil);
531 break;
532
533 case 'f': /* Existing file name. */
df31bc64 534 args[i] = Fread_file_name (build_string (callint_message),
ec28a64d
MB
535 Qnil, Qnil, Qlambda, Qnil);
536 break;
537
538 case 'F': /* Possibly nonexistent file name. */
df31bc64 539 args[i] = Fread_file_name (build_string (callint_message),
ec28a64d
MB
540 Qnil, Qnil, Qnil, Qnil);
541 break;
542
40b2421c
KH
543 case 'i': /* Ignore an argument -- Does not do I/O */
544 varies[i] = -1;
545 break;
546
1989e7bc 547 case 'k': /* Key sequence. */
c631c234
RS
548 {
549 int speccount1 = specpdl_ptr - specpdl;
550 specbind (Qcursor_in_echo_area, Qt);
551 args[i] = Fread_key_sequence (build_string (callint_message),
552 Qnil, Qnil, Qnil);
553 unbind_to (speccount1, Qnil);
554 teml = args[i];
555 visargs[i] = Fkey_description (teml);
556 }
1989e7bc
RS
557 break;
558
559 case 'K': /* Key sequence to be defined. */
c631c234
RS
560 {
561 int speccount1 = specpdl_ptr - specpdl;
562 specbind (Qcursor_in_echo_area, Qt);
563 args[i] = Fread_key_sequence (build_string (callint_message),
564 Qnil, Qt, Qnil);
565 teml = args[i];
566 visargs[i] = Fkey_description (teml);
567 unbind_to (speccount1, Qnil);
568 }
ec28a64d
MB
569 break;
570
bc78232c 571 case 'e': /* The invoking event. */
d455db8e 572 if (next_event >= key_count)
bc78232c 573 error ("%s must be bound to an event with parameters",
6e54b3de 574 (SYMBOLP (function)
63007de2 575 ? (char *) XSYMBOL (function)->name->data
bc78232c 576 : "command"));
d455db8e 577 args[i] = XVECTOR (keys)->contents[next_event++];
e5d77022 578 varies[i] = -1;
dbc4e1c1
JB
579
580 /* Find the next parameterized event. */
d455db8e 581 while (next_event < key_count
dbc4e1c1 582 && ! (EVENT_HAS_PARAMETERS
d455db8e 583 (XVECTOR (keys)->contents[next_event])))
dbc4e1c1
JB
584 next_event++;
585
63007de2
JB
586 break;
587
ec28a64d
MB
588 case 'm': /* Value of mark. Does not do I/O. */
589 check_mark ();
590 /* visargs[i] = Qnil; */
824977b6 591 args[i] = current_buffer->mark;
ec28a64d
MB
592 varies[i] = 2;
593 break;
594
93fb51ae
KH
595 case 'M': /* String read via minibuffer with
596 inheriting the current input method. */
597 args[i] = Fread_string (build_string (callint_message),
598 Qnil, Qnil, Qnil, Qt);
599 break;
600
ec28a64d 601 case 'N': /* Prefix arg, else number from minibuffer */
265a9e55 602 if (!NILP (prefix_arg))
ec28a64d
MB
603 goto have_prefix_arg;
604 case 'n': /* Read number from minibuffer. */
f0490a0b
RS
605 {
606 int first = 1;
607 do
608 {
609 Lisp_Object tem;
610 if (! first)
611 {
612 message ("Please enter a number.");
56fe6fc0 613 sit_for (1, 0, 0, 0, 0);
f0490a0b
RS
614 }
615 first = 0;
616
617 tem = Fread_from_minibuffer (build_string (callint_message),
93fb51ae
KH
618 Qnil, Qnil, Qnil, Qnil, Qnil,
619 Qnil);
f0490a0b
RS
620 if (! STRINGP (tem) || XSTRING (tem)->size == 0)
621 args[i] = Qnil;
622 else
623 args[i] = Fread (tem);
624 }
625 while (! NUMBERP (args[i]));
626 }
ec28a64d
MB
627 visargs[i] = last_minibuf_string;
628 break;
629
630 case 'P': /* Prefix arg in raw form. Does no I/O. */
ec28a64d
MB
631 args[i] = prefix_arg;
632 /* visargs[i] = Qnil; */
633 varies[i] = -1;
634 break;
635
636 case 'p': /* Prefix arg converted to number. No I/O. */
71eda2d5 637 have_prefix_arg:
ec28a64d
MB
638 args[i] = Fprefix_numeric_value (prefix_arg);
639 /* visargs[i] = Qnil; */
640 varies[i] = -1;
641 break;
642
643 case 'r': /* Region, point and mark as 2 args. */
644 check_mark ();
dc330139 645 set_marker_both (point_marker, Qnil, PT, PT_BYTE);
ec28a64d
MB
646 /* visargs[i+1] = Qnil; */
647 foo = marker_position (current_buffer->mark);
648 /* visargs[i] = Qnil; */
6ec8bbd2 649 args[i] = PT < foo ? point_marker : current_buffer->mark;
ec28a64d 650 varies[i] = 3;
6ec8bbd2 651 args[++i] = PT > foo ? point_marker : current_buffer->mark;
ec28a64d
MB
652 varies[i] = 4;
653 break;
654
93fb51ae
KH
655 case 's': /* String read via minibuffer without
656 inheriting the current input method. */
55c4d99f 657 args[i] = Fread_string (build_string (callint_message),
93fb51ae 658 Qnil, Qnil, Qnil, Qnil);
ec28a64d
MB
659 break;
660
661 case 'S': /* Any symbol. */
df31bc64 662 visargs[i] = Fread_string (build_string (callint_message),
93fb51ae 663 Qnil, Qnil, Qnil, Qnil);
ec28a64d
MB
664 /* Passing args[i] directly stimulates compiler bug */
665 teml = visargs[i];
666 args[i] = Fintern (teml, Qnil);
667 break;
668
669 case 'v': /* Variable name: symbol that is
670 user-variable-p. */
ff9cd111 671 args[i] = Fread_variable (build_string (callint_message), Qnil);
ec28a64d
MB
672 visargs[i] = last_minibuf_string;
673 break;
674
675 case 'x': /* Lisp expression read but not evaluated */
df31bc64 676 args[i] = Fread_minibuffer (build_string (callint_message), Qnil);
ec28a64d
MB
677 visargs[i] = last_minibuf_string;
678 break;
679
680 case 'X': /* Lisp expression read and evaluated */
df31bc64 681 args[i] = Feval_minibuffer (build_string (callint_message), Qnil);
ec28a64d
MB
682 visargs[i] = last_minibuf_string;
683 break;
684
40b2421c
KH
685 case 'Z': /* Coding-system symbol, or ignore the
686 argument if no prefix */
687 if (NILP (prefix_arg))
688 {
689 args[i] = Qnil;
690 varies[i] = -1;
691 }
692 else
693 {
694 args[i]
695 = Fread_non_nil_coding_system (build_string (callint_message));
696 visargs[i] = last_minibuf_string;
697 }
698 break;
699
700 case 'z': /* Coding-system symbol or nil */
024d8713 701 args[i] = Fread_coding_system (build_string (callint_message), Qnil);
40b2421c
KH
702 visargs[i] = last_minibuf_string;
703 break;
704
e92d107b
RS
705 /* We have a case for `+' so we get an error
706 if anyone tries to define one here. */
707 case '+':
ec28a64d 708 default:
e92d107b 709 error ("Invalid control letter `%c' (%03o) in interactive calling string",
ec28a64d
MB
710 *tem, *tem);
711 }
712
713 if (varies[i] == 0)
714 arg_from_tty = 1;
715
6e54b3de 716 if (NILP (visargs[i]) && STRINGP (args[i]))
ec28a64d
MB
717 visargs[i] = args[i];
718
719 tem = (unsigned char *) index (tem, '\n');
720 if (tem) tem++;
721 else tem = (unsigned char *) "";
722 }
52614803 723 unbind_to (speccount, Qnil);
ec28a64d
MB
724
725 QUIT;
726
727 args[0] = function;
728
7868a977 729 if (arg_from_tty || !NILP (record_flag))
ec28a64d
MB
730 {
731 visargs[0] = function;
63007de2 732 for (i = 1; i < count + 1; i++)
824977b6
RS
733 {
734 if (varies[i] > 0)
735 visargs[i] = Fcons (intern (callint_argfuns[varies[i]]), Qnil);
736 else
737 visargs[i] = quotify_arg (args[i]);
738 }
ec28a64d
MB
739 Vcommand_history = Fcons (Flist (count + 1, visargs),
740 Vcommand_history);
225c2157
RS
741 /* Don't keep command history around forever. */
742 if (NUMBERP (Vhistory_length) && XINT (Vhistory_length) > 0)
743 {
744 teml = Fnthcdr (Vhistory_length, Vcommand_history);
745 if (CONSP (teml))
746 XCONS (teml)->cdr = Qnil;
747 }
ec28a64d
MB
748 }
749
824977b6
RS
750 /* If we used a marker to hold point, mark, or an end of the region,
751 temporarily, convert it to an integer now. */
f4c8ded2 752 for (i = 1; i <= count; i++)
824977b6
RS
753 if (varies[i] >= 1 && varies[i] <= 4)
754 XSETINT (args[i], marker_position (args[i]));
755
652e2240 756 single_kboard_state ();
ebfbe249 757
ec28a64d
MB
758 {
759 Lisp_Object val;
ec28a64d
MB
760 specbind (Qcommand_debug_status, Qnil);
761
762 val = Ffuncall (count + 1, args);
763 UNGCPRO;
764 return unbind_to (speccount, val);
765 }
766}
767
768DEFUN ("prefix-numeric-value", Fprefix_numeric_value, Sprefix_numeric_value,
769 1, 1, 0,
7868a977 770 "Return numeric meaning of raw prefix argument RAW.\n\
ec28a64d
MB
771A raw prefix argument is what you get from `(interactive \"P\")'.\n\
772Its numeric meaning is what you would get from `(interactive \"p\")'.")
773 (raw)
774 Lisp_Object raw;
775{
776 Lisp_Object val;
777
265a9e55 778 if (NILP (raw))
acab6442 779 XSETFASTINT (val, 1);
fd5285f3 780 else if (EQ (raw, Qminus))
ec28a64d 781 XSETINT (val, -1);
3399a477 782 else if (CONSP (raw) && INTEGERP (XCONS (raw)->car))
ec28a64d 783 XSETINT (val, XINT (XCONS (raw)->car));
6e54b3de 784 else if (INTEGERP (raw))
ec28a64d
MB
785 val = raw;
786 else
acab6442 787 XSETFASTINT (val, 1);
ec28a64d
MB
788
789 return val;
790}
791
dfcf069d 792void
ec28a64d
MB
793syms_of_callint ()
794{
824977b6
RS
795 point_marker = Fmake_marker ();
796 staticpro (&point_marker);
797
03e130d5
RS
798 preserved_fns = Fcons (intern ("region-beginning"),
799 Fcons (intern ("region-end"),
800 Fcons (intern ("point"),
801 Fcons (intern ("mark"), Qnil))));
802 staticpro (&preserved_fns);
803
804 Qlist = intern ("list");
805 staticpro (&Qlist);
8450690a
RS
806 Qlet = intern ("let");
807 staticpro (&Qlet);
808 Qletx = intern ("let*");
809 staticpro (&Qletx);
810 Qsave_excursion = intern ("save-excursion");
811 staticpro (&Qsave_excursion);
03e130d5 812
ec28a64d
MB
813 Qminus = intern ("-");
814 staticpro (&Qminus);
815
fdb4a38c
RS
816 Qplus = intern ("+");
817 staticpro (&Qplus);
818
ec28a64d
MB
819 Qcall_interactively = intern ("call-interactively");
820 staticpro (&Qcall_interactively);
821
822 Qcommand_debug_status = intern ("command-debug-status");
823 staticpro (&Qcommand_debug_status);
824
52614803
RS
825 Qenable_recursive_minibuffers = intern ("enable-recursive-minibuffers");
826 staticpro (&Qenable_recursive_minibuffers);
827
ef2515c0
RS
828 Qmouse_leave_buffer_hook = intern ("mouse-leave-buffer-hook");
829 staticpro (&Qmouse_leave_buffer_hook);
830
df31bc64
RS
831 callint_message_size = 100;
832 callint_message = (char *) xmalloc (callint_message_size);
833
834
1e0c5826 835 DEFVAR_KBOARD ("prefix-arg", Vprefix_arg,
8c917bf2
KH
836 "The value of the prefix argument for the next editing command.\n\
837It may be a number, or the symbol `-' for just a minus sign as arg,\n\
838or a list whose car is a number for just one or more C-U's\n\
839or nil if no argument has been specified.\n\
840\n\
841You cannot examine this variable to find the argument for this command\n\
842since it has been set to nil by the time you can look.\n\
843Instead, you should use the variable `current-prefix-arg', although\n\
844normally commands can get this prefix argument with (interactive \"P\").");
8c917bf2 845
fe3fbdcc
RS
846 DEFVAR_KBOARD ("last-prefix-arg", Vlast_prefix_arg,
847 "The value of the prefix argument for the previous editing command.\n\
848See `prefix-arg' for the meaning of the value.");
849
8c917bf2
KH
850 DEFVAR_LISP ("current-prefix-arg", &Vcurrent_prefix_arg,
851 "The value of the prefix argument for this editing command.\n\
852It may be a number, or the symbol `-' for just a minus sign as arg,\n\
853or a list whose car is a number for just one or more C-U's\n\
854or nil if no argument has been specified.\n\
855This is what `(interactive \"P\")' returns.");
856 Vcurrent_prefix_arg = Qnil;
857
ec28a64d
MB
858 DEFVAR_LISP ("command-history", &Vcommand_history,
859 "List of recent commands that read arguments from terminal.\n\
860Each command is represented as a form to evaluate.");
861 Vcommand_history = Qnil;
862
863 DEFVAR_LISP ("command-debug-status", &Vcommand_debug_status,
864 "Debugging status of current interactive command.\n\
865Bound each time `call-interactively' is called;\n\
866may be set by the debugger as a reminder for itself.");
867 Vcommand_debug_status = Qnil;
868
2ad6c959 869 DEFVAR_LISP ("mark-even-if-inactive", &Vmark_even_if_inactive,
9f315aeb
RS
870 "*Non-nil means you can use the mark even when inactive.\n\
871This option makes a difference in Transient Mark mode.\n\
872When the option is non-nil, deactivation of the mark\n\
873turns off region highlighting, but commands that use the mark\n\
874behave as if the mark were still active.");
875 Vmark_even_if_inactive = Qnil;
876
ef2515c0
RS
877 DEFVAR_LISP ("mouse-leave-buffer-hook", &Vmouse_leave_buffer_hook,
878 "Hook to run when about to switch windows with a mouse command.\n\
879Its purpose is to give temporary modes such as Isearch mode\n\
880a way to turn themselves off when a mouse command switches windows.");
881 Vmouse_leave_buffer_hook = Qnil;
882
ec28a64d
MB
883 defsubr (&Sinteractive);
884 defsubr (&Scall_interactively);
885 defsubr (&Sprefix_numeric_value);
886}