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