Try and be more careful about propagation of lexical environment.
[emacs.git] / src / callint.c
blob960158029c3bd1be47b3dd5830a354e4c7ea395b
1 /* Call a Lisp function interactively.
2 Copyright (C) 1985, 1986, 1993, 1994, 1995, 1997, 2000, 2001, 2002,
3 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
4 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
22 #include <config.h>
23 #include <setjmp.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 Lisp_Object Vcurrent_prefix_arg, Qminus, Qplus;
33 Lisp_Object Qcall_interactively;
34 Lisp_Object Vcommand_history;
36 Lisp_Object Vcommand_debug_status, Qcommand_debug_status;
37 Lisp_Object Qenable_recursive_minibuffers;
39 /* Non-nil means treat the mark as active
40 even if mark_active is 0. */
41 Lisp_Object Vmark_even_if_inactive;
43 Lisp_Object Qhandle_shift_selection;
45 Lisp_Object Vmouse_leave_buffer_hook, Qmouse_leave_buffer_hook;
47 Lisp_Object Qlist, Qlet, Qletx, Qsave_excursion, Qprogn, Qif, Qwhen;
48 static Lisp_Object preserved_fns;
50 /* Marker used within call-interactively to refer to point. */
51 static Lisp_Object point_marker;
53 /* String for the prompt text used in Fcall_interactively. */
54 static Lisp_Object callint_message;
56 /* ARGSUSED */
57 DEFUN ("interactive", Finteractive, Sinteractive, 0, UNEVALLED, 0,
58 doc: /* Specify a way of parsing arguments for interactive use of a function.
59 For example, write
60 (defun foo (arg buf) "Doc string" (interactive "P\\nbbuffer: ") .... )
61 to make ARG be the raw prefix argument, and set BUF to an existing buffer,
62 when `foo' is called as a command.
63 The "call" to `interactive' is actually a declaration rather than a function;
64 it tells `call-interactively' how to read arguments
65 to pass to the function.
66 When actually called, `interactive' just returns nil.
68 Usually the argument of `interactive' is a string containing a code letter
69 followed optionally by a prompt. (Some code letters do not use I/O to get
70 the argument and do not use prompts.) To get several arguments, concatenate
71 the individual strings, separating them by newline characters.
72 Prompts are passed to format, and may use % escapes to print the
73 arguments that have already been read.
74 If the argument is not a string, it is evaluated to get a list of
75 arguments to pass to the function.
76 Just `(interactive)' means pass no args when calling interactively.
78 Code letters available are:
79 a -- Function name: symbol with a function definition.
80 b -- Name of existing buffer.
81 B -- Name of buffer, possibly nonexistent.
82 c -- Character (no input method is used).
83 C -- Command name: symbol with interactive function definition.
84 d -- Value of point as number. Does not do I/O.
85 D -- Directory name.
86 e -- Parametrized event (i.e., one that's a list) that invoked this command.
87 If used more than once, the Nth `e' returns the Nth parameterized event.
88 This skips events that are integers or symbols.
89 f -- Existing file name.
90 F -- Possibly nonexistent file name.
91 G -- Possibly nonexistent file name, defaulting to just directory name.
92 i -- Ignored, i.e. always nil. Does not do I/O.
93 k -- Key sequence (downcase the last event if needed to get a definition).
94 K -- Key sequence to be redefined (do not downcase the last event).
95 m -- Value of mark as number. Does not do I/O.
96 M -- Any string. Inherits the current input method.
97 n -- Number read using minibuffer.
98 N -- Numeric prefix arg, or if none, do like code `n'.
99 p -- Prefix arg converted to number. Does not do I/O.
100 P -- Prefix arg in raw form. Does not do I/O.
101 r -- Region: point and mark as 2 numeric args, smallest first. Does no I/O.
102 s -- Any string. Does not inherit the current input method.
103 S -- Any symbol.
104 U -- Mouse up event discarded by a previous k or K argument.
105 v -- Variable name: symbol that is user-variable-p.
106 x -- Lisp expression read but not evaluated.
107 X -- Lisp expression read and evaluated.
108 z -- Coding system.
109 Z -- Coding system, nil if no prefix arg.
111 In addition, if the string begins with `*', an error is signaled if
112 the buffer is read-only.
113 If the string begins with `@', Emacs searches the key sequence which
114 invoked the command for its first mouse click (or any other event
115 which specifies a window).
116 If the string begins with `^' and `shift-select-mode' is non-nil,
117 Emacs first calls the function `handle-shift-selection'.
118 You may use `@', `*', and `^' together. They are processed in the
119 order that they appear, before reading any arguments.
120 usage: (interactive &optional ARGS) */)
121 (Lisp_Object args)
123 return Qnil;
126 /* Quotify EXP: if EXP is constant, return it.
127 If EXP is not constant, return (quote EXP). */
128 Lisp_Object
129 quotify_arg (register Lisp_Object exp)
131 if (!INTEGERP (exp) && !STRINGP (exp)
132 && !NILP (exp) && !EQ (exp, Qt))
133 return Fcons (Qquote, Fcons (exp, Qnil));
135 return exp;
138 /* Modify EXP by quotifying each element (except the first). */
139 Lisp_Object
140 quotify_args (Lisp_Object exp)
142 register Lisp_Object tail;
143 Lisp_Object next;
144 for (tail = exp; CONSP (tail); tail = next)
146 next = XCDR (tail);
147 XSETCAR (tail, quotify_arg (XCAR (tail)));
149 return exp;
152 static const char *callint_argfuns[]
153 = {"", "point", "mark", "region-beginning", "region-end"};
155 static void
156 check_mark (int for_region)
158 Lisp_Object tem;
159 tem = Fmarker_buffer (current_buffer->mark);
160 if (NILP (tem) || (XBUFFER (tem) != current_buffer))
161 error (for_region ? "The mark is not set now, so there is no region"
162 : "The mark is not set now");
163 if (!NILP (Vtransient_mark_mode) && NILP (Vmark_even_if_inactive)
164 && NILP (current_buffer->mark_active))
165 xsignal0 (Qmark_inactive);
168 /* If the list of args INPUT was produced with an explicit call to
169 `list', look for elements that were computed with
170 (region-beginning) or (region-end), and put those expressions into
171 VALUES instead of the present values.
173 This function doesn't return a value because it modifies elements
174 of VALUES to do its job. */
176 static void
177 fix_command (Lisp_Object input, Lisp_Object values)
179 if (CONSP (input))
181 Lisp_Object car;
183 car = XCAR (input);
184 /* Skip through certain special forms. */
185 while (EQ (car, Qlet) || EQ (car, Qletx)
186 || EQ (car, Qsave_excursion)
187 || EQ (car, Qprogn))
189 while (CONSP (XCDR (input)))
190 input = XCDR (input);
191 input = XCAR (input);
192 if (!CONSP (input))
193 break;
194 car = XCAR (input);
196 if (EQ (car, Qlist))
198 Lisp_Object intail, valtail;
199 for (intail = Fcdr (input), valtail = values;
200 CONSP (valtail);
201 intail = Fcdr (intail), valtail = XCDR (valtail))
203 Lisp_Object elt;
204 elt = Fcar (intail);
205 if (CONSP (elt))
207 Lisp_Object presflag, carelt;
208 carelt = Fcar (elt);
209 /* If it is (if X Y), look at Y. */
210 if (EQ (carelt, Qif)
211 && EQ (Fnthcdr (make_number (3), elt), Qnil))
212 elt = Fnth (make_number (2), elt);
213 /* If it is (when ... Y), look at Y. */
214 else if (EQ (carelt, Qwhen))
216 while (CONSP (XCDR (elt)))
217 elt = XCDR (elt);
218 elt = Fcar (elt);
221 /* If the function call we're looking at
222 is a special preserved one, copy the
223 whole expression for this argument. */
224 if (CONSP (elt))
226 presflag = Fmemq (Fcar (elt), preserved_fns);
227 if (!NILP (presflag))
228 Fsetcar (valtail, Fcar (intail));
236 DEFUN ("call-interactively", Fcall_interactively, Scall_interactively, 1, 3, 0,
237 doc: /* Call FUNCTION, reading args according to its interactive calling specs.
238 Return the value FUNCTION returns.
239 The function contains a specification of how to do the argument reading.
240 In the case of user-defined functions, this is specified by placing a call
241 to the function `interactive' at the top level of the function body.
242 See `interactive'.
244 Optional second arg RECORD-FLAG non-nil
245 means unconditionally put this command in the command-history.
246 Otherwise, this is done only if an arg is read using the minibuffer.
248 Optional third arg KEYS, if given, specifies the sequence of events to
249 supply, as a vector, if the command inquires which events were used to
250 invoke it. If KEYS is omitted or nil, the return value of
251 `this-command-keys-vector' is used. */)
252 (Lisp_Object function, Lisp_Object record_flag, Lisp_Object keys)
254 Lisp_Object *args, *visargs;
255 Lisp_Object specs;
256 Lisp_Object filter_specs;
257 Lisp_Object teml;
258 Lisp_Object up_event;
259 Lisp_Object enable;
260 int speccount = SPECPDL_INDEX ();
262 /* The index of the next element of this_command_keys to examine for
263 the 'e' interactive code. */
264 int next_event;
266 Lisp_Object prefix_arg;
267 unsigned char *string;
268 unsigned char *tem;
270 /* If varies[i] > 0, the i'th argument shouldn't just have its value
271 in this call quoted in the command history. It should be
272 recorded as a call to the function named callint_argfuns[varies[i]]. */
273 int *varies;
275 register int i, j;
276 int count, foo;
277 char prompt1[100];
278 char *tem1;
279 int arg_from_tty = 0;
280 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
281 int key_count;
282 int record_then_fail = 0;
284 Lisp_Object save_this_command, save_last_command;
285 Lisp_Object save_this_original_command, save_real_this_command;
287 save_this_command = Vthis_command;
288 save_this_original_command = Vthis_original_command;
289 save_real_this_command = real_this_command;
290 save_last_command = current_kboard->Vlast_command;
292 if (NILP (keys))
293 keys = this_command_keys, key_count = this_command_key_count;
294 else
296 CHECK_VECTOR (keys);
297 key_count = XVECTOR (keys)->size;
300 /* Save this now, since use of minibuffer will clobber it. */
301 prefix_arg = Vcurrent_prefix_arg;
303 if (SYMBOLP (function))
304 enable = Fget (function, Qenable_recursive_minibuffers);
305 else
306 enable = Qnil;
308 specs = Qnil;
309 string = 0;
310 /* The idea of FILTER_SPECS is to provide away to
311 specify how to represent the arguments in command history.
312 The feature is not fully implemented. */
313 filter_specs = Qnil;
315 /* If k or K discard an up-event, save it here so it can be retrieved with U */
316 up_event = Qnil;
318 /* Set SPECS to the interactive form, or barf if not interactive. */
320 Lisp_Object form;
321 GCPRO2 (function, prefix_arg);
322 form = Finteractive_form (function);
323 UNGCPRO;
324 if (CONSP (form))
325 specs = filter_specs = Fcar (XCDR (form));
326 else
327 wrong_type_argument (Qcommandp, function);
330 /* If SPECS is set to a string, use it as an interactive prompt. */
331 if (STRINGP (specs))
333 /* Make a copy of string so that if a GC relocates specs,
334 `string' will still be valid. */
335 string = (unsigned char *) alloca (SBYTES (specs) + 1);
336 memcpy (string, SDATA (specs), SBYTES (specs) + 1);
338 else
340 Lisp_Object input;
341 i = num_input_events;
342 input = specs;
343 /* Compute the arg values using the user's expression. */
344 GCPRO2 (input, filter_specs);
345 specs = Feval (specs); /* FIXME: lexbind */
346 UNGCPRO;
347 if (i != num_input_events || !NILP (record_flag))
349 /* We should record this command on the command history. */
350 Lisp_Object values;
351 Lisp_Object this_cmd;
352 /* Make a copy of the list of values, for the command history,
353 and turn them into things we can eval. */
354 values = quotify_args (Fcopy_sequence (specs));
355 fix_command (input, values);
356 this_cmd = Fcons (function, values);
357 if (history_delete_duplicates)
358 Vcommand_history = Fdelete (this_cmd, Vcommand_history);
359 Vcommand_history = Fcons (this_cmd, Vcommand_history);
361 /* Don't keep command history around forever. */
362 if (INTEGERP (Vhistory_length) && XINT (Vhistory_length) > 0)
364 teml = Fnthcdr (Vhistory_length, Vcommand_history);
365 if (CONSP (teml))
366 XSETCDR (teml, Qnil);
370 Vthis_command = save_this_command;
371 Vthis_original_command = save_this_original_command;
372 real_this_command= save_real_this_command;
373 current_kboard->Vlast_command = save_last_command;
375 temporarily_switch_to_single_kboard (NULL);
376 return unbind_to (speccount, apply1 (function, specs));
379 /* Here if function specifies a string to control parsing the defaults */
381 /* Set next_event to point to the first event with parameters. */
382 for (next_event = 0; next_event < key_count; next_event++)
383 if (EVENT_HAS_PARAMETERS (AREF (keys, next_event)))
384 break;
386 /* Handle special starting chars `*' and `@'. Also `-'. */
387 /* Note that `+' is reserved for user extensions. */
388 while (1)
390 if (*string == '+')
391 error ("`+' is not used in `interactive' for ordinary commands");
392 else if (*string == '*')
394 string++;
395 if (!NILP (current_buffer->read_only))
397 if (!NILP (record_flag))
399 unsigned char *p = string;
400 while (*p)
402 if (! (*p == 'r' || *p == 'p' || *p == 'P'
403 || *p == '\n'))
404 Fbarf_if_buffer_read_only ();
405 p++;
407 record_then_fail = 1;
409 else
410 Fbarf_if_buffer_read_only ();
413 /* Ignore this for semi-compatibility with Lucid. */
414 else if (*string == '-')
415 string++;
416 else if (*string == '@')
418 Lisp_Object event, tem;
420 event = (next_event < key_count
421 ? AREF (keys, next_event)
422 : Qnil);
423 if (EVENT_HAS_PARAMETERS (event)
424 && (tem = XCDR (event), CONSP (tem))
425 && (tem = XCAR (tem), CONSP (tem))
426 && (tem = XCAR (tem), WINDOWP (tem)))
428 if (MINI_WINDOW_P (XWINDOW (tem))
429 && ! (minibuf_level > 0 && EQ (tem, minibuf_window)))
430 error ("Attempt to select inactive minibuffer window");
432 /* If the current buffer wants to clean up, let it. */
433 if (!NILP (Vmouse_leave_buffer_hook))
434 call1 (Vrun_hooks, Qmouse_leave_buffer_hook);
436 Fselect_window (tem, Qnil);
438 string++;
440 else if (*string == '^')
442 call0 (Qhandle_shift_selection);
443 string++;
445 else break;
448 /* Count the number of arguments the interactive spec would have
449 us give to the function. */
450 tem = string;
451 for (j = 0; *tem;)
453 /* 'r' specifications ("point and mark as 2 numeric args")
454 produce *two* arguments. */
455 if (*tem == 'r')
456 j += 2;
457 else
458 j++;
459 tem = (unsigned char *) strchr (tem, '\n');
460 if (tem)
461 ++tem;
462 else
463 break;
465 count = j;
467 args = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object));
468 visargs = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object));
469 varies = (int *) alloca ((count + 1) * sizeof (int));
471 for (i = 0; i < (count + 1); i++)
473 args[i] = Qnil;
474 visargs[i] = Qnil;
475 varies[i] = 0;
478 GCPRO5 (prefix_arg, function, *args, *visargs, up_event);
479 gcpro3.nvars = (count + 1);
480 gcpro4.nvars = (count + 1);
482 if (!NILP (enable))
483 specbind (Qenable_recursive_minibuffers, Qt);
485 tem = string;
486 for (i = 1; *tem; i++)
488 strncpy (prompt1, tem + 1, sizeof prompt1 - 1);
489 prompt1[sizeof prompt1 - 1] = 0;
490 tem1 = strchr (prompt1, '\n');
491 if (tem1) *tem1 = 0;
493 visargs[0] = build_string (prompt1);
494 if (strchr (prompt1, '%'))
495 callint_message = Fformat (i, visargs);
496 else
497 callint_message = visargs[0];
499 switch (*tem)
501 case 'a': /* Symbol defined as a function */
502 visargs[i] = Fcompleting_read (callint_message,
503 Vobarray, Qfboundp, Qt,
504 Qnil, Qnil, Qnil, Qnil);
505 /* Passing args[i] directly stimulates compiler bug */
506 teml = visargs[i];
507 args[i] = Fintern (teml, Qnil);
508 break;
510 case 'b': /* Name of existing buffer */
511 args[i] = Fcurrent_buffer ();
512 if (EQ (selected_window, minibuf_window))
513 args[i] = Fother_buffer (args[i], Qnil, Qnil);
514 args[i] = Fread_buffer (callint_message, args[i], Qt);
515 break;
517 case 'B': /* Name of buffer, possibly nonexistent */
518 args[i] = Fread_buffer (callint_message,
519 Fother_buffer (Fcurrent_buffer (), Qnil, Qnil),
520 Qnil);
521 break;
523 case 'c': /* Character */
524 /* Prompt in `minibuffer-prompt' face. */
525 Fput_text_property (make_number (0),
526 make_number (SCHARS (callint_message)),
527 Qface, Qminibuffer_prompt, callint_message);
528 args[i] = Fread_char (callint_message, Qnil, Qnil);
529 message1_nolog ((char *) 0);
530 /* Passing args[i] directly stimulates compiler bug */
531 teml = args[i];
532 visargs[i] = Fchar_to_string (teml);
533 break;
535 case 'C': /* Command: symbol with interactive function */
536 visargs[i] = Fcompleting_read (callint_message,
537 Vobarray, Qcommandp,
538 Qt, Qnil, Qnil, Qnil, Qnil);
539 /* Passing args[i] directly stimulates compiler bug */
540 teml = visargs[i];
541 args[i] = Fintern (teml, Qnil);
542 break;
544 case 'd': /* Value of point. Does not do I/O. */
545 set_marker_both (point_marker, Qnil, PT, PT_BYTE);
546 args[i] = point_marker;
547 /* visargs[i] = Qnil; */
548 varies[i] = 1;
549 break;
551 case 'D': /* Directory name. */
552 args[i] = Fread_file_name (callint_message, Qnil,
553 current_buffer->directory, Qlambda, Qnil,
554 Qfile_directory_p);
555 break;
557 case 'f': /* Existing file name. */
558 args[i] = Fread_file_name (callint_message,
559 Qnil, Qnil, Qlambda, Qnil, Qnil);
560 break;
562 case 'F': /* Possibly nonexistent file name. */
563 args[i] = Fread_file_name (callint_message,
564 Qnil, Qnil, Qnil, Qnil, Qnil);
565 break;
567 case 'G': /* Possibly nonexistent file name,
568 default to directory alone. */
569 args[i] = Fread_file_name (callint_message,
570 Qnil, Qnil, Qnil, empty_unibyte_string, Qnil);
571 break;
573 case 'i': /* Ignore an argument -- Does not do I/O */
574 varies[i] = -1;
575 break;
577 case 'k': /* Key sequence. */
579 int speccount1 = SPECPDL_INDEX ();
580 specbind (Qcursor_in_echo_area, Qt);
581 /* Prompt in `minibuffer-prompt' face. */
582 Fput_text_property (make_number (0),
583 make_number (SCHARS (callint_message)),
584 Qface, Qminibuffer_prompt, callint_message);
585 args[i] = Fread_key_sequence (callint_message,
586 Qnil, Qnil, Qnil, Qnil);
587 unbind_to (speccount1, Qnil);
588 teml = args[i];
589 visargs[i] = Fkey_description (teml, Qnil);
591 /* If the key sequence ends with a down-event,
592 discard the following up-event. */
593 teml = Faref (args[i], make_number (XINT (Flength (args[i])) - 1));
594 if (CONSP (teml))
595 teml = XCAR (teml);
596 if (SYMBOLP (teml))
598 Lisp_Object tem2;
600 teml = Fget (teml, intern ("event-symbol-elements"));
601 /* Ignore first element, which is the base key. */
602 tem2 = Fmemq (intern ("down"), Fcdr (teml));
603 if (! NILP (tem2))
604 up_event = Fread_event (Qnil, Qnil, Qnil);
607 break;
609 case 'K': /* Key sequence to be defined. */
611 int speccount1 = SPECPDL_INDEX ();
612 specbind (Qcursor_in_echo_area, Qt);
613 /* Prompt in `minibuffer-prompt' face. */
614 Fput_text_property (make_number (0),
615 make_number (SCHARS (callint_message)),
616 Qface, Qminibuffer_prompt, callint_message);
617 args[i] = Fread_key_sequence (callint_message,
618 Qnil, Qt, Qnil, Qnil);
619 teml = args[i];
620 visargs[i] = Fkey_description (teml, Qnil);
621 unbind_to (speccount1, 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, Qnil);
639 break;
641 case 'U': /* Up event from last k or K */
642 if (!NILP (up_event))
644 args[i] = Fmake_vector (make_number (1), up_event);
645 up_event = Qnil;
646 teml = args[i];
647 visargs[i] = Fkey_description (teml, Qnil);
649 break;
651 case 'e': /* The invoking event. */
652 if (next_event >= key_count)
653 error ("%s must be bound to an event with parameters",
654 (SYMBOLP (function)
655 ? (char *) SDATA (SYMBOL_NAME (function))
656 : "command"));
657 args[i] = AREF (keys, next_event);
658 next_event++;
659 varies[i] = -1;
661 /* Find the next parameterized event. */
662 while (next_event < key_count
663 && !(EVENT_HAS_PARAMETERS (AREF (keys, next_event))))
664 next_event++;
666 break;
668 case 'm': /* Value of mark. Does not do I/O. */
669 check_mark (0);
670 /* visargs[i] = Qnil; */
671 args[i] = current_buffer->mark;
672 varies[i] = 2;
673 break;
675 case 'M': /* String read via minibuffer with
676 inheriting the current input method. */
677 args[i] = Fread_string (callint_message,
678 Qnil, Qnil, Qnil, Qt);
679 break;
681 case 'N': /* Prefix arg as number, else number from minibuffer */
682 if (!NILP (prefix_arg))
683 goto have_prefix_arg;
684 case 'n': /* Read number from minibuffer. */
686 int first = 1;
689 Lisp_Object tem;
690 if (! first)
692 message ("Please enter a number.");
693 sit_for (make_number (1), 0, 0);
695 first = 0;
697 tem = Fread_from_minibuffer (callint_message,
698 Qnil, Qnil, Qnil, Qnil, Qnil,
699 Qnil);
700 if (! STRINGP (tem) || SCHARS (tem) == 0)
701 args[i] = Qnil;
702 else
703 args[i] = Fread (tem);
705 while (! NUMBERP (args[i]));
707 visargs[i] = args[i];
708 break;
710 case 'P': /* Prefix arg in raw form. Does no I/O. */
711 args[i] = prefix_arg;
712 /* visargs[i] = Qnil; */
713 varies[i] = -1;
714 break;
716 case 'p': /* Prefix arg converted to number. No I/O. */
717 have_prefix_arg:
718 args[i] = Fprefix_numeric_value (prefix_arg);
719 /* visargs[i] = Qnil; */
720 varies[i] = -1;
721 break;
723 case 'r': /* Region, point and mark as 2 args. */
724 check_mark (1);
725 set_marker_both (point_marker, Qnil, PT, PT_BYTE);
726 /* visargs[i+1] = Qnil; */
727 foo = marker_position (current_buffer->mark);
728 /* visargs[i] = Qnil; */
729 args[i] = PT < foo ? point_marker : current_buffer->mark;
730 varies[i] = 3;
731 args[++i] = PT > foo ? point_marker : current_buffer->mark;
732 varies[i] = 4;
733 break;
735 case 's': /* String read via minibuffer without
736 inheriting the current input method. */
737 args[i] = Fread_string (callint_message,
738 Qnil, Qnil, Qnil, Qnil);
739 break;
741 case 'S': /* Any symbol. */
742 visargs[i] = Fread_string (callint_message,
743 Qnil, Qnil, Qnil, Qnil);
744 /* Passing args[i] directly stimulates compiler bug */
745 teml = visargs[i];
746 args[i] = Fintern (teml, Qnil);
747 break;
749 case 'v': /* Variable name: symbol that is
750 user-variable-p. */
751 args[i] = Fread_variable (callint_message, Qnil);
752 visargs[i] = last_minibuf_string;
753 break;
755 case 'x': /* Lisp expression read but not evaluated */
756 args[i] = Fread_minibuffer (callint_message, Qnil);
757 visargs[i] = last_minibuf_string;
758 break;
760 case 'X': /* Lisp expression read and evaluated */
761 args[i] = Feval_minibuffer (callint_message, Qnil);
762 visargs[i] = last_minibuf_string;
763 break;
765 case 'Z': /* Coding-system symbol, or ignore the
766 argument if no prefix */
767 if (NILP (prefix_arg))
769 args[i] = Qnil;
770 varies[i] = -1;
772 else
774 args[i]
775 = Fread_non_nil_coding_system (callint_message);
776 visargs[i] = last_minibuf_string;
778 break;
780 case 'z': /* Coding-system symbol or nil */
781 args[i] = Fread_coding_system (callint_message, Qnil);
782 visargs[i] = last_minibuf_string;
783 break;
785 /* We have a case for `+' so we get an error
786 if anyone tries to define one here. */
787 case '+':
788 default:
789 error ("Invalid control letter `%c' (%03o) in interactive calling string",
790 *tem, *tem);
793 if (varies[i] == 0)
794 arg_from_tty = 1;
796 if (NILP (visargs[i]) && STRINGP (args[i]))
797 visargs[i] = args[i];
799 tem = (unsigned char *) strchr (tem, '\n');
800 if (tem) tem++;
801 else tem = (unsigned char *) "";
803 unbind_to (speccount, Qnil);
805 QUIT;
807 args[0] = function;
809 if (arg_from_tty || !NILP (record_flag))
811 visargs[0] = function;
812 for (i = 1; i < count + 1; i++)
814 if (varies[i] > 0)
815 visargs[i] = Fcons (intern (callint_argfuns[varies[i]]), Qnil);
816 else
817 visargs[i] = quotify_arg (args[i]);
819 Vcommand_history = Fcons (Flist (count + 1, visargs),
820 Vcommand_history);
821 /* Don't keep command history around forever. */
822 if (INTEGERP (Vhistory_length) && XINT (Vhistory_length) > 0)
824 teml = Fnthcdr (Vhistory_length, Vcommand_history);
825 if (CONSP (teml))
826 XSETCDR (teml, Qnil);
830 /* If we used a marker to hold point, mark, or an end of the region,
831 temporarily, convert it to an integer now. */
832 for (i = 1; i <= count; i++)
833 if (varies[i] >= 1 && varies[i] <= 4)
834 XSETINT (args[i], marker_position (args[i]));
836 if (record_then_fail)
837 Fbarf_if_buffer_read_only ();
839 Vthis_command = save_this_command;
840 Vthis_original_command = save_this_original_command;
841 real_this_command= save_real_this_command;
842 current_kboard->Vlast_command = save_last_command;
845 Lisp_Object val;
846 specbind (Qcommand_debug_status, Qnil);
848 temporarily_switch_to_single_kboard (NULL);
849 val = Ffuncall (count + 1, args);
850 UNGCPRO;
851 return unbind_to (speccount, val);
855 DEFUN ("prefix-numeric-value", Fprefix_numeric_value, Sprefix_numeric_value,
856 1, 1, 0,
857 doc: /* Return numeric meaning of raw prefix argument RAW.
858 A raw prefix argument is what you get from `(interactive "P")'.
859 Its numeric meaning is what you would get from `(interactive "p")'. */)
860 (Lisp_Object raw)
862 Lisp_Object val;
864 if (NILP (raw))
865 XSETFASTINT (val, 1);
866 else if (EQ (raw, Qminus))
867 XSETINT (val, -1);
868 else if (CONSP (raw) && INTEGERP (XCAR (raw)))
869 XSETINT (val, XINT (XCAR (raw)));
870 else if (INTEGERP (raw))
871 val = raw;
872 else
873 XSETFASTINT (val, 1);
875 return val;
878 void
879 syms_of_callint (void)
881 point_marker = Fmake_marker ();
882 staticpro (&point_marker);
884 callint_message = Qnil;
885 staticpro (&callint_message);
887 preserved_fns = pure_cons (intern_c_string ("region-beginning"),
888 pure_cons (intern_c_string ("region-end"),
889 pure_cons (intern_c_string ("point"),
890 pure_cons (intern_c_string ("mark"), Qnil))));
892 Qlist = intern_c_string ("list");
893 staticpro (&Qlist);
894 Qlet = intern_c_string ("let");
895 staticpro (&Qlet);
896 Qif = intern_c_string ("if");
897 staticpro (&Qif);
898 Qwhen = intern_c_string ("when");
899 staticpro (&Qwhen);
900 Qletx = intern_c_string ("let*");
901 staticpro (&Qletx);
902 Qsave_excursion = intern_c_string ("save-excursion");
903 staticpro (&Qsave_excursion);
904 Qprogn = intern_c_string ("progn");
905 staticpro (&Qprogn);
907 Qminus = intern_c_string ("-");
908 staticpro (&Qminus);
910 Qplus = intern_c_string ("+");
911 staticpro (&Qplus);
913 Qhandle_shift_selection = intern_c_string ("handle-shift-selection");
914 staticpro (&Qhandle_shift_selection);
916 Qcall_interactively = intern_c_string ("call-interactively");
917 staticpro (&Qcall_interactively);
919 Qcommand_debug_status = intern_c_string ("command-debug-status");
920 staticpro (&Qcommand_debug_status);
922 Qenable_recursive_minibuffers = intern_c_string ("enable-recursive-minibuffers");
923 staticpro (&Qenable_recursive_minibuffers);
925 Qmouse_leave_buffer_hook = intern_c_string ("mouse-leave-buffer-hook");
926 staticpro (&Qmouse_leave_buffer_hook);
928 DEFVAR_KBOARD ("prefix-arg", Vprefix_arg,
929 doc: /* The value of the prefix argument for the next editing command.
930 It may be a number, or the symbol `-' for just a minus sign as arg,
931 or a list whose car is a number for just one or more C-u's
932 or nil if no argument has been specified.
934 You cannot examine this variable to find the argument for this command
935 since it has been set to nil by the time you can look.
936 Instead, you should use the variable `current-prefix-arg', although
937 normally commands can get this prefix argument with (interactive "P"). */);
939 DEFVAR_KBOARD ("last-prefix-arg", Vlast_prefix_arg,
940 doc: /* The value of the prefix argument for the previous editing command.
941 See `prefix-arg' for the meaning of the value. */);
943 DEFVAR_LISP ("current-prefix-arg", &Vcurrent_prefix_arg,
944 doc: /* The value of the prefix argument for this editing command.
945 It may be a number, or the symbol `-' for just a minus sign as arg,
946 or a list whose car is a number for just one or more C-u's
947 or nil if no argument has been specified.
948 This is what `(interactive \"P\")' returns. */);
949 Vcurrent_prefix_arg = Qnil;
951 DEFVAR_LISP ("command-history", &Vcommand_history,
952 doc: /* List of recent commands that read arguments from terminal.
953 Each command is represented as a form to evaluate.
955 Maximum length of the history list is determined by the value
956 of `history-length', which see. */);
957 Vcommand_history = Qnil;
959 DEFVAR_LISP ("command-debug-status", &Vcommand_debug_status,
960 doc: /* Debugging status of current interactive command.
961 Bound each time `call-interactively' is called;
962 may be set by the debugger as a reminder for itself. */);
963 Vcommand_debug_status = Qnil;
965 DEFVAR_LISP ("mark-even-if-inactive", &Vmark_even_if_inactive,
966 doc: /* *Non-nil means you can use the mark even when inactive.
967 This option makes a difference in Transient Mark mode.
968 When the option is non-nil, deactivation of the mark
969 turns off region highlighting, but commands that use the mark
970 behave as if the mark were still active. */);
971 Vmark_even_if_inactive = Qt;
973 DEFVAR_LISP ("mouse-leave-buffer-hook", &Vmouse_leave_buffer_hook,
974 doc: /* Hook to run when about to switch windows with a mouse command.
975 Its purpose is to give temporary modes such as Isearch mode
976 a way to turn themselves off when a mouse command switches windows. */);
977 Vmouse_leave_buffer_hook = Qnil;
979 defsubr (&Sinteractive);
980 defsubr (&Scall_interactively);
981 defsubr (&Sprefix_numeric_value);
984 /* arch-tag: a3a7cad7-bcac-42ce-916e-1bd2546ebf37
985 (do not change this comment) */