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