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