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