(hol-loaddefs): Load this rather than explicit autoloads.
[emacs.git] / src / callint.c
blob8a9f8322d9b889828581598c773c27148f2bd5a2
1 /* Call a Lisp function interactively.
2 Copyright (C) 1985, 1986, 1993, 1994, 1995, 1997, 2000, 2001, 2002,
3 2003, 2004, 2005, 2006, 2007, 2008
4 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 3, or (at your option)
11 any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs; see the file COPYING. If not, write to
20 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
21 Boston, MA 02110-1301, USA. */
24 #include <config.h>
26 #include "lisp.h"
27 #include "buffer.h"
28 #include "commands.h"
29 #include "keyboard.h"
30 #include "window.h"
31 #include "keymap.h"
33 #ifdef HAVE_INDEX
34 extern char *index P_ ((const char *, int));
35 #endif
37 extern Lisp_Object Qcursor_in_echo_area;
38 extern Lisp_Object Qfile_directory_p;
40 Lisp_Object Vcurrent_prefix_arg, Qminus, Qplus;
41 Lisp_Object Qcall_interactively;
42 Lisp_Object Vcommand_history;
44 extern Lisp_Object Vhistory_length;
45 extern Lisp_Object Vthis_original_command, real_this_command;
47 Lisp_Object Vcommand_debug_status, Qcommand_debug_status;
48 Lisp_Object Qenable_recursive_minibuffers;
50 /* Non-nil means treat the mark as active
51 even if mark_active is 0. */
52 Lisp_Object Vmark_even_if_inactive;
54 Lisp_Object Vmouse_leave_buffer_hook, Qmouse_leave_buffer_hook;
56 Lisp_Object Qlist, Qlet, Qletx, Qsave_excursion, Qprogn, Qif, Qwhen;
57 static Lisp_Object preserved_fns;
59 /* Marker used within call-interactively to refer to point. */
60 static Lisp_Object point_marker;
62 /* String for the prompt text used in Fcall_interactively. */
63 static Lisp_Object callint_message;
65 /* ARGSUSED */
66 DEFUN ("interactive", Finteractive, Sinteractive, 0, UNEVALLED, 0,
67 doc: /* Specify a way of parsing arguments for interactive use of a function.
68 For example, write
69 (defun foo (arg) "Doc string" (interactive "p") ...use arg...)
70 to make ARG be the prefix argument when `foo' is called as a command.
71 The "call" to `interactive' is actually a declaration rather than a function;
72 it tells `call-interactively' how to read arguments
73 to pass to the function.
74 When actually called, `interactive' just returns nil.
76 The argument of `interactive' is usually a string containing a code letter
77 followed by a prompt. (Some code letters do not use I/O to get
78 the argument and do not need prompts.) To prompt for multiple arguments,
79 give a code letter, its prompt, a newline, and another code letter, etc.
80 Prompts are passed to format, and may use % escapes to print the
81 arguments that have already been read.
82 If the argument is not a string, it is evaluated to get a list of
83 arguments to pass to the function.
84 Just `(interactive)' means pass no args when calling interactively.
86 Code letters available are:
87 a -- Function name: symbol with a function definition.
88 b -- Name of existing buffer.
89 B -- Name of buffer, possibly nonexistent.
90 c -- Character (no input method is used).
91 C -- Command name: symbol with interactive function definition.
92 d -- Value of point as number. Does not do I/O.
93 D -- Directory name.
94 e -- Parametrized event (i.e., one that's a list) that invoked this command.
95 If used more than once, the Nth `e' returns the Nth parameterized event.
96 This skips events that are integers or symbols.
97 f -- Existing file name.
98 F -- Possibly nonexistent file name.
99 G -- Possibly nonexistent file name, defaulting to just directory name.
100 i -- Ignored, i.e. always nil. Does not do I/O.
101 k -- Key sequence (downcase the last event if needed to get a definition).
102 K -- Key sequence to be redefined (do not downcase the last event).
103 m -- Value of mark as number. Does not do I/O.
104 M -- Any string. Inherits the current input method.
105 n -- Number read using minibuffer.
106 N -- Numeric prefix arg, or if none, do like code `n'.
107 p -- Prefix arg converted to number. Does not do I/O.
108 P -- Prefix arg in raw form. Does not do I/O.
109 r -- Region: point and mark as 2 numeric args, smallest first. Does no I/O.
110 s -- Any string. Does not inherit the current input method.
111 S -- Any symbol.
112 U -- Mouse up event discarded by a previous k or K argument.
113 v -- Variable name: symbol that is user-variable-p.
114 x -- Lisp expression read but not evaluated.
115 X -- Lisp expression read and evaluated.
116 z -- Coding system.
117 Z -- Coding system, nil if no prefix arg.
118 In addition, if the string begins with `*'
119 then an error is signaled if the buffer is read-only.
120 This happens before reading any arguments.
121 If the string begins with `@', then Emacs searches the key sequence
122 which invoked the command for its first mouse click (or any other
123 event which specifies a window), and selects that window before
124 reading any arguments. You may use both `@' and `*'; they are
125 processed in the order that they appear.
126 usage: (interactive ARGS) */)
127 (args)
128 Lisp_Object args;
130 return Qnil;
133 /* Quotify EXP: if EXP is constant, return it.
134 If EXP is not constant, return (quote EXP). */
135 Lisp_Object
136 quotify_arg (exp)
137 register Lisp_Object exp;
139 if (!INTEGERP (exp) && !STRINGP (exp)
140 && !NILP (exp) && !EQ (exp, Qt))
141 return Fcons (Qquote, Fcons (exp, Qnil));
143 return exp;
146 /* Modify EXP by quotifying each element (except the first). */
147 Lisp_Object
148 quotify_args (exp)
149 Lisp_Object exp;
151 register Lisp_Object tail;
152 Lisp_Object next;
153 for (tail = exp; CONSP (tail); tail = next)
155 next = XCDR (tail);
156 XSETCAR (tail, quotify_arg (XCAR (tail)));
158 return exp;
161 char *callint_argfuns[]
162 = {"", "point", "mark", "region-beginning", "region-end"};
164 static void
165 check_mark (for_region)
166 int for_region;
168 Lisp_Object tem;
169 tem = Fmarker_buffer (current_buffer->mark);
170 if (NILP (tem) || (XBUFFER (tem) != current_buffer))
171 error (for_region ? "The mark is not set now, so there is no region"
172 : "The mark is not set now");
173 if (!NILP (Vtransient_mark_mode) && NILP (Vmark_even_if_inactive)
174 && NILP (current_buffer->mark_active))
175 xsignal0 (Qmark_inactive);
178 /* If the list of args INPUT was produced with an explicit call to
179 `list', look for elements that were computed with
180 (region-beginning) or (region-end), and put those expressions into
181 VALUES instead of the present values.
183 This function doesn't return a value because it modifies elements
184 of VALUES to do its job. */
186 static void
187 fix_command (input, values)
188 Lisp_Object input, values;
190 if (CONSP (input))
192 Lisp_Object car;
194 car = XCAR (input);
195 /* Skip through certain special forms. */
196 while (EQ (car, Qlet) || EQ (car, Qletx)
197 || EQ (car, Qsave_excursion)
198 || EQ (car, Qprogn))
200 while (CONSP (XCDR (input)))
201 input = XCDR (input);
202 input = XCAR (input);
203 if (!CONSP (input))
204 break;
205 car = XCAR (input);
207 if (EQ (car, Qlist))
209 Lisp_Object intail, valtail;
210 for (intail = Fcdr (input), valtail = values;
211 CONSP (valtail);
212 intail = Fcdr (intail), valtail = XCDR (valtail))
214 Lisp_Object elt;
215 elt = Fcar (intail);
216 if (CONSP (elt))
218 Lisp_Object presflag, carelt;
219 carelt = Fcar (elt);
220 /* If it is (if X Y), look at Y. */
221 if (EQ (carelt, Qif)
222 && EQ (Fnthcdr (make_number (3), elt), Qnil))
223 elt = Fnth (make_number (2), elt);
224 /* If it is (when ... Y), look at Y. */
225 else if (EQ (carelt, Qwhen))
227 while (CONSP (XCDR (elt)))
228 elt = XCDR (elt);
229 elt = Fcar (elt);
232 /* If the function call we're looking at
233 is a special preserved one, copy the
234 whole expression for this argument. */
235 if (CONSP (elt))
237 presflag = Fmemq (Fcar (elt), preserved_fns);
238 if (!NILP (presflag))
239 Fsetcar (valtail, Fcar (intail));
247 DEFUN ("call-interactively", Fcall_interactively, Scall_interactively, 1, 3, 0,
248 doc: /* Call FUNCTION, reading args according to its interactive calling specs.
249 Return the value FUNCTION returns.
250 The function contains a specification of how to do the argument reading.
251 In the case of user-defined functions, this is specified by placing a call
252 to the function `interactive' at the top level of the function body.
253 See `interactive'.
255 Optional second arg RECORD-FLAG non-nil
256 means unconditionally put this command in the command-history.
257 Otherwise, this is done only if an arg is read using the minibuffer.
259 Optional third arg KEYS, if given, specifies the sequence of events to
260 supply, as a vector, if the command inquires which events were used to
261 invoke it. If KEYS is omitted or nil, the return value of
262 `this-command-keys-vector' is used. */)
263 (function, record_flag, keys)
264 Lisp_Object function, record_flag, keys;
266 Lisp_Object *args, *visargs;
267 Lisp_Object specs;
268 Lisp_Object filter_specs;
269 Lisp_Object teml;
270 Lisp_Object up_event;
271 Lisp_Object enable;
272 int speccount = SPECPDL_INDEX ();
274 /* The index of the next element of this_command_keys to examine for
275 the 'e' interactive code. */
276 int next_event;
278 Lisp_Object prefix_arg;
279 unsigned char *string;
280 unsigned char *tem;
282 /* If varies[i] > 0, the i'th argument shouldn't just have its value
283 in this call quoted in the command history. It should be
284 recorded as a call to the function named callint_argfuns[varies[i]]. */
285 int *varies;
287 register int i, j;
288 int count, foo;
289 char prompt1[100];
290 char *tem1;
291 int arg_from_tty = 0;
292 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
293 int key_count;
294 int record_then_fail = 0;
296 Lisp_Object save_this_command, save_last_command;
297 Lisp_Object save_this_original_command, save_real_this_command;
299 save_this_command = Vthis_command;
300 save_this_original_command = Vthis_original_command;
301 save_real_this_command = real_this_command;
302 save_last_command = current_kboard->Vlast_command;
304 if (NILP (keys))
305 keys = this_command_keys, key_count = this_command_key_count;
306 else
308 CHECK_VECTOR (keys);
309 key_count = XVECTOR (keys)->size;
312 /* Save this now, since use of minibuffer will clobber it. */
313 prefix_arg = Vcurrent_prefix_arg;
315 if (SYMBOLP (function))
316 enable = Fget (function, Qenable_recursive_minibuffers);
317 else
318 enable = Qnil;
320 specs = Qnil;
321 string = 0;
322 /* The idea of FILTER_SPECS is to provide away to
323 specify how to represent the arguments in command history.
324 The feature is not fully implemented. */
325 filter_specs = Qnil;
327 /* If k or K discard an up-event, save it here so it can be retrieved with U */
328 up_event = Qnil;
330 /* Set SPECS to the interactive form, or barf if not interactive. */
332 Lisp_Object form;
333 GCPRO2 (function, prefix_arg);
334 form = Finteractive_form (function);
335 UNGCPRO;
336 if (CONSP (form))
337 specs = filter_specs = Fcar (XCDR (form));
338 else
339 wrong_type_argument (Qcommandp, function);
342 /* If SPECS is set to a string, use it as an interactive prompt. */
343 if (STRINGP (specs))
345 /* Make a copy of string so that if a GC relocates specs,
346 `string' will still be valid. */
347 string = (unsigned char *) alloca (SBYTES (specs) + 1);
348 bcopy (SDATA (specs), string,
349 SBYTES (specs) + 1);
351 else
353 Lisp_Object input;
354 i = num_input_events;
355 input = specs;
356 /* Compute the arg values using the user's expression. */
357 GCPRO2 (input, filter_specs);
358 specs = Feval (specs);
359 UNGCPRO;
360 if (i != num_input_events || !NILP (record_flag))
362 /* We should record this command on the command history. */
363 Lisp_Object values;
364 /* Make a copy of the list of values, for the command history,
365 and turn them into things we can eval. */
366 values = quotify_args (Fcopy_sequence (specs));
367 fix_command (input, values);
368 Vcommand_history
369 = Fcons (Fcons (function, values), Vcommand_history);
371 /* Don't keep command history around forever. */
372 if (INTEGERP (Vhistory_length) && XINT (Vhistory_length) > 0)
374 teml = Fnthcdr (Vhistory_length, Vcommand_history);
375 if (CONSP (teml))
376 XSETCDR (teml, Qnil);
380 Vthis_command = save_this_command;
381 Vthis_original_command = save_this_original_command;
382 real_this_command= save_real_this_command;
383 current_kboard->Vlast_command = save_last_command;
385 temporarily_switch_to_single_kboard (NULL);
386 return unbind_to (speccount, apply1 (function, specs));
389 /* Here if function specifies a string to control parsing the defaults */
391 /* Set next_event to point to the first event with parameters. */
392 for (next_event = 0; next_event < key_count; next_event++)
393 if (EVENT_HAS_PARAMETERS (AREF (keys, next_event)))
394 break;
396 /* Handle special starting chars `*' and `@'. Also `-'. */
397 /* Note that `+' is reserved for user extensions. */
398 while (1)
400 if (*string == '+')
401 error ("`+' is not used in `interactive' for ordinary commands");
402 else if (*string == '*')
404 string++;
405 if (!NILP (current_buffer->read_only))
407 if (!NILP (record_flag))
409 unsigned char *p = string;
410 while (*p)
412 if (! (*p == 'r' || *p == 'p' || *p == 'P'
413 || *p == '\n'))
414 Fbarf_if_buffer_read_only ();
415 p++;
417 record_then_fail = 1;
419 else
420 Fbarf_if_buffer_read_only ();
423 /* Ignore this for semi-compatibility with Lucid. */
424 else if (*string == '-')
425 string++;
426 else if (*string == '@')
428 Lisp_Object event, tem;
430 event = (next_event < key_count
431 ? AREF (keys, next_event)
432 : Qnil);
433 if (EVENT_HAS_PARAMETERS (event)
434 && (tem = XCDR (event), CONSP (tem))
435 && (tem = XCAR (tem), CONSP (tem))
436 && (tem = XCAR (tem), WINDOWP (tem)))
438 if (MINI_WINDOW_P (XWINDOW (tem))
439 && ! (minibuf_level > 0 && EQ (tem, minibuf_window)))
440 error ("Attempt to select inactive minibuffer window");
442 /* If the current buffer wants to clean up, let it. */
443 if (!NILP (Vmouse_leave_buffer_hook))
444 call1 (Vrun_hooks, Qmouse_leave_buffer_hook);
446 Fselect_window (tem, Qnil);
448 string++;
450 else break;
453 /* Count the number of arguments the interactive spec would have
454 us give to the function. */
455 tem = string;
456 for (j = 0; *tem;)
458 /* 'r' specifications ("point and mark as 2 numeric args")
459 produce *two* arguments. */
460 if (*tem == 'r')
461 j += 2;
462 else
463 j++;
464 tem = (unsigned char *) index (tem, '\n');
465 if (tem)
466 ++tem;
467 else
468 break;
470 count = j;
472 args = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object));
473 visargs = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object));
474 varies = (int *) alloca ((count + 1) * sizeof (int));
476 for (i = 0; i < (count + 1); i++)
478 args[i] = Qnil;
479 visargs[i] = Qnil;
480 varies[i] = 0;
483 GCPRO5 (prefix_arg, function, *args, *visargs, up_event);
484 gcpro3.nvars = (count + 1);
485 gcpro4.nvars = (count + 1);
487 if (!NILP (enable))
488 specbind (Qenable_recursive_minibuffers, Qt);
490 tem = string;
491 for (i = 1; *tem; i++)
493 strncpy (prompt1, tem + 1, sizeof prompt1 - 1);
494 prompt1[sizeof prompt1 - 1] = 0;
495 tem1 = (char *) index (prompt1, '\n');
496 if (tem1) *tem1 = 0;
498 visargs[0] = build_string (prompt1);
499 if (index (prompt1, '%'))
500 callint_message = Fformat (i, visargs);
501 else
502 callint_message = visargs[0];
504 switch (*tem)
506 case 'a': /* Symbol defined as a function */
507 visargs[i] = Fcompleting_read (callint_message,
508 Vobarray, Qfboundp, Qt,
509 Qnil, Qnil, Qnil, Qnil);
510 /* Passing args[i] directly stimulates compiler bug */
511 teml = visargs[i];
512 args[i] = Fintern (teml, Qnil);
513 break;
515 case 'b': /* Name of existing buffer */
516 args[i] = Fcurrent_buffer ();
517 if (EQ (selected_window, minibuf_window))
518 args[i] = Fother_buffer (args[i], Qnil, Qnil);
519 args[i] = Fread_buffer (callint_message, args[i], Qt);
520 break;
522 case 'B': /* Name of buffer, possibly nonexistent */
523 args[i] = Fread_buffer (callint_message,
524 Fother_buffer (Fcurrent_buffer (), Qnil, Qnil),
525 Qnil);
526 break;
528 case 'c': /* Character */
529 args[i] = Fread_char (callint_message, Qnil, Qnil);
530 message1_nolog ((char *) 0);
531 /* Passing args[i] directly stimulates compiler bug */
532 teml = args[i];
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 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 args[i] = Fread_key_sequence (callint_message,
583 Qnil, Qnil, Qnil, Qnil);
584 unbind_to (speccount1, Qnil);
585 teml = args[i];
586 visargs[i] = Fkey_description (teml, Qnil);
588 /* If the key sequence ends with a down-event,
589 discard the following up-event. */
590 teml = Faref (args[i], make_number (XINT (Flength (args[i])) - 1));
591 if (CONSP (teml))
592 teml = XCAR (teml);
593 if (SYMBOLP (teml))
595 Lisp_Object tem2;
597 teml = Fget (teml, intern ("event-symbol-elements"));
598 /* Ignore first element, which is the base key. */
599 tem2 = Fmemq (intern ("down"), Fcdr (teml));
600 if (! NILP (tem2))
601 up_event = Fread_event (Qnil, Qnil, Qnil);
604 break;
606 case 'K': /* Key sequence to be defined. */
608 int speccount1 = SPECPDL_INDEX ();
609 specbind (Qcursor_in_echo_area, Qt);
610 args[i] = Fread_key_sequence (callint_message,
611 Qnil, Qt, Qnil, Qnil);
612 teml = args[i];
613 visargs[i] = Fkey_description (teml, Qnil);
614 unbind_to (speccount1, Qnil);
616 /* If the key sequence ends with a down-event,
617 discard the following up-event. */
618 teml = Faref (args[i], make_number (XINT (Flength (args[i])) - 1));
619 if (CONSP (teml))
620 teml = XCAR (teml);
621 if (SYMBOLP (teml))
623 Lisp_Object tem2;
625 teml = Fget (teml, intern ("event-symbol-elements"));
626 /* Ignore first element, which is the base key. */
627 tem2 = Fmemq (intern ("down"), Fcdr (teml));
628 if (! NILP (tem2))
629 up_event = Fread_event (Qnil, Qnil, Qnil);
632 break;
634 case 'U': /* Up event from last k or K */
635 if (!NILP (up_event))
637 args[i] = Fmake_vector (make_number (1), up_event);
638 up_event = Qnil;
639 teml = args[i];
640 visargs[i] = Fkey_description (teml, Qnil);
642 break;
644 case 'e': /* The invoking event. */
645 if (next_event >= key_count)
646 error ("%s must be bound to an event with parameters",
647 (SYMBOLP (function)
648 ? (char *) SDATA (SYMBOL_NAME (function))
649 : "command"));
650 args[i] = AREF (keys, next_event);
651 next_event++;
652 varies[i] = -1;
654 /* Find the next parameterized event. */
655 while (next_event < key_count
656 && !(EVENT_HAS_PARAMETERS (AREF (keys, next_event))))
657 next_event++;
659 break;
661 case 'm': /* Value of mark. Does not do I/O. */
662 check_mark (0);
663 /* visargs[i] = Qnil; */
664 args[i] = current_buffer->mark;
665 varies[i] = 2;
666 break;
668 case 'M': /* String read via minibuffer with
669 inheriting the current input method. */
670 args[i] = Fread_string (callint_message,
671 Qnil, Qnil, Qnil, Qt);
672 break;
674 case 'N': /* Prefix arg as number, else number from minibuffer */
675 if (!NILP (prefix_arg))
676 goto have_prefix_arg;
677 case 'n': /* Read number from minibuffer. */
679 int first = 1;
682 Lisp_Object tem;
683 if (! first)
685 message ("Please enter a number.");
686 sit_for (make_number (1), 0, 0);
688 first = 0;
690 tem = Fread_from_minibuffer (callint_message,
691 Qnil, Qnil, Qnil, Qnil, Qnil,
692 Qnil);
693 if (! STRINGP (tem) || SCHARS (tem) == 0)
694 args[i] = Qnil;
695 else
696 args[i] = Fread (tem);
698 while (! NUMBERP (args[i]));
700 visargs[i] = args[i];
701 break;
703 case 'P': /* Prefix arg in raw form. Does no I/O. */
704 args[i] = prefix_arg;
705 /* visargs[i] = Qnil; */
706 varies[i] = -1;
707 break;
709 case 'p': /* Prefix arg converted to number. No I/O. */
710 have_prefix_arg:
711 args[i] = Fprefix_numeric_value (prefix_arg);
712 /* visargs[i] = Qnil; */
713 varies[i] = -1;
714 break;
716 case 'r': /* Region, point and mark as 2 args. */
717 check_mark (1);
718 set_marker_both (point_marker, Qnil, PT, PT_BYTE);
719 /* visargs[i+1] = Qnil; */
720 foo = marker_position (current_buffer->mark);
721 /* visargs[i] = Qnil; */
722 args[i] = PT < foo ? point_marker : current_buffer->mark;
723 varies[i] = 3;
724 args[++i] = PT > foo ? point_marker : current_buffer->mark;
725 varies[i] = 4;
726 break;
728 case 's': /* String read via minibuffer without
729 inheriting the current input method. */
730 args[i] = Fread_string (callint_message,
731 Qnil, Qnil, Qnil, Qnil);
732 break;
734 case 'S': /* Any symbol. */
735 visargs[i] = Fread_string (callint_message,
736 Qnil, Qnil, Qnil, Qnil);
737 /* Passing args[i] directly stimulates compiler bug */
738 teml = visargs[i];
739 args[i] = Fintern (teml, Qnil);
740 break;
742 case 'v': /* Variable name: symbol that is
743 user-variable-p. */
744 args[i] = Fread_variable (callint_message, Qnil);
745 visargs[i] = last_minibuf_string;
746 break;
748 case 'x': /* Lisp expression read but not evaluated */
749 args[i] = Fread_minibuffer (callint_message, Qnil);
750 visargs[i] = last_minibuf_string;
751 break;
753 case 'X': /* Lisp expression read and evaluated */
754 args[i] = Feval_minibuffer (callint_message, Qnil);
755 visargs[i] = last_minibuf_string;
756 break;
758 case 'Z': /* Coding-system symbol, or ignore the
759 argument if no prefix */
760 if (NILP (prefix_arg))
762 args[i] = Qnil;
763 varies[i] = -1;
765 else
767 args[i]
768 = Fread_non_nil_coding_system (callint_message);
769 visargs[i] = last_minibuf_string;
771 break;
773 case 'z': /* Coding-system symbol or nil */
774 args[i] = Fread_coding_system (callint_message, Qnil);
775 visargs[i] = last_minibuf_string;
776 break;
778 /* We have a case for `+' so we get an error
779 if anyone tries to define one here. */
780 case '+':
781 default:
782 error ("Invalid control letter `%c' (%03o) in interactive calling string",
783 *tem, *tem);
786 if (varies[i] == 0)
787 arg_from_tty = 1;
789 if (NILP (visargs[i]) && STRINGP (args[i]))
790 visargs[i] = args[i];
792 tem = (unsigned char *) index (tem, '\n');
793 if (tem) tem++;
794 else tem = (unsigned char *) "";
796 unbind_to (speccount, Qnil);
798 QUIT;
800 args[0] = function;
802 if (arg_from_tty || !NILP (record_flag))
804 visargs[0] = function;
805 for (i = 1; i < count + 1; i++)
807 if (varies[i] > 0)
808 visargs[i] = Fcons (intern (callint_argfuns[varies[i]]), Qnil);
809 else
810 visargs[i] = quotify_arg (args[i]);
812 Vcommand_history = Fcons (Flist (count + 1, visargs),
813 Vcommand_history);
814 /* Don't keep command history around forever. */
815 if (INTEGERP (Vhistory_length) && XINT (Vhistory_length) > 0)
817 teml = Fnthcdr (Vhistory_length, Vcommand_history);
818 if (CONSP (teml))
819 XSETCDR (teml, Qnil);
823 /* If we used a marker to hold point, mark, or an end of the region,
824 temporarily, convert it to an integer now. */
825 for (i = 1; i <= count; i++)
826 if (varies[i] >= 1 && varies[i] <= 4)
827 XSETINT (args[i], marker_position (args[i]));
829 if (record_then_fail)
830 Fbarf_if_buffer_read_only ();
832 Vthis_command = save_this_command;
833 Vthis_original_command = save_this_original_command;
834 real_this_command= save_real_this_command;
835 current_kboard->Vlast_command = save_last_command;
838 Lisp_Object val;
839 specbind (Qcommand_debug_status, Qnil);
841 temporarily_switch_to_single_kboard (NULL);
842 val = Ffuncall (count + 1, args);
843 UNGCPRO;
844 return unbind_to (speccount, val);
848 DEFUN ("prefix-numeric-value", Fprefix_numeric_value, Sprefix_numeric_value,
849 1, 1, 0,
850 doc: /* Return numeric meaning of raw prefix argument RAW.
851 A raw prefix argument is what you get from `(interactive "P")'.
852 Its numeric meaning is what you would get from `(interactive "p")'. */)
853 (raw)
854 Lisp_Object raw;
856 Lisp_Object val;
858 if (NILP (raw))
859 XSETFASTINT (val, 1);
860 else if (EQ (raw, Qminus))
861 XSETINT (val, -1);
862 else if (CONSP (raw) && INTEGERP (XCAR (raw)))
863 XSETINT (val, XINT (XCAR (raw)));
864 else if (INTEGERP (raw))
865 val = raw;
866 else
867 XSETFASTINT (val, 1);
869 return val;
872 void
873 syms_of_callint ()
875 point_marker = Fmake_marker ();
876 staticpro (&point_marker);
878 callint_message = Qnil;
879 staticpro (&callint_message);
881 preserved_fns = Fcons (intern ("region-beginning"),
882 Fcons (intern ("region-end"),
883 Fcons (intern ("point"),
884 Fcons (intern ("mark"), Qnil))));
885 staticpro (&preserved_fns);
887 Qlist = intern ("list");
888 staticpro (&Qlist);
889 Qlet = intern ("let");
890 staticpro (&Qlet);
891 Qif = intern ("if");
892 staticpro (&Qif);
893 Qwhen = intern ("when");
894 staticpro (&Qwhen);
895 Qletx = intern ("let*");
896 staticpro (&Qletx);
897 Qsave_excursion = intern ("save-excursion");
898 staticpro (&Qsave_excursion);
899 Qprogn = intern ("progn");
900 staticpro (&Qprogn);
902 Qminus = intern ("-");
903 staticpro (&Qminus);
905 Qplus = intern ("+");
906 staticpro (&Qplus);
908 Qcall_interactively = intern ("call-interactively");
909 staticpro (&Qcall_interactively);
911 Qcommand_debug_status = intern ("command-debug-status");
912 staticpro (&Qcommand_debug_status);
914 Qenable_recursive_minibuffers = intern ("enable-recursive-minibuffers");
915 staticpro (&Qenable_recursive_minibuffers);
917 Qmouse_leave_buffer_hook = intern ("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);
976 /* arch-tag: a3a7cad7-bcac-42ce-916e-1bd2546ebf37
977 (do not change this comment) */