Remove resolved GTK on Cygwin problem.
[emacs.git] / src / callint.c
blob371dd55dec9cea372b8c7d0a9d35eee22cca141b
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
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 #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;
38 extern Lisp_Object Qonly;
40 Lisp_Object Vcurrent_prefix_arg, Qminus, Qplus;
41 Lisp_Object Qcall_interactively;
42 Lisp_Object Vcommand_history;
44 extern Lisp_Object Vhistory_length;
45 extern Lisp_Object Vthis_original_command, real_this_command;
46 extern int history_delete_duplicates;
48 Lisp_Object Vcommand_debug_status, Qcommand_debug_status;
49 Lisp_Object Qenable_recursive_minibuffers;
50 extern Lisp_Object Qface, Qminibuffer_prompt;
52 /* Non-nil means treat the mark as active
53 even if mark_active is 0. */
54 Lisp_Object Vmark_even_if_inactive;
56 Lisp_Object Qhandle_shift_selection;
58 Lisp_Object Vmouse_leave_buffer_hook, Qmouse_leave_buffer_hook;
60 Lisp_Object Qlist, Qlet, Qletx, Qsave_excursion, Qprogn, Qif, Qwhen;
61 static Lisp_Object preserved_fns;
63 /* Marker used within call-interactively to refer to point. */
64 static Lisp_Object point_marker;
66 /* String for the prompt text used in Fcall_interactively. */
67 static Lisp_Object callint_message;
69 /* ARGSUSED */
70 DEFUN ("interactive", Finteractive, Sinteractive, 0, UNEVALLED, 0,
71 doc: /* Specify a way of parsing arguments for interactive use of a function.
72 For example, write
73 (defun foo (arg buf) "Doc string" (interactive "P\\nbbuffer: ") .... )
74 to make ARG be the raw prefix argument, and set BUF to an existing buffer,
75 when `foo' is called as a command.
76 The "call" to `interactive' is actually a declaration rather than a function;
77 it tells `call-interactively' how to read arguments
78 to pass to the function.
79 When actually called, `interactive' just returns nil.
81 Usually the argument of `interactive' is a string containing a code letter
82 followed optionally by a prompt. (Some code letters do not use I/O to get
83 the argument and do not use prompts.) To get several arguments, concatenate
84 the individual strings, separating them by newline characters.
85 Prompts are passed to format, and may use % escapes to print the
86 arguments that have already been read.
87 If the argument is not a string, it is evaluated to get a list of
88 arguments to pass to the function.
89 Just `(interactive)' means pass no args when calling interactively.
91 Code letters available are:
92 a -- Function name: symbol with a function definition.
93 b -- Name of existing buffer.
94 B -- Name of buffer, possibly nonexistent.
95 c -- Character (no input method is used).
96 C -- Command name: symbol with interactive function definition.
97 d -- Value of point as number. Does not do I/O.
98 D -- Directory name.
99 e -- Parametrized event (i.e., one that's a list) that invoked this command.
100 If used more than once, the Nth `e' returns the Nth parameterized event.
101 This skips events that are integers or symbols.
102 f -- Existing file name.
103 F -- Possibly nonexistent file name.
104 G -- Possibly nonexistent file name, defaulting to just directory name.
105 i -- Ignored, i.e. always nil. Does not do I/O.
106 k -- Key sequence (downcase the last event if needed to get a definition).
107 K -- Key sequence to be redefined (do not downcase the last event).
108 m -- Value of mark as number. Does not do I/O.
109 M -- Any string. Inherits the current input method.
110 n -- Number read using minibuffer.
111 N -- Numeric prefix arg, or if none, do like code `n'.
112 p -- Prefix arg converted to number. Does not do I/O.
113 P -- Prefix arg in raw form. Does not do I/O.
114 r -- Region: point and mark as 2 numeric args, smallest first. Does no I/O.
115 s -- Any string. Does not inherit the current input method.
116 S -- Any symbol.
117 U -- Mouse up event discarded by a previous k or K argument.
118 v -- Variable name: symbol that is user-variable-p.
119 x -- Lisp expression read but not evaluated.
120 X -- Lisp expression read and evaluated.
121 z -- Coding system.
122 Z -- Coding system, nil if no prefix arg.
124 In addition, if the string begins with `*', an error is signaled if
125 the buffer is read-only.
126 If the string begins with `@', Emacs searches the key sequence which
127 invoked the command for its first mouse click (or any other event
128 which specifies a window).
129 If the string begins with `^' and `shift-select-mode' is non-nil,
130 Emacs first calls the function `handle-shift-select'.
131 You may use `@', `*', and `^' together. They are processed in the
132 order that they appear, before reading any arguments.
133 usage: (interactive &optional ARGS) */)
134 (args)
135 Lisp_Object args;
137 return Qnil;
140 /* Quotify EXP: if EXP is constant, return it.
141 If EXP is not constant, return (quote EXP). */
142 Lisp_Object
143 quotify_arg (exp)
144 register Lisp_Object exp;
146 if (!INTEGERP (exp) && !STRINGP (exp)
147 && !NILP (exp) && !EQ (exp, Qt))
148 return Fcons (Qquote, Fcons (exp, Qnil));
150 return exp;
153 /* Modify EXP by quotifying each element (except the first). */
154 Lisp_Object
155 quotify_args (exp)
156 Lisp_Object exp;
158 register Lisp_Object tail;
159 Lisp_Object next;
160 for (tail = exp; CONSP (tail); tail = next)
162 next = XCDR (tail);
163 XSETCAR (tail, quotify_arg (XCAR (tail)));
165 return exp;
168 char *callint_argfuns[]
169 = {"", "point", "mark", "region-beginning", "region-end"};
171 static void
172 check_mark (for_region)
173 int for_region;
175 Lisp_Object tem;
176 tem = Fmarker_buffer (current_buffer->mark);
177 if (NILP (tem) || (XBUFFER (tem) != current_buffer))
178 error (for_region ? "The mark is not set now, so there is no region"
179 : "The mark is not set now");
180 if (!NILP (Vtransient_mark_mode) && NILP (Vmark_even_if_inactive)
181 && NILP (current_buffer->mark_active))
182 xsignal0 (Qmark_inactive);
185 /* If the list of args INPUT was produced with an explicit call to
186 `list', look for elements that were computed with
187 (region-beginning) or (region-end), and put those expressions into
188 VALUES instead of the present values.
190 This function doesn't return a value because it modifies elements
191 of VALUES to do its job. */
193 static void
194 fix_command (input, values)
195 Lisp_Object input, values;
197 if (CONSP (input))
199 Lisp_Object car;
201 car = XCAR (input);
202 /* Skip through certain special forms. */
203 while (EQ (car, Qlet) || EQ (car, Qletx)
204 || EQ (car, Qsave_excursion)
205 || EQ (car, Qprogn))
207 while (CONSP (XCDR (input)))
208 input = XCDR (input);
209 input = XCAR (input);
210 if (!CONSP (input))
211 break;
212 car = XCAR (input);
214 if (EQ (car, Qlist))
216 Lisp_Object intail, valtail;
217 for (intail = Fcdr (input), valtail = values;
218 CONSP (valtail);
219 intail = Fcdr (intail), valtail = XCDR (valtail))
221 Lisp_Object elt;
222 elt = Fcar (intail);
223 if (CONSP (elt))
225 Lisp_Object presflag, carelt;
226 carelt = Fcar (elt);
227 /* If it is (if X Y), look at Y. */
228 if (EQ (carelt, Qif)
229 && EQ (Fnthcdr (make_number (3), elt), Qnil))
230 elt = Fnth (make_number (2), elt);
231 /* If it is (when ... Y), look at Y. */
232 else if (EQ (carelt, Qwhen))
234 while (CONSP (XCDR (elt)))
235 elt = XCDR (elt);
236 elt = Fcar (elt);
239 /* If the function call we're looking at
240 is a special preserved one, copy the
241 whole expression for this argument. */
242 if (CONSP (elt))
244 presflag = Fmemq (Fcar (elt), preserved_fns);
245 if (!NILP (presflag))
246 Fsetcar (valtail, Fcar (intail));
254 DEFUN ("call-interactively", Fcall_interactively, Scall_interactively, 1, 3, 0,
255 doc: /* Call FUNCTION, reading args according to its interactive calling specs.
256 Return the value FUNCTION returns.
257 The function contains a specification of how to do the argument reading.
258 In the case of user-defined functions, this is specified by placing a call
259 to the function `interactive' at the top level of the function body.
260 See `interactive'.
262 Optional second arg RECORD-FLAG non-nil
263 means unconditionally put this command in the command-history.
264 Otherwise, this is done only if an arg is read using the minibuffer.
266 Optional third arg KEYS, if given, specifies the sequence of events to
267 supply, as a vector, if the command inquires which events were used to
268 invoke it. If KEYS is omitted or nil, the return value of
269 `this-command-keys-vector' is used. */)
270 (function, record_flag, keys)
271 Lisp_Object function, record_flag, keys;
273 Lisp_Object *args, *visargs;
274 Lisp_Object specs;
275 Lisp_Object filter_specs;
276 Lisp_Object teml;
277 Lisp_Object up_event;
278 Lisp_Object enable;
279 int speccount = SPECPDL_INDEX ();
281 /* The index of the next element of this_command_keys to examine for
282 the 'e' interactive code. */
283 int next_event;
285 Lisp_Object prefix_arg;
286 unsigned char *string;
287 unsigned char *tem;
289 /* If varies[i] > 0, the i'th argument shouldn't just have its value
290 in this call quoted in the command history. It should be
291 recorded as a call to the function named callint_argfuns[varies[i]]. */
292 int *varies;
294 register int i, j;
295 int count, foo;
296 char prompt1[100];
297 char *tem1;
298 int arg_from_tty = 0;
299 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
300 int key_count;
301 int record_then_fail = 0;
303 Lisp_Object save_this_command, save_last_command;
304 Lisp_Object save_this_original_command, save_real_this_command;
306 save_this_command = Vthis_command;
307 save_this_original_command = Vthis_original_command;
308 save_real_this_command = real_this_command;
309 save_last_command = current_kboard->Vlast_command;
311 if (NILP (keys))
312 keys = this_command_keys, key_count = this_command_key_count;
313 else
315 CHECK_VECTOR (keys);
316 key_count = XVECTOR (keys)->size;
319 /* Save this now, since use of minibuffer will clobber it. */
320 prefix_arg = Vcurrent_prefix_arg;
322 if (SYMBOLP (function))
323 enable = Fget (function, Qenable_recursive_minibuffers);
324 else
325 enable = Qnil;
327 specs = Qnil;
328 string = 0;
329 /* The idea of FILTER_SPECS is to provide away to
330 specify how to represent the arguments in command history.
331 The feature is not fully implemented. */
332 filter_specs = Qnil;
334 /* If k or K discard an up-event, save it here so it can be retrieved with U */
335 up_event = Qnil;
337 /* Set SPECS to the interactive form, or barf if not interactive. */
339 Lisp_Object form;
340 GCPRO2 (function, prefix_arg);
341 form = Finteractive_form (function);
342 UNGCPRO;
343 if (CONSP (form))
344 specs = filter_specs = Fcar (XCDR (form));
345 else
346 wrong_type_argument (Qcommandp, function);
349 /* If SPECS is set to a string, use it as an interactive prompt. */
350 if (STRINGP (specs))
352 /* Make a copy of string so that if a GC relocates specs,
353 `string' will still be valid. */
354 string = (unsigned char *) alloca (SBYTES (specs) + 1);
355 bcopy (SDATA (specs), string,
356 SBYTES (specs) + 1);
358 else
360 Lisp_Object input;
361 i = num_input_events;
362 input = specs;
363 /* Compute the arg values using the user's expression. */
364 GCPRO2 (input, filter_specs);
365 specs = Feval (specs);
366 UNGCPRO;
367 if (i != num_input_events || !NILP (record_flag))
369 /* We should record this command on the command history. */
370 Lisp_Object values;
371 Lisp_Object this_cmd;
372 /* Make a copy of the list of values, for the command history,
373 and turn them into things we can eval. */
374 values = quotify_args (Fcopy_sequence (specs));
375 fix_command (input, values);
376 this_cmd = Fcons (function, values);
377 if (history_delete_duplicates)
378 Vcommand_history = Fdelete (this_cmd, Vcommand_history);
379 Vcommand_history = Fcons (this_cmd, Vcommand_history);
381 /* Don't keep command history around forever. */
382 if (INTEGERP (Vhistory_length) && XINT (Vhistory_length) > 0)
384 teml = Fnthcdr (Vhistory_length, Vcommand_history);
385 if (CONSP (teml))
386 XSETCDR (teml, Qnil);
390 Vthis_command = save_this_command;
391 Vthis_original_command = save_this_original_command;
392 real_this_command= save_real_this_command;
393 current_kboard->Vlast_command = save_last_command;
395 temporarily_switch_to_single_kboard (NULL);
396 return unbind_to (speccount, apply1 (function, specs));
399 /* Here if function specifies a string to control parsing the defaults */
401 /* Set next_event to point to the first event with parameters. */
402 for (next_event = 0; next_event < key_count; next_event++)
403 if (EVENT_HAS_PARAMETERS (AREF (keys, next_event)))
404 break;
406 /* Handle special starting chars `*' and `@'. Also `-'. */
407 /* Note that `+' is reserved for user extensions. */
408 while (1)
410 if (*string == '+')
411 error ("`+' is not used in `interactive' for ordinary commands");
412 else if (*string == '*')
414 string++;
415 if (!NILP (current_buffer->read_only))
417 if (!NILP (record_flag))
419 unsigned char *p = string;
420 while (*p)
422 if (! (*p == 'r' || *p == 'p' || *p == 'P'
423 || *p == '\n'))
424 Fbarf_if_buffer_read_only ();
425 p++;
427 record_then_fail = 1;
429 else
430 Fbarf_if_buffer_read_only ();
433 /* Ignore this for semi-compatibility with Lucid. */
434 else if (*string == '-')
435 string++;
436 else if (*string == '@')
438 Lisp_Object event, tem;
440 event = (next_event < key_count
441 ? AREF (keys, next_event)
442 : Qnil);
443 if (EVENT_HAS_PARAMETERS (event)
444 && (tem = XCDR (event), CONSP (tem))
445 && (tem = XCAR (tem), CONSP (tem))
446 && (tem = XCAR (tem), WINDOWP (tem)))
448 if (MINI_WINDOW_P (XWINDOW (tem))
449 && ! (minibuf_level > 0 && EQ (tem, minibuf_window)))
450 error ("Attempt to select inactive minibuffer window");
452 /* If the current buffer wants to clean up, let it. */
453 if (!NILP (Vmouse_leave_buffer_hook))
454 call1 (Vrun_hooks, Qmouse_leave_buffer_hook);
456 Fselect_window (tem, Qnil);
458 string++;
460 else if (*string == '^')
462 call0 (Qhandle_shift_selection);
463 string++;
465 else break;
468 /* Count the number of arguments the interactive spec would have
469 us give to the function. */
470 tem = string;
471 for (j = 0; *tem;)
473 /* 'r' specifications ("point and mark as 2 numeric args")
474 produce *two* arguments. */
475 if (*tem == 'r')
476 j += 2;
477 else
478 j++;
479 tem = (unsigned char *) index (tem, '\n');
480 if (tem)
481 ++tem;
482 else
483 break;
485 count = j;
487 args = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object));
488 visargs = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object));
489 varies = (int *) alloca ((count + 1) * sizeof (int));
491 for (i = 0; i < (count + 1); i++)
493 args[i] = Qnil;
494 visargs[i] = Qnil;
495 varies[i] = 0;
498 GCPRO5 (prefix_arg, function, *args, *visargs, up_event);
499 gcpro3.nvars = (count + 1);
500 gcpro4.nvars = (count + 1);
502 if (!NILP (enable))
503 specbind (Qenable_recursive_minibuffers, Qt);
505 tem = string;
506 for (i = 1; *tem; i++)
508 strncpy (prompt1, tem + 1, sizeof prompt1 - 1);
509 prompt1[sizeof prompt1 - 1] = 0;
510 tem1 = (char *) index (prompt1, '\n');
511 if (tem1) *tem1 = 0;
513 visargs[0] = build_string (prompt1);
514 if (index (prompt1, '%'))
515 callint_message = Fformat (i, visargs);
516 else
517 callint_message = visargs[0];
519 switch (*tem)
521 case 'a': /* Symbol defined as a function */
522 visargs[i] = Fcompleting_read (callint_message,
523 Vobarray, Qfboundp, Qt,
524 Qnil, Qnil, Qnil, Qnil);
525 /* Passing args[i] directly stimulates compiler bug */
526 teml = visargs[i];
527 args[i] = Fintern (teml, Qnil);
528 break;
530 case 'b': /* Name of existing buffer */
531 args[i] = Fcurrent_buffer ();
532 if (EQ (selected_window, minibuf_window))
533 args[i] = Fother_buffer (args[i], Qnil, Qnil);
534 args[i] = Fread_buffer (callint_message, args[i], Qt);
535 break;
537 case 'B': /* Name of buffer, possibly nonexistent */
538 args[i] = Fread_buffer (callint_message,
539 Fother_buffer (Fcurrent_buffer (), Qnil, Qnil),
540 Qnil);
541 break;
543 case 'c': /* Character */
544 /* Prompt in `minibuffer-prompt' face. */
545 Fput_text_property (make_number (0),
546 make_number (SCHARS (callint_message)),
547 Qface, Qminibuffer_prompt, callint_message);
548 args[i] = Fread_char (callint_message, Qnil, Qnil);
549 message1_nolog ((char *) 0);
550 /* Passing args[i] directly stimulates compiler bug */
551 teml = args[i];
552 visargs[i] = Fchar_to_string (teml);
553 break;
555 case 'C': /* Command: symbol with interactive function */
556 visargs[i] = Fcompleting_read (callint_message,
557 Vobarray, Qcommandp,
558 Qt, Qnil, Qnil, Qnil, Qnil);
559 /* Passing args[i] directly stimulates compiler bug */
560 teml = visargs[i];
561 args[i] = Fintern (teml, Qnil);
562 break;
564 case 'd': /* Value of point. Does not do I/O. */
565 set_marker_both (point_marker, Qnil, PT, PT_BYTE);
566 args[i] = point_marker;
567 /* visargs[i] = Qnil; */
568 varies[i] = 1;
569 break;
571 case 'D': /* Directory name. */
572 args[i] = Fread_file_name (callint_message, Qnil,
573 current_buffer->directory, Qlambda, Qnil,
574 Qfile_directory_p);
575 break;
577 case 'f': /* Existing file name. */
578 args[i] = Fread_file_name (callint_message,
579 Qnil, Qnil, Qlambda, Qnil, Qnil);
580 break;
582 case 'F': /* Possibly nonexistent file name. */
583 args[i] = Fread_file_name (callint_message,
584 Qnil, Qnil, Qnil, Qnil, Qnil);
585 break;
587 case 'G': /* Possibly nonexistent file name,
588 default to directory alone. */
589 args[i] = Fread_file_name (callint_message,
590 Qnil, Qnil, Qnil, empty_unibyte_string, Qnil);
591 break;
593 case 'i': /* Ignore an argument -- Does not do I/O */
594 varies[i] = -1;
595 break;
597 case 'k': /* Key sequence. */
599 int speccount1 = SPECPDL_INDEX ();
600 specbind (Qcursor_in_echo_area, Qt);
601 /* Prompt in `minibuffer-prompt' face. */
602 Fput_text_property (make_number (0),
603 make_number (SCHARS (callint_message)),
604 Qface, Qminibuffer_prompt, callint_message);
605 args[i] = Fread_key_sequence (callint_message,
606 Qnil, Qnil, Qnil, Qnil);
607 unbind_to (speccount1, Qnil);
608 teml = args[i];
609 visargs[i] = Fkey_description (teml, Qnil);
611 /* If the key sequence ends with a down-event,
612 discard the following up-event. */
613 teml = Faref (args[i], make_number (XINT (Flength (args[i])) - 1));
614 if (CONSP (teml))
615 teml = XCAR (teml);
616 if (SYMBOLP (teml))
618 Lisp_Object tem2;
620 teml = Fget (teml, intern ("event-symbol-elements"));
621 /* Ignore first element, which is the base key. */
622 tem2 = Fmemq (intern ("down"), Fcdr (teml));
623 if (! NILP (tem2))
624 up_event = Fread_event (Qnil, Qnil, Qnil);
627 break;
629 case 'K': /* Key sequence to be defined. */
631 int speccount1 = SPECPDL_INDEX ();
632 specbind (Qcursor_in_echo_area, Qt);
633 /* Prompt in `minibuffer-prompt' face. */
634 Fput_text_property (make_number (0),
635 make_number (SCHARS (callint_message)),
636 Qface, Qminibuffer_prompt, callint_message);
637 args[i] = Fread_key_sequence (callint_message,
638 Qnil, Qt, Qnil, Qnil);
639 teml = args[i];
640 visargs[i] = Fkey_description (teml, Qnil);
641 unbind_to (speccount1, Qnil);
643 /* If the key sequence ends with a down-event,
644 discard the following up-event. */
645 teml = Faref (args[i], make_number (XINT (Flength (args[i])) - 1));
646 if (CONSP (teml))
647 teml = XCAR (teml);
648 if (SYMBOLP (teml))
650 Lisp_Object tem2;
652 teml = Fget (teml, intern ("event-symbol-elements"));
653 /* Ignore first element, which is the base key. */
654 tem2 = Fmemq (intern ("down"), Fcdr (teml));
655 if (! NILP (tem2))
656 up_event = Fread_event (Qnil, Qnil, Qnil);
659 break;
661 case 'U': /* Up event from last k or K */
662 if (!NILP (up_event))
664 args[i] = Fmake_vector (make_number (1), up_event);
665 up_event = Qnil;
666 teml = args[i];
667 visargs[i] = Fkey_description (teml, Qnil);
669 break;
671 case 'e': /* The invoking event. */
672 if (next_event >= key_count)
673 error ("%s must be bound to an event with parameters",
674 (SYMBOLP (function)
675 ? (char *) SDATA (SYMBOL_NAME (function))
676 : "command"));
677 args[i] = AREF (keys, next_event);
678 next_event++;
679 varies[i] = -1;
681 /* Find the next parameterized event. */
682 while (next_event < key_count
683 && !(EVENT_HAS_PARAMETERS (AREF (keys, next_event))))
684 next_event++;
686 break;
688 case 'm': /* Value of mark. Does not do I/O. */
689 check_mark (0);
690 /* visargs[i] = Qnil; */
691 args[i] = current_buffer->mark;
692 varies[i] = 2;
693 break;
695 case 'M': /* String read via minibuffer with
696 inheriting the current input method. */
697 args[i] = Fread_string (callint_message,
698 Qnil, Qnil, Qnil, Qt);
699 break;
701 case 'N': /* Prefix arg as number, else number from minibuffer */
702 if (!NILP (prefix_arg))
703 goto have_prefix_arg;
704 case 'n': /* Read number from minibuffer. */
706 int first = 1;
709 Lisp_Object tem;
710 if (! first)
712 message ("Please enter a number.");
713 sit_for (make_number (1), 0, 0);
715 first = 0;
717 tem = Fread_from_minibuffer (callint_message,
718 Qnil, Qnil, Qnil, Qnil, Qnil,
719 Qnil);
720 if (! STRINGP (tem) || SCHARS (tem) == 0)
721 args[i] = Qnil;
722 else
723 args[i] = Fread (tem);
725 while (! NUMBERP (args[i]));
727 visargs[i] = args[i];
728 break;
730 case 'P': /* Prefix arg in raw form. Does no I/O. */
731 args[i] = prefix_arg;
732 /* visargs[i] = Qnil; */
733 varies[i] = -1;
734 break;
736 case 'p': /* Prefix arg converted to number. No I/O. */
737 have_prefix_arg:
738 args[i] = Fprefix_numeric_value (prefix_arg);
739 /* visargs[i] = Qnil; */
740 varies[i] = -1;
741 break;
743 case 'r': /* Region, point and mark as 2 args. */
744 check_mark (1);
745 set_marker_both (point_marker, Qnil, PT, PT_BYTE);
746 /* visargs[i+1] = Qnil; */
747 foo = marker_position (current_buffer->mark);
748 /* visargs[i] = Qnil; */
749 args[i] = PT < foo ? point_marker : current_buffer->mark;
750 varies[i] = 3;
751 args[++i] = PT > foo ? point_marker : current_buffer->mark;
752 varies[i] = 4;
753 break;
755 case 's': /* String read via minibuffer without
756 inheriting the current input method. */
757 args[i] = Fread_string (callint_message,
758 Qnil, Qnil, Qnil, Qnil);
759 break;
761 case 'S': /* Any symbol. */
762 visargs[i] = Fread_string (callint_message,
763 Qnil, Qnil, Qnil, Qnil);
764 /* Passing args[i] directly stimulates compiler bug */
765 teml = visargs[i];
766 args[i] = Fintern (teml, Qnil);
767 break;
769 case 'v': /* Variable name: symbol that is
770 user-variable-p. */
771 args[i] = Fread_variable (callint_message, Qnil);
772 visargs[i] = last_minibuf_string;
773 break;
775 case 'x': /* Lisp expression read but not evaluated */
776 args[i] = Fread_minibuffer (callint_message, Qnil);
777 visargs[i] = last_minibuf_string;
778 break;
780 case 'X': /* Lisp expression read and evaluated */
781 args[i] = Feval_minibuffer (callint_message, Qnil);
782 visargs[i] = last_minibuf_string;
783 break;
785 case 'Z': /* Coding-system symbol, or ignore the
786 argument if no prefix */
787 if (NILP (prefix_arg))
789 args[i] = Qnil;
790 varies[i] = -1;
792 else
794 args[i]
795 = Fread_non_nil_coding_system (callint_message);
796 visargs[i] = last_minibuf_string;
798 break;
800 case 'z': /* Coding-system symbol or nil */
801 args[i] = Fread_coding_system (callint_message, Qnil);
802 visargs[i] = last_minibuf_string;
803 break;
805 /* We have a case for `+' so we get an error
806 if anyone tries to define one here. */
807 case '+':
808 default:
809 error ("Invalid control letter `%c' (%03o) in interactive calling string",
810 *tem, *tem);
813 if (varies[i] == 0)
814 arg_from_tty = 1;
816 if (NILP (visargs[i]) && STRINGP (args[i]))
817 visargs[i] = args[i];
819 tem = (unsigned char *) index (tem, '\n');
820 if (tem) tem++;
821 else tem = (unsigned char *) "";
823 unbind_to (speccount, Qnil);
825 QUIT;
827 args[0] = function;
829 if (arg_from_tty || !NILP (record_flag))
831 visargs[0] = function;
832 for (i = 1; i < count + 1; i++)
834 if (varies[i] > 0)
835 visargs[i] = Fcons (intern (callint_argfuns[varies[i]]), Qnil);
836 else
837 visargs[i] = quotify_arg (args[i]);
839 Vcommand_history = Fcons (Flist (count + 1, visargs),
840 Vcommand_history);
841 /* Don't keep command history around forever. */
842 if (INTEGERP (Vhistory_length) && XINT (Vhistory_length) > 0)
844 teml = Fnthcdr (Vhistory_length, Vcommand_history);
845 if (CONSP (teml))
846 XSETCDR (teml, Qnil);
850 /* If we used a marker to hold point, mark, or an end of the region,
851 temporarily, convert it to an integer now. */
852 for (i = 1; i <= count; i++)
853 if (varies[i] >= 1 && varies[i] <= 4)
854 XSETINT (args[i], marker_position (args[i]));
856 if (record_then_fail)
857 Fbarf_if_buffer_read_only ();
859 Vthis_command = save_this_command;
860 Vthis_original_command = save_this_original_command;
861 real_this_command= save_real_this_command;
862 current_kboard->Vlast_command = save_last_command;
865 Lisp_Object val;
866 specbind (Qcommand_debug_status, Qnil);
868 temporarily_switch_to_single_kboard (NULL);
869 val = Ffuncall (count + 1, args);
870 UNGCPRO;
871 return unbind_to (speccount, val);
875 DEFUN ("prefix-numeric-value", Fprefix_numeric_value, Sprefix_numeric_value,
876 1, 1, 0,
877 doc: /* Return numeric meaning of raw prefix argument RAW.
878 A raw prefix argument is what you get from `(interactive "P")'.
879 Its numeric meaning is what you would get from `(interactive "p")'. */)
880 (raw)
881 Lisp_Object raw;
883 Lisp_Object val;
885 if (NILP (raw))
886 XSETFASTINT (val, 1);
887 else if (EQ (raw, Qminus))
888 XSETINT (val, -1);
889 else if (CONSP (raw) && INTEGERP (XCAR (raw)))
890 XSETINT (val, XINT (XCAR (raw)));
891 else if (INTEGERP (raw))
892 val = raw;
893 else
894 XSETFASTINT (val, 1);
896 return val;
899 void
900 syms_of_callint ()
902 point_marker = Fmake_marker ();
903 staticpro (&point_marker);
905 callint_message = Qnil;
906 staticpro (&callint_message);
908 preserved_fns = pure_cons (intern_c_string ("region-beginning"),
909 pure_cons (intern_c_string ("region-end"),
910 pure_cons (intern_c_string ("point"),
911 pure_cons (intern_c_string ("mark"), Qnil))));
913 Qlist = intern_c_string ("list");
914 staticpro (&Qlist);
915 Qlet = intern_c_string ("let");
916 staticpro (&Qlet);
917 Qif = intern_c_string ("if");
918 staticpro (&Qif);
919 Qwhen = intern_c_string ("when");
920 staticpro (&Qwhen);
921 Qletx = intern_c_string ("let*");
922 staticpro (&Qletx);
923 Qsave_excursion = intern_c_string ("save-excursion");
924 staticpro (&Qsave_excursion);
925 Qprogn = intern_c_string ("progn");
926 staticpro (&Qprogn);
928 Qminus = intern_c_string ("-");
929 staticpro (&Qminus);
931 Qplus = intern_c_string ("+");
932 staticpro (&Qplus);
934 Qhandle_shift_selection = intern_c_string ("handle-shift-selection");
935 staticpro (&Qhandle_shift_selection);
937 Qcall_interactively = intern_c_string ("call-interactively");
938 staticpro (&Qcall_interactively);
940 Qcommand_debug_status = intern_c_string ("command-debug-status");
941 staticpro (&Qcommand_debug_status);
943 Qenable_recursive_minibuffers = intern_c_string ("enable-recursive-minibuffers");
944 staticpro (&Qenable_recursive_minibuffers);
946 Qmouse_leave_buffer_hook = intern_c_string ("mouse-leave-buffer-hook");
947 staticpro (&Qmouse_leave_buffer_hook);
949 DEFVAR_KBOARD ("prefix-arg", Vprefix_arg,
950 doc: /* The value of the prefix argument for the next editing command.
951 It may be a number, or the symbol `-' for just a minus sign as arg,
952 or a list whose car is a number for just one or more C-u's
953 or nil if no argument has been specified.
955 You cannot examine this variable to find the argument for this command
956 since it has been set to nil by the time you can look.
957 Instead, you should use the variable `current-prefix-arg', although
958 normally commands can get this prefix argument with (interactive "P"). */);
960 DEFVAR_KBOARD ("last-prefix-arg", Vlast_prefix_arg,
961 doc: /* The value of the prefix argument for the previous editing command.
962 See `prefix-arg' for the meaning of the value. */);
964 DEFVAR_LISP ("current-prefix-arg", &Vcurrent_prefix_arg,
965 doc: /* The value of the prefix argument for this editing command.
966 It may be a number, or the symbol `-' for just a minus sign as arg,
967 or a list whose car is a number for just one or more C-u's
968 or nil if no argument has been specified.
969 This is what `(interactive \"P\")' returns. */);
970 Vcurrent_prefix_arg = Qnil;
972 DEFVAR_LISP ("command-history", &Vcommand_history,
973 doc: /* List of recent commands that read arguments from terminal.
974 Each command is represented as a form to evaluate.
976 Maximum length of the history list is determined by the value
977 of `history-length', which see. */);
978 Vcommand_history = Qnil;
980 DEFVAR_LISP ("command-debug-status", &Vcommand_debug_status,
981 doc: /* Debugging status of current interactive command.
982 Bound each time `call-interactively' is called;
983 may be set by the debugger as a reminder for itself. */);
984 Vcommand_debug_status = Qnil;
986 DEFVAR_LISP ("mark-even-if-inactive", &Vmark_even_if_inactive,
987 doc: /* *Non-nil means you can use the mark even when inactive.
988 This option makes a difference in Transient Mark mode.
989 When the option is non-nil, deactivation of the mark
990 turns off region highlighting, but commands that use the mark
991 behave as if the mark were still active. */);
992 Vmark_even_if_inactive = Qt;
994 DEFVAR_LISP ("mouse-leave-buffer-hook", &Vmouse_leave_buffer_hook,
995 doc: /* Hook to run when about to switch windows with a mouse command.
996 Its purpose is to give temporary modes such as Isearch mode
997 a way to turn themselves off when a mouse command switches windows. */);
998 Vmouse_leave_buffer_hook = Qnil;
1000 defsubr (&Sinteractive);
1001 defsubr (&Scall_interactively);
1002 defsubr (&Sprefix_numeric_value);
1005 /* arch-tag: a3a7cad7-bcac-42ce-916e-1bd2546ebf37
1006 (do not change this comment) */