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