]> code.delx.au - gnu-emacs/blob - src/callint.c
(Fcall_interactively): Use INTEGERP instead of
[gnu-emacs] / 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
38 Lisp_Object Vcurrent_prefix_arg, Qminus, Qplus;
39 Lisp_Object Qcall_interactively;
40 Lisp_Object Vcommand_history;
41
42 extern Lisp_Object Vhistory_length;
43
44 Lisp_Object Vcommand_debug_status, Qcommand_debug_status;
45 Lisp_Object Qenable_recursive_minibuffers;
46
47 /* Non-nil means treat the mark as active
48 even if mark_active is 0. */
49 Lisp_Object Vmark_even_if_inactive;
50
51 Lisp_Object Vmouse_leave_buffer_hook, Qmouse_leave_buffer_hook;
52
53 Lisp_Object Qlist, Qlet, Qletx, Qsave_excursion;
54 static Lisp_Object preserved_fns;
55
56 /* Marker used within call-interactively to refer to point. */
57 static Lisp_Object point_marker;
58
59 /* Buffer for the prompt text used in Fcall_interactively. */
60 static char *callint_message;
61
62 /* Allocated length of that buffer. */
63 static int callint_message_size;
64
65 /* ARGSUSED */
66 DEFUN ("interactive", Finteractive, Sinteractive, 0, UNEVALLED, 0,
67 doc: /* Specify a way of parsing arguments for interactive use of a function.
68 For example, write
69 (defun foo (arg) "Doc string" (interactive "p") ...use arg...)
70 to make ARG be the prefix argument when `foo' is called as a command.
71 The "call" to `interactive' is actually a declaration rather than a function;
72 it tells `call-interactively' how to read arguments
73 to pass to the function.
74 When actually called, `interactive' just returns nil.
75
76 The argument of `interactive' is usually a string containing a code letter
77 followed by a prompt. (Some code letters do not use I/O to get
78 the argument and do not need prompts.) To prompt for multiple arguments,
79 give a code letter, its prompt, a newline, and another code letter, etc.
80 Prompts are passed to format, and may use % escapes to print the
81 arguments that have already been read.
82 If the argument is not a string, it is evaluated to get a list of
83 arguments to pass to the function.
84 Just `(interactive)' means pass no args when calling interactively.
85
86 Code letters available are:
87 a -- Function name: symbol with a function definition.
88 b -- Name of existing buffer.
89 B -- Name of buffer, possibly nonexistent.
90 c -- Character (no input method is used).
91 C -- Command name: symbol with interactive function definition.
92 d -- Value of point as number. Does not do I/O.
93 D -- Directory name.
94 e -- Parametrized event (i.e., one that's a list) that invoked this command.
95 If used more than once, the Nth `e' returns the Nth parameterized event.
96 This skips events that are integers or symbols.
97 f -- Existing file name.
98 F -- Possibly nonexistent file 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 -- Raw 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 v -- Variable name: symbol that is user-variable-p.
112 x -- Lisp expression read but not evaluated.
113 X -- Lisp expression read and evaluated.
114 z -- Coding system.
115 Z -- Coding system, nil if no prefix arg.
116 In addition, if the string begins with `*'
117 then an error is signaled if the buffer is read-only.
118 This happens before reading any arguments.
119 If the string begins with `@', then Emacs searches the key sequence
120 which invoked the command for its first mouse click (or any other
121 event which specifies a window), and selects that window before
122 reading any arguments. You may use both `@' and `*'; they are
123 processed in the order that they appear.
124 usage: (interactive ARGS) */)
125 (args)
126 Lisp_Object args;
127 {
128 return Qnil;
129 }
130
131 /* Quotify EXP: if EXP is constant, return it.
132 If EXP is not constant, return (quote EXP). */
133 Lisp_Object
134 quotify_arg (exp)
135 register Lisp_Object exp;
136 {
137 if (!INTEGERP (exp) && !STRINGP (exp)
138 && !NILP (exp) && !EQ (exp, Qt))
139 return Fcons (Qquote, Fcons (exp, Qnil));
140
141 return exp;
142 }
143
144 /* Modify EXP by quotifying each element (except the first). */
145 Lisp_Object
146 quotify_args (exp)
147 Lisp_Object exp;
148 {
149 register Lisp_Object tail;
150 Lisp_Object next;
151 for (tail = exp; CONSP (tail); tail = next)
152 {
153 next = XCDR (tail);
154 XSETCAR (tail, quotify_arg (XCAR (tail)));
155 }
156 return exp;
157 }
158
159 char *callint_argfuns[]
160 = {"", "point", "mark", "region-beginning", "region-end"};
161
162 static void
163 check_mark (for_region)
164 int for_region;
165 {
166 Lisp_Object tem;
167 tem = Fmarker_buffer (current_buffer->mark);
168 if (NILP (tem) || (XBUFFER (tem) != current_buffer))
169 error (for_region ? "The mark is not set now, so there is no region"
170 : "The mark is not set now");
171 if (!NILP (Vtransient_mark_mode) && NILP (Vmark_even_if_inactive)
172 && NILP (current_buffer->mark_active))
173 Fsignal (Qmark_inactive, Qnil);
174 }
175
176
177 DEFUN ("call-interactively", Fcall_interactively, Scall_interactively, 1, 3, 0,
178 doc: /* Call FUNCTION, reading args according to its interactive calling specs.
179 Return the value FUNCTION returns.
180 The function contains a specification of how to do the argument reading.
181 In the case of user-defined functions, this is specified by placing a call
182 to the function `interactive' at the top level of the function body.
183 See `interactive'.
184
185 Optional second arg RECORD-FLAG non-nil
186 means unconditionally put this command in the command-history.
187 Otherwise, this is done only if an arg is read using the minibuffer.
188 Optional third arg KEYS, if given, specifies the sequence of events to
189 supply if the command inquires which events were used to invoke it. */)
190 (function, record_flag, keys)
191 Lisp_Object function, record_flag, keys;
192 {
193 Lisp_Object *args, *visargs;
194 unsigned char **argstrings;
195 Lisp_Object fun;
196 Lisp_Object funcar;
197 Lisp_Object specs;
198 Lisp_Object teml;
199 Lisp_Object enable;
200 int speccount = specpdl_ptr - specpdl;
201
202 /* The index of the next element of this_command_keys to examine for
203 the 'e' interactive code. */
204 int next_event;
205
206 Lisp_Object prefix_arg;
207 unsigned char *string;
208 unsigned char *tem;
209
210 /* If varies[i] > 0, the i'th argument shouldn't just have its value
211 in this call quoted in the command history. It should be
212 recorded as a call to the function named callint_argfuns[varies[i]]. */
213 int *varies;
214
215 register int i, j;
216 int count, foo;
217 char prompt1[100];
218 char *tem1;
219 int arg_from_tty = 0;
220 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
221 int key_count;
222
223 if (NILP (keys))
224 keys = this_command_keys, key_count = this_command_key_count;
225 else
226 {
227 CHECK_VECTOR (keys);
228 key_count = XVECTOR (keys)->size;
229 }
230
231 /* Save this now, since use of minibuffer will clobber it. */
232 prefix_arg = Vcurrent_prefix_arg;
233
234 retry:
235
236 if (SYMBOLP (function))
237 enable = Fget (function, Qenable_recursive_minibuffers);
238 else
239 enable = Qnil;
240
241 fun = indirect_function (function);
242
243 specs = Qnil;
244 string = 0;
245
246 /* Decode the kind of function. Either handle it and return,
247 or go to `lose' if not interactive, or go to `retry'
248 to specify a different function, or set either STRING or SPECS. */
249
250 if (SUBRP (fun))
251 {
252 string = (unsigned char *) XSUBR (fun)->prompt;
253 if (!string)
254 {
255 lose:
256 function = wrong_type_argument (Qcommandp, function);
257 goto retry;
258 }
259 }
260 else if (COMPILEDP (fun))
261 {
262 if ((XVECTOR (fun)->size & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_INTERACTIVE)
263 goto lose;
264 specs = XVECTOR (fun)->contents[COMPILED_INTERACTIVE];
265 }
266 else if (!CONSP (fun))
267 goto lose;
268 else if (funcar = XCAR (fun), EQ (funcar, Qautoload))
269 {
270 GCPRO2 (function, prefix_arg);
271 do_autoload (fun, function);
272 UNGCPRO;
273 goto retry;
274 }
275 else if (EQ (funcar, Qlambda))
276 {
277 specs = Fassq (Qinteractive, Fcdr (XCDR (fun)));
278 if (NILP (specs))
279 goto lose;
280 specs = Fcar (Fcdr (specs));
281 }
282 else
283 goto lose;
284
285 /* If either specs or string is set to a string, use it. */
286 if (STRINGP (specs))
287 {
288 /* Make a copy of string so that if a GC relocates specs,
289 `string' will still be valid. */
290 string = (unsigned char *) alloca (STRING_BYTES (XSTRING (specs)) + 1);
291 bcopy (XSTRING (specs)->data, string,
292 STRING_BYTES (XSTRING (specs)) + 1);
293 }
294 else if (string == 0)
295 {
296 Lisp_Object input;
297 i = num_input_events;
298 input = specs;
299 /* Compute the arg values using the user's expression. */
300 specs = Feval (specs);
301 if (i != num_input_events || !NILP (record_flag))
302 {
303 /* We should record this command on the command history. */
304 Lisp_Object values, car;
305 /* Make a copy of the list of values, for the command history,
306 and turn them into things we can eval. */
307 values = quotify_args (Fcopy_sequence (specs));
308 /* If the list of args was produced with an explicit call to `list',
309 look for elements that were computed with (region-beginning)
310 or (region-end), and put those expressions into VALUES
311 instead of the present values. */
312 if (CONSP (input))
313 {
314 car = XCAR (input);
315 /* Skip through certain special forms. */
316 while (EQ (car, Qlet) || EQ (car, Qletx)
317 || EQ (car, Qsave_excursion))
318 {
319 while (CONSP (XCDR (input)))
320 input = XCDR (input);
321 input = XCAR (input);
322 if (!CONSP (input))
323 break;
324 car = XCAR (input);
325 }
326 if (EQ (car, Qlist))
327 {
328 Lisp_Object intail, valtail;
329 for (intail = Fcdr (input), valtail = values;
330 CONSP (valtail);
331 intail = Fcdr (intail), valtail = Fcdr (valtail))
332 {
333 Lisp_Object elt;
334 elt = Fcar (intail);
335 if (CONSP (elt))
336 {
337 Lisp_Object presflag;
338 presflag = Fmemq (Fcar (elt), preserved_fns);
339 if (!NILP (presflag))
340 Fsetcar (valtail, Fcar (intail));
341 }
342 }
343 }
344 }
345 Vcommand_history
346 = Fcons (Fcons (function, values), Vcommand_history);
347
348 /* Don't keep command history around forever. */
349 if (INTEGERP (Vhistory_length) && XINT (Vhistory_length) > 0)
350 {
351 teml = Fnthcdr (Vhistory_length, Vcommand_history);
352 if (CONSP (teml))
353 XSETCDR (teml, Qnil);
354 }
355 }
356 single_kboard_state ();
357 return apply1 (function, specs);
358 }
359
360 /* Here if function specifies a string to control parsing the defaults */
361
362 /* Set next_event to point to the first event with parameters. */
363 for (next_event = 0; next_event < key_count; next_event++)
364 if (EVENT_HAS_PARAMETERS (XVECTOR (keys)->contents[next_event]))
365 break;
366
367 /* Handle special starting chars `*' and `@'. Also `-'. */
368 /* Note that `+' is reserved for user extensions. */
369 while (1)
370 {
371 if (*string == '+')
372 error ("`+' is not used in `interactive' for ordinary commands");
373 else if (*string == '*')
374 {
375 string++;
376 if (!NILP (current_buffer->read_only))
377 Fbarf_if_buffer_read_only ();
378 }
379 /* Ignore this for semi-compatibility with Lucid. */
380 else if (*string == '-')
381 string++;
382 else if (*string == '@')
383 {
384 Lisp_Object event;
385
386 event = XVECTOR (keys)->contents[next_event];
387 if (EVENT_HAS_PARAMETERS (event)
388 && (event = XCDR (event), CONSP (event))
389 && (event = XCAR (event), CONSP (event))
390 && (event = XCAR (event), WINDOWP (event)))
391 {
392 if (MINI_WINDOW_P (XWINDOW (event))
393 && ! (minibuf_level > 0 && EQ (event, minibuf_window)))
394 error ("Attempt to select inactive minibuffer window");
395
396 /* If the current buffer wants to clean up, let it. */
397 if (!NILP (Vmouse_leave_buffer_hook))
398 call1 (Vrun_hooks, Qmouse_leave_buffer_hook);
399
400 Fselect_window (event);
401 }
402 string++;
403 }
404 else break;
405 }
406
407 /* Count the number of arguments the interactive spec would have
408 us give to the function. */
409 tem = string;
410 for (j = 0; *tem; j++)
411 {
412 /* 'r' specifications ("point and mark as 2 numeric args")
413 produce *two* arguments. */
414 if (*tem == 'r') j++;
415 tem = (unsigned char *) index (tem, '\n');
416 if (tem)
417 tem++;
418 else
419 tem = (unsigned char *) "";
420 }
421 count = j;
422
423 args = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object));
424 visargs = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object));
425 argstrings = (unsigned char **) alloca ((count + 1) * sizeof (char *));
426 varies = (int *) alloca ((count + 1) * sizeof (int));
427
428 for (i = 0; i < (count + 1); i++)
429 {
430 args[i] = Qnil;
431 visargs[i] = Qnil;
432 varies[i] = 0;
433 }
434
435 GCPRO4 (prefix_arg, function, *args, *visargs);
436 gcpro3.nvars = (count + 1);
437 gcpro4.nvars = (count + 1);
438
439 if (!NILP (enable))
440 specbind (Qenable_recursive_minibuffers, Qt);
441
442 tem = string;
443 for (i = 1; *tem; i++)
444 {
445 strncpy (prompt1, tem + 1, sizeof prompt1 - 1);
446 prompt1[sizeof prompt1 - 1] = 0;
447 tem1 = (char *) index (prompt1, '\n');
448 if (tem1) *tem1 = 0;
449 /* Fill argstrings with a vector of C strings
450 corresponding to the Lisp strings in visargs. */
451 for (j = 1; j < i; j++)
452 argstrings[j]
453 = (EQ (visargs[j], Qnil)
454 ? (unsigned char *) ""
455 : XSTRING (visargs[j])->data);
456
457 /* Process the format-string in prompt1, putting the output
458 into callint_message. Make callint_message bigger if necessary.
459 We don't use a buffer on the stack, because the contents
460 need to stay stable for a while. */
461 while (1)
462 {
463 int nchars = doprnt (callint_message, callint_message_size,
464 prompt1, (char *)0,
465 j - 1, (char **) argstrings + 1);
466 if (nchars < callint_message_size)
467 break;
468 callint_message_size *= 2;
469 callint_message
470 = (char *) xrealloc (callint_message, callint_message_size);
471 }
472
473 switch (*tem)
474 {
475 case 'a': /* Symbol defined as a function */
476 visargs[i] = Fcompleting_read (build_string (callint_message),
477 Vobarray, Qfboundp, Qt,
478 Qnil, Qnil, Qnil, Qnil);
479 /* Passing args[i] directly stimulates compiler bug */
480 teml = visargs[i];
481 args[i] = Fintern (teml, Qnil);
482 break;
483
484 case 'b': /* Name of existing buffer */
485 args[i] = Fcurrent_buffer ();
486 if (EQ (selected_window, minibuf_window))
487 args[i] = Fother_buffer (args[i], Qnil, Qnil);
488 args[i] = Fread_buffer (build_string (callint_message), args[i], Qt);
489 break;
490
491 case 'B': /* Name of buffer, possibly nonexistent */
492 args[i] = Fread_buffer (build_string (callint_message),
493 Fother_buffer (Fcurrent_buffer (), Qnil, Qnil),
494 Qnil);
495 break;
496
497 case 'c': /* Character */
498 args[i] = Fread_char (build_string (callint_message), Qnil);
499 message1_nolog ((char *) 0);
500 /* Passing args[i] directly stimulates compiler bug */
501 teml = args[i];
502 visargs[i] = Fchar_to_string (teml);
503 break;
504
505 case 'C': /* Command: symbol with interactive function */
506 visargs[i] = Fcompleting_read (build_string (callint_message),
507 Vobarray, Qcommandp,
508 Qt, 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 'd': /* Value of point. Does not do I/O. */
515 set_marker_both (point_marker, Qnil, PT, PT_BYTE);
516 args[i] = point_marker;
517 /* visargs[i] = Qnil; */
518 varies[i] = 1;
519 break;
520
521 case 'D': /* Directory name. */
522 args[i] = Fread_file_name (build_string (callint_message), Qnil,
523 current_buffer->directory, Qlambda, Qnil);
524 break;
525
526 case 'f': /* Existing file name. */
527 args[i] = Fread_file_name (build_string (callint_message),
528 Qnil, Qnil, Qlambda, Qnil);
529 break;
530
531 case 'F': /* Possibly nonexistent file name. */
532 args[i] = Fread_file_name (build_string (callint_message),
533 Qnil, Qnil, Qnil, Qnil);
534 break;
535
536 case 'i': /* Ignore an argument -- Does not do I/O */
537 varies[i] = -1;
538 break;
539
540 case 'k': /* Key sequence. */
541 {
542 int speccount1 = specpdl_ptr - specpdl;
543 specbind (Qcursor_in_echo_area, Qt);
544 args[i] = Fread_key_sequence (build_string (callint_message),
545 Qnil, Qnil, Qnil, Qnil);
546 unbind_to (speccount1, Qnil);
547 teml = args[i];
548 visargs[i] = Fkey_description (teml);
549
550 /* If the key sequence ends with a down-event,
551 discard the following up-event. */
552 teml = Faref (args[i], make_number (XINT (Flength (args[i])) - 1));
553 if (CONSP (teml))
554 teml = XCAR (teml);
555 if (SYMBOLP (teml))
556 {
557 Lisp_Object tem2;
558
559 teml = Fget (teml, intern ("event-symbol-elements"));
560 /* Ignore first element, which is the base key. */
561 tem2 = Fmemq (intern ("down"), Fcdr (teml));
562 if (! NILP (tem2))
563 Fread_event (Qnil, Qnil);
564 }
565 }
566 break;
567
568 case 'K': /* Key sequence to be defined. */
569 {
570 int speccount1 = specpdl_ptr - specpdl;
571 specbind (Qcursor_in_echo_area, Qt);
572 args[i] = Fread_key_sequence (build_string (callint_message),
573 Qnil, Qt, Qnil, Qnil);
574 teml = args[i];
575 visargs[i] = Fkey_description (teml);
576 unbind_to (speccount1, Qnil);
577
578 /* If the key sequence ends with a down-event,
579 discard the following up-event. */
580 teml = Faref (args[i], make_number (XINT (Flength (args[i])) - 1));
581 if (CONSP (teml))
582 teml = XCAR (teml);
583 if (SYMBOLP (teml))
584 {
585 Lisp_Object tem2;
586
587 teml = Fget (teml, intern ("event-symbol-elements"));
588 /* Ignore first element, which is the base key. */
589 tem2 = Fmemq (intern ("down"), Fcdr (teml));
590 if (! NILP (tem2))
591 Fread_event (Qnil, Qnil);
592 }
593 }
594 break;
595
596 case 'e': /* The invoking event. */
597 if (next_event >= key_count)
598 error ("%s must be bound to an event with parameters",
599 (SYMBOLP (function)
600 ? (char *) XSYMBOL (function)->name->data
601 : "command"));
602 args[i] = XVECTOR (keys)->contents[next_event++];
603 varies[i] = -1;
604
605 /* Find the next parameterized event. */
606 while (next_event < key_count
607 && ! (EVENT_HAS_PARAMETERS
608 (XVECTOR (keys)->contents[next_event])))
609 next_event++;
610
611 break;
612
613 case 'm': /* Value of mark. Does not do I/O. */
614 check_mark (0);
615 /* visargs[i] = Qnil; */
616 args[i] = current_buffer->mark;
617 varies[i] = 2;
618 break;
619
620 case 'M': /* String read via minibuffer with
621 inheriting the current input method. */
622 args[i] = Fread_string (build_string (callint_message),
623 Qnil, Qnil, Qnil, Qt);
624 break;
625
626 case 'N': /* Prefix arg, else number from minibuffer */
627 if (!NILP (prefix_arg))
628 goto have_prefix_arg;
629 case 'n': /* Read number from minibuffer. */
630 {
631 int first = 1;
632 do
633 {
634 Lisp_Object tem;
635 if (! first)
636 {
637 message ("Please enter a number.");
638 sit_for (1, 0, 0, 0, 0);
639 }
640 first = 0;
641
642 tem = Fread_from_minibuffer (build_string (callint_message),
643 Qnil, Qnil, Qnil, Qnil, Qnil,
644 Qnil);
645 if (! STRINGP (tem) || XSTRING (tem)->size == 0)
646 args[i] = Qnil;
647 else
648 args[i] = Fread (tem);
649 }
650 while (! NUMBERP (args[i]));
651 }
652 visargs[i] = last_minibuf_string;
653 break;
654
655 case 'P': /* Prefix arg in raw form. Does no I/O. */
656 args[i] = prefix_arg;
657 /* visargs[i] = Qnil; */
658 varies[i] = -1;
659 break;
660
661 case 'p': /* Prefix arg converted to number. No I/O. */
662 have_prefix_arg:
663 args[i] = Fprefix_numeric_value (prefix_arg);
664 /* visargs[i] = Qnil; */
665 varies[i] = -1;
666 break;
667
668 case 'r': /* Region, point and mark as 2 args. */
669 check_mark (1);
670 set_marker_both (point_marker, Qnil, PT, PT_BYTE);
671 /* visargs[i+1] = Qnil; */
672 foo = marker_position (current_buffer->mark);
673 /* visargs[i] = Qnil; */
674 args[i] = PT < foo ? point_marker : current_buffer->mark;
675 varies[i] = 3;
676 args[++i] = PT > foo ? point_marker : current_buffer->mark;
677 varies[i] = 4;
678 break;
679
680 case 's': /* String read via minibuffer without
681 inheriting the current input method. */
682 args[i] = Fread_string (build_string (callint_message),
683 Qnil, Qnil, Qnil, Qnil);
684 break;
685
686 case 'S': /* Any symbol. */
687 visargs[i] = Fread_string (build_string (callint_message),
688 Qnil, Qnil, Qnil, Qnil);
689 /* Passing args[i] directly stimulates compiler bug */
690 teml = visargs[i];
691 args[i] = Fintern (teml, Qnil);
692 break;
693
694 case 'v': /* Variable name: symbol that is
695 user-variable-p. */
696 args[i] = Fread_variable (build_string (callint_message), Qnil);
697 visargs[i] = last_minibuf_string;
698 break;
699
700 case 'x': /* Lisp expression read but not evaluated */
701 args[i] = Fread_minibuffer (build_string (callint_message), Qnil);
702 visargs[i] = last_minibuf_string;
703 break;
704
705 case 'X': /* Lisp expression read and evaluated */
706 args[i] = Feval_minibuffer (build_string (callint_message), Qnil);
707 visargs[i] = last_minibuf_string;
708 break;
709
710 case 'Z': /* Coding-system symbol, or ignore the
711 argument if no prefix */
712 if (NILP (prefix_arg))
713 {
714 args[i] = Qnil;
715 varies[i] = -1;
716 }
717 else
718 {
719 args[i]
720 = Fread_non_nil_coding_system (build_string (callint_message));
721 visargs[i] = last_minibuf_string;
722 }
723 break;
724
725 case 'z': /* Coding-system symbol or nil */
726 args[i] = Fread_coding_system (build_string (callint_message), Qnil);
727 visargs[i] = last_minibuf_string;
728 break;
729
730 /* We have a case for `+' so we get an error
731 if anyone tries to define one here. */
732 case '+':
733 default:
734 error ("Invalid control letter `%c' (%03o) in interactive calling string",
735 *tem, *tem);
736 }
737
738 if (varies[i] == 0)
739 arg_from_tty = 1;
740
741 if (NILP (visargs[i]) && STRINGP (args[i]))
742 visargs[i] = args[i];
743
744 tem = (unsigned char *) index (tem, '\n');
745 if (tem) tem++;
746 else tem = (unsigned char *) "";
747 }
748 unbind_to (speccount, Qnil);
749
750 QUIT;
751
752 args[0] = function;
753
754 if (arg_from_tty || !NILP (record_flag))
755 {
756 visargs[0] = function;
757 for (i = 1; i < count + 1; i++)
758 {
759 if (varies[i] > 0)
760 visargs[i] = Fcons (intern (callint_argfuns[varies[i]]), Qnil);
761 else
762 visargs[i] = quotify_arg (args[i]);
763 }
764 Vcommand_history = Fcons (Flist (count + 1, visargs),
765 Vcommand_history);
766 /* Don't keep command history around forever. */
767 if (INTEGERP (Vhistory_length) && XINT (Vhistory_length) > 0)
768 {
769 teml = Fnthcdr (Vhistory_length, Vcommand_history);
770 if (CONSP (teml))
771 XSETCDR (teml, Qnil);
772 }
773 }
774
775 /* If we used a marker to hold point, mark, or an end of the region,
776 temporarily, convert it to an integer now. */
777 for (i = 1; i <= count; i++)
778 if (varies[i] >= 1 && varies[i] <= 4)
779 XSETINT (args[i], marker_position (args[i]));
780
781 single_kboard_state ();
782
783 {
784 Lisp_Object val;
785 specbind (Qcommand_debug_status, Qnil);
786
787 val = Ffuncall (count + 1, args);
788 UNGCPRO;
789 return unbind_to (speccount, val);
790 }
791 }
792
793 DEFUN ("prefix-numeric-value", Fprefix_numeric_value, Sprefix_numeric_value,
794 1, 1, 0,
795 doc: /* Return numeric meaning of raw prefix argument RAW.
796 A raw prefix argument is what you get from `(interactive "P")'.
797 Its numeric meaning is what you would get from `(interactive "p")'. */)
798 (raw)
799 Lisp_Object raw;
800 {
801 Lisp_Object val;
802
803 if (NILP (raw))
804 XSETFASTINT (val, 1);
805 else if (EQ (raw, Qminus))
806 XSETINT (val, -1);
807 else if (CONSP (raw) && INTEGERP (XCAR (raw)))
808 XSETINT (val, XINT (XCAR (raw)));
809 else if (INTEGERP (raw))
810 val = raw;
811 else
812 XSETFASTINT (val, 1);
813
814 return val;
815 }
816
817 void
818 syms_of_callint ()
819 {
820 point_marker = Fmake_marker ();
821 staticpro (&point_marker);
822
823 preserved_fns = Fcons (intern ("region-beginning"),
824 Fcons (intern ("region-end"),
825 Fcons (intern ("point"),
826 Fcons (intern ("mark"), Qnil))));
827 staticpro (&preserved_fns);
828
829 Qlist = intern ("list");
830 staticpro (&Qlist);
831 Qlet = intern ("let");
832 staticpro (&Qlet);
833 Qletx = intern ("let*");
834 staticpro (&Qletx);
835 Qsave_excursion = intern ("save-excursion");
836 staticpro (&Qsave_excursion);
837
838 Qminus = intern ("-");
839 staticpro (&Qminus);
840
841 Qplus = intern ("+");
842 staticpro (&Qplus);
843
844 Qcall_interactively = intern ("call-interactively");
845 staticpro (&Qcall_interactively);
846
847 Qcommand_debug_status = intern ("command-debug-status");
848 staticpro (&Qcommand_debug_status);
849
850 Qenable_recursive_minibuffers = intern ("enable-recursive-minibuffers");
851 staticpro (&Qenable_recursive_minibuffers);
852
853 Qmouse_leave_buffer_hook = intern ("mouse-leave-buffer-hook");
854 staticpro (&Qmouse_leave_buffer_hook);
855
856 callint_message_size = 100;
857 callint_message = (char *) xmalloc (callint_message_size);
858
859
860 DEFVAR_KBOARD ("prefix-arg", Vprefix_arg,
861 doc: /* The value of the prefix argument for the next editing command.
862 It may be a number, or the symbol `-' for just a minus sign as arg,
863 or a list whose car is a number for just one or more C-u's
864 or nil if no argument has been specified.
865
866 You cannot examine this variable to find the argument for this command
867 since it has been set to nil by the time you can look.
868 Instead, you should use the variable `current-prefix-arg', although
869 normally commands can get this prefix argument with (interactive "P"). */);
870
871 DEFVAR_KBOARD ("last-prefix-arg", Vlast_prefix_arg,
872 doc: /* The value of the prefix argument for the previous editing command.
873 See `prefix-arg' for the meaning of the value. */);
874
875 DEFVAR_LISP ("current-prefix-arg", &Vcurrent_prefix_arg,
876 doc: /* The value of the prefix argument for this editing command.
877 It may be a number, or the symbol `-' for just a minus sign as arg,
878 or a list whose car is a number for just one or more C-u's
879 or nil if no argument has been specified.
880 This is what `(interactive \"P\")' returns. */);
881 Vcurrent_prefix_arg = Qnil;
882
883 DEFVAR_LISP ("command-history", &Vcommand_history,
884 doc: /* List of recent commands that read arguments from terminal.
885 Each command is represented as a form to evaluate. */);
886 Vcommand_history = Qnil;
887
888 DEFVAR_LISP ("command-debug-status", &Vcommand_debug_status,
889 doc: /* Debugging status of current interactive command.
890 Bound each time `call-interactively' is called;
891 may be set by the debugger as a reminder for itself. */);
892 Vcommand_debug_status = Qnil;
893
894 DEFVAR_LISP ("mark-even-if-inactive", &Vmark_even_if_inactive,
895 doc: /* *Non-nil means you can use the mark even when inactive.
896 This option makes a difference in Transient Mark mode.
897 When the option is non-nil, deactivation of the mark
898 turns off region highlighting, but commands that use the mark
899 behave as if the mark were still active. */);
900 Vmark_even_if_inactive = Qnil;
901
902 DEFVAR_LISP ("mouse-leave-buffer-hook", &Vmouse_leave_buffer_hook,
903 doc: /* Hook to run when about to switch windows with a mouse command.
904 Its purpose is to give temporary modes such as Isearch mode
905 a way to turn themselves off when a mouse command switches windows. */);
906 Vmouse_leave_buffer_hook = Qnil;
907
908 defsubr (&Sinteractive);
909 defsubr (&Scall_interactively);
910 defsubr (&Sprefix_numeric_value);
911 }