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