Merge from trunk
[emacs.git] / src / callint.c
blob489fa392e46554e43e9d26c460ef105cd40fbf60
1 /* Call a Lisp function interactively.
2 Copyright (C) 1985-1986, 1993-1995, 1997, 2000-2011
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"
31 Lisp_Object Qminus, Qplus;
32 Lisp_Object Qcall_interactively;
33 Lisp_Object Qcommand_debug_status;
34 Lisp_Object Qenable_recursive_minibuffers;
36 Lisp_Object Qhandle_shift_selection;
38 Lisp_Object Qmouse_leave_buffer_hook;
40 Lisp_Object Qlist, Qlet, Qletx, Qsave_excursion, Qprogn, Qif, Qwhen;
41 static Lisp_Object preserved_fns;
43 /* Marker used within call-interactively to refer to point. */
44 static Lisp_Object point_marker;
46 /* String for the prompt text used in Fcall_interactively. */
47 static Lisp_Object callint_message;
49 /* ARGSUSED */
50 DEFUN ("interactive", Finteractive, Sinteractive, 0, UNEVALLED, 0,
51 doc: /* Specify a way of parsing arguments for interactive use of a function.
52 For example, write
53 (defun foo (arg buf) "Doc string" (interactive "P\\nbbuffer: ") .... )
54 to make ARG be the raw prefix argument, and set BUF to an existing buffer,
55 when `foo' is called as a command.
56 The "call" to `interactive' is actually a declaration rather than a function;
57 it tells `call-interactively' how to read arguments
58 to pass to the function.
59 When actually called, `interactive' just returns nil.
61 Usually the argument of `interactive' is a string containing a code letter
62 followed optionally by a prompt. (Some code letters do not use I/O to get
63 the argument and do not use prompts.) To get several arguments, concatenate
64 the individual strings, separating them by newline characters.
65 Prompts are passed to format, and may use % escapes to print the
66 arguments that have already been read.
67 If the argument is not a string, it is evaluated to get a list of
68 arguments to pass to the function.
69 Just `(interactive)' means pass no args when calling interactively.
71 Code letters available are:
72 a -- Function name: symbol with a function definition.
73 b -- Name of existing buffer.
74 B -- Name of buffer, possibly nonexistent.
75 c -- Character (no input method is used).
76 C -- Command name: symbol with interactive function definition.
77 d -- Value of point as number. Does not do I/O.
78 D -- Directory name.
79 e -- Parametrized event (i.e., one that's a list) that invoked this command.
80 If used more than once, the Nth `e' returns the Nth parameterized event.
81 This skips events that are integers or symbols.
82 f -- Existing file name.
83 F -- Possibly nonexistent file name.
84 G -- Possibly nonexistent file name, defaulting to just directory name.
85 i -- Ignored, i.e. always nil. Does not do I/O.
86 k -- Key sequence (downcase the last event if needed to get a definition).
87 K -- Key sequence to be redefined (do not downcase the last event).
88 m -- Value of mark as number. Does not do I/O.
89 M -- Any string. Inherits the current input method.
90 n -- Number read using minibuffer.
91 N -- Numeric prefix arg, or if none, do like code `n'.
92 p -- Prefix arg converted to number. Does not do I/O.
93 P -- Prefix arg in raw form. Does not do I/O.
94 r -- Region: point and mark as 2 numeric args, smallest first. Does no I/O.
95 s -- Any string. Does not inherit the current input method.
96 S -- Any symbol.
97 U -- Mouse up event discarded by a previous k or K argument.
98 v -- Variable name: symbol that is user-variable-p.
99 x -- Lisp expression read but not evaluated.
100 X -- Lisp expression read and evaluated.
101 z -- Coding system.
102 Z -- Coding system, nil if no prefix arg.
104 In addition, if the string begins with `*', an error is signaled if
105 the buffer is read-only.
106 If the string begins with `@', Emacs searches the key sequence which
107 invoked the command for its first mouse click (or any other event
108 which specifies a window).
109 If the string begins with `^' and `shift-select-mode' is non-nil,
110 Emacs first calls the function `handle-shift-selection'.
111 You may use `@', `*', and `^' together. They are processed in the
112 order that they appear, before reading any arguments.
113 usage: (interactive &optional ARGS) */)
114 (Lisp_Object args)
116 return Qnil;
119 /* Quotify EXP: if EXP is constant, return it.
120 If EXP is not constant, return (quote EXP). */
121 static Lisp_Object
122 quotify_arg (register Lisp_Object exp)
124 if (CONSP (exp)
125 || (SYMBOLP (exp)
126 && !NILP (exp) && !EQ (exp, Qt)))
127 return Fcons (Qquote, Fcons (exp, Qnil));
129 return exp;
132 /* Modify EXP by quotifying each element (except the first). */
133 static Lisp_Object
134 quotify_args (Lisp_Object exp)
136 register Lisp_Object tail;
137 Lisp_Object next;
138 for (tail = exp; CONSP (tail); tail = next)
140 next = XCDR (tail);
141 XSETCAR (tail, quotify_arg (XCAR (tail)));
143 return exp;
146 static const char *callint_argfuns[]
147 = {"", "point", "mark", "region-beginning", "region-end"};
149 static void
150 check_mark (int for_region)
152 Lisp_Object tem;
153 tem = Fmarker_buffer (BVAR (current_buffer, mark));
154 if (NILP (tem) || (XBUFFER (tem) != current_buffer))
155 error (for_region ? "The mark is not set now, so there is no region"
156 : "The mark is not set now");
157 if (!NILP (Vtransient_mark_mode) && NILP (Vmark_even_if_inactive)
158 && NILP (BVAR (current_buffer, mark_active)))
159 xsignal0 (Qmark_inactive);
162 /* If the list of args INPUT was produced with an explicit call to
163 `list', look for elements that were computed with
164 (region-beginning) or (region-end), and put those expressions into
165 VALUES instead of the present values.
167 This function doesn't return a value because it modifies elements
168 of VALUES to do its job. */
170 static void
171 fix_command (Lisp_Object input, Lisp_Object values)
173 /* FIXME: Instead of this ugly hack, we should provide a way for an
174 interactive spec to return an expression that will re-build the args
175 without user intervention. */
176 if (CONSP (input))
178 Lisp_Object car;
180 car = XCAR (input);
181 /* Skip through certain special forms. */
182 while (EQ (car, Qlet) || EQ (car, Qletx)
183 || EQ (car, Qsave_excursion)
184 || EQ (car, Qprogn))
186 while (CONSP (XCDR (input)))
187 input = XCDR (input);
188 input = XCAR (input);
189 if (!CONSP (input))
190 break;
191 car = XCAR (input);
193 if (EQ (car, Qlist))
195 Lisp_Object intail, valtail;
196 for (intail = Fcdr (input), valtail = values;
197 CONSP (valtail);
198 intail = Fcdr (intail), valtail = XCDR (valtail))
200 Lisp_Object elt;
201 elt = Fcar (intail);
202 if (CONSP (elt))
204 Lisp_Object presflag, carelt;
205 carelt = Fcar (elt);
206 /* If it is (if X Y), look at Y. */
207 if (EQ (carelt, Qif)
208 && EQ (Fnthcdr (make_number (3), elt), Qnil))
209 elt = Fnth (make_number (2), elt);
210 /* If it is (when ... Y), look at Y. */
211 else if (EQ (carelt, Qwhen))
213 while (CONSP (XCDR (elt)))
214 elt = XCDR (elt);
215 elt = Fcar (elt);
218 /* If the function call we're looking at
219 is a special preserved one, copy the
220 whole expression for this argument. */
221 if (CONSP (elt))
223 presflag = Fmemq (Fcar (elt), preserved_fns);
224 if (!NILP (presflag))
225 Fsetcar (valtail, Fcar (intail));
233 DEFUN ("call-interactively", Fcall_interactively, Scall_interactively, 1, 3, 0,
234 doc: /* Call FUNCTION, reading args according to its interactive calling specs.
235 Return the value FUNCTION returns.
236 The function contains a specification of how to do the argument reading.
237 In the case of user-defined functions, this is specified by placing a call
238 to the function `interactive' at the top level of the function body.
239 See `interactive'.
241 Optional second arg RECORD-FLAG non-nil
242 means unconditionally put this command in the command-history.
243 Otherwise, this is done only if an arg is read using the minibuffer.
245 Optional third arg KEYS, if given, specifies the sequence of events to
246 supply, as a vector, if the command inquires which events were used to
247 invoke it. If KEYS is omitted or nil, the return value of
248 `this-command-keys-vector' is used. */)
249 (Lisp_Object function, Lisp_Object record_flag, Lisp_Object keys)
251 Lisp_Object *args, *visargs;
252 Lisp_Object specs;
253 Lisp_Object filter_specs;
254 Lisp_Object teml;
255 Lisp_Object up_event;
256 Lisp_Object enable;
257 int speccount = SPECPDL_INDEX ();
259 /* The index of the next element of this_command_keys to examine for
260 the 'e' interactive code. */
261 int next_event;
263 Lisp_Object prefix_arg;
264 char *string;
265 const char *tem;
267 /* If varies[i] > 0, the i'th argument shouldn't just have its value
268 in this call quoted in the command history. It should be
269 recorded as a call to the function named callint_argfuns[varies[i]]. */
270 int *varies;
272 register size_t i, j;
273 size_t count;
274 int foo;
275 char prompt1[100];
276 char *tem1;
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 = XVECTOR (keys)->size;
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 i = 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 (i != 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 the interactive spec would have
449 us give to the function. */
450 tem = string;
451 for (j = 0; *tem;)
453 /* 'r' specifications ("point and mark as 2 numeric args")
454 produce *two* arguments. */
455 if (*tem == 'r')
456 j += 2;
457 else
458 j++;
459 tem = strchr (tem, '\n');
460 if (tem)
461 ++tem;
462 else
463 break;
465 count = j;
467 args = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object));
468 visargs = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object));
469 varies = (int *) alloca ((count + 1) * sizeof (int));
471 for (i = 0; i < (count + 1); i++)
473 args[i] = Qnil;
474 visargs[i] = Qnil;
475 varies[i] = 0;
478 GCPRO5 (prefix_arg, function, *args, *visargs, up_event);
479 gcpro3.nvars = (count + 1);
480 gcpro4.nvars = (count + 1);
482 if (!NILP (enable))
483 specbind (Qenable_recursive_minibuffers, Qt);
485 tem = string;
486 for (i = 1; *tem; i++)
488 strncpy (prompt1, tem + 1, sizeof prompt1 - 1);
489 prompt1[sizeof prompt1 - 1] = 0;
490 tem1 = strchr (prompt1, '\n');
491 if (tem1) *tem1 = 0;
493 visargs[0] = build_string (prompt1);
494 if (strchr (prompt1, '%'))
495 callint_message = Fformat (i, visargs);
496 else
497 callint_message = visargs[0];
499 switch (*tem)
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;
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;
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;
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 visargs[i] = Fchar_to_string (teml);
533 break;
535 case 'C': /* Command: symbol with interactive function */
536 visargs[i] = Fcompleting_read (callint_message,
537 Vobarray, Qcommandp,
538 Qt, Qnil, Qnil, Qnil, Qnil);
539 /* Passing args[i] directly stimulates compiler bug */
540 teml = visargs[i];
541 args[i] = Fintern (teml, Qnil);
542 break;
544 case 'd': /* Value of point. Does not do I/O. */
545 set_marker_both (point_marker, Qnil, PT, PT_BYTE);
546 args[i] = point_marker;
547 /* visargs[i] = Qnil; */
548 varies[i] = 1;
549 break;
551 case 'D': /* Directory name. */
552 args[i] = Fread_file_name (callint_message, Qnil,
553 BVAR (current_buffer, directory), Qlambda, Qnil,
554 Qfile_directory_p);
555 break;
557 case 'f': /* Existing file name. */
558 args[i] = Fread_file_name (callint_message,
559 Qnil, Qnil, Qlambda, Qnil, Qnil);
560 break;
562 case 'F': /* Possibly nonexistent file name. */
563 args[i] = Fread_file_name (callint_message,
564 Qnil, Qnil, Qnil, Qnil, Qnil);
565 break;
567 case 'G': /* Possibly nonexistent file name,
568 default to directory alone. */
569 args[i] = Fread_file_name (callint_message,
570 Qnil, Qnil, Qnil, empty_unibyte_string, Qnil);
571 break;
573 case 'i': /* Ignore an argument -- Does not do I/O */
574 varies[i] = -1;
575 break;
577 case 'k': /* Key sequence. */
579 int speccount1 = SPECPDL_INDEX ();
580 specbind (Qcursor_in_echo_area, Qt);
581 /* Prompt in `minibuffer-prompt' face. */
582 Fput_text_property (make_number (0),
583 make_number (SCHARS (callint_message)),
584 Qface, Qminibuffer_prompt, callint_message);
585 args[i] = Fread_key_sequence (callint_message,
586 Qnil, Qnil, Qnil, Qnil);
587 unbind_to (speccount1, Qnil);
588 teml = args[i];
589 visargs[i] = Fkey_description (teml, Qnil);
591 /* If the key sequence ends with a down-event,
592 discard the following up-event. */
593 teml = Faref (args[i], make_number (XINT (Flength (args[i])) - 1));
594 if (CONSP (teml))
595 teml = XCAR (teml);
596 if (SYMBOLP (teml))
598 Lisp_Object tem2;
600 teml = Fget (teml, intern ("event-symbol-elements"));
601 /* Ignore first element, which is the base key. */
602 tem2 = Fmemq (intern ("down"), Fcdr (teml));
603 if (! NILP (tem2))
604 up_event = Fread_event (Qnil, Qnil, Qnil);
607 break;
609 case 'K': /* Key sequence to be defined. */
611 int speccount1 = SPECPDL_INDEX ();
612 specbind (Qcursor_in_echo_area, Qt);
613 /* Prompt in `minibuffer-prompt' face. */
614 Fput_text_property (make_number (0),
615 make_number (SCHARS (callint_message)),
616 Qface, Qminibuffer_prompt, callint_message);
617 args[i] = Fread_key_sequence (callint_message,
618 Qnil, Qt, Qnil, Qnil);
619 teml = args[i];
620 visargs[i] = Fkey_description (teml, Qnil);
621 unbind_to (speccount1, Qnil);
623 /* If the key sequence ends with a down-event,
624 discard the following up-event. */
625 teml = Faref (args[i], make_number (XINT (Flength (args[i])) - 1));
626 if (CONSP (teml))
627 teml = XCAR (teml);
628 if (SYMBOLP (teml))
630 Lisp_Object tem2;
632 teml = Fget (teml, intern ("event-symbol-elements"));
633 /* Ignore first element, which is the base key. */
634 tem2 = Fmemq (intern ("down"), Fcdr (teml));
635 if (! NILP (tem2))
636 up_event = Fread_event (Qnil, Qnil, Qnil);
639 break;
641 case 'U': /* Up event from last k or K */
642 if (!NILP (up_event))
644 args[i] = Fmake_vector (make_number (1), up_event);
645 up_event = Qnil;
646 teml = args[i];
647 visargs[i] = Fkey_description (teml, Qnil);
649 break;
651 case 'e': /* The invoking event. */
652 if (next_event >= key_count)
653 error ("%s must be bound to an event with parameters",
654 (SYMBOLP (function)
655 ? SSDATA (SYMBOL_NAME (function))
656 : "command"));
657 args[i] = AREF (keys, next_event);
658 next_event++;
659 varies[i] = -1;
661 /* Find the next parameterized event. */
662 while (next_event < key_count
663 && !(EVENT_HAS_PARAMETERS (AREF (keys, next_event))))
664 next_event++;
666 break;
668 case 'm': /* Value of mark. Does not do I/O. */
669 check_mark (0);
670 /* visargs[i] = Qnil; */
671 args[i] = BVAR (current_buffer, mark);
672 varies[i] = 2;
673 break;
675 case 'M': /* String read via minibuffer with
676 inheriting the current input method. */
677 args[i] = Fread_string (callint_message,
678 Qnil, Qnil, Qnil, Qt);
679 break;
681 case 'N': /* Prefix arg as number, else number from minibuffer */
682 if (!NILP (prefix_arg))
683 goto have_prefix_arg;
684 case 'n': /* Read number from minibuffer. */
686 int first = 1;
689 Lisp_Object str;
690 if (! first)
692 message ("Please enter a number.");
693 sit_for (make_number (1), 0, 0);
695 first = 0;
697 str = Fread_from_minibuffer (callint_message,
698 Qnil, Qnil, Qnil, Qnil, Qnil,
699 Qnil);
700 if (! STRINGP (str) || SCHARS (str) == 0)
701 args[i] = Qnil;
702 else
703 args[i] = Fread (str);
705 while (! NUMBERP (args[i]));
707 visargs[i] = args[i];
708 break;
710 case 'P': /* Prefix arg in raw form. Does no I/O. */
711 args[i] = prefix_arg;
712 /* visargs[i] = Qnil; */
713 varies[i] = -1;
714 break;
716 case 'p': /* Prefix arg converted to number. No I/O. */
717 have_prefix_arg:
718 args[i] = Fprefix_numeric_value (prefix_arg);
719 /* visargs[i] = Qnil; */
720 varies[i] = -1;
721 break;
723 case 'r': /* Region, point and mark as 2 args. */
724 check_mark (1);
725 set_marker_both (point_marker, Qnil, PT, PT_BYTE);
726 /* visargs[i+1] = Qnil; */
727 foo = marker_position (BVAR (current_buffer, mark));
728 /* visargs[i] = Qnil; */
729 args[i] = PT < foo ? point_marker : BVAR (current_buffer, mark);
730 varies[i] = 3;
731 args[++i] = PT > foo ? point_marker : BVAR (current_buffer, mark);
732 varies[i] = 4;
733 break;
735 case 's': /* String read via minibuffer without
736 inheriting the current input method. */
737 args[i] = Fread_string (callint_message,
738 Qnil, Qnil, Qnil, Qnil);
739 break;
741 case 'S': /* Any symbol. */
742 visargs[i] = Fread_string (callint_message,
743 Qnil, Qnil, Qnil, Qnil);
744 /* Passing args[i] directly stimulates compiler bug */
745 teml = visargs[i];
746 args[i] = Fintern (teml, Qnil);
747 break;
749 case 'v': /* Variable name: symbol that is
750 user-variable-p. */
751 args[i] = Fread_variable (callint_message, Qnil);
752 visargs[i] = last_minibuf_string;
753 break;
755 case 'x': /* Lisp expression read but not evaluated */
756 args[i] = Fread_minibuffer (callint_message, Qnil);
757 visargs[i] = last_minibuf_string;
758 break;
760 case 'X': /* Lisp expression read and evaluated */
761 args[i] = Feval_minibuffer (callint_message, Qnil);
762 visargs[i] = last_minibuf_string;
763 break;
765 case 'Z': /* Coding-system symbol, or ignore the
766 argument if no prefix */
767 if (NILP (prefix_arg))
769 args[i] = Qnil;
770 varies[i] = -1;
772 else
774 args[i]
775 = Fread_non_nil_coding_system (callint_message);
776 visargs[i] = last_minibuf_string;
778 break;
780 case 'z': /* Coding-system symbol or nil */
781 args[i] = Fread_coding_system (callint_message, Qnil);
782 visargs[i] = last_minibuf_string;
783 break;
785 /* We have a case for `+' so we get an error
786 if anyone tries to define one here. */
787 case '+':
788 default:
789 error ("Invalid control letter `%c' (%03o) in interactive calling string",
790 *tem, (unsigned char) *tem);
793 if (varies[i] == 0)
794 arg_from_tty = 1;
796 if (NILP (visargs[i]) && STRINGP (args[i]))
797 visargs[i] = args[i];
799 tem = strchr (tem, '\n');
800 if (tem) tem++;
801 else tem = "";
803 unbind_to (speccount, Qnil);
805 QUIT;
807 args[0] = function;
809 if (arg_from_tty || !NILP (record_flag))
811 visargs[0] = function;
812 for (i = 1; i < count + 1; i++)
814 if (varies[i] > 0)
815 visargs[i] = Fcons (intern (callint_argfuns[varies[i]]), Qnil);
816 else
817 visargs[i] = quotify_arg (args[i]);
819 Vcommand_history = Fcons (Flist (count + 1, visargs),
820 Vcommand_history);
821 /* Don't keep command history around forever. */
822 if (INTEGERP (Vhistory_length) && XINT (Vhistory_length) > 0)
824 teml = Fnthcdr (Vhistory_length, Vcommand_history);
825 if (CONSP (teml))
826 XSETCDR (teml, Qnil);
830 /* If we used a marker to hold point, mark, or an end of the region,
831 temporarily, convert it to an integer now. */
832 for (i = 1; i <= count; i++)
833 if (varies[i] >= 1 && varies[i] <= 4)
834 XSETINT (args[i], marker_position (args[i]));
836 if (record_then_fail)
837 Fbarf_if_buffer_read_only ();
839 Vthis_command = save_this_command;
840 Vthis_original_command = save_this_original_command;
841 real_this_command= save_real_this_command;
842 KVAR (current_kboard, Vlast_command) = save_last_command;
845 Lisp_Object val;
846 specbind (Qcommand_debug_status, Qnil);
848 temporarily_switch_to_single_kboard (NULL);
849 val = Ffuncall (count + 1, args);
850 UNGCPRO;
851 return unbind_to (speccount, val);
855 DEFUN ("prefix-numeric-value", Fprefix_numeric_value, Sprefix_numeric_value,
856 1, 1, 0,
857 doc: /* Return numeric meaning of raw prefix argument RAW.
858 A raw prefix argument is what you get from `(interactive "P")'.
859 Its numeric meaning is what you would get from `(interactive "p")'. */)
860 (Lisp_Object raw)
862 Lisp_Object val;
864 if (NILP (raw))
865 XSETFASTINT (val, 1);
866 else if (EQ (raw, Qminus))
867 XSETINT (val, -1);
868 else if (CONSP (raw) && INTEGERP (XCAR (raw)))
869 XSETINT (val, XINT (XCAR (raw)));
870 else if (INTEGERP (raw))
871 val = raw;
872 else
873 XSETFASTINT (val, 1);
875 return val;
878 void
879 syms_of_callint (void)
881 point_marker = Fmake_marker ();
882 staticpro (&point_marker);
884 callint_message = Qnil;
885 staticpro (&callint_message);
887 preserved_fns = pure_cons (intern_c_string ("region-beginning"),
888 pure_cons (intern_c_string ("region-end"),
889 pure_cons (intern_c_string ("point"),
890 pure_cons (intern_c_string ("mark"), Qnil))));
892 Qlist = intern_c_string ("list");
893 staticpro (&Qlist);
894 Qlet = intern_c_string ("let");
895 staticpro (&Qlet);
896 Qif = intern_c_string ("if");
897 staticpro (&Qif);
898 Qwhen = intern_c_string ("when");
899 staticpro (&Qwhen);
900 Qletx = intern_c_string ("let*");
901 staticpro (&Qletx);
902 Qsave_excursion = intern_c_string ("save-excursion");
903 staticpro (&Qsave_excursion);
904 Qprogn = intern_c_string ("progn");
905 staticpro (&Qprogn);
907 Qminus = intern_c_string ("-");
908 staticpro (&Qminus);
910 Qplus = intern_c_string ("+");
911 staticpro (&Qplus);
913 Qhandle_shift_selection = intern_c_string ("handle-shift-selection");
914 staticpro (&Qhandle_shift_selection);
916 Qcall_interactively = intern_c_string ("call-interactively");
917 staticpro (&Qcall_interactively);
919 Qcommand_debug_status = intern_c_string ("command-debug-status");
920 staticpro (&Qcommand_debug_status);
922 Qenable_recursive_minibuffers = intern_c_string ("enable-recursive-minibuffers");
923 staticpro (&Qenable_recursive_minibuffers);
925 Qmouse_leave_buffer_hook = intern_c_string ("mouse-leave-buffer-hook");
926 staticpro (&Qmouse_leave_buffer_hook);
928 DEFVAR_KBOARD ("prefix-arg", Vprefix_arg,
929 doc: /* The value of the prefix argument for the next editing command.
930 It may be a number, or the symbol `-' for just a minus sign as arg,
931 or a list whose car is a number for just one or more C-u's
932 or nil if no argument has been specified.
934 You cannot examine this variable to find the argument for this command
935 since it has been set to nil by the time you can look.
936 Instead, you should use the variable `current-prefix-arg', although
937 normally commands can get this prefix argument with (interactive "P"). */);
939 DEFVAR_KBOARD ("last-prefix-arg", Vlast_prefix_arg,
940 doc: /* The value of the prefix argument for the previous editing command.
941 See `prefix-arg' for the meaning of the value. */);
943 DEFVAR_LISP ("current-prefix-arg", Vcurrent_prefix_arg,
944 doc: /* The value of the prefix argument for this editing command.
945 It may be a number, or the symbol `-' for just a minus sign as arg,
946 or a list whose car is a number for just one or more C-u's
947 or nil if no argument has been specified.
948 This is what `(interactive \"P\")' returns. */);
949 Vcurrent_prefix_arg = Qnil;
951 DEFVAR_LISP ("command-history", Vcommand_history,
952 doc: /* List of recent commands that read arguments from terminal.
953 Each command is represented as a form to evaluate.
955 Maximum length of the history list is determined by the value
956 of `history-length', which see. */);
957 Vcommand_history = Qnil;
959 DEFVAR_LISP ("command-debug-status", Vcommand_debug_status,
960 doc: /* Debugging status of current interactive command.
961 Bound each time `call-interactively' is called;
962 may be set by the debugger as a reminder for itself. */);
963 Vcommand_debug_status = Qnil;
965 DEFVAR_LISP ("mark-even-if-inactive", Vmark_even_if_inactive,
966 doc: /* *Non-nil means you can use the mark even when inactive.
967 This option makes a difference in Transient Mark mode.
968 When the option is non-nil, deactivation of the mark
969 turns off region highlighting, but commands that use the mark
970 behave as if the mark were still active. */);
971 Vmark_even_if_inactive = Qt;
973 DEFVAR_LISP ("mouse-leave-buffer-hook", Vmouse_leave_buffer_hook,
974 doc: /* Hook to run when about to switch windows with a mouse command.
975 Its purpose is to give temporary modes such as Isearch mode
976 a way to turn themselves off when a mouse command switches windows. */);
977 Vmouse_leave_buffer_hook = Qnil;
979 defsubr (&Sinteractive);
980 defsubr (&Scall_interactively);
981 defsubr (&Sprefix_numeric_value);