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