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