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