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