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