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