(syms_of_callint) <command-history>: Add reference to history-length in
[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 /* 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; j++)
477 {
478 /* 'r' specifications ("point and mark as 2 numeric args")
479 produce *two* arguments. */
480 if (*tem == 'r') j++;
481 tem = (unsigned char *) index (tem, '\n');
482 if (tem)
483 tem++;
484 else
485 tem = (unsigned char *) "";
486 }
487 count = j;
488
489 args = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object));
490 visargs = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object));
491 varies = (int *) alloca ((count + 1) * sizeof (int));
492
493 for (i = 0; i < (count + 1); i++)
494 {
495 args[i] = Qnil;
496 visargs[i] = Qnil;
497 varies[i] = 0;
498 }
499
500 GCPRO5 (prefix_arg, function, *args, *visargs, up_event);
501 gcpro3.nvars = (count + 1);
502 gcpro4.nvars = (count + 1);
503
504 if (!NILP (enable))
505 specbind (Qenable_recursive_minibuffers, Qt);
506
507 tem = string;
508 for (i = 1; *tem; i++)
509 {
510 strncpy (prompt1, tem + 1, sizeof prompt1 - 1);
511 prompt1[sizeof prompt1 - 1] = 0;
512 tem1 = (char *) index (prompt1, '\n');
513 if (tem1) *tem1 = 0;
514
515 visargs[0] = build_string (prompt1);
516 if (index (prompt1, '%'))
517 callint_message = Fformat (i, visargs);
518 else
519 callint_message = visargs[0];
520
521 switch (*tem)
522 {
523 case 'a': /* Symbol defined as a function */
524 visargs[i] = Fcompleting_read (callint_message,
525 Vobarray, Qfboundp, Qt,
526 Qnil, Qnil, Qnil, Qnil);
527 /* Passing args[i] directly stimulates compiler bug */
528 teml = visargs[i];
529 args[i] = Fintern (teml, Qnil);
530 break;
531
532 case 'b': /* Name of existing buffer */
533 args[i] = Fcurrent_buffer ();
534 if (EQ (selected_window, minibuf_window))
535 args[i] = Fother_buffer (args[i], Qnil, Qnil);
536 args[i] = Fread_buffer (callint_message, args[i], Qt);
537 break;
538
539 case 'B': /* Name of buffer, possibly nonexistent */
540 args[i] = Fread_buffer (callint_message,
541 Fother_buffer (Fcurrent_buffer (), Qnil, Qnil),
542 Qnil);
543 break;
544
545 case 'c': /* Character */
546 args[i] = Fread_char (callint_message, Qnil, Qnil);
547 message1_nolog ((char *) 0);
548 /* Passing args[i] directly stimulates compiler bug */
549 teml = args[i];
550 visargs[i] = Fchar_to_string (teml);
551 break;
552
553 case 'C': /* Command: symbol with interactive function */
554 visargs[i] = Fcompleting_read (callint_message,
555 Vobarray, Qcommandp,
556 Qt, Qnil, Qnil, Qnil, Qnil);
557 /* Passing args[i] directly stimulates compiler bug */
558 teml = visargs[i];
559 args[i] = Fintern (teml, Qnil);
560 break;
561
562 case 'd': /* Value of point. Does not do I/O. */
563 set_marker_both (point_marker, Qnil, PT, PT_BYTE);
564 args[i] = point_marker;
565 /* visargs[i] = Qnil; */
566 varies[i] = 1;
567 break;
568
569 case 'D': /* Directory name. */
570 args[i] = Fread_file_name (callint_message, Qnil,
571 current_buffer->directory, Qlambda, Qnil,
572 Qfile_directory_p);
573 break;
574
575 case 'f': /* Existing file name. */
576 args[i] = Fread_file_name (callint_message,
577 Qnil, Qnil, Qlambda, Qnil, Qnil);
578 break;
579
580 case 'F': /* Possibly nonexistent file name. */
581 args[i] = Fread_file_name (callint_message,
582 Qnil, Qnil, Qnil, Qnil, Qnil);
583 break;
584
585 case 'G': /* Possibly nonexistent file name,
586 default to directory alone. */
587 args[i] = Fread_file_name (callint_message,
588 Qnil, Qnil, Qnil, build_string (""), Qnil);
589 break;
590
591 case 'i': /* Ignore an argument -- Does not do I/O */
592 varies[i] = -1;
593 break;
594
595 case 'k': /* Key sequence. */
596 {
597 int speccount1 = SPECPDL_INDEX ();
598 specbind (Qcursor_in_echo_area, Qt);
599 args[i] = Fread_key_sequence (callint_message,
600 Qnil, Qnil, Qnil, Qnil);
601 unbind_to (speccount1, Qnil);
602 teml = args[i];
603 visargs[i] = Fkey_description (teml, Qnil);
604
605 /* If the key sequence ends with a down-event,
606 discard the following up-event. */
607 teml = Faref (args[i], make_number (XINT (Flength (args[i])) - 1));
608 if (CONSP (teml))
609 teml = XCAR (teml);
610 if (SYMBOLP (teml))
611 {
612 Lisp_Object tem2;
613
614 teml = Fget (teml, intern ("event-symbol-elements"));
615 /* Ignore first element, which is the base key. */
616 tem2 = Fmemq (intern ("down"), Fcdr (teml));
617 if (! NILP (tem2))
618 up_event = Fread_event (Qnil, Qnil, Qnil);
619 }
620 }
621 break;
622
623 case 'K': /* Key sequence to be defined. */
624 {
625 int speccount1 = SPECPDL_INDEX ();
626 specbind (Qcursor_in_echo_area, Qt);
627 args[i] = Fread_key_sequence (callint_message,
628 Qnil, Qt, Qnil, Qnil);
629 teml = args[i];
630 visargs[i] = Fkey_description (teml, Qnil);
631 unbind_to (speccount1, Qnil);
632
633 /* If the key sequence ends with a down-event,
634 discard the following up-event. */
635 teml = Faref (args[i], make_number (XINT (Flength (args[i])) - 1));
636 if (CONSP (teml))
637 teml = XCAR (teml);
638 if (SYMBOLP (teml))
639 {
640 Lisp_Object tem2;
641
642 teml = Fget (teml, intern ("event-symbol-elements"));
643 /* Ignore first element, which is the base key. */
644 tem2 = Fmemq (intern ("down"), Fcdr (teml));
645 if (! NILP (tem2))
646 up_event = Fread_event (Qnil, Qnil, Qnil);
647 }
648 }
649 break;
650
651 case 'U': /* Up event from last k or K */
652 if (!NILP (up_event))
653 {
654 args[i] = Fmake_vector (make_number (1), up_event);
655 up_event = Qnil;
656 teml = args[i];
657 visargs[i] = Fkey_description (teml, Qnil);
658 }
659 break;
660
661 case 'e': /* The invoking event. */
662 if (next_event >= key_count)
663 error ("%s must be bound to an event with parameters",
664 (SYMBOLP (function)
665 ? (char *) SDATA (SYMBOL_NAME (function))
666 : "command"));
667 args[i] = XVECTOR (keys)->contents[next_event++];
668 varies[i] = -1;
669
670 /* Find the next parameterized event. */
671 while (next_event < key_count
672 && ! (EVENT_HAS_PARAMETERS
673 (XVECTOR (keys)->contents[next_event])))
674 next_event++;
675
676 break;
677
678 case 'm': /* Value of mark. Does not do I/O. */
679 check_mark (0);
680 /* visargs[i] = Qnil; */
681 args[i] = current_buffer->mark;
682 varies[i] = 2;
683 break;
684
685 case 'M': /* String read via minibuffer with
686 inheriting the current input method. */
687 args[i] = Fread_string (callint_message,
688 Qnil, Qnil, Qnil, Qt);
689 break;
690
691 case 'N': /* Prefix arg as number, else number from minibuffer */
692 if (!NILP (prefix_arg))
693 goto have_prefix_arg;
694 case 'n': /* Read number from minibuffer. */
695 {
696 int first = 1;
697 do
698 {
699 Lisp_Object tem;
700 if (! first)
701 {
702 message ("Please enter a number.");
703 sit_for (make_number (1), 0, 0);
704 }
705 first = 0;
706
707 tem = Fread_from_minibuffer (callint_message,
708 Qnil, Qnil, Qnil, Qnil, Qnil,
709 Qnil);
710 if (! STRINGP (tem) || SCHARS (tem) == 0)
711 args[i] = Qnil;
712 else
713 args[i] = Fread (tem);
714 }
715 while (! NUMBERP (args[i]));
716 }
717 visargs[i] = args[i];
718 break;
719
720 case 'P': /* Prefix arg in raw form. Does no I/O. */
721 args[i] = prefix_arg;
722 /* visargs[i] = Qnil; */
723 varies[i] = -1;
724 break;
725
726 case 'p': /* Prefix arg converted to number. No I/O. */
727 have_prefix_arg:
728 args[i] = Fprefix_numeric_value (prefix_arg);
729 /* visargs[i] = Qnil; */
730 varies[i] = -1;
731 break;
732
733 case 'r': /* Region, point and mark as 2 args. */
734 check_mark (1);
735 set_marker_both (point_marker, Qnil, PT, PT_BYTE);
736 /* visargs[i+1] = Qnil; */
737 foo = marker_position (current_buffer->mark);
738 /* visargs[i] = Qnil; */
739 args[i] = PT < foo ? point_marker : current_buffer->mark;
740 varies[i] = 3;
741 args[++i] = PT > foo ? point_marker : current_buffer->mark;
742 varies[i] = 4;
743 break;
744
745 case 's': /* String read via minibuffer without
746 inheriting the current input method. */
747 args[i] = Fread_string (callint_message,
748 Qnil, Qnil, Qnil, Qnil);
749 break;
750
751 case 'S': /* Any symbol. */
752 visargs[i] = Fread_string (callint_message,
753 Qnil, Qnil, Qnil, Qnil);
754 /* Passing args[i] directly stimulates compiler bug */
755 teml = visargs[i];
756 args[i] = Fintern (teml, Qnil);
757 break;
758
759 case 'v': /* Variable name: symbol that is
760 user-variable-p. */
761 args[i] = Fread_variable (callint_message, Qnil);
762 visargs[i] = last_minibuf_string;
763 break;
764
765 case 'x': /* Lisp expression read but not evaluated */
766 args[i] = Fread_minibuffer (callint_message, Qnil);
767 visargs[i] = last_minibuf_string;
768 break;
769
770 case 'X': /* Lisp expression read and evaluated */
771 args[i] = Feval_minibuffer (callint_message, Qnil);
772 visargs[i] = last_minibuf_string;
773 break;
774
775 case 'Z': /* Coding-system symbol, or ignore the
776 argument if no prefix */
777 if (NILP (prefix_arg))
778 {
779 args[i] = Qnil;
780 varies[i] = -1;
781 }
782 else
783 {
784 args[i]
785 = Fread_non_nil_coding_system (callint_message);
786 visargs[i] = last_minibuf_string;
787 }
788 break;
789
790 case 'z': /* Coding-system symbol or nil */
791 args[i] = Fread_coding_system (callint_message, Qnil);
792 visargs[i] = last_minibuf_string;
793 break;
794
795 /* We have a case for `+' so we get an error
796 if anyone tries to define one here. */
797 case '+':
798 default:
799 error ("Invalid control letter `%c' (%03o) in interactive calling string",
800 *tem, *tem);
801 }
802
803 if (varies[i] == 0)
804 arg_from_tty = 1;
805
806 if (NILP (visargs[i]) && STRINGP (args[i]))
807 visargs[i] = args[i];
808
809 tem = (unsigned char *) index (tem, '\n');
810 if (tem) tem++;
811 else tem = (unsigned char *) "";
812 }
813 unbind_to (speccount, Qnil);
814
815 QUIT;
816
817 args[0] = function;
818
819 if (arg_from_tty || !NILP (record_flag))
820 {
821 visargs[0] = function;
822 for (i = 1; i < count + 1; i++)
823 {
824 if (varies[i] > 0)
825 visargs[i] = Fcons (intern (callint_argfuns[varies[i]]), Qnil);
826 else
827 visargs[i] = quotify_arg (args[i]);
828 }
829 Vcommand_history = Fcons (Flist (count + 1, visargs),
830 Vcommand_history);
831 /* Don't keep command history around forever. */
832 if (INTEGERP (Vhistory_length) && XINT (Vhistory_length) > 0)
833 {
834 teml = Fnthcdr (Vhistory_length, Vcommand_history);
835 if (CONSP (teml))
836 XSETCDR (teml, Qnil);
837 }
838 }
839
840 /* If we used a marker to hold point, mark, or an end of the region,
841 temporarily, convert it to an integer now. */
842 for (i = 1; i <= count; i++)
843 if (varies[i] >= 1 && varies[i] <= 4)
844 XSETINT (args[i], marker_position (args[i]));
845
846 if (record_then_fail)
847 Fbarf_if_buffer_read_only ();
848
849 Vthis_command = save_this_command;
850 Vthis_original_command = save_this_original_command;
851 real_this_command= save_real_this_command;
852 current_kboard->Vlast_command = save_last_command;
853
854 single_kboard_state ();
855
856 {
857 Lisp_Object val;
858 specbind (Qcommand_debug_status, Qnil);
859
860 val = Ffuncall (count + 1, args);
861 UNGCPRO;
862 return unbind_to (speccount, val);
863 }
864 }
865
866 DEFUN ("prefix-numeric-value", Fprefix_numeric_value, Sprefix_numeric_value,
867 1, 1, 0,
868 doc: /* Return numeric meaning of raw prefix argument RAW.
869 A raw prefix argument is what you get from `(interactive "P")'.
870 Its numeric meaning is what you would get from `(interactive "p")'. */)
871 (raw)
872 Lisp_Object raw;
873 {
874 Lisp_Object val;
875
876 if (NILP (raw))
877 XSETFASTINT (val, 1);
878 else if (EQ (raw, Qminus))
879 XSETINT (val, -1);
880 else if (CONSP (raw) && INTEGERP (XCAR (raw)))
881 XSETINT (val, XINT (XCAR (raw)));
882 else if (INTEGERP (raw))
883 val = raw;
884 else
885 XSETFASTINT (val, 1);
886
887 return val;
888 }
889
890 void
891 syms_of_callint ()
892 {
893 point_marker = Fmake_marker ();
894 staticpro (&point_marker);
895
896 callint_message = Qnil;
897 staticpro (&callint_message);
898
899 preserved_fns = Fcons (intern ("region-beginning"),
900 Fcons (intern ("region-end"),
901 Fcons (intern ("point"),
902 Fcons (intern ("mark"), Qnil))));
903 staticpro (&preserved_fns);
904
905 Qlist = intern ("list");
906 staticpro (&Qlist);
907 Qlet = intern ("let");
908 staticpro (&Qlet);
909 Qif = intern ("if");
910 staticpro (&Qif);
911 Qwhen = intern ("when");
912 staticpro (&Qwhen);
913 Qletx = intern ("let*");
914 staticpro (&Qletx);
915 Qsave_excursion = intern ("save-excursion");
916 staticpro (&Qsave_excursion);
917 Qprogn = intern ("progn");
918 staticpro (&Qprogn);
919
920 Qminus = intern ("-");
921 staticpro (&Qminus);
922
923 Qplus = intern ("+");
924 staticpro (&Qplus);
925
926 Qcall_interactively = intern ("call-interactively");
927 staticpro (&Qcall_interactively);
928
929 Qcommand_debug_status = intern ("command-debug-status");
930 staticpro (&Qcommand_debug_status);
931
932 Qenable_recursive_minibuffers = intern ("enable-recursive-minibuffers");
933 staticpro (&Qenable_recursive_minibuffers);
934
935 Qmouse_leave_buffer_hook = intern ("mouse-leave-buffer-hook");
936 staticpro (&Qmouse_leave_buffer_hook);
937
938 DEFVAR_KBOARD ("prefix-arg", Vprefix_arg,
939 doc: /* The value of the prefix argument for the next editing command.
940 It may be a number, or the symbol `-' for just a minus sign as arg,
941 or a list whose car is a number for just one or more C-u's
942 or nil if no argument has been specified.
943
944 You cannot examine this variable to find the argument for this command
945 since it has been set to nil by the time you can look.
946 Instead, you should use the variable `current-prefix-arg', although
947 normally commands can get this prefix argument with (interactive "P"). */);
948
949 DEFVAR_KBOARD ("last-prefix-arg", Vlast_prefix_arg,
950 doc: /* The value of the prefix argument for the previous editing command.
951 See `prefix-arg' for the meaning of the value. */);
952
953 DEFVAR_LISP ("current-prefix-arg", &Vcurrent_prefix_arg,
954 doc: /* The value of the prefix argument for this editing command.
955 It may be a number, or the symbol `-' for just a minus sign as arg,
956 or a list whose car is a number for just one or more C-u's
957 or nil if no argument has been specified.
958 This is what `(interactive \"P\")' returns. */);
959 Vcurrent_prefix_arg = Qnil;
960
961 DEFVAR_LISP ("command-history", &Vcommand_history,
962 doc: /* List of recent commands that read arguments from terminal.
963 Each command is represented as a form to evaluate.
964
965 Maximum length of the history list is determined by the value
966 of `history-length', which see. */);
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) */