Fix display when left-fringe/right-fringe display spec is invalid.
[emacs.git] / src / callint.c
blobe09210f1bb6f48e21e1ca4e9309acce4a198cd7e
1 /* Call a Lisp function interactively.
2 Copyright (C) 1985-1986, 1993-1995, 1997, 2000-2012
3 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
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.
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.
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/>. */
21 #include <config.h>
22 #include <setjmp.h>
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"
32 Lisp_Object Qminus, Qplus;
33 Lisp_Object Qcall_interactively;
34 static Lisp_Object Qcommand_debug_status;
35 static Lisp_Object Qenable_recursive_minibuffers;
37 static Lisp_Object Qhandle_shift_selection;
39 Lisp_Object Qmouse_leave_buffer_hook;
41 static Lisp_Object Qlist, Qlet, Qletx, Qsave_excursion, Qprogn, Qif;
42 Lisp_Object Qwhen;
43 static Lisp_Object preserved_fns;
45 /* Marker used within call-interactively to refer to point. */
46 static Lisp_Object point_marker;
48 /* String for the prompt text used in Fcall_interactively. */
49 static Lisp_Object callint_message;
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.
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.
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 user-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.
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)
119 return Qnil;
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)
127 if (CONSP (exp)
128 || (SYMBOLP (exp)
129 && !NILP (exp) && !EQ (exp, Qt)))
130 return Fcons (Qquote, Fcons (exp, Qnil));
132 return exp;
135 /* Modify EXP by quotifying each element (except the first). */
136 static Lisp_Object
137 quotify_args (Lisp_Object exp)
139 register Lisp_Object tail;
140 Lisp_Object next;
141 for (tail = exp; CONSP (tail); tail = next)
143 next = XCDR (tail);
144 XSETCAR (tail, quotify_arg (XCAR (tail)));
146 return exp;
149 static const char *callint_argfuns[]
150 = {"", "point", "mark", "region-beginning", "region-end"};
152 static void
153 check_mark (int for_region)
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);
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.
170 This function doesn't return a value because it modifies elements
171 of VALUES to do its job. */
173 static void
174 fix_command (Lisp_Object input, Lisp_Object values)
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))
181 Lisp_Object car;
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))
189 while (CONSP (XCDR (input)))
190 input = XCDR (input);
191 input = XCAR (input);
192 if (!CONSP (input))
193 break;
194 car = XCAR (input);
196 if (EQ (car, Qlist))
198 Lisp_Object intail, valtail;
199 for (intail = Fcdr (input), valtail = values;
200 CONSP (valtail);
201 intail = Fcdr (intail), valtail = XCDR (valtail))
203 Lisp_Object elt;
204 elt = Fcar (intail);
205 if (CONSP (elt))
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))
216 while (CONSP (XCDR (elt)))
217 elt = XCDR (elt);
218 elt = Fcar (elt);
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))
226 presflag = Fmemq (Fcar (elt), preserved_fns);
227 if (!NILP (presflag))
228 Fsetcar (valtail, Fcar (intail));
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'.
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.
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)
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 int speccount = SPECPDL_INDEX ();
262 /* The index of the next element of this_command_keys to examine for
263 the 'e' interactive code. */
264 int next_event;
266 Lisp_Object prefix_arg;
267 char *string;
268 const char *tem;
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;
275 ptrdiff_t i, nargs;
276 int foo;
277 int arg_from_tty = 0;
278 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
279 int key_count;
280 int record_then_fail = 0;
282 Lisp_Object save_this_command, save_last_command;
283 Lisp_Object save_this_original_command, save_real_this_command;
285 save_this_command = Vthis_command;
286 save_this_original_command = Vthis_original_command;
287 save_real_this_command = real_this_command;
288 save_last_command = KVAR (current_kboard, Vlast_command);
290 if (NILP (keys))
291 keys = this_command_keys, key_count = this_command_key_count;
292 else
294 CHECK_VECTOR (keys);
295 key_count = ASIZE (keys);
298 /* Save this now, since use of minibuffer will clobber it. */
299 prefix_arg = Vcurrent_prefix_arg;
301 if (SYMBOLP (function))
302 enable = Fget (function, Qenable_recursive_minibuffers);
303 else
304 enable = Qnil;
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;
313 /* If k or K discard an up-event, save it here so it can be retrieved with U */
314 up_event = Qnil;
316 /* Set SPECS to the interactive form, or barf if not interactive. */
318 Lisp_Object form;
319 GCPRO2 (function, prefix_arg);
320 form = Finteractive_form (function);
321 UNGCPRO;
322 if (CONSP (form))
323 specs = filter_specs = Fcar (XCDR (form));
324 else
325 wrong_type_argument (Qcommandp, function);
328 /* If SPECS is set to a string, use it as an interactive prompt. */
329 if (STRINGP (specs))
331 /* Make a copy of string so that if a GC relocates specs,
332 `string' will still be valid. */
333 string = (char *) alloca (SBYTES (specs) + 1);
334 memcpy (string, SSDATA (specs), SBYTES (specs) + 1);
336 else
338 Lisp_Object input;
339 Lisp_Object funval = Findirect_function (function, Qt);
340 uintmax_t events = num_input_events;
341 input = specs;
342 /* Compute the arg values using the user's expression. */
343 GCPRO2 (input, filter_specs);
344 specs = Feval (specs,
345 CONSP (funval) && EQ (Qclosure, XCAR (funval))
346 ? Qt : Qnil);
347 UNGCPRO;
348 if (events != num_input_events || !NILP (record_flag))
350 /* We should record this command on the command history. */
351 Lisp_Object values;
352 Lisp_Object this_cmd;
353 /* Make a copy of the list of values, for the command history,
354 and turn them into things we can eval. */
355 values = quotify_args (Fcopy_sequence (specs));
356 fix_command (input, values);
357 this_cmd = Fcons (function, values);
358 if (history_delete_duplicates)
359 Vcommand_history = Fdelete (this_cmd, Vcommand_history);
360 Vcommand_history = Fcons (this_cmd, Vcommand_history);
362 /* Don't keep command history around forever. */
363 if (INTEGERP (Vhistory_length) && XINT (Vhistory_length) > 0)
365 teml = Fnthcdr (Vhistory_length, Vcommand_history);
366 if (CONSP (teml))
367 XSETCDR (teml, Qnil);
371 Vthis_command = save_this_command;
372 Vthis_original_command = save_this_original_command;
373 real_this_command= save_real_this_command;
374 KVAR (current_kboard, Vlast_command) = save_last_command;
376 temporarily_switch_to_single_kboard (NULL);
377 return unbind_to (speccount, apply1 (function, specs));
380 /* Here if function specifies a string to control parsing the defaults */
382 /* Set next_event to point to the first event with parameters. */
383 for (next_event = 0; next_event < key_count; next_event++)
384 if (EVENT_HAS_PARAMETERS (AREF (keys, next_event)))
385 break;
387 /* Handle special starting chars `*' and `@'. Also `-'. */
388 /* Note that `+' is reserved for user extensions. */
389 while (1)
391 if (*string == '+')
392 error ("`+' is not used in `interactive' for ordinary commands");
393 else if (*string == '*')
395 string++;
396 if (!NILP (BVAR (current_buffer, read_only)))
398 if (!NILP (record_flag))
400 char *p = string;
401 while (*p)
403 if (! (*p == 'r' || *p == 'p' || *p == 'P'
404 || *p == '\n'))
405 Fbarf_if_buffer_read_only ();
406 p++;
408 record_then_fail = 1;
410 else
411 Fbarf_if_buffer_read_only ();
414 /* Ignore this for semi-compatibility with Lucid. */
415 else if (*string == '-')
416 string++;
417 else if (*string == '@')
419 Lisp_Object event, w;
421 event = (next_event < key_count
422 ? AREF (keys, next_event)
423 : Qnil);
424 if (EVENT_HAS_PARAMETERS (event)
425 && (w = XCDR (event), CONSP (w))
426 && (w = XCAR (w), CONSP (w))
427 && (w = XCAR (w), WINDOWP (w)))
429 if (MINI_WINDOW_P (XWINDOW (w))
430 && ! (minibuf_level > 0 && EQ (w, minibuf_window)))
431 error ("Attempt to select inactive minibuffer window");
433 /* If the current buffer wants to clean up, let it. */
434 Frun_hooks (1, &Qmouse_leave_buffer_hook);
436 Fselect_window (w, Qnil);
438 string++;
440 else if (*string == '^')
442 call0 (Qhandle_shift_selection);
443 string++;
445 else break;
448 /* Count the number of arguments, which is one plus the number of arguments
449 the interactive spec would have us give to the function. */
450 tem = string;
451 for (nargs = 1; *tem; )
453 /* 'r' specifications ("point and mark as 2 numeric args")
454 produce *two* arguments. */
455 if (*tem == 'r')
456 nargs += 2;
457 else
458 nargs++;
459 tem = strchr (tem, '\n');
460 if (tem)
461 ++tem;
462 else
463 break;
466 if (min (MOST_POSITIVE_FIXNUM,
467 min (PTRDIFF_MAX, SIZE_MAX) / sizeof (Lisp_Object))
468 < nargs)
469 memory_full (SIZE_MAX);
471 args = (Lisp_Object *) alloca (nargs * sizeof (Lisp_Object));
472 visargs = (Lisp_Object *) alloca (nargs * sizeof (Lisp_Object));
473 varies = (signed char *) alloca (nargs);
475 for (i = 0; i < nargs; i++)
477 args[i] = Qnil;
478 visargs[i] = Qnil;
479 varies[i] = 0;
482 GCPRO5 (prefix_arg, function, *args, *visargs, up_event);
483 gcpro3.nvars = nargs;
484 gcpro4.nvars = nargs;
486 if (!NILP (enable))
487 specbind (Qenable_recursive_minibuffers, Qt);
489 tem = string;
490 for (i = 1; *tem; i++)
492 visargs[0] = make_string (tem + 1, strcspn (tem + 1, "\n"));
493 if (strchr (SSDATA (visargs[0]), '%'))
494 callint_message = Fformat (i, visargs);
495 else
496 callint_message = visargs[0];
498 switch (*tem)
500 case 'a': /* Symbol defined as a function */
501 visargs[i] = Fcompleting_read (callint_message,
502 Vobarray, Qfboundp, Qt,
503 Qnil, Qnil, Qnil, Qnil);
504 /* Passing args[i] directly stimulates compiler bug */
505 teml = visargs[i];
506 args[i] = Fintern (teml, Qnil);
507 break;
509 case 'b': /* Name of existing buffer */
510 args[i] = Fcurrent_buffer ();
511 if (EQ (selected_window, minibuf_window))
512 args[i] = Fother_buffer (args[i], Qnil, Qnil);
513 args[i] = Fread_buffer (callint_message, args[i], Qt);
514 break;
516 case 'B': /* Name of buffer, possibly nonexistent */
517 args[i] = Fread_buffer (callint_message,
518 Fother_buffer (Fcurrent_buffer (), Qnil, Qnil),
519 Qnil);
520 break;
522 case 'c': /* Character */
523 /* Prompt in `minibuffer-prompt' face. */
524 Fput_text_property (make_number (0),
525 make_number (SCHARS (callint_message)),
526 Qface, Qminibuffer_prompt, callint_message);
527 args[i] = Fread_char (callint_message, Qnil, Qnil);
528 message1_nolog ((char *) 0);
529 /* Passing args[i] directly stimulates compiler bug */
530 teml = args[i];
531 /* See bug#8479. */
532 if (! CHARACTERP (teml)) error ("Non-character input-event");
533 visargs[i] = Fchar_to_string (teml);
534 break;
536 case 'C': /* Command: symbol with interactive function */
537 visargs[i] = Fcompleting_read (callint_message,
538 Vobarray, Qcommandp,
539 Qt, Qnil, Qnil, Qnil, Qnil);
540 /* Passing args[i] directly stimulates compiler bug */
541 teml = visargs[i];
542 args[i] = Fintern (teml, Qnil);
543 break;
545 case 'd': /* Value of point. Does not do I/O. */
546 set_marker_both (point_marker, Qnil, PT, PT_BYTE);
547 args[i] = point_marker;
548 /* visargs[i] = Qnil; */
549 varies[i] = 1;
550 break;
552 case 'D': /* Directory name. */
553 args[i] = Fread_file_name (callint_message, Qnil,
554 BVAR (current_buffer, directory), Qlambda, Qnil,
555 Qfile_directory_p);
556 break;
558 case 'f': /* Existing file name. */
559 args[i] = Fread_file_name (callint_message,
560 Qnil, Qnil, Qlambda, Qnil, Qnil);
561 break;
563 case 'F': /* Possibly nonexistent file name. */
564 args[i] = Fread_file_name (callint_message,
565 Qnil, Qnil, Qnil, Qnil, Qnil);
566 break;
568 case 'G': /* Possibly nonexistent file name,
569 default to directory alone. */
570 args[i] = Fread_file_name (callint_message,
571 Qnil, Qnil, Qnil, empty_unibyte_string, Qnil);
572 break;
574 case 'i': /* Ignore an argument -- Does not do I/O */
575 varies[i] = -1;
576 break;
578 case 'k': /* Key sequence. */
580 int speccount1 = SPECPDL_INDEX ();
581 specbind (Qcursor_in_echo_area, Qt);
582 /* Prompt in `minibuffer-prompt' face. */
583 Fput_text_property (make_number (0),
584 make_number (SCHARS (callint_message)),
585 Qface, Qminibuffer_prompt, callint_message);
586 args[i] = Fread_key_sequence (callint_message,
587 Qnil, Qnil, Qnil, Qnil);
588 unbind_to (speccount1, Qnil);
589 teml = args[i];
590 visargs[i] = Fkey_description (teml, Qnil);
592 /* If the key sequence ends with a down-event,
593 discard the following up-event. */
594 teml = Faref (args[i], make_number (XINT (Flength (args[i])) - 1));
595 if (CONSP (teml))
596 teml = XCAR (teml);
597 if (SYMBOLP (teml))
599 Lisp_Object tem2;
601 teml = Fget (teml, intern ("event-symbol-elements"));
602 /* Ignore first element, which is the base key. */
603 tem2 = Fmemq (intern ("down"), Fcdr (teml));
604 if (! NILP (tem2))
605 up_event = Fread_event (Qnil, Qnil, Qnil);
608 break;
610 case 'K': /* Key sequence to be defined. */
612 int speccount1 = SPECPDL_INDEX ();
613 specbind (Qcursor_in_echo_area, Qt);
614 /* Prompt in `minibuffer-prompt' face. */
615 Fput_text_property (make_number (0),
616 make_number (SCHARS (callint_message)),
617 Qface, Qminibuffer_prompt, callint_message);
618 args[i] = Fread_key_sequence (callint_message,
619 Qnil, Qt, Qnil, Qnil);
620 teml = args[i];
621 visargs[i] = Fkey_description (teml, Qnil);
622 unbind_to (speccount1, Qnil);
624 /* If the key sequence ends with a down-event,
625 discard the following up-event. */
626 teml = Faref (args[i], make_number (XINT (Flength (args[i])) - 1));
627 if (CONSP (teml))
628 teml = XCAR (teml);
629 if (SYMBOLP (teml))
631 Lisp_Object tem2;
633 teml = Fget (teml, intern ("event-symbol-elements"));
634 /* Ignore first element, which is the base key. */
635 tem2 = Fmemq (intern ("down"), Fcdr (teml));
636 if (! NILP (tem2))
637 up_event = Fread_event (Qnil, Qnil, Qnil);
640 break;
642 case 'U': /* Up event from last k or K */
643 if (!NILP (up_event))
645 args[i] = Fmake_vector (make_number (1), up_event);
646 up_event = Qnil;
647 teml = args[i];
648 visargs[i] = Fkey_description (teml, Qnil);
650 break;
652 case 'e': /* The invoking event. */
653 if (next_event >= key_count)
654 error ("%s must be bound to an event with parameters",
655 (SYMBOLP (function)
656 ? SSDATA (SYMBOL_NAME (function))
657 : "command"));
658 args[i] = AREF (keys, next_event);
659 next_event++;
660 varies[i] = -1;
662 /* Find the next parameterized event. */
663 while (next_event < key_count
664 && !(EVENT_HAS_PARAMETERS (AREF (keys, next_event))))
665 next_event++;
667 break;
669 case 'm': /* Value of mark. Does not do I/O. */
670 check_mark (0);
671 /* visargs[i] = Qnil; */
672 args[i] = BVAR (current_buffer, mark);
673 varies[i] = 2;
674 break;
676 case 'M': /* String read via minibuffer with
677 inheriting the current input method. */
678 args[i] = Fread_string (callint_message,
679 Qnil, Qnil, Qnil, Qt);
680 break;
682 case 'N': /* Prefix arg as number, else number from minibuffer */
683 if (!NILP (prefix_arg))
684 goto have_prefix_arg;
685 case 'n': /* Read number from minibuffer. */
687 int first = 1;
690 Lisp_Object str;
691 if (! first)
693 message ("Please enter a number.");
694 sit_for (make_number (1), 0, 0);
696 first = 0;
698 str = Fread_from_minibuffer (callint_message,
699 Qnil, Qnil, Qnil, Qnil, Qnil,
700 Qnil);
701 if (! STRINGP (str) || SCHARS (str) == 0)
702 args[i] = Qnil;
703 else
704 args[i] = Fread (str);
706 while (! NUMBERP (args[i]));
708 visargs[i] = args[i];
709 break;
711 case 'P': /* Prefix arg in raw form. Does no I/O. */
712 args[i] = prefix_arg;
713 /* visargs[i] = Qnil; */
714 varies[i] = -1;
715 break;
717 case 'p': /* Prefix arg converted to number. No I/O. */
718 have_prefix_arg:
719 args[i] = Fprefix_numeric_value (prefix_arg);
720 /* visargs[i] = Qnil; */
721 varies[i] = -1;
722 break;
724 case 'r': /* Region, point and mark as 2 args. */
725 check_mark (1);
726 set_marker_both (point_marker, Qnil, PT, PT_BYTE);
727 /* visargs[i+1] = Qnil; */
728 foo = marker_position (BVAR (current_buffer, mark));
729 /* visargs[i] = Qnil; */
730 args[i] = PT < foo ? point_marker : BVAR (current_buffer, mark);
731 varies[i] = 3;
732 args[++i] = PT > foo ? point_marker : BVAR (current_buffer, mark);
733 varies[i] = 4;
734 break;
736 case 's': /* String read via minibuffer without
737 inheriting the current input method. */
738 args[i] = Fread_string (callint_message,
739 Qnil, Qnil, Qnil, Qnil);
740 break;
742 case 'S': /* Any symbol. */
743 visargs[i] = Fread_string (callint_message,
744 Qnil, Qnil, Qnil, Qnil);
745 /* Passing args[i] directly stimulates compiler bug */
746 teml = visargs[i];
747 args[i] = Fintern (teml, Qnil);
748 break;
750 case 'v': /* Variable name: symbol that is
751 user-variable-p. */
752 args[i] = Fread_variable (callint_message, Qnil);
753 visargs[i] = last_minibuf_string;
754 break;
756 case 'x': /* Lisp expression read but not evaluated */
757 args[i] = Fread_minibuffer (callint_message, Qnil);
758 visargs[i] = last_minibuf_string;
759 break;
761 case 'X': /* Lisp expression read and evaluated */
762 args[i] = Feval_minibuffer (callint_message, Qnil);
763 visargs[i] = last_minibuf_string;
764 break;
766 case 'Z': /* Coding-system symbol, or ignore the
767 argument if no prefix */
768 if (NILP (prefix_arg))
770 args[i] = Qnil;
771 varies[i] = -1;
773 else
775 args[i]
776 = Fread_non_nil_coding_system (callint_message);
777 visargs[i] = last_minibuf_string;
779 break;
781 case 'z': /* Coding-system symbol or nil */
782 args[i] = Fread_coding_system (callint_message, Qnil);
783 visargs[i] = last_minibuf_string;
784 break;
786 /* We have a case for `+' so we get an error
787 if anyone tries to define one here. */
788 case '+':
789 default:
790 error ("Invalid control letter `%c' (#o%03o, #x%04x) in interactive calling string",
791 STRING_CHAR ((unsigned char *) tem),
792 (unsigned) STRING_CHAR ((unsigned char *) tem),
793 (unsigned) STRING_CHAR ((unsigned char *) tem));
796 if (varies[i] == 0)
797 arg_from_tty = 1;
799 if (NILP (visargs[i]) && STRINGP (args[i]))
800 visargs[i] = args[i];
802 tem = strchr (tem, '\n');
803 if (tem) tem++;
804 else tem = "";
806 unbind_to (speccount, Qnil);
808 QUIT;
810 args[0] = function;
812 if (arg_from_tty || !NILP (record_flag))
814 visargs[0] = function;
815 for (i = 1; i < nargs; i++)
817 if (varies[i] > 0)
818 visargs[i] = Fcons (intern (callint_argfuns[varies[i]]), Qnil);
819 else
820 visargs[i] = quotify_arg (args[i]);
822 Vcommand_history = Fcons (Flist (nargs, visargs),
823 Vcommand_history);
824 /* Don't keep command history around forever. */
825 if (INTEGERP (Vhistory_length) && XINT (Vhistory_length) > 0)
827 teml = Fnthcdr (Vhistory_length, Vcommand_history);
828 if (CONSP (teml))
829 XSETCDR (teml, Qnil);
833 /* If we used a marker to hold point, mark, or an end of the region,
834 temporarily, convert it to an integer now. */
835 for (i = 1; i < nargs; i++)
836 if (varies[i] >= 1 && varies[i] <= 4)
837 XSETINT (args[i], marker_position (args[i]));
839 if (record_then_fail)
840 Fbarf_if_buffer_read_only ();
842 Vthis_command = save_this_command;
843 Vthis_original_command = save_this_original_command;
844 real_this_command= save_real_this_command;
845 KVAR (current_kboard, Vlast_command) = save_last_command;
848 Lisp_Object val;
849 specbind (Qcommand_debug_status, Qnil);
851 temporarily_switch_to_single_kboard (NULL);
852 val = Ffuncall (nargs, args);
853 UNGCPRO;
854 return unbind_to (speccount, val);
858 DEFUN ("prefix-numeric-value", Fprefix_numeric_value, Sprefix_numeric_value,
859 1, 1, 0,
860 doc: /* Return numeric meaning of raw prefix argument RAW.
861 A raw prefix argument is what you get from `(interactive "P")'.
862 Its numeric meaning is what you would get from `(interactive "p")'. */)
863 (Lisp_Object raw)
865 Lisp_Object val;
867 if (NILP (raw))
868 XSETFASTINT (val, 1);
869 else if (EQ (raw, Qminus))
870 XSETINT (val, -1);
871 else if (CONSP (raw) && INTEGERP (XCAR (raw)))
872 XSETINT (val, XINT (XCAR (raw)));
873 else if (INTEGERP (raw))
874 val = raw;
875 else
876 XSETFASTINT (val, 1);
878 return val;
881 void
882 syms_of_callint (void)
884 point_marker = Fmake_marker ();
885 staticpro (&point_marker);
887 callint_message = Qnil;
888 staticpro (&callint_message);
890 preserved_fns = pure_cons (intern_c_string ("region-beginning"),
891 pure_cons (intern_c_string ("region-end"),
892 pure_cons (intern_c_string ("point"),
893 pure_cons (intern_c_string ("mark"), Qnil))));
895 DEFSYM (Qlist, "list");
896 DEFSYM (Qlet, "let");
897 DEFSYM (Qif, "if");
898 DEFSYM (Qwhen, "when");
899 DEFSYM (Qletx, "let*");
900 DEFSYM (Qsave_excursion, "save-excursion");
901 DEFSYM (Qprogn, "progn");
902 DEFSYM (Qminus, "-");
903 DEFSYM (Qplus, "+");
904 DEFSYM (Qhandle_shift_selection, "handle-shift-selection");
905 DEFSYM (Qcall_interactively, "call-interactively");
906 DEFSYM (Qcommand_debug_status, "command-debug-status");
907 DEFSYM (Qenable_recursive_minibuffers, "enable-recursive-minibuffers");
908 DEFSYM (Qmouse_leave_buffer_hook, "mouse-leave-buffer-hook");
910 DEFVAR_KBOARD ("prefix-arg", Vprefix_arg,
911 doc: /* The value of the prefix argument for the next editing command.
912 It may be a number, or the symbol `-' for just a minus sign as arg,
913 or a list whose car is a number for just one or more C-u's
914 or nil if no argument has been specified.
916 You cannot examine this variable to find the argument for this command
917 since it has been set to nil by the time you can look.
918 Instead, you should use the variable `current-prefix-arg', although
919 normally commands can get this prefix argument with (interactive "P"). */);
921 DEFVAR_KBOARD ("last-prefix-arg", Vlast_prefix_arg,
922 doc: /* The value of the prefix argument for the previous editing command.
923 See `prefix-arg' for the meaning of the value. */);
925 DEFVAR_LISP ("current-prefix-arg", Vcurrent_prefix_arg,
926 doc: /* The value of the prefix argument for this editing command.
927 It may be a number, or the symbol `-' for just a minus sign as arg,
928 or a list whose car is a number for just one or more C-u's
929 or nil if no argument has been specified.
930 This is what `(interactive \"P\")' returns. */);
931 Vcurrent_prefix_arg = Qnil;
933 DEFVAR_LISP ("command-history", Vcommand_history,
934 doc: /* List of recent commands that read arguments from terminal.
935 Each command is represented as a form to evaluate.
937 Maximum length of the history list is determined by the value
938 of `history-length', which see. */);
939 Vcommand_history = Qnil;
941 DEFVAR_LISP ("command-debug-status", Vcommand_debug_status,
942 doc: /* Debugging status of current interactive command.
943 Bound each time `call-interactively' is called;
944 may be set by the debugger as a reminder for itself. */);
945 Vcommand_debug_status = Qnil;
947 DEFVAR_LISP ("mark-even-if-inactive", Vmark_even_if_inactive,
948 doc: /* *Non-nil means you can use the mark even when inactive.
949 This option makes a difference in Transient Mark mode.
950 When the option is non-nil, deactivation of the mark
951 turns off region highlighting, but commands that use the mark
952 behave as if the mark were still active. */);
953 Vmark_even_if_inactive = Qt;
955 DEFVAR_LISP ("mouse-leave-buffer-hook", Vmouse_leave_buffer_hook,
956 doc: /* Hook to run when about to switch windows with a mouse command.
957 Its purpose is to give temporary modes such as Isearch mode
958 a way to turn themselves off when a mouse command switches windows. */);
959 Vmouse_leave_buffer_hook = Qnil;
961 defsubr (&Sinteractive);
962 defsubr (&Scall_interactively);
963 defsubr (&Sprefix_numeric_value);