(cperl-switch-to-doc-buffer): Don't use interactive-p.
[emacs.git] / src / callint.c
blobda88693cd7882fa302f2d50c0ff9cb6cacc5c367
1 /* Call a Lisp function interactively.
2 Copyright (C) 1985, 86, 93, 94, 95, 1997, 2000, 02, 03, 2004
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 2, 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., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, 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 /* Buffer for the prompt text used in Fcall_interactively. */
62 static char *callint_message;
64 /* Allocated length of that buffer. */
65 static int callint_message_size;
67 /* ARGSUSED */
68 DEFUN ("interactive", Finteractive, Sinteractive, 0, UNEVALLED, 0,
69 doc: /* Specify a way of parsing arguments for interactive use of a function.
70 For example, write
71 (defun foo (arg) "Doc string" (interactive "p") ...use arg...)
72 to make ARG be the prefix argument when `foo' is called as a command.
73 The "call" to `interactive' is actually a declaration rather than a function;
74 it tells `call-interactively' how to read arguments
75 to pass to the function.
76 When actually called, `interactive' just returns nil.
78 The argument of `interactive' is usually a string containing a code letter
79 followed by a prompt. (Some code letters do not use I/O to get
80 the argument and do not need prompts.) To prompt for multiple arguments,
81 give a code letter, its prompt, a newline, and another code letter, etc.
82 Prompts are passed to format, and may use % escapes to print the
83 arguments that have already been read.
84 If the argument is not a string, it is evaluated to get a list of
85 arguments to pass to the function.
86 Just `(interactive)' means pass no args when calling interactively.
88 Code letters available are:
89 a -- Function name: symbol with a function definition.
90 b -- Name of existing buffer.
91 B -- Name of buffer, possibly nonexistent.
92 c -- Character (no input method is used).
93 C -- Command name: symbol with interactive function definition.
94 d -- Value of point as number. Does not do I/O.
95 D -- Directory name.
96 e -- Parametrized event (i.e., one that's a list) that invoked this command.
97 If used more than once, the Nth `e' returns the Nth parameterized event.
98 This skips events that are integers or symbols.
99 f -- Existing file name.
100 F -- Possibly nonexistent file name.
101 i -- Ignored, i.e. always nil. Does not do I/O.
102 k -- Key sequence (downcase the last event if needed to get a definition).
103 K -- Key sequence to be redefined (do not downcase the last event).
104 m -- Value of mark as number. Does not do I/O.
105 M -- Any string. Inherits the current input method.
106 n -- Number read using minibuffer.
107 N -- Raw prefix arg, or if none, do like code `n'.
108 p -- Prefix arg converted to number. Does not do I/O.
109 P -- Prefix arg in raw form. Does not do I/O.
110 r -- Region: point and mark as 2 numeric args, smallest first. Does no I/O.
111 s -- Any string. Does not inherit the current input method.
112 S -- Any symbol.
113 U -- Mouse up event discarded by a previous k or K argument.
114 v -- Variable name: symbol that is user-variable-p.
115 x -- Lisp expression read but not evaluated.
116 X -- Lisp expression read and evaluated.
117 z -- Coding system.
118 Z -- Coding system, nil if no prefix arg.
119 In addition, if the string begins with `*'
120 then an error is signaled if the buffer is read-only.
121 This happens before reading any arguments.
122 If the string begins with `@', then Emacs searches the key sequence
123 which invoked the command for its first mouse click (or any other
124 event which specifies a window), and selects that window before
125 reading any arguments. You may use both `@' and `*'; they are
126 processed in the order that they appear.
127 usage: (interactive ARGS) */)
128 (args)
129 Lisp_Object args;
131 return Qnil;
134 /* Quotify EXP: if EXP is constant, return it.
135 If EXP is not constant, return (quote EXP). */
136 Lisp_Object
137 quotify_arg (exp)
138 register Lisp_Object exp;
140 if (!INTEGERP (exp) && !STRINGP (exp)
141 && !NILP (exp) && !EQ (exp, Qt))
142 return Fcons (Qquote, Fcons (exp, Qnil));
144 return exp;
147 /* Modify EXP by quotifying each element (except the first). */
148 Lisp_Object
149 quotify_args (exp)
150 Lisp_Object exp;
152 register Lisp_Object tail;
153 Lisp_Object next;
154 for (tail = exp; CONSP (tail); tail = next)
156 next = XCDR (tail);
157 XSETCAR (tail, quotify_arg (XCAR (tail)));
159 return exp;
162 char *callint_argfuns[]
163 = {"", "point", "mark", "region-beginning", "region-end"};
165 static void
166 check_mark (for_region)
167 int for_region;
169 Lisp_Object tem;
170 tem = Fmarker_buffer (current_buffer->mark);
171 if (NILP (tem) || (XBUFFER (tem) != current_buffer))
172 error (for_region ? "The mark is not set now, so there is no region"
173 : "The mark is not set now");
174 if (!NILP (Vtransient_mark_mode) && NILP (Vmark_even_if_inactive)
175 && NILP (current_buffer->mark_active))
176 Fsignal (Qmark_inactive, Qnil);
179 /* If the list of args INPUT was produced with an explicit call to
180 `list', look for elements that were computed with
181 (region-beginning) or (region-end), and put those expressions into
182 VALUES instead of the present values.
184 This function doesn't return a value because it modifies elements
185 of VALUES to do its job. */
187 static void
188 fix_command (input, values)
189 Lisp_Object input, values;
191 if (CONSP (input))
193 Lisp_Object car;
195 car = XCAR (input);
196 /* Skip through certain special forms. */
197 while (EQ (car, Qlet) || EQ (car, Qletx)
198 || EQ (car, Qsave_excursion)
199 || EQ (car, Qprogn))
201 while (CONSP (XCDR (input)))
202 input = XCDR (input);
203 input = XCAR (input);
204 if (!CONSP (input))
205 break;
206 car = XCAR (input);
208 if (EQ (car, Qlist))
210 Lisp_Object intail, valtail;
211 for (intail = Fcdr (input), valtail = values;
212 CONSP (valtail);
213 intail = Fcdr (intail), valtail = XCDR (valtail))
215 Lisp_Object elt;
216 elt = Fcar (intail);
217 if (CONSP (elt))
219 Lisp_Object presflag, carelt;
220 carelt = Fcar (elt);
221 /* If it is (if X Y), look at Y. */
222 if (EQ (carelt, Qif)
223 && EQ (Fnthcdr (make_number (3), elt), Qnil))
224 elt = Fnth (make_number (2), elt);
225 /* If it is (when ... Y), look at Y. */
226 else if (EQ (carelt, Qwhen))
228 while (CONSP (XCDR (elt)))
229 elt = XCDR (elt);
230 elt = Fcar (elt);
233 /* If the function call we're looking at
234 is a special preserved one, copy the
235 whole expression for this argument. */
236 if (CONSP (elt))
238 presflag = Fmemq (Fcar (elt), preserved_fns);
239 if (!NILP (presflag))
240 Fsetcar (valtail, Fcar (intail));
248 DEFUN ("call-interactively", Fcall_interactively, Scall_interactively, 1, 3, 0,
249 doc: /* Call FUNCTION, reading args according to its interactive calling specs.
250 Return the value FUNCTION returns.
251 The function contains a specification of how to do the argument reading.
252 In the case of user-defined functions, this is specified by placing a call
253 to the function `interactive' at the top level of the function body.
254 See `interactive'.
256 Optional second arg RECORD-FLAG non-nil
257 means unconditionally put this command in the command-history.
258 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 if the command inquires which events were used to invoke it.
261 If KEYS is omitted or nil, the return value of `this-command-keys' is used. */)
262 (function, record_flag, keys)
263 Lisp_Object function, record_flag, keys;
265 Lisp_Object *args, *visargs;
266 unsigned char **argstrings;
267 Lisp_Object fun;
268 Lisp_Object funcar;
269 Lisp_Object specs;
270 Lisp_Object filter_specs;
271 Lisp_Object teml;
272 Lisp_Object up_event;
273 Lisp_Object enable;
274 int speccount = SPECPDL_INDEX ();
276 /* The index of the next element of this_command_keys to examine for
277 the 'e' interactive code. */
278 int next_event;
280 Lisp_Object prefix_arg;
281 unsigned char *string;
282 unsigned char *tem;
284 /* If varies[i] > 0, the i'th argument shouldn't just have its value
285 in this call quoted in the command history. It should be
286 recorded as a call to the function named callint_argfuns[varies[i]]. */
287 int *varies;
289 register int i, j;
290 int count, foo;
291 char prompt1[100];
292 char *tem1;
293 int arg_from_tty = 0;
294 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
295 int key_count;
296 int record_then_fail = 0;
298 Lisp_Object save_this_command, save_last_command;
299 Lisp_Object save_this_original_command, save_real_this_command;
301 save_this_command = Vthis_command;
302 save_this_original_command = Vthis_original_command;
303 save_real_this_command = real_this_command;
304 save_last_command = current_kboard->Vlast_command;
306 if (NILP (keys))
307 keys = this_command_keys, key_count = this_command_key_count;
308 else
310 CHECK_VECTOR (keys);
311 key_count = XVECTOR (keys)->size;
314 /* Save this now, since use of minibuffer will clobber it. */
315 prefix_arg = Vcurrent_prefix_arg;
317 retry:
319 if (SYMBOLP (function))
320 enable = Fget (function, Qenable_recursive_minibuffers);
321 else
322 enable = Qnil;
324 fun = indirect_function (function);
326 specs = Qnil;
327 string = 0;
328 /* The idea of FILTER_SPECS is to provide away to
329 specify how to represent the arguments in command history.
330 The feature is not fully implemented. */
331 filter_specs = Qnil;
333 /* If k or K discard an up-event, save it here so it can be retrieved with U */
334 up_event = Qnil;
336 /* Decode the kind of function. Either handle it and return,
337 or go to `lose' if not interactive, or go to `retry'
338 to specify a different function, or set either STRING or SPECS. */
340 if (SUBRP (fun))
342 string = (unsigned char *) XSUBR (fun)->prompt;
343 if (!string)
345 lose:
346 function = wrong_type_argument (Qcommandp, function);
347 goto retry;
350 else if (COMPILEDP (fun))
352 if ((XVECTOR (fun)->size & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_INTERACTIVE)
353 goto lose;
354 specs = XVECTOR (fun)->contents[COMPILED_INTERACTIVE];
356 else
358 Lisp_Object form;
359 GCPRO2 (function, prefix_arg);
360 form = Finteractive_form (function);
361 UNGCPRO;
362 if (CONSP (form))
363 specs = filter_specs = Fcar (XCDR (form));
364 else
365 goto lose;
368 /* If either SPECS or STRING is set to a string, use it. */
369 if (STRINGP (specs))
371 /* Make a copy of string so that if a GC relocates specs,
372 `string' will still be valid. */
373 string = (unsigned char *) alloca (SBYTES (specs) + 1);
374 bcopy (SDATA (specs), string,
375 SBYTES (specs) + 1);
377 else if (string == 0)
379 Lisp_Object input;
380 i = num_input_events;
381 input = specs;
382 /* Compute the arg values using the user's expression. */
383 GCPRO2 (input, filter_specs);
384 specs = Feval (specs);
385 UNGCPRO;
386 if (i != num_input_events || !NILP (record_flag))
388 /* We should record this command on the command history. */
389 Lisp_Object values;
390 /* Make a copy of the list of values, for the command history,
391 and turn them into things we can eval. */
392 values = quotify_args (Fcopy_sequence (specs));
393 fix_command (input, values);
394 Vcommand_history
395 = Fcons (Fcons (function, values), Vcommand_history);
397 /* Don't keep command history around forever. */
398 if (INTEGERP (Vhistory_length) && XINT (Vhistory_length) > 0)
400 teml = Fnthcdr (Vhistory_length, Vcommand_history);
401 if (CONSP (teml))
402 XSETCDR (teml, Qnil);
406 Vthis_command = save_this_command;
407 Vthis_original_command = save_this_original_command;
408 real_this_command= save_real_this_command;
409 current_kboard->Vlast_command = save_last_command;
411 single_kboard_state ();
412 return apply1 (function, specs);
415 /* Here if function specifies a string to control parsing the defaults */
417 /* Set next_event to point to the first event with parameters. */
418 for (next_event = 0; next_event < key_count; next_event++)
419 if (EVENT_HAS_PARAMETERS (XVECTOR (keys)->contents[next_event]))
420 break;
422 /* Handle special starting chars `*' and `@'. Also `-'. */
423 /* Note that `+' is reserved for user extensions. */
424 while (1)
426 if (*string == '+')
427 error ("`+' is not used in `interactive' for ordinary commands");
428 else if (*string == '*')
430 string++;
431 if (!NILP (current_buffer->read_only))
433 if (!NILP (record_flag))
435 unsigned char *p = string;
436 while (*p)
438 if (! (*p == 'r' || *p == 'p' || *p == 'P'
439 || *p == '\n'))
440 Fbarf_if_buffer_read_only ();
441 p++;
443 record_then_fail = 1;
445 else
446 Fbarf_if_buffer_read_only ();
449 /* Ignore this for semi-compatibility with Lucid. */
450 else if (*string == '-')
451 string++;
452 else if (*string == '@')
454 Lisp_Object event;
456 event = (next_event < key_count
457 ? XVECTOR (keys)->contents[next_event]
458 : Qnil);
459 if (EVENT_HAS_PARAMETERS (event)
460 && (event = XCDR (event), CONSP (event))
461 && (event = XCAR (event), CONSP (event))
462 && (event = XCAR (event), WINDOWP (event)))
464 if (MINI_WINDOW_P (XWINDOW (event))
465 && ! (minibuf_level > 0 && EQ (event, minibuf_window)))
466 error ("Attempt to select inactive minibuffer window");
468 /* If the current buffer wants to clean up, let it. */
469 if (!NILP (Vmouse_leave_buffer_hook))
470 call1 (Vrun_hooks, Qmouse_leave_buffer_hook);
472 Fselect_window (event, Qnil);
474 string++;
476 else break;
479 /* Count the number of arguments the interactive spec would have
480 us give to the function. */
481 tem = string;
482 for (j = 0; *tem; j++)
484 /* 'r' specifications ("point and mark as 2 numeric args")
485 produce *two* arguments. */
486 if (*tem == 'r') j++;
487 tem = (unsigned char *) index (tem, '\n');
488 if (tem)
489 tem++;
490 else
491 tem = (unsigned char *) "";
493 count = j;
495 args = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object));
496 visargs = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object));
497 argstrings = (unsigned char **) alloca ((count + 1) * sizeof (char *));
498 varies = (int *) alloca ((count + 1) * sizeof (int));
500 for (i = 0; i < (count + 1); i++)
502 args[i] = Qnil;
503 visargs[i] = Qnil;
504 varies[i] = 0;
507 GCPRO5 (prefix_arg, function, *args, *visargs, up_event);
508 gcpro3.nvars = (count + 1);
509 gcpro4.nvars = (count + 1);
511 if (!NILP (enable))
512 specbind (Qenable_recursive_minibuffers, Qt);
514 tem = string;
515 for (i = 1; *tem; i++)
517 strncpy (prompt1, tem + 1, sizeof prompt1 - 1);
518 prompt1[sizeof prompt1 - 1] = 0;
519 tem1 = (char *) index (prompt1, '\n');
520 if (tem1) *tem1 = 0;
521 /* Fill argstrings with a vector of C strings
522 corresponding to the Lisp strings in visargs. */
523 for (j = 1; j < i; j++)
524 argstrings[j]
525 = (EQ (visargs[j], Qnil)
526 ? (unsigned char *) ""
527 : SDATA (visargs[j]));
529 /* Process the format-string in prompt1, putting the output
530 into callint_message. Make callint_message bigger if necessary.
531 We don't use a buffer on the stack, because the contents
532 need to stay stable for a while. */
533 while (1)
535 int nchars = doprnt (callint_message, callint_message_size,
536 prompt1, (char *)0,
537 j - 1, (char **) argstrings + 1);
538 if (nchars < callint_message_size - 1)
539 break;
540 callint_message_size *= 2;
541 callint_message
542 = (char *) xrealloc (callint_message, callint_message_size);
545 switch (*tem)
547 case 'a': /* Symbol defined as a function */
548 visargs[i] = Fcompleting_read (build_string (callint_message),
549 Vobarray, Qfboundp, Qt,
550 Qnil, Qnil, Qnil, Qnil);
551 /* Passing args[i] directly stimulates compiler bug */
552 teml = visargs[i];
553 args[i] = Fintern (teml, Qnil);
554 break;
556 case 'b': /* Name of existing buffer */
557 args[i] = Fcurrent_buffer ();
558 if (EQ (selected_window, minibuf_window))
559 args[i] = Fother_buffer (args[i], Qnil, Qnil);
560 args[i] = Fread_buffer (build_string (callint_message), args[i], Qt);
561 break;
563 case 'B': /* Name of buffer, possibly nonexistent */
564 args[i] = Fread_buffer (build_string (callint_message),
565 Fother_buffer (Fcurrent_buffer (), Qnil, Qnil),
566 Qnil);
567 break;
569 case 'c': /* Character */
570 args[i] = Fread_char (build_string (callint_message), Qnil);
571 message1_nolog ((char *) 0);
572 /* Passing args[i] directly stimulates compiler bug */
573 teml = args[i];
574 visargs[i] = Fchar_to_string (teml);
575 break;
577 case 'C': /* Command: symbol with interactive function */
578 visargs[i] = Fcompleting_read (build_string (callint_message),
579 Vobarray, Qcommandp,
580 Qt, Qnil, Qnil, Qnil, Qnil);
581 /* Passing args[i] directly stimulates compiler bug */
582 teml = visargs[i];
583 args[i] = Fintern (teml, Qnil);
584 break;
586 case 'd': /* Value of point. Does not do I/O. */
587 set_marker_both (point_marker, Qnil, PT, PT_BYTE);
588 args[i] = point_marker;
589 /* visargs[i] = Qnil; */
590 varies[i] = 1;
591 break;
593 case 'D': /* Directory name. */
594 args[i] = Fread_file_name (build_string (callint_message), Qnil,
595 current_buffer->directory, Qlambda, Qnil,
596 Qfile_directory_p);
597 break;
599 case 'f': /* Existing file name. */
600 args[i] = Fread_file_name (build_string (callint_message),
601 Qnil, Qnil, Qlambda, Qnil, Qnil);
602 break;
604 case 'F': /* Possibly nonexistent file name. */
605 args[i] = Fread_file_name (build_string (callint_message),
606 Qnil, Qnil, Qnil, Qnil, Qnil);
607 break;
609 case 'i': /* Ignore an argument -- Does not do I/O */
610 varies[i] = -1;
611 break;
613 case 'k': /* Key sequence. */
615 int speccount1 = SPECPDL_INDEX ();
616 specbind (Qcursor_in_echo_area, Qt);
617 args[i] = Fread_key_sequence (build_string (callint_message),
618 Qnil, Qnil, Qnil, Qnil);
619 unbind_to (speccount1, Qnil);
620 teml = args[i];
621 visargs[i] = Fkey_description (teml, 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);
639 break;
641 case 'K': /* Key sequence to be defined. */
643 int speccount1 = SPECPDL_INDEX ();
644 specbind (Qcursor_in_echo_area, Qt);
645 args[i] = Fread_key_sequence (build_string (callint_message),
646 Qnil, Qt, Qnil, Qnil);
647 teml = args[i];
648 visargs[i] = Fkey_description (teml, Qnil);
649 unbind_to (speccount1, Qnil);
651 /* If the key sequence ends with a down-event,
652 discard the following up-event. */
653 teml = Faref (args[i], make_number (XINT (Flength (args[i])) - 1));
654 if (CONSP (teml))
655 teml = XCAR (teml);
656 if (SYMBOLP (teml))
658 Lisp_Object tem2;
660 teml = Fget (teml, intern ("event-symbol-elements"));
661 /* Ignore first element, which is the base key. */
662 tem2 = Fmemq (intern ("down"), Fcdr (teml));
663 if (! NILP (tem2))
664 up_event = Fread_event (Qnil, Qnil);
667 break;
669 case 'U': /* Up event from last k or K */
670 if (!NILP (up_event))
672 args[i] = Fmake_vector (make_number (1), up_event);
673 up_event = Qnil;
674 teml = args[i];
675 visargs[i] = Fkey_description (teml, Qnil);
677 break;
679 case 'e': /* The invoking event. */
680 if (next_event >= key_count)
681 error ("%s must be bound to an event with parameters",
682 (SYMBOLP (function)
683 ? (char *) SDATA (SYMBOL_NAME (function))
684 : "command"));
685 args[i] = XVECTOR (keys)->contents[next_event++];
686 varies[i] = -1;
688 /* Find the next parameterized event. */
689 while (next_event < key_count
690 && ! (EVENT_HAS_PARAMETERS
691 (XVECTOR (keys)->contents[next_event])))
692 next_event++;
694 break;
696 case 'm': /* Value of mark. Does not do I/O. */
697 check_mark (0);
698 /* visargs[i] = Qnil; */
699 args[i] = current_buffer->mark;
700 varies[i] = 2;
701 break;
703 case 'M': /* String read via minibuffer with
704 inheriting the current input method. */
705 args[i] = Fread_string (build_string (callint_message),
706 Qnil, Qnil, Qnil, Qt);
707 break;
709 case 'N': /* Prefix arg, else number from minibuffer */
710 if (!NILP (prefix_arg))
711 goto have_prefix_arg;
712 case 'n': /* Read number from minibuffer. */
714 int first = 1;
717 Lisp_Object tem;
718 if (! first)
720 message ("Please enter a number.");
721 sit_for (1, 0, 0, 0, 0);
723 first = 0;
725 tem = Fread_from_minibuffer (build_string (callint_message),
726 Qnil, Qnil, Qnil, Qnil, Qnil,
727 Qnil);
728 if (! STRINGP (tem) || SCHARS (tem) == 0)
729 args[i] = Qnil;
730 else
731 args[i] = Fread (tem);
733 while (! NUMBERP (args[i]));
735 visargs[i] = last_minibuf_string;
736 break;
738 case 'P': /* Prefix arg in raw form. Does no I/O. */
739 args[i] = prefix_arg;
740 /* visargs[i] = Qnil; */
741 varies[i] = -1;
742 break;
744 case 'p': /* Prefix arg converted to number. No I/O. */
745 have_prefix_arg:
746 args[i] = Fprefix_numeric_value (prefix_arg);
747 /* visargs[i] = Qnil; */
748 varies[i] = -1;
749 break;
751 case 'r': /* Region, point and mark as 2 args. */
752 check_mark (1);
753 set_marker_both (point_marker, Qnil, PT, PT_BYTE);
754 /* visargs[i+1] = Qnil; */
755 foo = marker_position (current_buffer->mark);
756 /* visargs[i] = Qnil; */
757 args[i] = PT < foo ? point_marker : current_buffer->mark;
758 varies[i] = 3;
759 args[++i] = PT > foo ? point_marker : current_buffer->mark;
760 varies[i] = 4;
761 break;
763 case 's': /* String read via minibuffer without
764 inheriting the current input method. */
765 args[i] = Fread_string (build_string (callint_message),
766 Qnil, Qnil, Qnil, Qnil);
767 break;
769 case 'S': /* Any symbol. */
770 visargs[i] = Fread_string (build_string (callint_message),
771 Qnil, Qnil, Qnil, Qnil);
772 /* Passing args[i] directly stimulates compiler bug */
773 teml = visargs[i];
774 args[i] = Fintern (teml, Qnil);
775 break;
777 case 'v': /* Variable name: symbol that is
778 user-variable-p. */
779 args[i] = Fread_variable (build_string (callint_message), Qnil);
780 visargs[i] = last_minibuf_string;
781 break;
783 case 'x': /* Lisp expression read but not evaluated */
784 args[i] = Fread_minibuffer (build_string (callint_message), Qnil);
785 visargs[i] = last_minibuf_string;
786 break;
788 case 'X': /* Lisp expression read and evaluated */
789 args[i] = Feval_minibuffer (build_string (callint_message), Qnil);
790 visargs[i] = last_minibuf_string;
791 break;
793 case 'Z': /* Coding-system symbol, or ignore the
794 argument if no prefix */
795 if (NILP (prefix_arg))
797 args[i] = Qnil;
798 varies[i] = -1;
800 else
802 args[i]
803 = Fread_non_nil_coding_system (build_string (callint_message));
804 visargs[i] = last_minibuf_string;
806 break;
808 case 'z': /* Coding-system symbol or nil */
809 args[i] = Fread_coding_system (build_string (callint_message), Qnil);
810 visargs[i] = last_minibuf_string;
811 break;
813 /* We have a case for `+' so we get an error
814 if anyone tries to define one here. */
815 case '+':
816 default:
817 error ("Invalid control letter `%c' (%03o) in interactive calling string",
818 *tem, *tem);
821 if (varies[i] == 0)
822 arg_from_tty = 1;
824 if (NILP (visargs[i]) && STRINGP (args[i]))
825 visargs[i] = args[i];
827 tem = (unsigned char *) index (tem, '\n');
828 if (tem) tem++;
829 else tem = (unsigned char *) "";
831 unbind_to (speccount, Qnil);
833 QUIT;
835 args[0] = function;
837 if (arg_from_tty || !NILP (record_flag))
839 visargs[0] = function;
840 for (i = 1; i < count + 1; i++)
842 if (varies[i] > 0)
843 visargs[i] = Fcons (intern (callint_argfuns[varies[i]]), Qnil);
844 else
845 visargs[i] = quotify_arg (args[i]);
847 Vcommand_history = Fcons (Flist (count + 1, visargs),
848 Vcommand_history);
849 /* Don't keep command history around forever. */
850 if (INTEGERP (Vhistory_length) && XINT (Vhistory_length) > 0)
852 teml = Fnthcdr (Vhistory_length, Vcommand_history);
853 if (CONSP (teml))
854 XSETCDR (teml, Qnil);
858 /* If we used a marker to hold point, mark, or an end of the region,
859 temporarily, convert it to an integer now. */
860 for (i = 1; i <= count; i++)
861 if (varies[i] >= 1 && varies[i] <= 4)
862 XSETINT (args[i], marker_position (args[i]));
864 if (record_then_fail)
865 Fbarf_if_buffer_read_only ();
867 Vthis_command = save_this_command;
868 Vthis_original_command = save_this_original_command;
869 real_this_command= save_real_this_command;
870 current_kboard->Vlast_command = save_last_command;
872 single_kboard_state ();
875 Lisp_Object val;
876 specbind (Qcommand_debug_status, Qnil);
878 val = Ffuncall (count + 1, args);
879 UNGCPRO;
880 return unbind_to (speccount, val);
884 DEFUN ("prefix-numeric-value", Fprefix_numeric_value, Sprefix_numeric_value,
885 1, 1, 0,
886 doc: /* Return numeric meaning of raw prefix argument RAW.
887 A raw prefix argument is what you get from `(interactive "P")'.
888 Its numeric meaning is what you would get from `(interactive "p")'. */)
889 (raw)
890 Lisp_Object raw;
892 Lisp_Object val;
894 if (NILP (raw))
895 XSETFASTINT (val, 1);
896 else if (EQ (raw, Qminus))
897 XSETINT (val, -1);
898 else if (CONSP (raw) && INTEGERP (XCAR (raw)))
899 XSETINT (val, XINT (XCAR (raw)));
900 else if (INTEGERP (raw))
901 val = raw;
902 else
903 XSETFASTINT (val, 1);
905 return val;
908 void
909 syms_of_callint ()
911 point_marker = Fmake_marker ();
912 staticpro (&point_marker);
914 preserved_fns = Fcons (intern ("region-beginning"),
915 Fcons (intern ("region-end"),
916 Fcons (intern ("point"),
917 Fcons (intern ("mark"), Qnil))));
918 staticpro (&preserved_fns);
920 Qlist = intern ("list");
921 staticpro (&Qlist);
922 Qlet = intern ("let");
923 staticpro (&Qlet);
924 Qif = intern ("if");
925 staticpro (&Qif);
926 Qwhen = intern ("when");
927 staticpro (&Qwhen);
928 Qletx = intern ("let*");
929 staticpro (&Qletx);
930 Qsave_excursion = intern ("save-excursion");
931 staticpro (&Qsave_excursion);
932 Qprogn = intern ("progn");
933 staticpro (&Qprogn);
935 Qminus = intern ("-");
936 staticpro (&Qminus);
938 Qplus = intern ("+");
939 staticpro (&Qplus);
941 Qcall_interactively = intern ("call-interactively");
942 staticpro (&Qcall_interactively);
944 Qcommand_debug_status = intern ("command-debug-status");
945 staticpro (&Qcommand_debug_status);
947 Qenable_recursive_minibuffers = intern ("enable-recursive-minibuffers");
948 staticpro (&Qenable_recursive_minibuffers);
950 Qmouse_leave_buffer_hook = intern ("mouse-leave-buffer-hook");
951 staticpro (&Qmouse_leave_buffer_hook);
953 callint_message_size = 100;
954 callint_message = (char *) xmalloc (callint_message_size);
957 DEFVAR_KBOARD ("prefix-arg", Vprefix_arg,
958 doc: /* The value of the prefix argument for the next editing command.
959 It may be a number, or the symbol `-' for just a minus sign as arg,
960 or a list whose car is a number for just one or more C-u's
961 or nil if no argument has been specified.
963 You cannot examine this variable to find the argument for this command
964 since it has been set to nil by the time you can look.
965 Instead, you should use the variable `current-prefix-arg', although
966 normally commands can get this prefix argument with (interactive "P"). */);
968 DEFVAR_KBOARD ("last-prefix-arg", Vlast_prefix_arg,
969 doc: /* The value of the prefix argument for the previous editing command.
970 See `prefix-arg' for the meaning of the value. */);
972 DEFVAR_LISP ("current-prefix-arg", &Vcurrent_prefix_arg,
973 doc: /* The value of the prefix argument for this editing command.
974 It may be a number, or the symbol `-' for just a minus sign as arg,
975 or a list whose car is a number for just one or more C-u's
976 or nil if no argument has been specified.
977 This is what `(interactive \"P\")' returns. */);
978 Vcurrent_prefix_arg = Qnil;
980 DEFVAR_LISP ("command-history", &Vcommand_history,
981 doc: /* List of recent commands that read arguments from terminal.
982 Each command is represented as a form to evaluate. */);
983 Vcommand_history = Qnil;
985 DEFVAR_LISP ("command-debug-status", &Vcommand_debug_status,
986 doc: /* Debugging status of current interactive command.
987 Bound each time `call-interactively' is called;
988 may be set by the debugger as a reminder for itself. */);
989 Vcommand_debug_status = Qnil;
991 DEFVAR_LISP ("mark-even-if-inactive", &Vmark_even_if_inactive,
992 doc: /* *Non-nil means you can use the mark even when inactive.
993 This option makes a difference in Transient Mark mode.
994 When the option is non-nil, deactivation of the mark
995 turns off region highlighting, but commands that use the mark
996 behave as if the mark were still active. */);
997 Vmark_even_if_inactive = Qnil;
999 DEFVAR_LISP ("mouse-leave-buffer-hook", &Vmouse_leave_buffer_hook,
1000 doc: /* Hook to run when about to switch windows with a mouse command.
1001 Its purpose is to give temporary modes such as Isearch mode
1002 a way to turn themselves off when a mouse command switches windows. */);
1003 Vmouse_leave_buffer_hook = Qnil;
1005 defsubr (&Sinteractive);
1006 defsubr (&Scall_interactively);
1007 defsubr (&Sprefix_numeric_value);
1010 /* arch-tag: a3a7cad7-bcac-42ce-916e-1bd2546ebf37
1011 (do not change this comment) */