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