*** empty log message ***
[emacs.git] / src / callint.c
blob39b2046e8fc08c2e0e2e1ac1a41ea0c8e628b12d
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 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 /* 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 fun;
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 fun = indirect_function (function);
322 specs = Qnil;
323 string = 0;
324 /* The idea of FILTER_SPECS is to provide away to
325 specify how to represent the arguments in command history.
326 The feature is not fully implemented. */
327 filter_specs = Qnil;
329 /* If k or K discard an up-event, save it here so it can be retrieved with U */
330 up_event = Qnil;
332 /* Decode the kind of function. Either handle it and return,
333 or go to `lose' if not interactive, or set either STRING or SPECS. */
335 if (SUBRP (fun))
337 string = (unsigned char *) XSUBR (fun)->prompt;
338 if (!string)
340 lose:
341 wrong_type_argument (Qcommandp, function);
344 else if (COMPILEDP (fun))
346 if ((XVECTOR (fun)->size & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_INTERACTIVE)
347 goto lose;
348 specs = XVECTOR (fun)->contents[COMPILED_INTERACTIVE];
350 else
352 Lisp_Object form;
353 GCPRO2 (function, prefix_arg);
354 form = Finteractive_form (function);
355 UNGCPRO;
356 if (CONSP (form))
357 specs = filter_specs = Fcar (XCDR (form));
358 else
359 goto lose;
362 /* If either SPECS or STRING is set to a string, use it. */
363 if (STRINGP (specs))
365 /* Make a copy of string so that if a GC relocates specs,
366 `string' will still be valid. */
367 string = (unsigned char *) alloca (SBYTES (specs) + 1);
368 bcopy (SDATA (specs), string,
369 SBYTES (specs) + 1);
371 else if (string == 0)
373 Lisp_Object input;
374 i = num_input_events;
375 input = specs;
376 /* Compute the arg values using the user's expression. */
377 GCPRO2 (input, filter_specs);
378 specs = Feval (specs);
379 UNGCPRO;
380 if (i != num_input_events || !NILP (record_flag))
382 /* We should record this command on the command history. */
383 Lisp_Object values;
384 /* Make a copy of the list of values, for the command history,
385 and turn them into things we can eval. */
386 values = quotify_args (Fcopy_sequence (specs));
387 fix_command (input, values);
388 Vcommand_history
389 = Fcons (Fcons (function, values), Vcommand_history);
391 /* Don't keep command history around forever. */
392 if (INTEGERP (Vhistory_length) && XINT (Vhistory_length) > 0)
394 teml = Fnthcdr (Vhistory_length, Vcommand_history);
395 if (CONSP (teml))
396 XSETCDR (teml, Qnil);
400 Vthis_command = save_this_command;
401 Vthis_original_command = save_this_original_command;
402 real_this_command= save_real_this_command;
403 current_kboard->Vlast_command = save_last_command;
405 single_kboard_state ();
406 return apply1 (function, specs);
409 /* Here if function specifies a string to control parsing the defaults */
411 /* Set next_event to point to the first event with parameters. */
412 for (next_event = 0; next_event < key_count; next_event++)
413 if (EVENT_HAS_PARAMETERS (XVECTOR (keys)->contents[next_event]))
414 break;
416 /* Handle special starting chars `*' and `@'. Also `-'. */
417 /* Note that `+' is reserved for user extensions. */
418 while (1)
420 if (*string == '+')
421 error ("`+' is not used in `interactive' for ordinary commands");
422 else if (*string == '*')
424 string++;
425 if (!NILP (current_buffer->read_only))
427 if (!NILP (record_flag))
429 unsigned char *p = string;
430 while (*p)
432 if (! (*p == 'r' || *p == 'p' || *p == 'P'
433 || *p == '\n'))
434 Fbarf_if_buffer_read_only ();
435 p++;
437 record_then_fail = 1;
439 else
440 Fbarf_if_buffer_read_only ();
443 /* Ignore this for semi-compatibility with Lucid. */
444 else if (*string == '-')
445 string++;
446 else if (*string == '@')
448 Lisp_Object event, tem;
450 event = (next_event < key_count
451 ? XVECTOR (keys)->contents[next_event]
452 : Qnil);
453 if (EVENT_HAS_PARAMETERS (event)
454 && (tem = XCDR (event), CONSP (tem))
455 && (tem = XCAR (tem), CONSP (tem))
456 && (tem = XCAR (tem), WINDOWP (tem)))
458 if (MINI_WINDOW_P (XWINDOW (tem))
459 && ! (minibuf_level > 0 && EQ (tem, minibuf_window)))
460 error ("Attempt to select inactive minibuffer window");
462 /* If the current buffer wants to clean up, let it. */
463 if (!NILP (Vmouse_leave_buffer_hook))
464 call1 (Vrun_hooks, Qmouse_leave_buffer_hook);
466 Fselect_window (tem, Qnil);
468 string++;
470 else break;
473 /* Count the number of arguments the interactive spec would have
474 us give to the function. */
475 tem = string;
476 for (j = 0; *tem; j++)
478 /* 'r' specifications ("point and mark as 2 numeric args")
479 produce *two* arguments. */
480 if (*tem == 'r') j++;
481 tem = (unsigned char *) index (tem, '\n');
482 if (tem)
483 tem++;
484 else
485 tem = (unsigned char *) "";
487 count = j;
489 args = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object));
490 visargs = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object));
491 varies = (int *) alloca ((count + 1) * sizeof (int));
493 for (i = 0; i < (count + 1); i++)
495 args[i] = Qnil;
496 visargs[i] = Qnil;
497 varies[i] = 0;
500 GCPRO5 (prefix_arg, function, *args, *visargs, up_event);
501 gcpro3.nvars = (count + 1);
502 gcpro4.nvars = (count + 1);
504 if (!NILP (enable))
505 specbind (Qenable_recursive_minibuffers, Qt);
507 tem = string;
508 for (i = 1; *tem; i++)
510 strncpy (prompt1, tem + 1, sizeof prompt1 - 1);
511 prompt1[sizeof prompt1 - 1] = 0;
512 tem1 = (char *) index (prompt1, '\n');
513 if (tem1) *tem1 = 0;
515 visargs[0] = build_string (prompt1);
516 if (index (prompt1, '%'))
517 callint_message = Fformat (i, visargs);
518 else
519 callint_message = visargs[0];
521 switch (*tem)
523 case 'a': /* Symbol defined as a function */
524 visargs[i] = Fcompleting_read (callint_message,
525 Vobarray, Qfboundp, Qt,
526 Qnil, Qnil, Qnil, Qnil);
527 /* Passing args[i] directly stimulates compiler bug */
528 teml = visargs[i];
529 args[i] = Fintern (teml, Qnil);
530 break;
532 case 'b': /* Name of existing buffer */
533 args[i] = Fcurrent_buffer ();
534 if (EQ (selected_window, minibuf_window))
535 args[i] = Fother_buffer (args[i], Qnil, Qnil);
536 args[i] = Fread_buffer (callint_message, args[i], Qt);
537 break;
539 case 'B': /* Name of buffer, possibly nonexistent */
540 args[i] = Fread_buffer (callint_message,
541 Fother_buffer (Fcurrent_buffer (), Qnil, Qnil),
542 Qnil);
543 break;
545 case 'c': /* Character */
546 args[i] = Fread_char (callint_message, Qnil, Qnil);
547 message1_nolog ((char *) 0);
548 /* Passing args[i] directly stimulates compiler bug */
549 teml = args[i];
550 visargs[i] = Fchar_to_string (teml);
551 break;
553 case 'C': /* Command: symbol with interactive function */
554 visargs[i] = Fcompleting_read (callint_message,
555 Vobarray, Qcommandp,
556 Qt, Qnil, Qnil, Qnil, Qnil);
557 /* Passing args[i] directly stimulates compiler bug */
558 teml = visargs[i];
559 args[i] = Fintern (teml, Qnil);
560 break;
562 case 'd': /* Value of point. Does not do I/O. */
563 set_marker_both (point_marker, Qnil, PT, PT_BYTE);
564 args[i] = point_marker;
565 /* visargs[i] = Qnil; */
566 varies[i] = 1;
567 break;
569 case 'D': /* Directory name. */
570 args[i] = Fread_file_name (callint_message, Qnil,
571 current_buffer->directory, Qlambda, Qnil,
572 Qfile_directory_p);
573 break;
575 case 'f': /* Existing file name. */
576 args[i] = Fread_file_name (callint_message,
577 Qnil, Qnil, Qlambda, Qnil, Qnil);
578 break;
580 case 'F': /* Possibly nonexistent file name. */
581 args[i] = Fread_file_name (callint_message,
582 Qnil, Qnil, Qnil, Qnil, Qnil);
583 break;
585 case 'G': /* Possibly nonexistent file name,
586 default to directory alone. */
587 args[i] = Fread_file_name (callint_message,
588 Qnil, Qnil, Qnil, build_string (""), Qnil);
589 break;
591 case 'i': /* Ignore an argument -- Does not do I/O */
592 varies[i] = -1;
593 break;
595 case 'k': /* Key sequence. */
597 int speccount1 = SPECPDL_INDEX ();
598 specbind (Qcursor_in_echo_area, Qt);
599 args[i] = Fread_key_sequence (callint_message,
600 Qnil, Qnil, Qnil, Qnil);
601 unbind_to (speccount1, Qnil);
602 teml = args[i];
603 visargs[i] = Fkey_description (teml, Qnil);
605 /* If the key sequence ends with a down-event,
606 discard the following up-event. */
607 teml = Faref (args[i], make_number (XINT (Flength (args[i])) - 1));
608 if (CONSP (teml))
609 teml = XCAR (teml);
610 if (SYMBOLP (teml))
612 Lisp_Object tem2;
614 teml = Fget (teml, intern ("event-symbol-elements"));
615 /* Ignore first element, which is the base key. */
616 tem2 = Fmemq (intern ("down"), Fcdr (teml));
617 if (! NILP (tem2))
618 up_event = Fread_event (Qnil, Qnil, Qnil);
621 break;
623 case 'K': /* Key sequence to be defined. */
625 int speccount1 = SPECPDL_INDEX ();
626 specbind (Qcursor_in_echo_area, Qt);
627 args[i] = Fread_key_sequence (callint_message,
628 Qnil, Qt, Qnil, Qnil);
629 teml = args[i];
630 visargs[i] = Fkey_description (teml, Qnil);
631 unbind_to (speccount1, Qnil);
633 /* If the key sequence ends with a down-event,
634 discard the following up-event. */
635 teml = Faref (args[i], make_number (XINT (Flength (args[i])) - 1));
636 if (CONSP (teml))
637 teml = XCAR (teml);
638 if (SYMBOLP (teml))
640 Lisp_Object tem2;
642 teml = Fget (teml, intern ("event-symbol-elements"));
643 /* Ignore first element, which is the base key. */
644 tem2 = Fmemq (intern ("down"), Fcdr (teml));
645 if (! NILP (tem2))
646 up_event = Fread_event (Qnil, Qnil, Qnil);
649 break;
651 case 'U': /* Up event from last k or K */
652 if (!NILP (up_event))
654 args[i] = Fmake_vector (make_number (1), up_event);
655 up_event = Qnil;
656 teml = args[i];
657 visargs[i] = Fkey_description (teml, Qnil);
659 break;
661 case 'e': /* The invoking event. */
662 if (next_event >= key_count)
663 error ("%s must be bound to an event with parameters",
664 (SYMBOLP (function)
665 ? (char *) SDATA (SYMBOL_NAME (function))
666 : "command"));
667 args[i] = XVECTOR (keys)->contents[next_event++];
668 varies[i] = -1;
670 /* Find the next parameterized event. */
671 while (next_event < key_count
672 && ! (EVENT_HAS_PARAMETERS
673 (XVECTOR (keys)->contents[next_event])))
674 next_event++;
676 break;
678 case 'm': /* Value of mark. Does not do I/O. */
679 check_mark (0);
680 /* visargs[i] = Qnil; */
681 args[i] = current_buffer->mark;
682 varies[i] = 2;
683 break;
685 case 'M': /* String read via minibuffer with
686 inheriting the current input method. */
687 args[i] = Fread_string (callint_message,
688 Qnil, Qnil, Qnil, Qt);
689 break;
691 case 'N': /* Prefix arg as number, else number from minibuffer */
692 if (!NILP (prefix_arg))
693 goto have_prefix_arg;
694 case 'n': /* Read number from minibuffer. */
696 int first = 1;
699 Lisp_Object tem;
700 if (! first)
702 message ("Please enter a number.");
703 sit_for (make_number (1), 0, 0);
705 first = 0;
707 tem = Fread_from_minibuffer (callint_message,
708 Qnil, Qnil, Qnil, Qnil, Qnil,
709 Qnil);
710 if (! STRINGP (tem) || SCHARS (tem) == 0)
711 args[i] = Qnil;
712 else
713 args[i] = Fread (tem);
715 while (! NUMBERP (args[i]));
717 visargs[i] = args[i];
718 break;
720 case 'P': /* Prefix arg in raw form. Does no I/O. */
721 args[i] = prefix_arg;
722 /* visargs[i] = Qnil; */
723 varies[i] = -1;
724 break;
726 case 'p': /* Prefix arg converted to number. No I/O. */
727 have_prefix_arg:
728 args[i] = Fprefix_numeric_value (prefix_arg);
729 /* visargs[i] = Qnil; */
730 varies[i] = -1;
731 break;
733 case 'r': /* Region, point and mark as 2 args. */
734 check_mark (1);
735 set_marker_both (point_marker, Qnil, PT, PT_BYTE);
736 /* visargs[i+1] = Qnil; */
737 foo = marker_position (current_buffer->mark);
738 /* visargs[i] = Qnil; */
739 args[i] = PT < foo ? point_marker : current_buffer->mark;
740 varies[i] = 3;
741 args[++i] = PT > foo ? point_marker : current_buffer->mark;
742 varies[i] = 4;
743 break;
745 case 's': /* String read via minibuffer without
746 inheriting the current input method. */
747 args[i] = Fread_string (callint_message,
748 Qnil, Qnil, Qnil, Qnil);
749 break;
751 case 'S': /* Any symbol. */
752 visargs[i] = Fread_string (callint_message,
753 Qnil, Qnil, Qnil, Qnil);
754 /* Passing args[i] directly stimulates compiler bug */
755 teml = visargs[i];
756 args[i] = Fintern (teml, Qnil);
757 break;
759 case 'v': /* Variable name: symbol that is
760 user-variable-p. */
761 args[i] = Fread_variable (callint_message, Qnil);
762 visargs[i] = last_minibuf_string;
763 break;
765 case 'x': /* Lisp expression read but not evaluated */
766 args[i] = Fread_minibuffer (callint_message, Qnil);
767 visargs[i] = last_minibuf_string;
768 break;
770 case 'X': /* Lisp expression read and evaluated */
771 args[i] = Feval_minibuffer (callint_message, Qnil);
772 visargs[i] = last_minibuf_string;
773 break;
775 case 'Z': /* Coding-system symbol, or ignore the
776 argument if no prefix */
777 if (NILP (prefix_arg))
779 args[i] = Qnil;
780 varies[i] = -1;
782 else
784 args[i]
785 = Fread_non_nil_coding_system (callint_message);
786 visargs[i] = last_minibuf_string;
788 break;
790 case 'z': /* Coding-system symbol or nil */
791 args[i] = Fread_coding_system (callint_message, Qnil);
792 visargs[i] = last_minibuf_string;
793 break;
795 /* We have a case for `+' so we get an error
796 if anyone tries to define one here. */
797 case '+':
798 default:
799 error ("Invalid control letter `%c' (%03o) in interactive calling string",
800 *tem, *tem);
803 if (varies[i] == 0)
804 arg_from_tty = 1;
806 if (NILP (visargs[i]) && STRINGP (args[i]))
807 visargs[i] = args[i];
809 tem = (unsigned char *) index (tem, '\n');
810 if (tem) tem++;
811 else tem = (unsigned char *) "";
813 unbind_to (speccount, Qnil);
815 QUIT;
817 args[0] = function;
819 if (arg_from_tty || !NILP (record_flag))
821 visargs[0] = function;
822 for (i = 1; i < count + 1; i++)
824 if (varies[i] > 0)
825 visargs[i] = Fcons (intern (callint_argfuns[varies[i]]), Qnil);
826 else
827 visargs[i] = quotify_arg (args[i]);
829 Vcommand_history = Fcons (Flist (count + 1, visargs),
830 Vcommand_history);
831 /* Don't keep command history around forever. */
832 if (INTEGERP (Vhistory_length) && XINT (Vhistory_length) > 0)
834 teml = Fnthcdr (Vhistory_length, Vcommand_history);
835 if (CONSP (teml))
836 XSETCDR (teml, Qnil);
840 /* If we used a marker to hold point, mark, or an end of the region,
841 temporarily, convert it to an integer now. */
842 for (i = 1; i <= count; i++)
843 if (varies[i] >= 1 && varies[i] <= 4)
844 XSETINT (args[i], marker_position (args[i]));
846 if (record_then_fail)
847 Fbarf_if_buffer_read_only ();
849 Vthis_command = save_this_command;
850 Vthis_original_command = save_this_original_command;
851 real_this_command= save_real_this_command;
852 current_kboard->Vlast_command = save_last_command;
854 single_kboard_state ();
857 Lisp_Object val;
858 specbind (Qcommand_debug_status, Qnil);
860 val = Ffuncall (count + 1, args);
861 UNGCPRO;
862 return unbind_to (speccount, val);
866 DEFUN ("prefix-numeric-value", Fprefix_numeric_value, Sprefix_numeric_value,
867 1, 1, 0,
868 doc: /* Return numeric meaning of raw prefix argument RAW.
869 A raw prefix argument is what you get from `(interactive "P")'.
870 Its numeric meaning is what you would get from `(interactive "p")'. */)
871 (raw)
872 Lisp_Object raw;
874 Lisp_Object val;
876 if (NILP (raw))
877 XSETFASTINT (val, 1);
878 else if (EQ (raw, Qminus))
879 XSETINT (val, -1);
880 else if (CONSP (raw) && INTEGERP (XCAR (raw)))
881 XSETINT (val, XINT (XCAR (raw)));
882 else if (INTEGERP (raw))
883 val = raw;
884 else
885 XSETFASTINT (val, 1);
887 return val;
890 void
891 syms_of_callint ()
893 point_marker = Fmake_marker ();
894 staticpro (&point_marker);
896 callint_message = Qnil;
897 staticpro (&callint_message);
899 preserved_fns = Fcons (intern ("region-beginning"),
900 Fcons (intern ("region-end"),
901 Fcons (intern ("point"),
902 Fcons (intern ("mark"), Qnil))));
903 staticpro (&preserved_fns);
905 Qlist = intern ("list");
906 staticpro (&Qlist);
907 Qlet = intern ("let");
908 staticpro (&Qlet);
909 Qif = intern ("if");
910 staticpro (&Qif);
911 Qwhen = intern ("when");
912 staticpro (&Qwhen);
913 Qletx = intern ("let*");
914 staticpro (&Qletx);
915 Qsave_excursion = intern ("save-excursion");
916 staticpro (&Qsave_excursion);
917 Qprogn = intern ("progn");
918 staticpro (&Qprogn);
920 Qminus = intern ("-");
921 staticpro (&Qminus);
923 Qplus = intern ("+");
924 staticpro (&Qplus);
926 Qcall_interactively = intern ("call-interactively");
927 staticpro (&Qcall_interactively);
929 Qcommand_debug_status = intern ("command-debug-status");
930 staticpro (&Qcommand_debug_status);
932 Qenable_recursive_minibuffers = intern ("enable-recursive-minibuffers");
933 staticpro (&Qenable_recursive_minibuffers);
935 Qmouse_leave_buffer_hook = intern ("mouse-leave-buffer-hook");
936 staticpro (&Qmouse_leave_buffer_hook);
938 DEFVAR_KBOARD ("prefix-arg", Vprefix_arg,
939 doc: /* The value of the prefix argument for the next editing command.
940 It may be a number, or the symbol `-' for just a minus sign as arg,
941 or a list whose car is a number for just one or more C-u's
942 or nil if no argument has been specified.
944 You cannot examine this variable to find the argument for this command
945 since it has been set to nil by the time you can look.
946 Instead, you should use the variable `current-prefix-arg', although
947 normally commands can get this prefix argument with (interactive "P"). */);
949 DEFVAR_KBOARD ("last-prefix-arg", Vlast_prefix_arg,
950 doc: /* The value of the prefix argument for the previous editing command.
951 See `prefix-arg' for the meaning of the value. */);
953 DEFVAR_LISP ("current-prefix-arg", &Vcurrent_prefix_arg,
954 doc: /* The value of the prefix argument for this editing command.
955 It may be a number, or the symbol `-' for just a minus sign as arg,
956 or a list whose car is a number for just one or more C-u's
957 or nil if no argument has been specified.
958 This is what `(interactive \"P\")' returns. */);
959 Vcurrent_prefix_arg = Qnil;
961 DEFVAR_LISP ("command-history", &Vcommand_history,
962 doc: /* List of recent commands that read arguments from terminal.
963 Each command is represented as a form to evaluate. */);
964 Vcommand_history = Qnil;
966 DEFVAR_LISP ("command-debug-status", &Vcommand_debug_status,
967 doc: /* Debugging status of current interactive command.
968 Bound each time `call-interactively' is called;
969 may be set by the debugger as a reminder for itself. */);
970 Vcommand_debug_status = Qnil;
972 DEFVAR_LISP ("mark-even-if-inactive", &Vmark_even_if_inactive,
973 doc: /* *Non-nil means you can use the mark even when inactive.
974 This option makes a difference in Transient Mark mode.
975 When the option is non-nil, deactivation of the mark
976 turns off region highlighting, but commands that use the mark
977 behave as if the mark were still active. */);
978 Vmark_even_if_inactive = Qnil;
980 DEFVAR_LISP ("mouse-leave-buffer-hook", &Vmouse_leave_buffer_hook,
981 doc: /* Hook to run when about to switch windows with a mouse command.
982 Its purpose is to give temporary modes such as Isearch mode
983 a way to turn themselves off when a mouse command switches windows. */);
984 Vmouse_leave_buffer_hook = Qnil;
986 defsubr (&Sinteractive);
987 defsubr (&Scall_interactively);
988 defsubr (&Sprefix_numeric_value);
991 /* arch-tag: a3a7cad7-bcac-42ce-916e-1bd2546ebf37
992 (do not change this comment) */