* xterm.c (x_fully_uncatch_errors, x_trace_wire, x_check_font): Convert old-style...
[emacs.git] / src / callint.c
blobfa0be112bea92f59ff7a7af87825290ff3f095b1
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 extern Lisp_Object Qcursor_in_echo_area;
33 extern Lisp_Object Qfile_directory_p;
34 extern Lisp_Object Qonly;
36 Lisp_Object Vcurrent_prefix_arg, Qminus, Qplus;
37 Lisp_Object Qcall_interactively;
38 Lisp_Object Vcommand_history;
40 extern Lisp_Object Vhistory_length;
41 extern Lisp_Object Vthis_original_command, real_this_command;
42 extern int history_delete_duplicates;
44 Lisp_Object Vcommand_debug_status, Qcommand_debug_status;
45 Lisp_Object Qenable_recursive_minibuffers;
46 extern Lisp_Object Qface, Qminibuffer_prompt;
48 /* Non-nil means treat the mark as active
49 even if mark_active is 0. */
50 Lisp_Object Vmark_even_if_inactive;
52 Lisp_Object Qhandle_shift_selection;
54 Lisp_Object Vmouse_leave_buffer_hook, Qmouse_leave_buffer_hook;
56 Lisp_Object Qlist, Qlet, Qletx, Qsave_excursion, Qprogn, Qif, Qwhen;
57 static Lisp_Object preserved_fns;
59 /* Marker used within call-interactively to refer to point. */
60 static Lisp_Object point_marker;
62 /* String for the prompt text used in Fcall_interactively. */
63 static Lisp_Object callint_message;
65 /* ARGSUSED */
66 DEFUN ("interactive", Finteractive, Sinteractive, 0, UNEVALLED, 0,
67 doc: /* Specify a way of parsing arguments for interactive use of a function.
68 For example, write
69 (defun foo (arg buf) "Doc string" (interactive "P\\nbbuffer: ") .... )
70 to make ARG be the raw prefix argument, and set BUF to an existing buffer,
71 when `foo' is called as a command.
72 The "call" to `interactive' is actually a declaration rather than a function;
73 it tells `call-interactively' how to read arguments
74 to pass to the function.
75 When actually called, `interactive' just returns nil.
77 Usually the argument of `interactive' is a string containing a code letter
78 followed optionally by a prompt. (Some code letters do not use I/O to get
79 the argument and do not use prompts.) To get several arguments, concatenate
80 the individual strings, separating them by newline characters.
81 Prompts are passed to format, and may use % escapes to print the
82 arguments that have already been read.
83 If the argument is not a string, it is evaluated to get a list of
84 arguments to pass to the function.
85 Just `(interactive)' means pass no args when calling interactively.
87 Code letters available are:
88 a -- Function name: symbol with a function definition.
89 b -- Name of existing buffer.
90 B -- Name of buffer, possibly nonexistent.
91 c -- Character (no input method is used).
92 C -- Command name: symbol with interactive function definition.
93 d -- Value of point as number. Does not do I/O.
94 D -- Directory name.
95 e -- Parametrized event (i.e., one that's a list) that invoked this command.
96 If used more than once, the Nth `e' returns the Nth parameterized event.
97 This skips events that are integers or symbols.
98 f -- Existing file name.
99 F -- Possibly nonexistent file name.
100 G -- Possibly nonexistent file name, defaulting to just directory 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 -- Numeric 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.
120 In addition, if the string begins with `*', an error is signaled if
121 the buffer is read-only.
122 If the string begins with `@', Emacs searches the key sequence which
123 invoked the command for its first mouse click (or any other event
124 which specifies a window).
125 If the string begins with `^' and `shift-select-mode' is non-nil,
126 Emacs first calls the function `handle-shift-selection'.
127 You may use `@', `*', and `^' together. They are processed in the
128 order that they appear, before reading any arguments.
129 usage: (interactive &optional 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 (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 (Lisp_Object exp)
151 register Lisp_Object tail;
152 Lisp_Object next;
153 for (tail = exp; CONSP (tail); tail = next)
155 next = XCDR (tail);
156 XSETCAR (tail, quotify_arg (XCAR (tail)));
158 return exp;
161 char *callint_argfuns[]
162 = {"", "point", "mark", "region-beginning", "region-end"};
164 static void
165 check_mark (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 (Lisp_Object input, Lisp_Object values)
188 if (CONSP (input))
190 Lisp_Object car;
192 car = XCAR (input);
193 /* Skip through certain special forms. */
194 while (EQ (car, Qlet) || EQ (car, Qletx)
195 || EQ (car, Qsave_excursion)
196 || EQ (car, Qprogn))
198 while (CONSP (XCDR (input)))
199 input = XCDR (input);
200 input = XCAR (input);
201 if (!CONSP (input))
202 break;
203 car = XCAR (input);
205 if (EQ (car, Qlist))
207 Lisp_Object intail, valtail;
208 for (intail = Fcdr (input), valtail = values;
209 CONSP (valtail);
210 intail = Fcdr (intail), valtail = XCDR (valtail))
212 Lisp_Object elt;
213 elt = Fcar (intail);
214 if (CONSP (elt))
216 Lisp_Object presflag, carelt;
217 carelt = Fcar (elt);
218 /* If it is (if X Y), look at Y. */
219 if (EQ (carelt, Qif)
220 && EQ (Fnthcdr (make_number (3), elt), Qnil))
221 elt = Fnth (make_number (2), elt);
222 /* If it is (when ... Y), look at Y. */
223 else if (EQ (carelt, Qwhen))
225 while (CONSP (XCDR (elt)))
226 elt = XCDR (elt);
227 elt = Fcar (elt);
230 /* If the function call we're looking at
231 is a special preserved one, copy the
232 whole expression for this argument. */
233 if (CONSP (elt))
235 presflag = Fmemq (Fcar (elt), preserved_fns);
236 if (!NILP (presflag))
237 Fsetcar (valtail, Fcar (intail));
245 DEFUN ("call-interactively", Fcall_interactively, Scall_interactively, 1, 3, 0,
246 doc: /* Call FUNCTION, reading args according to its interactive calling specs.
247 Return the value FUNCTION returns.
248 The function contains a specification of how to do the argument reading.
249 In the case of user-defined functions, this is specified by placing a call
250 to the function `interactive' at the top level of the function body.
251 See `interactive'.
253 Optional second arg RECORD-FLAG non-nil
254 means unconditionally put this command in the command-history.
255 Otherwise, this is done only if an arg is read using the minibuffer.
257 Optional third arg KEYS, if given, specifies the sequence of events to
258 supply, as a vector, if the command inquires which events were used to
259 invoke it. If KEYS is omitted or nil, the return value of
260 `this-command-keys-vector' is used. */)
261 (Lisp_Object function, Lisp_Object record_flag, Lisp_Object keys)
263 Lisp_Object *args, *visargs;
264 Lisp_Object specs;
265 Lisp_Object filter_specs;
266 Lisp_Object teml;
267 Lisp_Object up_event;
268 Lisp_Object enable;
269 int speccount = SPECPDL_INDEX ();
271 /* The index of the next element of this_command_keys to examine for
272 the 'e' interactive code. */
273 int next_event;
275 Lisp_Object prefix_arg;
276 unsigned char *string;
277 unsigned char *tem;
279 /* If varies[i] > 0, the i'th argument shouldn't just have its value
280 in this call quoted in the command history. It should be
281 recorded as a call to the function named callint_argfuns[varies[i]]. */
282 int *varies;
284 register int i, j;
285 int count, foo;
286 char prompt1[100];
287 char *tem1;
288 int arg_from_tty = 0;
289 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
290 int key_count;
291 int record_then_fail = 0;
293 Lisp_Object save_this_command, save_last_command;
294 Lisp_Object save_this_original_command, save_real_this_command;
296 save_this_command = Vthis_command;
297 save_this_original_command = Vthis_original_command;
298 save_real_this_command = real_this_command;
299 save_last_command = current_kboard->Vlast_command;
301 if (NILP (keys))
302 keys = this_command_keys, key_count = this_command_key_count;
303 else
305 CHECK_VECTOR (keys);
306 key_count = XVECTOR (keys)->size;
309 /* Save this now, since use of minibuffer will clobber it. */
310 prefix_arg = Vcurrent_prefix_arg;
312 if (SYMBOLP (function))
313 enable = Fget (function, Qenable_recursive_minibuffers);
314 else
315 enable = Qnil;
317 specs = Qnil;
318 string = 0;
319 /* The idea of FILTER_SPECS is to provide away to
320 specify how to represent the arguments in command history.
321 The feature is not fully implemented. */
322 filter_specs = Qnil;
324 /* If k or K discard an up-event, save it here so it can be retrieved with U */
325 up_event = Qnil;
327 /* Set SPECS to the interactive form, or barf if not interactive. */
329 Lisp_Object form;
330 GCPRO2 (function, prefix_arg);
331 form = Finteractive_form (function);
332 UNGCPRO;
333 if (CONSP (form))
334 specs = filter_specs = Fcar (XCDR (form));
335 else
336 wrong_type_argument (Qcommandp, function);
339 /* If SPECS is set to a string, use it as an interactive prompt. */
340 if (STRINGP (specs))
342 /* Make a copy of string so that if a GC relocates specs,
343 `string' will still be valid. */
344 string = (unsigned char *) alloca (SBYTES (specs) + 1);
345 memcpy (string, SDATA (specs), SBYTES (specs) + 1);
347 else
349 Lisp_Object input;
350 i = num_input_events;
351 input = specs;
352 /* Compute the arg values using the user's expression. */
353 GCPRO2 (input, filter_specs);
354 specs = Feval (specs);
355 UNGCPRO;
356 if (i != num_input_events || !NILP (record_flag))
358 /* We should record this command on the command history. */
359 Lisp_Object values;
360 Lisp_Object this_cmd;
361 /* Make a copy of the list of values, for the command history,
362 and turn them into things we can eval. */
363 values = quotify_args (Fcopy_sequence (specs));
364 fix_command (input, values);
365 this_cmd = Fcons (function, values);
366 if (history_delete_duplicates)
367 Vcommand_history = Fdelete (this_cmd, Vcommand_history);
368 Vcommand_history = Fcons (this_cmd, Vcommand_history);
370 /* Don't keep command history around forever. */
371 if (INTEGERP (Vhistory_length) && XINT (Vhistory_length) > 0)
373 teml = Fnthcdr (Vhistory_length, Vcommand_history);
374 if (CONSP (teml))
375 XSETCDR (teml, Qnil);
379 Vthis_command = save_this_command;
380 Vthis_original_command = save_this_original_command;
381 real_this_command= save_real_this_command;
382 current_kboard->Vlast_command = save_last_command;
384 temporarily_switch_to_single_kboard (NULL);
385 return unbind_to (speccount, apply1 (function, specs));
388 /* Here if function specifies a string to control parsing the defaults */
390 /* Set next_event to point to the first event with parameters. */
391 for (next_event = 0; next_event < key_count; next_event++)
392 if (EVENT_HAS_PARAMETERS (AREF (keys, next_event)))
393 break;
395 /* Handle special starting chars `*' and `@'. Also `-'. */
396 /* Note that `+' is reserved for user extensions. */
397 while (1)
399 if (*string == '+')
400 error ("`+' is not used in `interactive' for ordinary commands");
401 else if (*string == '*')
403 string++;
404 if (!NILP (current_buffer->read_only))
406 if (!NILP (record_flag))
408 unsigned char *p = string;
409 while (*p)
411 if (! (*p == 'r' || *p == 'p' || *p == 'P'
412 || *p == '\n'))
413 Fbarf_if_buffer_read_only ();
414 p++;
416 record_then_fail = 1;
418 else
419 Fbarf_if_buffer_read_only ();
422 /* Ignore this for semi-compatibility with Lucid. */
423 else if (*string == '-')
424 string++;
425 else if (*string == '@')
427 Lisp_Object event, tem;
429 event = (next_event < key_count
430 ? AREF (keys, next_event)
431 : Qnil);
432 if (EVENT_HAS_PARAMETERS (event)
433 && (tem = XCDR (event), CONSP (tem))
434 && (tem = XCAR (tem), CONSP (tem))
435 && (tem = XCAR (tem), WINDOWP (tem)))
437 if (MINI_WINDOW_P (XWINDOW (tem))
438 && ! (minibuf_level > 0 && EQ (tem, minibuf_window)))
439 error ("Attempt to select inactive minibuffer window");
441 /* If the current buffer wants to clean up, let it. */
442 if (!NILP (Vmouse_leave_buffer_hook))
443 call1 (Vrun_hooks, Qmouse_leave_buffer_hook);
445 Fselect_window (tem, Qnil);
447 string++;
449 else if (*string == '^')
451 call0 (Qhandle_shift_selection);
452 string++;
454 else break;
457 /* Count the number of arguments the interactive spec would have
458 us give to the function. */
459 tem = string;
460 for (j = 0; *tem;)
462 /* 'r' specifications ("point and mark as 2 numeric args")
463 produce *two* arguments. */
464 if (*tem == 'r')
465 j += 2;
466 else
467 j++;
468 tem = (unsigned char *) strchr (tem, '\n');
469 if (tem)
470 ++tem;
471 else
472 break;
474 count = j;
476 args = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object));
477 visargs = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object));
478 varies = (int *) alloca ((count + 1) * sizeof (int));
480 for (i = 0; i < (count + 1); i++)
482 args[i] = Qnil;
483 visargs[i] = Qnil;
484 varies[i] = 0;
487 GCPRO5 (prefix_arg, function, *args, *visargs, up_event);
488 gcpro3.nvars = (count + 1);
489 gcpro4.nvars = (count + 1);
491 if (!NILP (enable))
492 specbind (Qenable_recursive_minibuffers, Qt);
494 tem = string;
495 for (i = 1; *tem; i++)
497 strncpy (prompt1, tem + 1, sizeof prompt1 - 1);
498 prompt1[sizeof prompt1 - 1] = 0;
499 tem1 = strchr (prompt1, '\n');
500 if (tem1) *tem1 = 0;
502 visargs[0] = build_string (prompt1);
503 if (strchr (prompt1, '%'))
504 callint_message = Fformat (i, visargs);
505 else
506 callint_message = visargs[0];
508 switch (*tem)
510 case 'a': /* Symbol defined as a function */
511 visargs[i] = Fcompleting_read (callint_message,
512 Vobarray, Qfboundp, Qt,
513 Qnil, Qnil, Qnil, Qnil);
514 /* Passing args[i] directly stimulates compiler bug */
515 teml = visargs[i];
516 args[i] = Fintern (teml, Qnil);
517 break;
519 case 'b': /* Name of existing buffer */
520 args[i] = Fcurrent_buffer ();
521 if (EQ (selected_window, minibuf_window))
522 args[i] = Fother_buffer (args[i], Qnil, Qnil);
523 args[i] = Fread_buffer (callint_message, args[i], Qt);
524 break;
526 case 'B': /* Name of buffer, possibly nonexistent */
527 args[i] = Fread_buffer (callint_message,
528 Fother_buffer (Fcurrent_buffer (), Qnil, Qnil),
529 Qnil);
530 break;
532 case 'c': /* Character */
533 /* Prompt in `minibuffer-prompt' face. */
534 Fput_text_property (make_number (0),
535 make_number (SCHARS (callint_message)),
536 Qface, Qminibuffer_prompt, callint_message);
537 args[i] = Fread_char (callint_message, Qnil, Qnil);
538 message1_nolog ((char *) 0);
539 /* Passing args[i] directly stimulates compiler bug */
540 teml = args[i];
541 visargs[i] = Fchar_to_string (teml);
542 break;
544 case 'C': /* Command: symbol with interactive function */
545 visargs[i] = Fcompleting_read (callint_message,
546 Vobarray, Qcommandp,
547 Qt, Qnil, Qnil, Qnil, Qnil);
548 /* Passing args[i] directly stimulates compiler bug */
549 teml = visargs[i];
550 args[i] = Fintern (teml, Qnil);
551 break;
553 case 'd': /* Value of point. Does not do I/O. */
554 set_marker_both (point_marker, Qnil, PT, PT_BYTE);
555 args[i] = point_marker;
556 /* visargs[i] = Qnil; */
557 varies[i] = 1;
558 break;
560 case 'D': /* Directory name. */
561 args[i] = Fread_file_name (callint_message, Qnil,
562 current_buffer->directory, Qlambda, Qnil,
563 Qfile_directory_p);
564 break;
566 case 'f': /* Existing file name. */
567 args[i] = Fread_file_name (callint_message,
568 Qnil, Qnil, Qlambda, Qnil, Qnil);
569 break;
571 case 'F': /* Possibly nonexistent file name. */
572 args[i] = Fread_file_name (callint_message,
573 Qnil, Qnil, Qnil, Qnil, Qnil);
574 break;
576 case 'G': /* Possibly nonexistent file name,
577 default to directory alone. */
578 args[i] = Fread_file_name (callint_message,
579 Qnil, Qnil, Qnil, empty_unibyte_string, Qnil);
580 break;
582 case 'i': /* Ignore an argument -- Does not do I/O */
583 varies[i] = -1;
584 break;
586 case 'k': /* Key sequence. */
588 int speccount1 = SPECPDL_INDEX ();
589 specbind (Qcursor_in_echo_area, Qt);
590 /* Prompt in `minibuffer-prompt' face. */
591 Fput_text_property (make_number (0),
592 make_number (SCHARS (callint_message)),
593 Qface, Qminibuffer_prompt, callint_message);
594 args[i] = Fread_key_sequence (callint_message,
595 Qnil, Qnil, Qnil, Qnil);
596 unbind_to (speccount1, Qnil);
597 teml = args[i];
598 visargs[i] = Fkey_description (teml, Qnil);
600 /* If the key sequence ends with a down-event,
601 discard the following up-event. */
602 teml = Faref (args[i], make_number (XINT (Flength (args[i])) - 1));
603 if (CONSP (teml))
604 teml = XCAR (teml);
605 if (SYMBOLP (teml))
607 Lisp_Object tem2;
609 teml = Fget (teml, intern ("event-symbol-elements"));
610 /* Ignore first element, which is the base key. */
611 tem2 = Fmemq (intern ("down"), Fcdr (teml));
612 if (! NILP (tem2))
613 up_event = Fread_event (Qnil, Qnil, Qnil);
616 break;
618 case 'K': /* Key sequence to be defined. */
620 int speccount1 = SPECPDL_INDEX ();
621 specbind (Qcursor_in_echo_area, Qt);
622 /* Prompt in `minibuffer-prompt' face. */
623 Fput_text_property (make_number (0),
624 make_number (SCHARS (callint_message)),
625 Qface, Qminibuffer_prompt, callint_message);
626 args[i] = Fread_key_sequence (callint_message,
627 Qnil, Qt, Qnil, Qnil);
628 teml = args[i];
629 visargs[i] = Fkey_description (teml, Qnil);
630 unbind_to (speccount1, Qnil);
632 /* If the key sequence ends with a down-event,
633 discard the following up-event. */
634 teml = Faref (args[i], make_number (XINT (Flength (args[i])) - 1));
635 if (CONSP (teml))
636 teml = XCAR (teml);
637 if (SYMBOLP (teml))
639 Lisp_Object tem2;
641 teml = Fget (teml, intern ("event-symbol-elements"));
642 /* Ignore first element, which is the base key. */
643 tem2 = Fmemq (intern ("down"), Fcdr (teml));
644 if (! NILP (tem2))
645 up_event = Fread_event (Qnil, Qnil, Qnil);
648 break;
650 case 'U': /* Up event from last k or K */
651 if (!NILP (up_event))
653 args[i] = Fmake_vector (make_number (1), up_event);
654 up_event = Qnil;
655 teml = args[i];
656 visargs[i] = Fkey_description (teml, Qnil);
658 break;
660 case 'e': /* The invoking event. */
661 if (next_event >= key_count)
662 error ("%s must be bound to an event with parameters",
663 (SYMBOLP (function)
664 ? (char *) SDATA (SYMBOL_NAME (function))
665 : "command"));
666 args[i] = AREF (keys, next_event);
667 next_event++;
668 varies[i] = -1;
670 /* Find the next parameterized event. */
671 while (next_event < key_count
672 && !(EVENT_HAS_PARAMETERS (AREF (keys, next_event))))
673 next_event++;
675 break;
677 case 'm': /* Value of mark. Does not do I/O. */
678 check_mark (0);
679 /* visargs[i] = Qnil; */
680 args[i] = current_buffer->mark;
681 varies[i] = 2;
682 break;
684 case 'M': /* String read via minibuffer with
685 inheriting the current input method. */
686 args[i] = Fread_string (callint_message,
687 Qnil, Qnil, Qnil, Qt);
688 break;
690 case 'N': /* Prefix arg as number, else number from minibuffer */
691 if (!NILP (prefix_arg))
692 goto have_prefix_arg;
693 case 'n': /* Read number from minibuffer. */
695 int first = 1;
698 Lisp_Object tem;
699 if (! first)
701 message ("Please enter a number.");
702 sit_for (make_number (1), 0, 0);
704 first = 0;
706 tem = Fread_from_minibuffer (callint_message,
707 Qnil, Qnil, Qnil, Qnil, Qnil,
708 Qnil);
709 if (! STRINGP (tem) || SCHARS (tem) == 0)
710 args[i] = Qnil;
711 else
712 args[i] = Fread (tem);
714 while (! NUMBERP (args[i]));
716 visargs[i] = args[i];
717 break;
719 case 'P': /* Prefix arg in raw form. Does no I/O. */
720 args[i] = prefix_arg;
721 /* visargs[i] = Qnil; */
722 varies[i] = -1;
723 break;
725 case 'p': /* Prefix arg converted to number. No I/O. */
726 have_prefix_arg:
727 args[i] = Fprefix_numeric_value (prefix_arg);
728 /* visargs[i] = Qnil; */
729 varies[i] = -1;
730 break;
732 case 'r': /* Region, point and mark as 2 args. */
733 check_mark (1);
734 set_marker_both (point_marker, Qnil, PT, PT_BYTE);
735 /* visargs[i+1] = Qnil; */
736 foo = marker_position (current_buffer->mark);
737 /* visargs[i] = Qnil; */
738 args[i] = PT < foo ? point_marker : current_buffer->mark;
739 varies[i] = 3;
740 args[++i] = PT > foo ? point_marker : current_buffer->mark;
741 varies[i] = 4;
742 break;
744 case 's': /* String read via minibuffer without
745 inheriting the current input method. */
746 args[i] = Fread_string (callint_message,
747 Qnil, Qnil, Qnil, Qnil);
748 break;
750 case 'S': /* Any symbol. */
751 visargs[i] = Fread_string (callint_message,
752 Qnil, Qnil, Qnil, Qnil);
753 /* Passing args[i] directly stimulates compiler bug */
754 teml = visargs[i];
755 args[i] = Fintern (teml, Qnil);
756 break;
758 case 'v': /* Variable name: symbol that is
759 user-variable-p. */
760 args[i] = Fread_variable (callint_message, Qnil);
761 visargs[i] = last_minibuf_string;
762 break;
764 case 'x': /* Lisp expression read but not evaluated */
765 args[i] = Fread_minibuffer (callint_message, Qnil);
766 visargs[i] = last_minibuf_string;
767 break;
769 case 'X': /* Lisp expression read and evaluated */
770 args[i] = Feval_minibuffer (callint_message, Qnil);
771 visargs[i] = last_minibuf_string;
772 break;
774 case 'Z': /* Coding-system symbol, or ignore the
775 argument if no prefix */
776 if (NILP (prefix_arg))
778 args[i] = Qnil;
779 varies[i] = -1;
781 else
783 args[i]
784 = Fread_non_nil_coding_system (callint_message);
785 visargs[i] = last_minibuf_string;
787 break;
789 case 'z': /* Coding-system symbol or nil */
790 args[i] = Fread_coding_system (callint_message, Qnil);
791 visargs[i] = last_minibuf_string;
792 break;
794 /* We have a case for `+' so we get an error
795 if anyone tries to define one here. */
796 case '+':
797 default:
798 error ("Invalid control letter `%c' (%03o) in interactive calling string",
799 *tem, *tem);
802 if (varies[i] == 0)
803 arg_from_tty = 1;
805 if (NILP (visargs[i]) && STRINGP (args[i]))
806 visargs[i] = args[i];
808 tem = (unsigned char *) strchr (tem, '\n');
809 if (tem) tem++;
810 else tem = (unsigned char *) "";
812 unbind_to (speccount, Qnil);
814 QUIT;
816 args[0] = function;
818 if (arg_from_tty || !NILP (record_flag))
820 visargs[0] = function;
821 for (i = 1; i < count + 1; i++)
823 if (varies[i] > 0)
824 visargs[i] = Fcons (intern (callint_argfuns[varies[i]]), Qnil);
825 else
826 visargs[i] = quotify_arg (args[i]);
828 Vcommand_history = Fcons (Flist (count + 1, visargs),
829 Vcommand_history);
830 /* Don't keep command history around forever. */
831 if (INTEGERP (Vhistory_length) && XINT (Vhistory_length) > 0)
833 teml = Fnthcdr (Vhistory_length, Vcommand_history);
834 if (CONSP (teml))
835 XSETCDR (teml, Qnil);
839 /* If we used a marker to hold point, mark, or an end of the region,
840 temporarily, convert it to an integer now. */
841 for (i = 1; i <= count; i++)
842 if (varies[i] >= 1 && varies[i] <= 4)
843 XSETINT (args[i], marker_position (args[i]));
845 if (record_then_fail)
846 Fbarf_if_buffer_read_only ();
848 Vthis_command = save_this_command;
849 Vthis_original_command = save_this_original_command;
850 real_this_command= save_real_this_command;
851 current_kboard->Vlast_command = save_last_command;
854 Lisp_Object val;
855 specbind (Qcommand_debug_status, Qnil);
857 temporarily_switch_to_single_kboard (NULL);
858 val = Ffuncall (count + 1, args);
859 UNGCPRO;
860 return unbind_to (speccount, val);
864 DEFUN ("prefix-numeric-value", Fprefix_numeric_value, Sprefix_numeric_value,
865 1, 1, 0,
866 doc: /* Return numeric meaning of raw prefix argument RAW.
867 A raw prefix argument is what you get from `(interactive "P")'.
868 Its numeric meaning is what you would get from `(interactive "p")'. */)
869 (Lisp_Object raw)
871 Lisp_Object val;
873 if (NILP (raw))
874 XSETFASTINT (val, 1);
875 else if (EQ (raw, Qminus))
876 XSETINT (val, -1);
877 else if (CONSP (raw) && INTEGERP (XCAR (raw)))
878 XSETINT (val, XINT (XCAR (raw)));
879 else if (INTEGERP (raw))
880 val = raw;
881 else
882 XSETFASTINT (val, 1);
884 return val;
887 void
888 syms_of_callint (void)
890 point_marker = Fmake_marker ();
891 staticpro (&point_marker);
893 callint_message = Qnil;
894 staticpro (&callint_message);
896 preserved_fns = pure_cons (intern_c_string ("region-beginning"),
897 pure_cons (intern_c_string ("region-end"),
898 pure_cons (intern_c_string ("point"),
899 pure_cons (intern_c_string ("mark"), Qnil))));
901 Qlist = intern_c_string ("list");
902 staticpro (&Qlist);
903 Qlet = intern_c_string ("let");
904 staticpro (&Qlet);
905 Qif = intern_c_string ("if");
906 staticpro (&Qif);
907 Qwhen = intern_c_string ("when");
908 staticpro (&Qwhen);
909 Qletx = intern_c_string ("let*");
910 staticpro (&Qletx);
911 Qsave_excursion = intern_c_string ("save-excursion");
912 staticpro (&Qsave_excursion);
913 Qprogn = intern_c_string ("progn");
914 staticpro (&Qprogn);
916 Qminus = intern_c_string ("-");
917 staticpro (&Qminus);
919 Qplus = intern_c_string ("+");
920 staticpro (&Qplus);
922 Qhandle_shift_selection = intern_c_string ("handle-shift-selection");
923 staticpro (&Qhandle_shift_selection);
925 Qcall_interactively = intern_c_string ("call-interactively");
926 staticpro (&Qcall_interactively);
928 Qcommand_debug_status = intern_c_string ("command-debug-status");
929 staticpro (&Qcommand_debug_status);
931 Qenable_recursive_minibuffers = intern_c_string ("enable-recursive-minibuffers");
932 staticpro (&Qenable_recursive_minibuffers);
934 Qmouse_leave_buffer_hook = intern_c_string ("mouse-leave-buffer-hook");
935 staticpro (&Qmouse_leave_buffer_hook);
937 DEFVAR_KBOARD ("prefix-arg", Vprefix_arg,
938 doc: /* The value of the prefix argument for the next editing command.
939 It may be a number, or the symbol `-' for just a minus sign as arg,
940 or a list whose car is a number for just one or more C-u's
941 or nil if no argument has been specified.
943 You cannot examine this variable to find the argument for this command
944 since it has been set to nil by the time you can look.
945 Instead, you should use the variable `current-prefix-arg', although
946 normally commands can get this prefix argument with (interactive "P"). */);
948 DEFVAR_KBOARD ("last-prefix-arg", Vlast_prefix_arg,
949 doc: /* The value of the prefix argument for the previous editing command.
950 See `prefix-arg' for the meaning of the value. */);
952 DEFVAR_LISP ("current-prefix-arg", &Vcurrent_prefix_arg,
953 doc: /* The value of the prefix argument for this editing command.
954 It may be a number, or the symbol `-' for just a minus sign as arg,
955 or a list whose car is a number for just one or more C-u's
956 or nil if no argument has been specified.
957 This is what `(interactive \"P\")' returns. */);
958 Vcurrent_prefix_arg = Qnil;
960 DEFVAR_LISP ("command-history", &Vcommand_history,
961 doc: /* List of recent commands that read arguments from terminal.
962 Each command is represented as a form to evaluate.
964 Maximum length of the history list is determined by the value
965 of `history-length', which see. */);
966 Vcommand_history = Qnil;
968 DEFVAR_LISP ("command-debug-status", &Vcommand_debug_status,
969 doc: /* Debugging status of current interactive command.
970 Bound each time `call-interactively' is called;
971 may be set by the debugger as a reminder for itself. */);
972 Vcommand_debug_status = Qnil;
974 DEFVAR_LISP ("mark-even-if-inactive", &Vmark_even_if_inactive,
975 doc: /* *Non-nil means you can use the mark even when inactive.
976 This option makes a difference in Transient Mark mode.
977 When the option is non-nil, deactivation of the mark
978 turns off region highlighting, but commands that use the mark
979 behave as if the mark were still active. */);
980 Vmark_even_if_inactive = Qt;
982 DEFVAR_LISP ("mouse-leave-buffer-hook", &Vmouse_leave_buffer_hook,
983 doc: /* Hook to run when about to switch windows with a mouse command.
984 Its purpose is to give temporary modes such as Isearch mode
985 a way to turn themselves off when a mouse command switches windows. */);
986 Vmouse_leave_buffer_hook = Qnil;
988 defsubr (&Sinteractive);
989 defsubr (&Scall_interactively);
990 defsubr (&Sprefix_numeric_value);
993 /* arch-tag: a3a7cad7-bcac-42ce-916e-1bd2546ebf37
994 (do not change this comment) */