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