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