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