Add support for defun in thingatpt.el
[emacs.git] / src / callint.c
blobbb815a5bd0165ba36bfb57d7a63205efa29496a2
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 (!INTEGERP (exp) && !STRINGP (exp)
125 && !NILP (exp) && !EQ (exp, Qt))
126 return Fcons (Qquote, Fcons (exp, Qnil));
128 return exp;
131 /* Modify EXP by quotifying each element (except the first). */
132 static Lisp_Object
133 quotify_args (Lisp_Object exp)
135 register Lisp_Object tail;
136 Lisp_Object next;
137 for (tail = exp; CONSP (tail); tail = next)
139 next = XCDR (tail);
140 XSETCAR (tail, quotify_arg (XCAR (tail)));
142 return exp;
145 static const char *callint_argfuns[]
146 = {"", "point", "mark", "region-beginning", "region-end"};
148 static void
149 check_mark (int for_region)
151 Lisp_Object tem;
152 tem = Fmarker_buffer (BVAR (current_buffer, mark));
153 if (NILP (tem) || (XBUFFER (tem) != current_buffer))
154 error (for_region ? "The mark is not set now, so there is no region"
155 : "The mark is not set now");
156 if (!NILP (Vtransient_mark_mode) && NILP (Vmark_even_if_inactive)
157 && NILP (BVAR (current_buffer, mark_active)))
158 xsignal0 (Qmark_inactive);
161 /* If the list of args INPUT was produced with an explicit call to
162 `list', look for elements that were computed with
163 (region-beginning) or (region-end), and put those expressions into
164 VALUES instead of the present values.
166 This function doesn't return a value because it modifies elements
167 of VALUES to do its job. */
169 static void
170 fix_command (Lisp_Object input, Lisp_Object values)
172 if (CONSP (input))
174 Lisp_Object car;
176 car = XCAR (input);
177 /* Skip through certain special forms. */
178 while (EQ (car, Qlet) || EQ (car, Qletx)
179 || EQ (car, Qsave_excursion)
180 || EQ (car, Qprogn))
182 while (CONSP (XCDR (input)))
183 input = XCDR (input);
184 input = XCAR (input);
185 if (!CONSP (input))
186 break;
187 car = XCAR (input);
189 if (EQ (car, Qlist))
191 Lisp_Object intail, valtail;
192 for (intail = Fcdr (input), valtail = values;
193 CONSP (valtail);
194 intail = Fcdr (intail), valtail = XCDR (valtail))
196 Lisp_Object elt;
197 elt = Fcar (intail);
198 if (CONSP (elt))
200 Lisp_Object presflag, carelt;
201 carelt = Fcar (elt);
202 /* If it is (if X Y), look at Y. */
203 if (EQ (carelt, Qif)
204 && EQ (Fnthcdr (make_number (3), elt), Qnil))
205 elt = Fnth (make_number (2), elt);
206 /* If it is (when ... Y), look at Y. */
207 else if (EQ (carelt, Qwhen))
209 while (CONSP (XCDR (elt)))
210 elt = XCDR (elt);
211 elt = Fcar (elt);
214 /* If the function call we're looking at
215 is a special preserved one, copy the
216 whole expression for this argument. */
217 if (CONSP (elt))
219 presflag = Fmemq (Fcar (elt), preserved_fns);
220 if (!NILP (presflag))
221 Fsetcar (valtail, Fcar (intail));
229 DEFUN ("call-interactively", Fcall_interactively, Scall_interactively, 1, 3, 0,
230 doc: /* Call FUNCTION, reading args according to its interactive calling specs.
231 Return the value FUNCTION returns.
232 The function contains a specification of how to do the argument reading.
233 In the case of user-defined functions, this is specified by placing a call
234 to the function `interactive' at the top level of the function body.
235 See `interactive'.
237 Optional second arg RECORD-FLAG non-nil
238 means unconditionally put this command in the command-history.
239 Otherwise, this is done only if an arg is read using the minibuffer.
241 Optional third arg KEYS, if given, specifies the sequence of events to
242 supply, as a vector, if the command inquires which events were used to
243 invoke it. If KEYS is omitted or nil, the return value of
244 `this-command-keys-vector' is used. */)
245 (Lisp_Object function, Lisp_Object record_flag, Lisp_Object keys)
247 Lisp_Object *args, *visargs;
248 Lisp_Object specs;
249 Lisp_Object filter_specs;
250 Lisp_Object teml;
251 Lisp_Object up_event;
252 Lisp_Object enable;
253 int speccount = SPECPDL_INDEX ();
255 /* The index of the next element of this_command_keys to examine for
256 the 'e' interactive code. */
257 int next_event;
259 Lisp_Object prefix_arg;
260 char *string;
261 const char *tem;
263 /* If varies[i] > 0, the i'th argument shouldn't just have its value
264 in this call quoted in the command history. It should be
265 recorded as a call to the function named callint_argfuns[varies[i]]. */
266 int *varies;
268 register int i, j;
269 int count, foo;
270 char prompt1[100];
271 char *tem1;
272 int arg_from_tty = 0;
273 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
274 int key_count;
275 int record_then_fail = 0;
277 Lisp_Object save_this_command, save_last_command;
278 Lisp_Object save_this_original_command, save_real_this_command;
280 save_this_command = Vthis_command;
281 save_this_original_command = Vthis_original_command;
282 save_real_this_command = real_this_command;
283 save_last_command = KVAR (current_kboard, Vlast_command);
285 if (NILP (keys))
286 keys = this_command_keys, key_count = this_command_key_count;
287 else
289 CHECK_VECTOR (keys);
290 key_count = XVECTOR (keys)->size;
293 /* Save this now, since use of minibuffer will clobber it. */
294 prefix_arg = Vcurrent_prefix_arg;
296 if (SYMBOLP (function))
297 enable = Fget (function, Qenable_recursive_minibuffers);
298 else
299 enable = Qnil;
301 specs = Qnil;
302 string = 0;
303 /* The idea of FILTER_SPECS is to provide away to
304 specify how to represent the arguments in command history.
305 The feature is not fully implemented. */
306 filter_specs = Qnil;
308 /* If k or K discard an up-event, save it here so it can be retrieved with U */
309 up_event = Qnil;
311 /* Set SPECS to the interactive form, or barf if not interactive. */
313 Lisp_Object form;
314 GCPRO2 (function, prefix_arg);
315 form = Finteractive_form (function);
316 UNGCPRO;
317 if (CONSP (form))
318 specs = filter_specs = Fcar (XCDR (form));
319 else
320 wrong_type_argument (Qcommandp, function);
323 /* If SPECS is set to a string, use it as an interactive prompt. */
324 if (STRINGP (specs))
326 /* Make a copy of string so that if a GC relocates specs,
327 `string' will still be valid. */
328 string = (char *) alloca (SBYTES (specs) + 1);
329 memcpy (string, SSDATA (specs), SBYTES (specs) + 1);
331 else
333 Lisp_Object input;
334 i = num_input_events;
335 input = specs;
336 /* Compute the arg values using the user's expression. */
337 GCPRO2 (input, filter_specs);
338 specs = Feval (specs);
339 UNGCPRO;
340 if (i != num_input_events || !NILP (record_flag))
342 /* We should record this command on the command history. */
343 Lisp_Object values;
344 Lisp_Object this_cmd;
345 /* Make a copy of the list of values, for the command history,
346 and turn them into things we can eval. */
347 values = quotify_args (Fcopy_sequence (specs));
348 fix_command (input, values);
349 this_cmd = Fcons (function, values);
350 if (history_delete_duplicates)
351 Vcommand_history = Fdelete (this_cmd, Vcommand_history);
352 Vcommand_history = Fcons (this_cmd, Vcommand_history);
354 /* Don't keep command history around forever. */
355 if (INTEGERP (Vhistory_length) && XINT (Vhistory_length) > 0)
357 teml = Fnthcdr (Vhistory_length, Vcommand_history);
358 if (CONSP (teml))
359 XSETCDR (teml, Qnil);
363 Vthis_command = save_this_command;
364 Vthis_original_command = save_this_original_command;
365 real_this_command= save_real_this_command;
366 KVAR (current_kboard, Vlast_command) = save_last_command;
368 temporarily_switch_to_single_kboard (NULL);
369 return unbind_to (speccount, apply1 (function, specs));
372 /* Here if function specifies a string to control parsing the defaults */
374 /* Set next_event to point to the first event with parameters. */
375 for (next_event = 0; next_event < key_count; next_event++)
376 if (EVENT_HAS_PARAMETERS (AREF (keys, next_event)))
377 break;
379 /* Handle special starting chars `*' and `@'. Also `-'. */
380 /* Note that `+' is reserved for user extensions. */
381 while (1)
383 if (*string == '+')
384 error ("`+' is not used in `interactive' for ordinary commands");
385 else if (*string == '*')
387 string++;
388 if (!NILP (BVAR (current_buffer, read_only)))
390 if (!NILP (record_flag))
392 char *p = string;
393 while (*p)
395 if (! (*p == 'r' || *p == 'p' || *p == 'P'
396 || *p == '\n'))
397 Fbarf_if_buffer_read_only ();
398 p++;
400 record_then_fail = 1;
402 else
403 Fbarf_if_buffer_read_only ();
406 /* Ignore this for semi-compatibility with Lucid. */
407 else if (*string == '-')
408 string++;
409 else if (*string == '@')
411 Lisp_Object event, w;
413 event = (next_event < key_count
414 ? AREF (keys, next_event)
415 : Qnil);
416 if (EVENT_HAS_PARAMETERS (event)
417 && (w = XCDR (event), CONSP (w))
418 && (w = XCAR (w), CONSP (w))
419 && (w = XCAR (w), WINDOWP (w)))
421 if (MINI_WINDOW_P (XWINDOW (w))
422 && ! (minibuf_level > 0 && EQ (w, minibuf_window)))
423 error ("Attempt to select inactive minibuffer window");
425 /* If the current buffer wants to clean up, let it. */
426 Frun_hooks (1, &Qmouse_leave_buffer_hook);
428 Fselect_window (w, Qnil);
430 string++;
432 else if (*string == '^')
434 call0 (Qhandle_shift_selection);
435 string++;
437 else break;
440 /* Count the number of arguments the interactive spec would have
441 us give to the function. */
442 tem = string;
443 for (j = 0; *tem;)
445 /* 'r' specifications ("point and mark as 2 numeric args")
446 produce *two* arguments. */
447 if (*tem == 'r')
448 j += 2;
449 else
450 j++;
451 tem = strchr (tem, '\n');
452 if (tem)
453 ++tem;
454 else
455 break;
457 count = j;
459 args = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object));
460 visargs = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object));
461 varies = (int *) alloca ((count + 1) * sizeof (int));
463 for (i = 0; i < (count + 1); i++)
465 args[i] = Qnil;
466 visargs[i] = Qnil;
467 varies[i] = 0;
470 GCPRO5 (prefix_arg, function, *args, *visargs, up_event);
471 gcpro3.nvars = (count + 1);
472 gcpro4.nvars = (count + 1);
474 if (!NILP (enable))
475 specbind (Qenable_recursive_minibuffers, Qt);
477 tem = string;
478 for (i = 1; *tem; i++)
480 strncpy (prompt1, tem + 1, sizeof prompt1 - 1);
481 prompt1[sizeof prompt1 - 1] = 0;
482 tem1 = strchr (prompt1, '\n');
483 if (tem1) *tem1 = 0;
485 visargs[0] = build_string (prompt1);
486 if (strchr (prompt1, '%'))
487 callint_message = Fformat (i, visargs);
488 else
489 callint_message = visargs[0];
491 switch (*tem)
493 case 'a': /* Symbol defined as a function */
494 visargs[i] = Fcompleting_read (callint_message,
495 Vobarray, Qfboundp, Qt,
496 Qnil, Qnil, Qnil, Qnil);
497 /* Passing args[i] directly stimulates compiler bug */
498 teml = visargs[i];
499 args[i] = Fintern (teml, Qnil);
500 break;
502 case 'b': /* Name of existing buffer */
503 args[i] = Fcurrent_buffer ();
504 if (EQ (selected_window, minibuf_window))
505 args[i] = Fother_buffer (args[i], Qnil, Qnil);
506 args[i] = Fread_buffer (callint_message, args[i], Qt);
507 break;
509 case 'B': /* Name of buffer, possibly nonexistent */
510 args[i] = Fread_buffer (callint_message,
511 Fother_buffer (Fcurrent_buffer (), Qnil, Qnil),
512 Qnil);
513 break;
515 case 'c': /* Character */
516 /* Prompt in `minibuffer-prompt' face. */
517 Fput_text_property (make_number (0),
518 make_number (SCHARS (callint_message)),
519 Qface, Qminibuffer_prompt, callint_message);
520 args[i] = Fread_char (callint_message, Qnil, Qnil);
521 message1_nolog ((char *) 0);
522 /* Passing args[i] directly stimulates compiler bug */
523 teml = args[i];
524 visargs[i] = Fchar_to_string (teml);
525 break;
527 case 'C': /* Command: symbol with interactive function */
528 visargs[i] = Fcompleting_read (callint_message,
529 Vobarray, Qcommandp,
530 Qt, Qnil, Qnil, Qnil, Qnil);
531 /* Passing args[i] directly stimulates compiler bug */
532 teml = visargs[i];
533 args[i] = Fintern (teml, Qnil);
534 break;
536 case 'd': /* Value of point. Does not do I/O. */
537 set_marker_both (point_marker, Qnil, PT, PT_BYTE);
538 args[i] = point_marker;
539 /* visargs[i] = Qnil; */
540 varies[i] = 1;
541 break;
543 case 'D': /* Directory name. */
544 args[i] = Fread_file_name (callint_message, Qnil,
545 BVAR (current_buffer, directory), Qlambda, Qnil,
546 Qfile_directory_p);
547 break;
549 case 'f': /* Existing file name. */
550 args[i] = Fread_file_name (callint_message,
551 Qnil, Qnil, Qlambda, Qnil, Qnil);
552 break;
554 case 'F': /* Possibly nonexistent file name. */
555 args[i] = Fread_file_name (callint_message,
556 Qnil, Qnil, Qnil, Qnil, Qnil);
557 break;
559 case 'G': /* Possibly nonexistent file name,
560 default to directory alone. */
561 args[i] = Fread_file_name (callint_message,
562 Qnil, Qnil, Qnil, empty_unibyte_string, Qnil);
563 break;
565 case 'i': /* Ignore an argument -- Does not do I/O */
566 varies[i] = -1;
567 break;
569 case 'k': /* Key sequence. */
571 int speccount1 = SPECPDL_INDEX ();
572 specbind (Qcursor_in_echo_area, Qt);
573 /* Prompt in `minibuffer-prompt' face. */
574 Fput_text_property (make_number (0),
575 make_number (SCHARS (callint_message)),
576 Qface, Qminibuffer_prompt, callint_message);
577 args[i] = Fread_key_sequence (callint_message,
578 Qnil, Qnil, Qnil, Qnil);
579 unbind_to (speccount1, Qnil);
580 teml = args[i];
581 visargs[i] = Fkey_description (teml, Qnil);
583 /* If the key sequence ends with a down-event,
584 discard the following up-event. */
585 teml = Faref (args[i], make_number (XINT (Flength (args[i])) - 1));
586 if (CONSP (teml))
587 teml = XCAR (teml);
588 if (SYMBOLP (teml))
590 Lisp_Object tem2;
592 teml = Fget (teml, intern ("event-symbol-elements"));
593 /* Ignore first element, which is the base key. */
594 tem2 = Fmemq (intern ("down"), Fcdr (teml));
595 if (! NILP (tem2))
596 up_event = Fread_event (Qnil, Qnil, Qnil);
599 break;
601 case 'K': /* Key sequence to be defined. */
603 int speccount1 = SPECPDL_INDEX ();
604 specbind (Qcursor_in_echo_area, Qt);
605 /* Prompt in `minibuffer-prompt' face. */
606 Fput_text_property (make_number (0),
607 make_number (SCHARS (callint_message)),
608 Qface, Qminibuffer_prompt, callint_message);
609 args[i] = Fread_key_sequence (callint_message,
610 Qnil, Qt, Qnil, Qnil);
611 teml = args[i];
612 visargs[i] = Fkey_description (teml, Qnil);
613 unbind_to (speccount1, Qnil);
615 /* If the key sequence ends with a down-event,
616 discard the following up-event. */
617 teml = Faref (args[i], make_number (XINT (Flength (args[i])) - 1));
618 if (CONSP (teml))
619 teml = XCAR (teml);
620 if (SYMBOLP (teml))
622 Lisp_Object tem2;
624 teml = Fget (teml, intern ("event-symbol-elements"));
625 /* Ignore first element, which is the base key. */
626 tem2 = Fmemq (intern ("down"), Fcdr (teml));
627 if (! NILP (tem2))
628 up_event = Fread_event (Qnil, Qnil, Qnil);
631 break;
633 case 'U': /* Up event from last k or K */
634 if (!NILP (up_event))
636 args[i] = Fmake_vector (make_number (1), up_event);
637 up_event = Qnil;
638 teml = args[i];
639 visargs[i] = Fkey_description (teml, Qnil);
641 break;
643 case 'e': /* The invoking event. */
644 if (next_event >= key_count)
645 error ("%s must be bound to an event with parameters",
646 (SYMBOLP (function)
647 ? SSDATA (SYMBOL_NAME (function))
648 : "command"));
649 args[i] = AREF (keys, next_event);
650 next_event++;
651 varies[i] = -1;
653 /* Find the next parameterized event. */
654 while (next_event < key_count
655 && !(EVENT_HAS_PARAMETERS (AREF (keys, next_event))))
656 next_event++;
658 break;
660 case 'm': /* Value of mark. Does not do I/O. */
661 check_mark (0);
662 /* visargs[i] = Qnil; */
663 args[i] = BVAR (current_buffer, mark);
664 varies[i] = 2;
665 break;
667 case 'M': /* String read via minibuffer with
668 inheriting the current input method. */
669 args[i] = Fread_string (callint_message,
670 Qnil, Qnil, Qnil, Qt);
671 break;
673 case 'N': /* Prefix arg as number, else number from minibuffer */
674 if (!NILP (prefix_arg))
675 goto have_prefix_arg;
676 case 'n': /* Read number from minibuffer. */
678 int first = 1;
681 Lisp_Object str;
682 if (! first)
684 message ("Please enter a number.");
685 sit_for (make_number (1), 0, 0);
687 first = 0;
689 str = Fread_from_minibuffer (callint_message,
690 Qnil, Qnil, Qnil, Qnil, Qnil,
691 Qnil);
692 if (! STRINGP (str) || SCHARS (str) == 0)
693 args[i] = Qnil;
694 else
695 args[i] = Fread (str);
697 while (! NUMBERP (args[i]));
699 visargs[i] = args[i];
700 break;
702 case 'P': /* Prefix arg in raw form. Does no I/O. */
703 args[i] = prefix_arg;
704 /* visargs[i] = Qnil; */
705 varies[i] = -1;
706 break;
708 case 'p': /* Prefix arg converted to number. No I/O. */
709 have_prefix_arg:
710 args[i] = Fprefix_numeric_value (prefix_arg);
711 /* visargs[i] = Qnil; */
712 varies[i] = -1;
713 break;
715 case 'r': /* Region, point and mark as 2 args. */
716 check_mark (1);
717 set_marker_both (point_marker, Qnil, PT, PT_BYTE);
718 /* visargs[i+1] = Qnil; */
719 foo = marker_position (BVAR (current_buffer, mark));
720 /* visargs[i] = Qnil; */
721 args[i] = PT < foo ? point_marker : BVAR (current_buffer, mark);
722 varies[i] = 3;
723 args[++i] = PT > foo ? point_marker : BVAR (current_buffer, mark);
724 varies[i] = 4;
725 break;
727 case 's': /* String read via minibuffer without
728 inheriting the current input method. */
729 args[i] = Fread_string (callint_message,
730 Qnil, Qnil, Qnil, Qnil);
731 break;
733 case 'S': /* Any symbol. */
734 visargs[i] = Fread_string (callint_message,
735 Qnil, Qnil, Qnil, Qnil);
736 /* Passing args[i] directly stimulates compiler bug */
737 teml = visargs[i];
738 args[i] = Fintern (teml, Qnil);
739 break;
741 case 'v': /* Variable name: symbol that is
742 user-variable-p. */
743 args[i] = Fread_variable (callint_message, Qnil);
744 visargs[i] = last_minibuf_string;
745 break;
747 case 'x': /* Lisp expression read but not evaluated */
748 args[i] = Fread_minibuffer (callint_message, Qnil);
749 visargs[i] = last_minibuf_string;
750 break;
752 case 'X': /* Lisp expression read and evaluated */
753 args[i] = Feval_minibuffer (callint_message, Qnil);
754 visargs[i] = last_minibuf_string;
755 break;
757 case 'Z': /* Coding-system symbol, or ignore the
758 argument if no prefix */
759 if (NILP (prefix_arg))
761 args[i] = Qnil;
762 varies[i] = -1;
764 else
766 args[i]
767 = Fread_non_nil_coding_system (callint_message);
768 visargs[i] = last_minibuf_string;
770 break;
772 case 'z': /* Coding-system symbol or nil */
773 args[i] = Fread_coding_system (callint_message, Qnil);
774 visargs[i] = last_minibuf_string;
775 break;
777 /* We have a case for `+' so we get an error
778 if anyone tries to define one here. */
779 case '+':
780 default:
781 error ("Invalid control letter `%c' (%03o) in interactive calling string",
782 *tem, (unsigned char) *tem);
785 if (varies[i] == 0)
786 arg_from_tty = 1;
788 if (NILP (visargs[i]) && STRINGP (args[i]))
789 visargs[i] = args[i];
791 tem = strchr (tem, '\n');
792 if (tem) tem++;
793 else tem = "";
795 unbind_to (speccount, Qnil);
797 QUIT;
799 args[0] = function;
801 if (arg_from_tty || !NILP (record_flag))
803 visargs[0] = function;
804 for (i = 1; i < count + 1; i++)
806 if (varies[i] > 0)
807 visargs[i] = Fcons (intern (callint_argfuns[varies[i]]), Qnil);
808 else
809 visargs[i] = quotify_arg (args[i]);
811 Vcommand_history = Fcons (Flist (count + 1, visargs),
812 Vcommand_history);
813 /* Don't keep command history around forever. */
814 if (INTEGERP (Vhistory_length) && XINT (Vhistory_length) > 0)
816 teml = Fnthcdr (Vhistory_length, Vcommand_history);
817 if (CONSP (teml))
818 XSETCDR (teml, Qnil);
822 /* If we used a marker to hold point, mark, or an end of the region,
823 temporarily, convert it to an integer now. */
824 for (i = 1; i <= count; i++)
825 if (varies[i] >= 1 && varies[i] <= 4)
826 XSETINT (args[i], marker_position (args[i]));
828 if (record_then_fail)
829 Fbarf_if_buffer_read_only ();
831 Vthis_command = save_this_command;
832 Vthis_original_command = save_this_original_command;
833 real_this_command= save_real_this_command;
834 KVAR (current_kboard, Vlast_command) = save_last_command;
837 Lisp_Object val;
838 specbind (Qcommand_debug_status, Qnil);
840 temporarily_switch_to_single_kboard (NULL);
841 val = Ffuncall (count + 1, args);
842 UNGCPRO;
843 return unbind_to (speccount, val);
847 DEFUN ("prefix-numeric-value", Fprefix_numeric_value, Sprefix_numeric_value,
848 1, 1, 0,
849 doc: /* Return numeric meaning of raw prefix argument RAW.
850 A raw prefix argument is what you get from `(interactive "P")'.
851 Its numeric meaning is what you would get from `(interactive "p")'. */)
852 (Lisp_Object raw)
854 Lisp_Object val;
856 if (NILP (raw))
857 XSETFASTINT (val, 1);
858 else if (EQ (raw, Qminus))
859 XSETINT (val, -1);
860 else if (CONSP (raw) && INTEGERP (XCAR (raw)))
861 XSETINT (val, XINT (XCAR (raw)));
862 else if (INTEGERP (raw))
863 val = raw;
864 else
865 XSETFASTINT (val, 1);
867 return val;
870 void
871 syms_of_callint (void)
873 point_marker = Fmake_marker ();
874 staticpro (&point_marker);
876 callint_message = Qnil;
877 staticpro (&callint_message);
879 preserved_fns = pure_cons (intern_c_string ("region-beginning"),
880 pure_cons (intern_c_string ("region-end"),
881 pure_cons (intern_c_string ("point"),
882 pure_cons (intern_c_string ("mark"), Qnil))));
884 Qlist = intern_c_string ("list");
885 staticpro (&Qlist);
886 Qlet = intern_c_string ("let");
887 staticpro (&Qlet);
888 Qif = intern_c_string ("if");
889 staticpro (&Qif);
890 Qwhen = intern_c_string ("when");
891 staticpro (&Qwhen);
892 Qletx = intern_c_string ("let*");
893 staticpro (&Qletx);
894 Qsave_excursion = intern_c_string ("save-excursion");
895 staticpro (&Qsave_excursion);
896 Qprogn = intern_c_string ("progn");
897 staticpro (&Qprogn);
899 Qminus = intern_c_string ("-");
900 staticpro (&Qminus);
902 Qplus = intern_c_string ("+");
903 staticpro (&Qplus);
905 Qhandle_shift_selection = intern_c_string ("handle-shift-selection");
906 staticpro (&Qhandle_shift_selection);
908 Qcall_interactively = intern_c_string ("call-interactively");
909 staticpro (&Qcall_interactively);
911 Qcommand_debug_status = intern_c_string ("command-debug-status");
912 staticpro (&Qcommand_debug_status);
914 Qenable_recursive_minibuffers = intern_c_string ("enable-recursive-minibuffers");
915 staticpro (&Qenable_recursive_minibuffers);
917 Qmouse_leave_buffer_hook = intern_c_string ("mouse-leave-buffer-hook");
918 staticpro (&Qmouse_leave_buffer_hook);
920 DEFVAR_KBOARD ("prefix-arg", Vprefix_arg,
921 doc: /* The value of the prefix argument for the next editing command.
922 It may be a number, or the symbol `-' for just a minus sign as arg,
923 or a list whose car is a number for just one or more C-u's
924 or nil if no argument has been specified.
926 You cannot examine this variable to find the argument for this command
927 since it has been set to nil by the time you can look.
928 Instead, you should use the variable `current-prefix-arg', although
929 normally commands can get this prefix argument with (interactive "P"). */);
931 DEFVAR_KBOARD ("last-prefix-arg", Vlast_prefix_arg,
932 doc: /* The value of the prefix argument for the previous editing command.
933 See `prefix-arg' for the meaning of the value. */);
935 DEFVAR_LISP ("current-prefix-arg", Vcurrent_prefix_arg,
936 doc: /* The value of the prefix argument for this editing command.
937 It may be a number, or the symbol `-' for just a minus sign as arg,
938 or a list whose car is a number for just one or more C-u's
939 or nil if no argument has been specified.
940 This is what `(interactive \"P\")' returns. */);
941 Vcurrent_prefix_arg = Qnil;
943 DEFVAR_LISP ("command-history", Vcommand_history,
944 doc: /* List of recent commands that read arguments from terminal.
945 Each command is represented as a form to evaluate.
947 Maximum length of the history list is determined by the value
948 of `history-length', which see. */);
949 Vcommand_history = Qnil;
951 DEFVAR_LISP ("command-debug-status", Vcommand_debug_status,
952 doc: /* Debugging status of current interactive command.
953 Bound each time `call-interactively' is called;
954 may be set by the debugger as a reminder for itself. */);
955 Vcommand_debug_status = Qnil;
957 DEFVAR_LISP ("mark-even-if-inactive", Vmark_even_if_inactive,
958 doc: /* *Non-nil means you can use the mark even when inactive.
959 This option makes a difference in Transient Mark mode.
960 When the option is non-nil, deactivation of the mark
961 turns off region highlighting, but commands that use the mark
962 behave as if the mark were still active. */);
963 Vmark_even_if_inactive = Qt;
965 DEFVAR_LISP ("mouse-leave-buffer-hook", Vmouse_leave_buffer_hook,
966 doc: /* Hook to run when about to switch windows with a mouse command.
967 Its purpose is to give temporary modes such as Isearch mode
968 a way to turn themselves off when a mouse command switches windows. */);
969 Vmouse_leave_buffer_hook = Qnil;
971 defsubr (&Sinteractive);
972 defsubr (&Scall_interactively);
973 defsubr (&Sprefix_numeric_value);