(Syntax Table Functions):
[emacs.git] / src / callint.c
blob5979e495ac361aab38ddd60bf939bc30132d7cdb
1 /* Call a Lisp function interactively.
2 Copyright (C) 1985, 1986, 1993, 1994, 1995, 1997, 2000, 2002, 2003,
3 2004, 2005 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., 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 /* 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 G -- Possibly nonexistent file name, defaulting to just directory name.
102 i -- Ignored, i.e. always nil. Does not do I/O.
103 k -- Key sequence (downcase the last event if needed to get a definition).
104 K -- Key sequence to be redefined (do not downcase the last event).
105 m -- Value of mark as number. Does not do I/O.
106 M -- Any string. Inherits the current input method.
107 n -- Number read using minibuffer.
108 N -- Raw prefix arg, or if none, do like code `n'.
109 p -- Prefix arg converted to number. Does not do I/O.
110 P -- Prefix arg in raw form. Does not do I/O.
111 r -- Region: point and mark as 2 numeric args, smallest first. Does no I/O.
112 s -- Any string. Does not inherit the current input method.
113 S -- Any symbol.
114 U -- Mouse up event discarded by a previous k or K argument.
115 v -- Variable name: symbol that is user-variable-p.
116 x -- Lisp expression read but not evaluated.
117 X -- Lisp expression read and evaluated.
118 z -- Coding system.
119 Z -- Coding system, nil if no prefix arg.
120 In addition, if the string begins with `*'
121 then an error is signaled if the buffer is read-only.
122 This happens before reading any arguments.
123 If the string begins with `@', then Emacs searches the key sequence
124 which invoked the command for its first mouse click (or any other
125 event which specifies a window), and selects that window before
126 reading any arguments. You may use both `@' and `*'; they are
127 processed in the order that they appear.
128 usage: (interactive ARGS) */)
129 (args)
130 Lisp_Object args;
132 return Qnil;
135 /* Quotify EXP: if EXP is constant, return it.
136 If EXP is not constant, return (quote EXP). */
137 Lisp_Object
138 quotify_arg (exp)
139 register Lisp_Object exp;
141 if (!INTEGERP (exp) && !STRINGP (exp)
142 && !NILP (exp) && !EQ (exp, Qt))
143 return Fcons (Qquote, Fcons (exp, Qnil));
145 return exp;
148 /* Modify EXP by quotifying each element (except the first). */
149 Lisp_Object
150 quotify_args (exp)
151 Lisp_Object exp;
153 register Lisp_Object tail;
154 Lisp_Object next;
155 for (tail = exp; CONSP (tail); tail = next)
157 next = XCDR (tail);
158 XSETCAR (tail, quotify_arg (XCAR (tail)));
160 return exp;
163 char *callint_argfuns[]
164 = {"", "point", "mark", "region-beginning", "region-end"};
166 static void
167 check_mark (for_region)
168 int for_region;
170 Lisp_Object tem;
171 tem = Fmarker_buffer (current_buffer->mark);
172 if (NILP (tem) || (XBUFFER (tem) != current_buffer))
173 error (for_region ? "The mark is not set now, so there is no region"
174 : "The mark is not set now");
175 if (!NILP (Vtransient_mark_mode) && NILP (Vmark_even_if_inactive)
176 && NILP (current_buffer->mark_active))
177 Fsignal (Qmark_inactive, Qnil);
180 /* If the list of args INPUT was produced with an explicit call to
181 `list', look for elements that were computed with
182 (region-beginning) or (region-end), and put those expressions into
183 VALUES instead of the present values.
185 This function doesn't return a value because it modifies elements
186 of VALUES to do its job. */
188 static void
189 fix_command (input, values)
190 Lisp_Object input, values;
192 if (CONSP (input))
194 Lisp_Object car;
196 car = XCAR (input);
197 /* Skip through certain special forms. */
198 while (EQ (car, Qlet) || EQ (car, Qletx)
199 || EQ (car, Qsave_excursion)
200 || EQ (car, Qprogn))
202 while (CONSP (XCDR (input)))
203 input = XCDR (input);
204 input = XCAR (input);
205 if (!CONSP (input))
206 break;
207 car = XCAR (input);
209 if (EQ (car, Qlist))
211 Lisp_Object intail, valtail;
212 for (intail = Fcdr (input), valtail = values;
213 CONSP (valtail);
214 intail = Fcdr (intail), valtail = XCDR (valtail))
216 Lisp_Object elt;
217 elt = Fcar (intail);
218 if (CONSP (elt))
220 Lisp_Object presflag, carelt;
221 carelt = Fcar (elt);
222 /* If it is (if X Y), look at Y. */
223 if (EQ (carelt, Qif)
224 && EQ (Fnthcdr (make_number (3), elt), Qnil))
225 elt = Fnth (make_number (2), elt);
226 /* If it is (when ... Y), look at Y. */
227 else if (EQ (carelt, Qwhen))
229 while (CONSP (XCDR (elt)))
230 elt = XCDR (elt);
231 elt = Fcar (elt);
234 /* If the function call we're looking at
235 is a special preserved one, copy the
236 whole expression for this argument. */
237 if (CONSP (elt))
239 presflag = Fmemq (Fcar (elt), preserved_fns);
240 if (!NILP (presflag))
241 Fsetcar (valtail, Fcar (intail));
249 DEFUN ("call-interactively", Fcall_interactively, Scall_interactively, 1, 3, 0,
250 doc: /* Call FUNCTION, reading args according to its interactive calling specs.
251 Return the value FUNCTION returns.
252 The function contains a specification of how to do the argument reading.
253 In the case of user-defined functions, this is specified by placing a call
254 to the function `interactive' at the top level of the function body.
255 See `interactive'.
257 Optional second arg RECORD-FLAG non-nil
258 means unconditionally put this command in the command-history.
259 Otherwise, this is done only if an arg is read using the minibuffer.
260 Optional third arg KEYS, if given, specifies the sequence of events to
261 supply if the command inquires which events were used to invoke it.
262 If KEYS is omitted or nil, the return value of `this-command-keys' is used. */)
263 (function, record_flag, keys)
264 Lisp_Object function, record_flag, keys;
266 Lisp_Object *args, *visargs;
267 unsigned char **argstrings;
268 Lisp_Object fun;
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, tem;
456 event = (next_event < key_count
457 ? XVECTOR (keys)->contents[next_event]
458 : Qnil);
459 if (EVENT_HAS_PARAMETERS (event)
460 && (tem = XCDR (event), CONSP (tem))
461 && (tem = XCAR (tem), CONSP (tem))
462 && (tem = XCAR (tem), WINDOWP (tem)))
464 if (MINI_WINDOW_P (XWINDOW (tem))
465 && ! (minibuf_level > 0 && EQ (tem, 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 (tem, 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 'G': /* Possibly nonexistent file name,
610 default to directory alone. */
611 args[i] = Fread_file_name (build_string (callint_message),
612 Qnil, Qnil, Qnil, build_string (""), Qnil);
613 break;
615 case 'i': /* Ignore an argument -- Does not do I/O */
616 varies[i] = -1;
617 break;
619 case 'k': /* Key sequence. */
621 int speccount1 = SPECPDL_INDEX ();
622 specbind (Qcursor_in_echo_area, Qt);
623 args[i] = Fread_key_sequence (build_string (callint_message),
624 Qnil, Qnil, Qnil, Qnil);
625 unbind_to (speccount1, Qnil);
626 teml = args[i];
627 visargs[i] = Fkey_description (teml, Qnil);
629 /* If the key sequence ends with a down-event,
630 discard the following up-event. */
631 teml = Faref (args[i], make_number (XINT (Flength (args[i])) - 1));
632 if (CONSP (teml))
633 teml = XCAR (teml);
634 if (SYMBOLP (teml))
636 Lisp_Object tem2;
638 teml = Fget (teml, intern ("event-symbol-elements"));
639 /* Ignore first element, which is the base key. */
640 tem2 = Fmemq (intern ("down"), Fcdr (teml));
641 if (! NILP (tem2))
642 up_event = Fread_event (Qnil, Qnil);
645 break;
647 case 'K': /* Key sequence to be defined. */
649 int speccount1 = SPECPDL_INDEX ();
650 specbind (Qcursor_in_echo_area, Qt);
651 args[i] = Fread_key_sequence (build_string (callint_message),
652 Qnil, Qt, Qnil, Qnil);
653 teml = args[i];
654 visargs[i] = Fkey_description (teml, Qnil);
655 unbind_to (speccount1, Qnil);
657 /* If the key sequence ends with a down-event,
658 discard the following up-event. */
659 teml = Faref (args[i], make_number (XINT (Flength (args[i])) - 1));
660 if (CONSP (teml))
661 teml = XCAR (teml);
662 if (SYMBOLP (teml))
664 Lisp_Object tem2;
666 teml = Fget (teml, intern ("event-symbol-elements"));
667 /* Ignore first element, which is the base key. */
668 tem2 = Fmemq (intern ("down"), Fcdr (teml));
669 if (! NILP (tem2))
670 up_event = Fread_event (Qnil, Qnil);
673 break;
675 case 'U': /* Up event from last k or K */
676 if (!NILP (up_event))
678 args[i] = Fmake_vector (make_number (1), up_event);
679 up_event = Qnil;
680 teml = args[i];
681 visargs[i] = Fkey_description (teml, Qnil);
683 break;
685 case 'e': /* The invoking event. */
686 if (next_event >= key_count)
687 error ("%s must be bound to an event with parameters",
688 (SYMBOLP (function)
689 ? (char *) SDATA (SYMBOL_NAME (function))
690 : "command"));
691 args[i] = XVECTOR (keys)->contents[next_event++];
692 varies[i] = -1;
694 /* Find the next parameterized event. */
695 while (next_event < key_count
696 && ! (EVENT_HAS_PARAMETERS
697 (XVECTOR (keys)->contents[next_event])))
698 next_event++;
700 break;
702 case 'm': /* Value of mark. Does not do I/O. */
703 check_mark (0);
704 /* visargs[i] = Qnil; */
705 args[i] = current_buffer->mark;
706 varies[i] = 2;
707 break;
709 case 'M': /* String read via minibuffer with
710 inheriting the current input method. */
711 args[i] = Fread_string (build_string (callint_message),
712 Qnil, Qnil, Qnil, Qt);
713 break;
715 case 'N': /* Prefix arg, else number from minibuffer */
716 if (!NILP (prefix_arg))
717 goto have_prefix_arg;
718 case 'n': /* Read number from minibuffer. */
720 int first = 1;
723 Lisp_Object tem;
724 if (! first)
726 message ("Please enter a number.");
727 sit_for (1, 0, 0, 0, 0);
729 first = 0;
731 tem = Fread_from_minibuffer (build_string (callint_message),
732 Qnil, Qnil, Qnil, Qnil, Qnil,
733 Qnil, Qnil);
734 if (! STRINGP (tem) || SCHARS (tem) == 0)
735 args[i] = Qnil;
736 else
737 args[i] = Fread (tem);
739 while (! NUMBERP (args[i]));
741 visargs[i] = last_minibuf_string;
742 break;
744 case 'P': /* Prefix arg in raw form. Does no I/O. */
745 args[i] = prefix_arg;
746 /* visargs[i] = Qnil; */
747 varies[i] = -1;
748 break;
750 case 'p': /* Prefix arg converted to number. No I/O. */
751 have_prefix_arg:
752 args[i] = Fprefix_numeric_value (prefix_arg);
753 /* visargs[i] = Qnil; */
754 varies[i] = -1;
755 break;
757 case 'r': /* Region, point and mark as 2 args. */
758 check_mark (1);
759 set_marker_both (point_marker, Qnil, PT, PT_BYTE);
760 /* visargs[i+1] = Qnil; */
761 foo = marker_position (current_buffer->mark);
762 /* visargs[i] = Qnil; */
763 args[i] = PT < foo ? point_marker : current_buffer->mark;
764 varies[i] = 3;
765 args[++i] = PT > foo ? point_marker : current_buffer->mark;
766 varies[i] = 4;
767 break;
769 case 's': /* String read via minibuffer without
770 inheriting the current input method. */
771 args[i] = Fread_string (build_string (callint_message),
772 Qnil, Qnil, Qnil, Qnil);
773 break;
775 case 'S': /* Any symbol. */
776 visargs[i] = Fread_string (build_string (callint_message),
777 Qnil, Qnil, Qnil, Qnil);
778 /* Passing args[i] directly stimulates compiler bug */
779 teml = visargs[i];
780 args[i] = Fintern (teml, Qnil);
781 break;
783 case 'v': /* Variable name: symbol that is
784 user-variable-p. */
785 args[i] = Fread_variable (build_string (callint_message), Qnil);
786 visargs[i] = last_minibuf_string;
787 break;
789 case 'x': /* Lisp expression read but not evaluated */
790 args[i] = Fread_minibuffer (build_string (callint_message), Qnil);
791 visargs[i] = last_minibuf_string;
792 break;
794 case 'X': /* Lisp expression read and evaluated */
795 args[i] = Feval_minibuffer (build_string (callint_message), Qnil);
796 visargs[i] = last_minibuf_string;
797 break;
799 case 'Z': /* Coding-system symbol, or ignore the
800 argument if no prefix */
801 if (NILP (prefix_arg))
803 args[i] = Qnil;
804 varies[i] = -1;
806 else
808 args[i]
809 = Fread_non_nil_coding_system (build_string (callint_message));
810 visargs[i] = last_minibuf_string;
812 break;
814 case 'z': /* Coding-system symbol or nil */
815 args[i] = Fread_coding_system (build_string (callint_message), Qnil);
816 visargs[i] = last_minibuf_string;
817 break;
819 /* We have a case for `+' so we get an error
820 if anyone tries to define one here. */
821 case '+':
822 default:
823 error ("Invalid control letter `%c' (%03o) in interactive calling string",
824 *tem, *tem);
827 if (varies[i] == 0)
828 arg_from_tty = 1;
830 if (NILP (visargs[i]) && STRINGP (args[i]))
831 visargs[i] = args[i];
833 tem = (unsigned char *) index (tem, '\n');
834 if (tem) tem++;
835 else tem = (unsigned char *) "";
837 unbind_to (speccount, Qnil);
839 QUIT;
841 args[0] = function;
843 if (arg_from_tty || !NILP (record_flag))
845 visargs[0] = function;
846 for (i = 1; i < count + 1; i++)
848 if (varies[i] > 0)
849 visargs[i] = Fcons (intern (callint_argfuns[varies[i]]), Qnil);
850 else
851 visargs[i] = quotify_arg (args[i]);
853 Vcommand_history = Fcons (Flist (count + 1, visargs),
854 Vcommand_history);
855 /* Don't keep command history around forever. */
856 if (INTEGERP (Vhistory_length) && XINT (Vhistory_length) > 0)
858 teml = Fnthcdr (Vhistory_length, Vcommand_history);
859 if (CONSP (teml))
860 XSETCDR (teml, Qnil);
864 /* If we used a marker to hold point, mark, or an end of the region,
865 temporarily, convert it to an integer now. */
866 for (i = 1; i <= count; i++)
867 if (varies[i] >= 1 && varies[i] <= 4)
868 XSETINT (args[i], marker_position (args[i]));
870 if (record_then_fail)
871 Fbarf_if_buffer_read_only ();
873 Vthis_command = save_this_command;
874 Vthis_original_command = save_this_original_command;
875 real_this_command= save_real_this_command;
876 current_kboard->Vlast_command = save_last_command;
878 single_kboard_state ();
881 Lisp_Object val;
882 specbind (Qcommand_debug_status, Qnil);
884 val = Ffuncall (count + 1, args);
885 UNGCPRO;
886 return unbind_to (speccount, val);
890 DEFUN ("prefix-numeric-value", Fprefix_numeric_value, Sprefix_numeric_value,
891 1, 1, 0,
892 doc: /* Return numeric meaning of raw prefix argument RAW.
893 A raw prefix argument is what you get from `(interactive "P")'.
894 Its numeric meaning is what you would get from `(interactive "p")'. */)
895 (raw)
896 Lisp_Object raw;
898 Lisp_Object val;
900 if (NILP (raw))
901 XSETFASTINT (val, 1);
902 else if (EQ (raw, Qminus))
903 XSETINT (val, -1);
904 else if (CONSP (raw) && INTEGERP (XCAR (raw)))
905 XSETINT (val, XINT (XCAR (raw)));
906 else if (INTEGERP (raw))
907 val = raw;
908 else
909 XSETFASTINT (val, 1);
911 return val;
914 void
915 syms_of_callint ()
917 point_marker = Fmake_marker ();
918 staticpro (&point_marker);
920 preserved_fns = Fcons (intern ("region-beginning"),
921 Fcons (intern ("region-end"),
922 Fcons (intern ("point"),
923 Fcons (intern ("mark"), Qnil))));
924 staticpro (&preserved_fns);
926 Qlist = intern ("list");
927 staticpro (&Qlist);
928 Qlet = intern ("let");
929 staticpro (&Qlet);
930 Qif = intern ("if");
931 staticpro (&Qif);
932 Qwhen = intern ("when");
933 staticpro (&Qwhen);
934 Qletx = intern ("let*");
935 staticpro (&Qletx);
936 Qsave_excursion = intern ("save-excursion");
937 staticpro (&Qsave_excursion);
938 Qprogn = intern ("progn");
939 staticpro (&Qprogn);
941 Qminus = intern ("-");
942 staticpro (&Qminus);
944 Qplus = intern ("+");
945 staticpro (&Qplus);
947 Qcall_interactively = intern ("call-interactively");
948 staticpro (&Qcall_interactively);
950 Qcommand_debug_status = intern ("command-debug-status");
951 staticpro (&Qcommand_debug_status);
953 Qenable_recursive_minibuffers = intern ("enable-recursive-minibuffers");
954 staticpro (&Qenable_recursive_minibuffers);
956 Qmouse_leave_buffer_hook = intern ("mouse-leave-buffer-hook");
957 staticpro (&Qmouse_leave_buffer_hook);
959 callint_message_size = 100;
960 callint_message = (char *) xmalloc (callint_message_size);
963 DEFVAR_KBOARD ("prefix-arg", Vprefix_arg,
964 doc: /* The value of the prefix argument for the next editing command.
965 It may be a number, or the symbol `-' for just a minus sign as arg,
966 or a list whose car is a number for just one or more C-u's
967 or nil if no argument has been specified.
969 You cannot examine this variable to find the argument for this command
970 since it has been set to nil by the time you can look.
971 Instead, you should use the variable `current-prefix-arg', although
972 normally commands can get this prefix argument with (interactive "P"). */);
974 DEFVAR_KBOARD ("last-prefix-arg", Vlast_prefix_arg,
975 doc: /* The value of the prefix argument for the previous editing command.
976 See `prefix-arg' for the meaning of the value. */);
978 DEFVAR_LISP ("current-prefix-arg", &Vcurrent_prefix_arg,
979 doc: /* The value of the prefix argument for this editing command.
980 It may be a number, or the symbol `-' for just a minus sign as arg,
981 or a list whose car is a number for just one or more C-u's
982 or nil if no argument has been specified.
983 This is what `(interactive \"P\")' returns. */);
984 Vcurrent_prefix_arg = Qnil;
986 DEFVAR_LISP ("command-history", &Vcommand_history,
987 doc: /* List of recent commands that read arguments from terminal.
988 Each command is represented as a form to evaluate. */);
989 Vcommand_history = Qnil;
991 DEFVAR_LISP ("command-debug-status", &Vcommand_debug_status,
992 doc: /* Debugging status of current interactive command.
993 Bound each time `call-interactively' is called;
994 may be set by the debugger as a reminder for itself. */);
995 Vcommand_debug_status = Qnil;
997 DEFVAR_LISP ("mark-even-if-inactive", &Vmark_even_if_inactive,
998 doc: /* *Non-nil means you can use the mark even when inactive.
999 This option makes a difference in Transient Mark mode.
1000 When the option is non-nil, deactivation of the mark
1001 turns off region highlighting, but commands that use the mark
1002 behave as if the mark were still active. */);
1003 Vmark_even_if_inactive = Qnil;
1005 DEFVAR_LISP ("mouse-leave-buffer-hook", &Vmouse_leave_buffer_hook,
1006 doc: /* Hook to run when about to switch windows with a mouse command.
1007 Its purpose is to give temporary modes such as Isearch mode
1008 a way to turn themselves off when a mouse command switches windows. */);
1009 Vmouse_leave_buffer_hook = Qnil;
1011 defsubr (&Sinteractive);
1012 defsubr (&Scall_interactively);
1013 defsubr (&Sprefix_numeric_value);
1016 /* arch-tag: a3a7cad7-bcac-42ce-916e-1bd2546ebf37
1017 (do not change this comment) */