Minor improvements in nt/INSTALL.MSYS instructions.
[emacs.git] / src / callint.c
blob0651b68dc05f2ab334a1b4ae3e746a70cfc0dfd3
1 /* Call a Lisp function interactively.
2 Copyright (C) 1985-1986, 1993-1995, 1997, 2000-2013 Free Software
3 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>
23 #include "lisp.h"
24 #include "character.h"
25 #include "buffer.h"
26 #include "commands.h"
27 #include "keyboard.h"
28 #include "window.h"
29 #include "keymap.h"
31 Lisp_Object Qminus, Qplus;
32 static Lisp_Object Qcall_interactively;
33 static Lisp_Object Qcommand_debug_status;
34 static Lisp_Object Qenable_recursive_minibuffers;
36 static Lisp_Object Qhandle_shift_selection;
37 static Lisp_Object Qread_number;
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 `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.
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 (bool 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 = XCAR (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 /* `args' will contain the array of arguments to pass to the function.
255 `visargs' will contain the same list but in a nicer form, so that if we
256 pass it to `Fformat' it will be understandable to a human. */
257 Lisp_Object *args, *visargs;
258 Lisp_Object specs;
259 Lisp_Object filter_specs;
260 Lisp_Object teml;
261 Lisp_Object up_event;
262 Lisp_Object enable;
263 ptrdiff_t speccount = SPECPDL_INDEX ();
265 /* The index of the next element of this_command_keys to examine for
266 the 'e' interactive code. */
267 ptrdiff_t next_event;
269 Lisp_Object prefix_arg;
270 char *string;
271 const char *tem;
273 /* If varies[i] > 0, the i'th argument shouldn't just have its value
274 in this call quoted in the command history. It should be
275 recorded as a call to the function named callint_argfuns[varies[i]]. */
276 signed char *varies;
278 ptrdiff_t i, nargs;
279 ptrdiff_t mark;
280 bool arg_from_tty = 0;
281 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
282 ptrdiff_t key_count;
283 bool record_then_fail = 0;
285 Lisp_Object save_this_command, save_last_command;
286 Lisp_Object save_this_original_command, save_real_this_command;
288 save_this_command = Vthis_command;
289 save_this_original_command = Vthis_original_command;
290 save_real_this_command = Vreal_this_command;
291 save_last_command = KVAR (current_kboard, Vlast_command);
293 if (NILP (keys))
294 keys = this_command_keys, key_count = this_command_key_count;
295 else
297 CHECK_VECTOR (keys);
298 key_count = ASIZE (keys);
301 /* Save this now, since use of minibuffer will clobber it. */
302 prefix_arg = Vcurrent_prefix_arg;
304 if (SYMBOLP (function))
305 enable = Fget (function, Qenable_recursive_minibuffers);
306 else
307 enable = Qnil;
309 specs = Qnil;
310 string = 0;
311 /* The idea of FILTER_SPECS is to provide away to
312 specify how to represent the arguments in command history.
313 The feature is not fully implemented. */
314 filter_specs = Qnil;
316 /* If k or K discard an up-event, save it here so it can be retrieved with
317 U. */
318 up_event = Qnil;
320 /* Set SPECS to the interactive form, or barf if not interactive. */
322 Lisp_Object form;
323 GCPRO2 (function, prefix_arg);
324 form = Finteractive_form (function);
325 UNGCPRO;
326 if (CONSP (form))
327 specs = filter_specs = Fcar (XCDR (form));
328 else
329 wrong_type_argument (Qcommandp, function);
332 /* If SPECS is set to a string, use it as an interactive prompt. */
333 if (STRINGP (specs))
335 /* Make a copy of string so that if a GC relocates specs,
336 `string' will still be valid. */
337 string = alloca (SBYTES (specs) + 1);
338 memcpy (string, SSDATA (specs), SBYTES (specs) + 1);
340 else
342 Lisp_Object input;
343 Lisp_Object funval = Findirect_function (function, Qt);
344 uintmax_t events = num_input_events;
345 input = specs;
346 /* Compute the arg values using the user's expression. */
347 GCPRO2 (input, filter_specs);
348 specs = Feval (specs,
349 CONSP (funval) && EQ (Qclosure, XCAR (funval))
350 ? CAR_SAFE (XCDR (funval)) : Qnil);
351 UNGCPRO;
352 if (events != num_input_events || !NILP (record_flag))
354 /* We should record this command on the command history. */
355 Lisp_Object values;
356 Lisp_Object this_cmd;
357 /* Make a copy of the list of values, for the command history,
358 and turn them into things we can eval. */
359 values = quotify_args (Fcopy_sequence (specs));
360 fix_command (input, values);
361 this_cmd = Fcons (function, values);
362 if (history_delete_duplicates)
363 Vcommand_history = Fdelete (this_cmd, Vcommand_history);
364 Vcommand_history = Fcons (this_cmd, Vcommand_history);
366 /* Don't keep command history around forever. */
367 if (INTEGERP (Vhistory_length) && XINT (Vhistory_length) > 0)
369 teml = Fnthcdr (Vhistory_length, Vcommand_history);
370 if (CONSP (teml))
371 XSETCDR (teml, Qnil);
375 Vthis_command = save_this_command;
376 Vthis_original_command = save_this_original_command;
377 Vreal_this_command = save_real_this_command;
378 kset_last_command (current_kboard, save_last_command);
380 temporarily_switch_to_single_kboard (NULL);
381 return unbind_to (speccount, apply1 (function, specs));
384 /* Here if function specifies a string to control parsing the defaults. */
386 /* Set next_event to point to the first event with parameters. */
387 for (next_event = 0; next_event < key_count; next_event++)
388 if (EVENT_HAS_PARAMETERS (AREF (keys, next_event)))
389 break;
391 /* Handle special starting chars `*' and `@'. Also `-'. */
392 /* Note that `+' is reserved for user extensions. */
393 while (1)
395 if (*string == '+')
396 error ("`+' is not used in `interactive' for ordinary commands");
397 else if (*string == '*')
399 string++;
400 if (!NILP (BVAR (current_buffer, read_only)))
402 if (!NILP (record_flag))
404 char *p = string;
405 while (*p)
407 if (! (*p == 'r' || *p == 'p' || *p == 'P'
408 || *p == '\n'))
409 Fbarf_if_buffer_read_only ();
410 p++;
412 record_then_fail = 1;
414 else
415 Fbarf_if_buffer_read_only ();
418 /* Ignore this for semi-compatibility with Lucid. */
419 else if (*string == '-')
420 string++;
421 else if (*string == '@')
423 Lisp_Object event, w;
425 event = (next_event < key_count
426 ? AREF (keys, next_event)
427 : Qnil);
428 if (EVENT_HAS_PARAMETERS (event)
429 && (w = XCDR (event), CONSP (w))
430 && (w = XCAR (w), CONSP (w))
431 && (w = XCAR (w), WINDOWP (w)))
433 if (MINI_WINDOW_P (XWINDOW (w))
434 && ! (minibuf_level > 0 && EQ (w, minibuf_window)))
435 error ("Attempt to select inactive minibuffer window");
437 /* If the current buffer wants to clean up, let it. */
438 Frun_hooks (1, &Qmouse_leave_buffer_hook);
440 Fselect_window (w, Qnil);
442 string++;
444 else if (*string == '^')
446 call0 (Qhandle_shift_selection);
447 string++;
449 else break;
452 /* Count the number of arguments, which is one plus the number of arguments
453 the interactive spec would have us give to the function. */
454 tem = string;
455 for (nargs = 1; *tem; )
457 /* 'r' specifications ("point and mark as 2 numeric args")
458 produce *two* arguments. */
459 if (*tem == 'r')
460 nargs += 2;
461 else
462 nargs++;
463 tem = strchr (tem, '\n');
464 if (tem)
465 ++tem;
466 else
467 break;
470 if (min (MOST_POSITIVE_FIXNUM,
471 min (PTRDIFF_MAX, SIZE_MAX) / word_size)
472 < nargs)
473 memory_full (SIZE_MAX);
475 args = alloca (nargs * sizeof *args);
476 visargs = alloca (nargs * sizeof *visargs);
477 varies = alloca (nargs * sizeof *varies);
479 for (i = 0; i < nargs; i++)
481 args[i] = Qnil;
482 visargs[i] = Qnil;
483 varies[i] = 0;
486 GCPRO5 (prefix_arg, function, *args, *visargs, up_event);
487 gcpro3.nvars = nargs;
488 gcpro4.nvars = nargs;
490 if (!NILP (enable))
491 specbind (Qenable_recursive_minibuffers, Qt);
493 tem = string;
494 for (i = 1; *tem; i++)
496 visargs[0] = make_string (tem + 1, strcspn (tem + 1, "\n"));
497 if (strchr (SSDATA (visargs[0]), '%'))
498 callint_message = Fformat (i, visargs);
499 else
500 callint_message = visargs[0];
502 switch (*tem)
504 case 'a': /* Symbol defined as a function. */
505 visargs[i] = Fcompleting_read (callint_message,
506 Vobarray, Qfboundp, Qt,
507 Qnil, Qnil, Qnil, Qnil);
508 /* Passing args[i] directly stimulates compiler bug. */
509 teml = visargs[i];
510 args[i] = Fintern (teml, Qnil);
511 break;
513 case 'b': /* Name of existing buffer. */
514 args[i] = Fcurrent_buffer ();
515 if (EQ (selected_window, minibuf_window))
516 args[i] = Fother_buffer (args[i], Qnil, Qnil);
517 args[i] = Fread_buffer (callint_message, args[i], Qt);
518 break;
520 case 'B': /* Name of buffer, possibly nonexistent. */
521 args[i] = Fread_buffer (callint_message,
522 Fother_buffer (Fcurrent_buffer (), Qnil, Qnil),
523 Qnil);
524 break;
526 case 'c': /* Character. */
527 /* Prompt in `minibuffer-prompt' face. */
528 Fput_text_property (make_number (0),
529 make_number (SCHARS (callint_message)),
530 Qface, Qminibuffer_prompt, callint_message);
531 args[i] = Fread_char (callint_message, Qnil, Qnil);
532 message1_nolog ((char *) 0);
533 /* Passing args[i] directly stimulates compiler bug. */
534 teml = args[i];
535 /* See bug#8479. */
536 if (! CHARACTERP (teml)) error ("Non-character input-event");
537 visargs[i] = Fchar_to_string (teml);
538 break;
540 case 'C': /* Command: symbol with interactive function. */
541 visargs[i] = Fcompleting_read (callint_message,
542 Vobarray, Qcommandp,
543 Qt, Qnil, Qnil, Qnil, Qnil);
544 /* Passing args[i] directly stimulates compiler bug. */
545 teml = visargs[i];
546 args[i] = Fintern (teml, Qnil);
547 break;
549 case 'd': /* Value of point. Does not do I/O. */
550 set_marker_both (point_marker, Qnil, PT, PT_BYTE);
551 args[i] = point_marker;
552 /* visargs[i] = Qnil; */
553 varies[i] = 1;
554 break;
556 case 'D': /* Directory name. */
557 args[i] = Fread_file_name (callint_message, Qnil,
558 BVAR (current_buffer, directory), Qlambda, Qnil,
559 Qfile_directory_p);
560 break;
562 case 'f': /* Existing file name. */
563 args[i] = Fread_file_name (callint_message,
564 Qnil, Qnil, Qlambda, Qnil, Qnil);
565 break;
567 case 'F': /* Possibly nonexistent file name. */
568 args[i] = Fread_file_name (callint_message,
569 Qnil, Qnil, Qnil, Qnil, Qnil);
570 break;
572 case 'G': /* Possibly nonexistent file name,
573 default to directory alone. */
574 args[i] = Fread_file_name (callint_message,
575 Qnil, Qnil, Qnil, empty_unibyte_string, Qnil);
576 break;
578 case 'i': /* Ignore an argument -- Does not do I/O. */
579 varies[i] = -1;
580 break;
582 case 'k': /* Key sequence. */
584 ptrdiff_t speccount1 = SPECPDL_INDEX ();
585 specbind (Qcursor_in_echo_area, Qt);
586 /* Prompt in `minibuffer-prompt' face. */
587 Fput_text_property (make_number (0),
588 make_number (SCHARS (callint_message)),
589 Qface, Qminibuffer_prompt, callint_message);
590 args[i] = Fread_key_sequence (callint_message,
591 Qnil, Qnil, Qnil, Qnil);
592 unbind_to (speccount1, Qnil);
593 teml = args[i];
594 visargs[i] = Fkey_description (teml, Qnil);
596 /* If the key sequence ends with a down-event,
597 discard the following up-event. */
598 teml = Faref (args[i], make_number (XINT (Flength (args[i])) - 1));
599 if (CONSP (teml))
600 teml = XCAR (teml);
601 if (SYMBOLP (teml))
603 Lisp_Object tem2;
605 teml = Fget (teml, intern ("event-symbol-elements"));
606 /* Ignore first element, which is the base key. */
607 tem2 = Fmemq (intern ("down"), Fcdr (teml));
608 if (! NILP (tem2))
609 up_event = Fread_event (Qnil, Qnil, Qnil);
612 break;
614 case 'K': /* Key sequence to be defined. */
616 ptrdiff_t speccount1 = SPECPDL_INDEX ();
617 specbind (Qcursor_in_echo_area, Qt);
618 /* Prompt in `minibuffer-prompt' face. */
619 Fput_text_property (make_number (0),
620 make_number (SCHARS (callint_message)),
621 Qface, Qminibuffer_prompt, callint_message);
622 args[i] = Fread_key_sequence (callint_message,
623 Qnil, Qt, Qnil, Qnil);
624 teml = args[i];
625 visargs[i] = Fkey_description (teml, Qnil);
626 unbind_to (speccount1, Qnil);
628 /* If the key sequence ends with a down-event,
629 discard the following up-event. */
630 teml = Faref (args[i], make_number (XINT (Flength (args[i])) - 1));
631 if (CONSP (teml))
632 teml = XCAR (teml);
633 if (SYMBOLP (teml))
635 Lisp_Object tem2;
637 teml = Fget (teml, intern ("event-symbol-elements"));
638 /* Ignore first element, which is the base key. */
639 tem2 = Fmemq (intern ("down"), Fcdr (teml));
640 if (! NILP (tem2))
641 up_event = Fread_event (Qnil, Qnil, Qnil);
644 break;
646 case 'U': /* Up event from last k or K. */
647 if (!NILP (up_event))
649 args[i] = Fmake_vector (make_number (1), up_event);
650 up_event = Qnil;
651 teml = args[i];
652 visargs[i] = Fkey_description (teml, Qnil);
654 break;
656 case 'e': /* The invoking event. */
657 if (next_event >= key_count)
658 error ("%s must be bound to an event with parameters",
659 (SYMBOLP (function)
660 ? SSDATA (SYMBOL_NAME (function))
661 : "command"));
662 args[i] = AREF (keys, next_event);
663 next_event++;
664 varies[i] = -1;
666 /* Find the next parameterized event. */
667 while (next_event < key_count
668 && !(EVENT_HAS_PARAMETERS (AREF (keys, next_event))))
669 next_event++;
671 break;
673 case 'm': /* Value of mark. Does not do I/O. */
674 check_mark (0);
675 /* visargs[i] = Qnil; */
676 args[i] = BVAR (current_buffer, mark);
677 varies[i] = 2;
678 break;
680 case 'M': /* String read via minibuffer with
681 inheriting the current input method. */
682 args[i] = Fread_string (callint_message,
683 Qnil, Qnil, Qnil, Qt);
684 break;
686 case 'N': /* Prefix arg as number, else number from minibuffer. */
687 if (!NILP (prefix_arg))
688 goto have_prefix_arg;
689 case 'n': /* Read number from minibuffer. */
690 args[i] = call1 (Qread_number, callint_message);
691 /* Passing args[i] directly stimulates compiler bug. */
692 teml = args[i];
693 visargs[i] = Fnumber_to_string (teml);
694 break;
696 case 'P': /* Prefix arg in raw form. Does no I/O. */
697 args[i] = prefix_arg;
698 /* visargs[i] = Qnil; */
699 varies[i] = -1;
700 break;
702 case 'p': /* Prefix arg converted to number. No I/O. */
703 have_prefix_arg:
704 args[i] = Fprefix_numeric_value (prefix_arg);
705 /* visargs[i] = Qnil; */
706 varies[i] = -1;
707 break;
709 case 'r': /* Region, point and mark as 2 args. */
710 check_mark (1);
711 set_marker_both (point_marker, Qnil, PT, PT_BYTE);
712 /* visargs[i+1] = Qnil; */
713 mark = marker_position (BVAR (current_buffer, mark));
714 /* visargs[i] = Qnil; */
715 args[i] = PT < mark ? point_marker : BVAR (current_buffer, mark);
716 varies[i] = 3;
717 args[++i] = PT > mark ? point_marker : BVAR (current_buffer, mark);
718 varies[i] = 4;
719 break;
721 case 's': /* String read via minibuffer without
722 inheriting the current input method. */
723 args[i] = Fread_string (callint_message,
724 Qnil, Qnil, Qnil, Qnil);
725 break;
727 case 'S': /* Any symbol. */
728 visargs[i] = Fread_string (callint_message,
729 Qnil, Qnil, Qnil, Qnil);
730 /* Passing args[i] directly stimulates compiler bug. */
731 teml = visargs[i];
732 args[i] = Fintern (teml, Qnil);
733 break;
735 case 'v': /* Variable name: symbol that is
736 custom-variable-p. */
737 args[i] = Fread_variable (callint_message, Qnil);
738 visargs[i] = last_minibuf_string;
739 break;
741 case 'x': /* Lisp expression read but not evaluated. */
742 args[i] = call1 (intern ("read-minibuffer"), callint_message);
743 visargs[i] = last_minibuf_string;
744 break;
746 case 'X': /* Lisp expression read and evaluated. */
747 args[i] = call1 (intern ("eval-minibuffer"), callint_message);
748 visargs[i] = last_minibuf_string;
749 break;
751 case 'Z': /* Coding-system symbol, or ignore the
752 argument if no prefix. */
753 if (NILP (prefix_arg))
755 args[i] = Qnil;
756 varies[i] = -1;
758 else
760 args[i]
761 = Fread_non_nil_coding_system (callint_message);
762 visargs[i] = last_minibuf_string;
764 break;
766 case 'z': /* Coding-system symbol or nil. */
767 args[i] = Fread_coding_system (callint_message, Qnil);
768 visargs[i] = last_minibuf_string;
769 break;
771 /* We have a case for `+' so we get an error
772 if anyone tries to define one here. */
773 case '+':
774 default:
775 error ("Invalid control letter `%c' (#o%03o, #x%04x) in interactive calling string",
776 STRING_CHAR ((unsigned char *) tem),
777 (unsigned) STRING_CHAR ((unsigned char *) tem),
778 (unsigned) STRING_CHAR ((unsigned char *) tem));
781 if (varies[i] == 0)
782 arg_from_tty = 1;
784 if (NILP (visargs[i]) && STRINGP (args[i]))
785 visargs[i] = args[i];
787 tem = strchr (tem, '\n');
788 if (tem) tem++;
789 else tem = "";
791 unbind_to (speccount, Qnil);
793 QUIT;
795 args[0] = function;
797 if (arg_from_tty || !NILP (record_flag))
799 /* We don't need `visargs' any more, so let's recycle it since we need
800 an array of just the same size. */
801 visargs[0] = function;
802 for (i = 1; i < nargs; i++)
804 if (varies[i] > 0)
805 visargs[i] = Fcons (intern (callint_argfuns[varies[i]]), Qnil);
806 else
807 visargs[i] = quotify_arg (args[i]);
809 Vcommand_history = Fcons (Flist (nargs, visargs),
810 Vcommand_history);
811 /* Don't keep command history around forever. */
812 if (INTEGERP (Vhistory_length) && XINT (Vhistory_length) > 0)
814 teml = Fnthcdr (Vhistory_length, Vcommand_history);
815 if (CONSP (teml))
816 XSETCDR (teml, Qnil);
820 /* If we used a marker to hold point, mark, or an end of the region,
821 temporarily, convert it to an integer now. */
822 for (i = 1; i < nargs; i++)
823 if (varies[i] >= 1 && varies[i] <= 4)
824 XSETINT (args[i], marker_position (args[i]));
826 if (record_then_fail)
827 Fbarf_if_buffer_read_only ();
829 Vthis_command = save_this_command;
830 Vthis_original_command = save_this_original_command;
831 Vreal_this_command = save_real_this_command;
832 kset_last_command (current_kboard, save_last_command);
835 Lisp_Object val;
836 specbind (Qcommand_debug_status, Qnil);
838 temporarily_switch_to_single_kboard (NULL);
839 val = Ffuncall (nargs, args);
840 UNGCPRO;
841 return unbind_to (speccount, val);
845 DEFUN ("prefix-numeric-value", Fprefix_numeric_value, Sprefix_numeric_value,
846 1, 1, 0,
847 doc: /* Return numeric meaning of raw prefix argument RAW.
848 A raw prefix argument is what you get from `(interactive "P")'.
849 Its numeric meaning is what you would get from `(interactive "p")'. */)
850 (Lisp_Object raw)
852 Lisp_Object val;
854 if (NILP (raw))
855 XSETFASTINT (val, 1);
856 else if (EQ (raw, Qminus))
857 XSETINT (val, -1);
858 else if (CONSP (raw) && INTEGERP (XCAR (raw)))
859 XSETINT (val, XINT (XCAR (raw)));
860 else if (INTEGERP (raw))
861 val = raw;
862 else
863 XSETFASTINT (val, 1);
865 return val;
868 void
869 syms_of_callint (void)
871 point_marker = Fmake_marker ();
872 staticpro (&point_marker);
874 callint_message = Qnil;
875 staticpro (&callint_message);
877 preserved_fns = listn (CONSTYPE_PURE, 4,
878 intern_c_string ("region-beginning"),
879 intern_c_string ("region-end"),
880 intern_c_string ("point"),
881 intern_c_string ("mark"));
883 DEFSYM (Qlist, "list");
884 DEFSYM (Qlet, "let");
885 DEFSYM (Qif, "if");
886 DEFSYM (Qwhen, "when");
887 DEFSYM (Qletx, "let*");
888 DEFSYM (Qsave_excursion, "save-excursion");
889 DEFSYM (Qprogn, "progn");
890 DEFSYM (Qminus, "-");
891 DEFSYM (Qplus, "+");
892 DEFSYM (Qhandle_shift_selection, "handle-shift-selection");
893 DEFSYM (Qread_number, "read-number");
894 DEFSYM (Qcall_interactively, "call-interactively");
895 DEFSYM (Qcommand_debug_status, "command-debug-status");
896 DEFSYM (Qenable_recursive_minibuffers, "enable-recursive-minibuffers");
897 DEFSYM (Qmouse_leave_buffer_hook, "mouse-leave-buffer-hook");
899 DEFVAR_KBOARD ("prefix-arg", Vprefix_arg,
900 doc: /* The value of the prefix argument for the next editing command.
901 It may be a number, or the symbol `-' for just a minus sign as arg,
902 or a list whose car is a number for just one or more C-u's
903 or nil if no argument has been specified.
905 You cannot examine this variable to find the argument for this command
906 since it has been set to nil by the time you can look.
907 Instead, you should use the variable `current-prefix-arg', although
908 normally commands can get this prefix argument with (interactive "P"). */);
910 DEFVAR_KBOARD ("last-prefix-arg", Vlast_prefix_arg,
911 doc: /* The value of the prefix argument for the previous editing command.
912 See `prefix-arg' for the meaning of the value. */);
914 DEFVAR_LISP ("current-prefix-arg", Vcurrent_prefix_arg,
915 doc: /* The value of the prefix argument for this editing command.
916 It may be a number, or the symbol `-' for just a minus sign as arg,
917 or a list whose car is a number for just one or more C-u's
918 or nil if no argument has been specified.
919 This is what `(interactive \"P\")' returns. */);
920 Vcurrent_prefix_arg = Qnil;
922 DEFVAR_LISP ("command-history", Vcommand_history,
923 doc: /* List of recent commands that read arguments from terminal.
924 Each command is represented as a form to evaluate.
926 Maximum length of the history list is determined by the value
927 of `history-length', which see. */);
928 Vcommand_history = Qnil;
930 DEFVAR_LISP ("command-debug-status", Vcommand_debug_status,
931 doc: /* Debugging status of current interactive command.
932 Bound each time `call-interactively' is called;
933 may be set by the debugger as a reminder for itself. */);
934 Vcommand_debug_status = Qnil;
936 DEFVAR_LISP ("mark-even-if-inactive", Vmark_even_if_inactive,
937 doc: /* Non-nil means you can use the mark even when inactive.
938 This option makes a difference in Transient Mark mode.
939 When the option is non-nil, deactivation of the mark
940 turns off region highlighting, but commands that use the mark
941 behave as if the mark were still active. */);
942 Vmark_even_if_inactive = Qt;
944 DEFVAR_LISP ("mouse-leave-buffer-hook", Vmouse_leave_buffer_hook,
945 doc: /* Hook to run when about to switch windows with a mouse command.
946 Its purpose is to give temporary modes such as Isearch mode
947 a way to turn themselves off when a mouse command switches windows. */);
948 Vmouse_leave_buffer_hook = Qnil;
950 defsubr (&Sinteractive);
951 defsubr (&Scall_interactively);
952 defsubr (&Sprefix_numeric_value);