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