Merge from emacs--rel--22
[emacs.git] / src / callint.c
blob2ac53105afb9c2faa33e69352a353063d6473cf9
1 /* Call a Lisp function interactively.
2 Copyright (C) 1985, 1986, 1993, 1994, 1995, 1997, 2000, 2001, 2002,
3 2003, 2004, 2005, 2006, 2007 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, or (at your option)
10 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; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
20 Boston, MA 02110-1301, USA. */
23 #include <config.h>
25 #include "lisp.h"
26 #include "buffer.h"
27 #include "commands.h"
28 #include "keyboard.h"
29 #include "window.h"
30 #include "keymap.h"
32 #ifdef HAVE_INDEX
33 extern char *index P_ ((const char *, int));
34 #endif
36 extern Lisp_Object Qcursor_in_echo_area;
37 extern Lisp_Object Qfile_directory_p;
39 Lisp_Object Vcurrent_prefix_arg, Qminus, Qplus;
40 Lisp_Object Qcall_interactively;
41 Lisp_Object Vcommand_history;
43 extern Lisp_Object Vhistory_length;
44 extern Lisp_Object Vthis_original_command, real_this_command;
46 Lisp_Object Vcommand_debug_status, Qcommand_debug_status;
47 Lisp_Object Qenable_recursive_minibuffers;
49 /* Non-nil means treat the mark as active
50 even if mark_active is 0. */
51 Lisp_Object Vmark_even_if_inactive;
53 Lisp_Object Vmouse_leave_buffer_hook, Qmouse_leave_buffer_hook;
55 Lisp_Object Qlist, Qlet, Qletx, Qsave_excursion, Qprogn, Qif, Qwhen;
56 static Lisp_Object preserved_fns;
58 /* Marker used within call-interactively to refer to point. */
59 static Lisp_Object point_marker;
61 /* String for the prompt text used in Fcall_interactively. */
62 static Lisp_Object callint_message;
64 /* ARGSUSED */
65 DEFUN ("interactive", Finteractive, Sinteractive, 0, UNEVALLED, 0,
66 doc: /* Specify a way of parsing arguments for interactive use of a function.
67 For example, write
68 (defun foo (arg) "Doc string" (interactive "p") ...use arg...)
69 to make ARG be the prefix argument when `foo' is called as a command.
70 The "call" to `interactive' is actually a declaration rather than a function;
71 it tells `call-interactively' how to read arguments
72 to pass to the function.
73 When actually called, `interactive' just returns nil.
75 The argument of `interactive' is usually a string containing a code letter
76 followed by a prompt. (Some code letters do not use I/O to get
77 the argument and do not need prompts.) To prompt for multiple arguments,
78 give a code letter, its prompt, a newline, and another code letter, etc.
79 Prompts are passed to format, and may use % escapes to print the
80 arguments that have already been read.
81 If the argument is not a string, it is evaluated to get a list of
82 arguments to pass to the function.
83 Just `(interactive)' means pass no args when calling interactively.
85 Code letters available are:
86 a -- Function name: symbol with a function definition.
87 b -- Name of existing buffer.
88 B -- Name of buffer, possibly nonexistent.
89 c -- Character (no input method is used).
90 C -- Command name: symbol with interactive function definition.
91 d -- Value of point as number. Does not do I/O.
92 D -- Directory name.
93 e -- Parametrized event (i.e., one that's a list) that invoked this command.
94 If used more than once, the Nth `e' returns the Nth parameterized event.
95 This skips events that are integers or symbols.
96 f -- Existing file name.
97 F -- Possibly nonexistent file name.
98 G -- Possibly nonexistent file name, defaulting to just directory name.
99 i -- Ignored, i.e. always nil. Does not do I/O.
100 k -- Key sequence (downcase the last event if needed to get a definition).
101 K -- Key sequence to be redefined (do not downcase the last event).
102 m -- Value of mark as number. Does not do I/O.
103 M -- Any string. Inherits the current input method.
104 n -- Number read using minibuffer.
105 N -- Numeric prefix arg, or if none, do like code `n'.
106 p -- Prefix arg converted to number. Does not do I/O.
107 P -- Prefix arg in raw form. Does not do I/O.
108 r -- Region: point and mark as 2 numeric args, smallest first. Does no I/O.
109 s -- Any string. Does not inherit the current input method.
110 S -- Any symbol.
111 U -- Mouse up event discarded by a previous k or K argument.
112 v -- Variable name: symbol that is user-variable-p.
113 x -- Lisp expression read but not evaluated.
114 X -- Lisp expression read and evaluated.
115 z -- Coding system.
116 Z -- Coding system, nil if no prefix arg.
117 In addition, if the string begins with `*'
118 then an error is signaled if the buffer is read-only.
119 This happens before reading any arguments.
120 If the string begins with `@', then Emacs searches the key sequence
121 which invoked the command for its first mouse click (or any other
122 event which specifies a window), and selects that window before
123 reading any arguments. You may use both `@' and `*'; they are
124 processed in the order that they appear.
125 usage: (interactive ARGS) */)
126 (args)
127 Lisp_Object args;
129 return Qnil;
132 /* Quotify EXP: if EXP is constant, return it.
133 If EXP is not constant, return (quote EXP). */
134 Lisp_Object
135 quotify_arg (exp)
136 register Lisp_Object exp;
138 if (!INTEGERP (exp) && !STRINGP (exp)
139 && !NILP (exp) && !EQ (exp, Qt))
140 return Fcons (Qquote, Fcons (exp, Qnil));
142 return exp;
145 /* Modify EXP by quotifying each element (except the first). */
146 Lisp_Object
147 quotify_args (exp)
148 Lisp_Object exp;
150 register Lisp_Object tail;
151 Lisp_Object next;
152 for (tail = exp; CONSP (tail); tail = next)
154 next = XCDR (tail);
155 XSETCAR (tail, quotify_arg (XCAR (tail)));
157 return exp;
160 char *callint_argfuns[]
161 = {"", "point", "mark", "region-beginning", "region-end"};
163 static void
164 check_mark (for_region)
165 int for_region;
167 Lisp_Object tem;
168 tem = Fmarker_buffer (current_buffer->mark);
169 if (NILP (tem) || (XBUFFER (tem) != current_buffer))
170 error (for_region ? "The mark is not set now, so there is no region"
171 : "The mark is not set now");
172 if (!NILP (Vtransient_mark_mode) && NILP (Vmark_even_if_inactive)
173 && NILP (current_buffer->mark_active))
174 xsignal0 (Qmark_inactive);
177 /* If the list of args INPUT was produced with an explicit call to
178 `list', look for elements that were computed with
179 (region-beginning) or (region-end), and put those expressions into
180 VALUES instead of the present values.
182 This function doesn't return a value because it modifies elements
183 of VALUES to do its job. */
185 static void
186 fix_command (input, values)
187 Lisp_Object input, values;
189 if (CONSP (input))
191 Lisp_Object car;
193 car = XCAR (input);
194 /* Skip through certain special forms. */
195 while (EQ (car, Qlet) || EQ (car, Qletx)
196 || EQ (car, Qsave_excursion)
197 || EQ (car, Qprogn))
199 while (CONSP (XCDR (input)))
200 input = XCDR (input);
201 input = XCAR (input);
202 if (!CONSP (input))
203 break;
204 car = XCAR (input);
206 if (EQ (car, Qlist))
208 Lisp_Object intail, valtail;
209 for (intail = Fcdr (input), valtail = values;
210 CONSP (valtail);
211 intail = Fcdr (intail), valtail = XCDR (valtail))
213 Lisp_Object elt;
214 elt = Fcar (intail);
215 if (CONSP (elt))
217 Lisp_Object presflag, carelt;
218 carelt = Fcar (elt);
219 /* If it is (if X Y), look at Y. */
220 if (EQ (carelt, Qif)
221 && EQ (Fnthcdr (make_number (3), elt), Qnil))
222 elt = Fnth (make_number (2), elt);
223 /* If it is (when ... Y), look at Y. */
224 else if (EQ (carelt, Qwhen))
226 while (CONSP (XCDR (elt)))
227 elt = XCDR (elt);
228 elt = Fcar (elt);
231 /* If the function call we're looking at
232 is a special preserved one, copy the
233 whole expression for this argument. */
234 if (CONSP (elt))
236 presflag = Fmemq (Fcar (elt), preserved_fns);
237 if (!NILP (presflag))
238 Fsetcar (valtail, Fcar (intail));
246 DEFUN ("call-interactively", Fcall_interactively, Scall_interactively, 1, 3, 0,
247 doc: /* Call FUNCTION, reading args according to its interactive calling specs.
248 Return the value FUNCTION returns.
249 The function contains a specification of how to do the argument reading.
250 In the case of user-defined functions, this is specified by placing a call
251 to the function `interactive' at the top level of the function body.
252 See `interactive'.
254 Optional second arg RECORD-FLAG non-nil
255 means unconditionally put this command in the command-history.
256 Otherwise, this is done only if an arg is read using the minibuffer.
258 Optional third arg KEYS, if given, specifies the sequence of events to
259 supply, as a vector, if the command inquires which events were used to
260 invoke it. If KEYS is omitted or nil, the return value of
261 `this-command-keys-vector' is used. */)
262 (function, record_flag, keys)
263 Lisp_Object function, record_flag, keys;
265 Lisp_Object *args, *visargs;
266 Lisp_Object specs;
267 Lisp_Object filter_specs;
268 Lisp_Object teml;
269 Lisp_Object up_event;
270 Lisp_Object enable;
271 int speccount = SPECPDL_INDEX ();
273 /* The index of the next element of this_command_keys to examine for
274 the 'e' interactive code. */
275 int next_event;
277 Lisp_Object prefix_arg;
278 unsigned char *string;
279 unsigned char *tem;
281 /* If varies[i] > 0, the i'th argument shouldn't just have its value
282 in this call quoted in the command history. It should be
283 recorded as a call to the function named callint_argfuns[varies[i]]. */
284 int *varies;
286 register int i, j;
287 int count, foo;
288 char prompt1[100];
289 char *tem1;
290 int arg_from_tty = 0;
291 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
292 int key_count;
293 int record_then_fail = 0;
295 Lisp_Object save_this_command, save_last_command;
296 Lisp_Object save_this_original_command, save_real_this_command;
298 save_this_command = Vthis_command;
299 save_this_original_command = Vthis_original_command;
300 save_real_this_command = real_this_command;
301 save_last_command = current_kboard->Vlast_command;
303 if (NILP (keys))
304 keys = this_command_keys, key_count = this_command_key_count;
305 else
307 CHECK_VECTOR (keys);
308 key_count = XVECTOR (keys)->size;
311 /* Save this now, since use of minibuffer will clobber it. */
312 prefix_arg = Vcurrent_prefix_arg;
314 if (SYMBOLP (function))
315 enable = Fget (function, Qenable_recursive_minibuffers);
316 else
317 enable = Qnil;
319 specs = Qnil;
320 string = 0;
321 /* The idea of FILTER_SPECS is to provide away to
322 specify how to represent the arguments in command history.
323 The feature is not fully implemented. */
324 filter_specs = Qnil;
326 /* If k or K discard an up-event, save it here so it can be retrieved with U */
327 up_event = Qnil;
329 /* Set SPECS to the interactive form, or barf if not interactive. */
331 Lisp_Object form;
332 GCPRO2 (function, prefix_arg);
333 form = Finteractive_form (function);
334 UNGCPRO;
335 if (CONSP (form))
336 specs = filter_specs = Fcar (XCDR (form));
337 else
338 wrong_type_argument (Qcommandp, function);
341 /* If SPECS is set to a string, use it as an interactive prompt. */
342 if (STRINGP (specs))
344 /* Make a copy of string so that if a GC relocates specs,
345 `string' will still be valid. */
346 string = (unsigned char *) alloca (SBYTES (specs) + 1);
347 bcopy (SDATA (specs), string,
348 SBYTES (specs) + 1);
350 else
352 Lisp_Object input;
353 i = num_input_events;
354 input = specs;
355 /* Compute the arg values using the user's expression. */
356 GCPRO2 (input, filter_specs);
357 specs = Feval (specs);
358 UNGCPRO;
359 if (i != num_input_events || !NILP (record_flag))
361 /* We should record this command on the command history. */
362 Lisp_Object values;
363 /* Make a copy of the list of values, for the command history,
364 and turn them into things we can eval. */
365 values = quotify_args (Fcopy_sequence (specs));
366 fix_command (input, values);
367 Vcommand_history
368 = Fcons (Fcons (function, values), Vcommand_history);
370 /* Don't keep command history around forever. */
371 if (INTEGERP (Vhistory_length) && XINT (Vhistory_length) > 0)
373 teml = Fnthcdr (Vhistory_length, Vcommand_history);
374 if (CONSP (teml))
375 XSETCDR (teml, Qnil);
379 Vthis_command = save_this_command;
380 Vthis_original_command = save_this_original_command;
381 real_this_command= save_real_this_command;
382 current_kboard->Vlast_command = save_last_command;
384 temporarily_switch_to_single_kboard (NULL);
385 return unbind_to (speccount, apply1 (function, specs));
388 /* Here if function specifies a string to control parsing the defaults */
390 /* Set next_event to point to the first event with parameters. */
391 for (next_event = 0; next_event < key_count; next_event++)
392 if (EVENT_HAS_PARAMETERS (XVECTOR (keys)->contents[next_event]))
393 break;
395 /* Handle special starting chars `*' and `@'. Also `-'. */
396 /* Note that `+' is reserved for user extensions. */
397 while (1)
399 if (*string == '+')
400 error ("`+' is not used in `interactive' for ordinary commands");
401 else if (*string == '*')
403 string++;
404 if (!NILP (current_buffer->read_only))
406 if (!NILP (record_flag))
408 unsigned char *p = string;
409 while (*p)
411 if (! (*p == 'r' || *p == 'p' || *p == 'P'
412 || *p == '\n'))
413 Fbarf_if_buffer_read_only ();
414 p++;
416 record_then_fail = 1;
418 else
419 Fbarf_if_buffer_read_only ();
422 /* Ignore this for semi-compatibility with Lucid. */
423 else if (*string == '-')
424 string++;
425 else if (*string == '@')
427 Lisp_Object event, tem;
429 event = (next_event < key_count
430 ? XVECTOR (keys)->contents[next_event]
431 : Qnil);
432 if (EVENT_HAS_PARAMETERS (event)
433 && (tem = XCDR (event), CONSP (tem))
434 && (tem = XCAR (tem), CONSP (tem))
435 && (tem = XCAR (tem), WINDOWP (tem)))
437 if (MINI_WINDOW_P (XWINDOW (tem))
438 && ! (minibuf_level > 0 && EQ (tem, minibuf_window)))
439 error ("Attempt to select inactive minibuffer window");
441 /* If the current buffer wants to clean up, let it. */
442 if (!NILP (Vmouse_leave_buffer_hook))
443 call1 (Vrun_hooks, Qmouse_leave_buffer_hook);
445 Fselect_window (tem, Qnil);
447 string++;
449 else break;
452 /* Count the number of arguments the interactive spec would have
453 us give to the function. */
454 tem = string;
455 for (j = 0; *tem;)
457 /* 'r' specifications ("point and mark as 2 numeric args")
458 produce *two* arguments. */
459 if (*tem == 'r')
460 j += 2;
461 else
462 j++;
463 tem = (unsigned char *) index (tem, '\n');
464 if (tem)
465 ++tem;
466 else
467 break;
469 count = j;
471 args = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object));
472 visargs = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object));
473 varies = (int *) alloca ((count + 1) * sizeof (int));
475 for (i = 0; i < (count + 1); i++)
477 args[i] = Qnil;
478 visargs[i] = Qnil;
479 varies[i] = 0;
482 GCPRO5 (prefix_arg, function, *args, *visargs, up_event);
483 gcpro3.nvars = (count + 1);
484 gcpro4.nvars = (count + 1);
486 if (!NILP (enable))
487 specbind (Qenable_recursive_minibuffers, Qt);
489 tem = string;
490 for (i = 1; *tem; i++)
492 strncpy (prompt1, tem + 1, sizeof prompt1 - 1);
493 prompt1[sizeof prompt1 - 1] = 0;
494 tem1 = (char *) index (prompt1, '\n');
495 if (tem1) *tem1 = 0;
497 visargs[0] = build_string (prompt1);
498 if (index (prompt1, '%'))
499 callint_message = Fformat (i, visargs);
500 else
501 callint_message = visargs[0];
503 switch (*tem)
505 case 'a': /* Symbol defined as a function */
506 visargs[i] = Fcompleting_read (callint_message,
507 Vobarray, Qfboundp, Qt,
508 Qnil, Qnil, Qnil, Qnil);
509 /* Passing args[i] directly stimulates compiler bug */
510 teml = visargs[i];
511 args[i] = Fintern (teml, Qnil);
512 break;
514 case 'b': /* Name of existing buffer */
515 args[i] = Fcurrent_buffer ();
516 if (EQ (selected_window, minibuf_window))
517 args[i] = Fother_buffer (args[i], Qnil, Qnil);
518 args[i] = Fread_buffer (callint_message, args[i], Qt);
519 break;
521 case 'B': /* Name of buffer, possibly nonexistent */
522 args[i] = Fread_buffer (callint_message,
523 Fother_buffer (Fcurrent_buffer (), Qnil, Qnil),
524 Qnil);
525 break;
527 case 'c': /* Character */
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 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 args[i] = Fread_key_sequence (callint_message,
582 Qnil, Qnil, Qnil, Qnil);
583 unbind_to (speccount1, Qnil);
584 teml = args[i];
585 visargs[i] = Fkey_description (teml, Qnil);
587 /* If the key sequence ends with a down-event,
588 discard the following up-event. */
589 teml = Faref (args[i], make_number (XINT (Flength (args[i])) - 1));
590 if (CONSP (teml))
591 teml = XCAR (teml);
592 if (SYMBOLP (teml))
594 Lisp_Object tem2;
596 teml = Fget (teml, intern ("event-symbol-elements"));
597 /* Ignore first element, which is the base key. */
598 tem2 = Fmemq (intern ("down"), Fcdr (teml));
599 if (! NILP (tem2))
600 up_event = Fread_event (Qnil, Qnil, Qnil);
603 break;
605 case 'K': /* Key sequence to be defined. */
607 int speccount1 = SPECPDL_INDEX ();
608 specbind (Qcursor_in_echo_area, Qt);
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 ? (char *) SDATA (SYMBOL_NAME (function))
648 : "command"));
649 args[i] = XVECTOR (keys)->contents[next_event++];
650 varies[i] = -1;
652 /* Find the next parameterized event. */
653 while (next_event < key_count
654 && ! (EVENT_HAS_PARAMETERS
655 (XVECTOR (keys)->contents[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] = 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 tem;
682 if (! first)
684 message ("Please enter a number.");
685 sit_for (make_number (1), 0, 0);
687 first = 0;
689 tem = Fread_from_minibuffer (callint_message,
690 Qnil, Qnil, Qnil, Qnil, Qnil,
691 Qnil);
692 if (! STRINGP (tem) || SCHARS (tem) == 0)
693 args[i] = Qnil;
694 else
695 args[i] = Fread (tem);
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 (current_buffer->mark);
720 /* visargs[i] = Qnil; */
721 args[i] = PT < foo ? point_marker : current_buffer->mark;
722 varies[i] = 3;
723 args[++i] = PT > foo ? point_marker : 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, *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 = (unsigned char *) index (tem, '\n');
792 if (tem) tem++;
793 else tem = (unsigned char *) "";
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 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 (raw)
853 Lisp_Object raw;
855 Lisp_Object val;
857 if (NILP (raw))
858 XSETFASTINT (val, 1);
859 else if (EQ (raw, Qminus))
860 XSETINT (val, -1);
861 else if (CONSP (raw) && INTEGERP (XCAR (raw)))
862 XSETINT (val, XINT (XCAR (raw)));
863 else if (INTEGERP (raw))
864 val = raw;
865 else
866 XSETFASTINT (val, 1);
868 return val;
871 void
872 syms_of_callint ()
874 point_marker = Fmake_marker ();
875 staticpro (&point_marker);
877 callint_message = Qnil;
878 staticpro (&callint_message);
880 preserved_fns = Fcons (intern ("region-beginning"),
881 Fcons (intern ("region-end"),
882 Fcons (intern ("point"),
883 Fcons (intern ("mark"), Qnil))));
884 staticpro (&preserved_fns);
886 Qlist = intern ("list");
887 staticpro (&Qlist);
888 Qlet = intern ("let");
889 staticpro (&Qlet);
890 Qif = intern ("if");
891 staticpro (&Qif);
892 Qwhen = intern ("when");
893 staticpro (&Qwhen);
894 Qletx = intern ("let*");
895 staticpro (&Qletx);
896 Qsave_excursion = intern ("save-excursion");
897 staticpro (&Qsave_excursion);
898 Qprogn = intern ("progn");
899 staticpro (&Qprogn);
901 Qminus = intern ("-");
902 staticpro (&Qminus);
904 Qplus = intern ("+");
905 staticpro (&Qplus);
907 Qcall_interactively = intern ("call-interactively");
908 staticpro (&Qcall_interactively);
910 Qcommand_debug_status = intern ("command-debug-status");
911 staticpro (&Qcommand_debug_status);
913 Qenable_recursive_minibuffers = intern ("enable-recursive-minibuffers");
914 staticpro (&Qenable_recursive_minibuffers);
916 Qmouse_leave_buffer_hook = intern ("mouse-leave-buffer-hook");
917 staticpro (&Qmouse_leave_buffer_hook);
919 DEFVAR_KBOARD ("prefix-arg", Vprefix_arg,
920 doc: /* The value of the prefix argument for the next editing command.
921 It may be a number, or the symbol `-' for just a minus sign as arg,
922 or a list whose car is a number for just one or more C-u's
923 or nil if no argument has been specified.
925 You cannot examine this variable to find the argument for this command
926 since it has been set to nil by the time you can look.
927 Instead, you should use the variable `current-prefix-arg', although
928 normally commands can get this prefix argument with (interactive "P"). */);
930 DEFVAR_KBOARD ("last-prefix-arg", Vlast_prefix_arg,
931 doc: /* The value of the prefix argument for the previous editing command.
932 See `prefix-arg' for the meaning of the value. */);
934 DEFVAR_LISP ("current-prefix-arg", &Vcurrent_prefix_arg,
935 doc: /* The value of the prefix argument for this editing command.
936 It may be a number, or the symbol `-' for just a minus sign as arg,
937 or a list whose car is a number for just one or more C-u's
938 or nil if no argument has been specified.
939 This is what `(interactive \"P\")' returns. */);
940 Vcurrent_prefix_arg = Qnil;
942 DEFVAR_LISP ("command-history", &Vcommand_history,
943 doc: /* List of recent commands that read arguments from terminal.
944 Each command is represented as a form to evaluate.
946 Maximum length of the history list is determined by the value
947 of `history-length', which see. */);
948 Vcommand_history = Qnil;
950 DEFVAR_LISP ("command-debug-status", &Vcommand_debug_status,
951 doc: /* Debugging status of current interactive command.
952 Bound each time `call-interactively' is called;
953 may be set by the debugger as a reminder for itself. */);
954 Vcommand_debug_status = Qnil;
956 DEFVAR_LISP ("mark-even-if-inactive", &Vmark_even_if_inactive,
957 doc: /* *Non-nil means you can use the mark even when inactive.
958 This option makes a difference in Transient Mark mode.
959 When the option is non-nil, deactivation of the mark
960 turns off region highlighting, but commands that use the mark
961 behave as if the mark were still active. */);
962 Vmark_even_if_inactive = Qnil;
964 DEFVAR_LISP ("mouse-leave-buffer-hook", &Vmouse_leave_buffer_hook,
965 doc: /* Hook to run when about to switch windows with a mouse command.
966 Its purpose is to give temporary modes such as Isearch mode
967 a way to turn themselves off when a mouse command switches windows. */);
968 Vmouse_leave_buffer_hook = Qnil;
970 defsubr (&Sinteractive);
971 defsubr (&Scall_interactively);
972 defsubr (&Sprefix_numeric_value);
975 /* arch-tag: a3a7cad7-bcac-42ce-916e-1bd2546ebf37
976 (do not change this comment) */