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