(font-lock-defontify): Use restore-buffer-modified-p.
[emacs.git] / src / callint.c
blob6ce9fb123879d00b64d283f3a916db337739f26c
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;
224 int record_then_fail = 0;
226 if (NILP (keys))
227 keys = this_command_keys, key_count = this_command_key_count;
228 else
230 CHECK_VECTOR (keys);
231 key_count = XVECTOR (keys)->size;
234 /* Save this now, since use of minibuffer will clobber it. */
235 prefix_arg = Vcurrent_prefix_arg;
237 retry:
239 if (SYMBOLP (function))
240 enable = Fget (function, Qenable_recursive_minibuffers);
241 else
242 enable = Qnil;
244 fun = indirect_function (function);
246 specs = Qnil;
247 string = 0;
248 /* The idea of FILTER_SPECS is to provide away to
249 specify how to represent the arguments in command history.
250 The feature is not fully implemented. */
251 filter_specs = Qnil;
253 /* Decode the kind of function. Either handle it and return,
254 or go to `lose' if not interactive, or go to `retry'
255 to specify a different function, or set either STRING or SPECS. */
257 if (SUBRP (fun))
259 string = (unsigned char *) XSUBR (fun)->prompt;
260 if (!string)
262 lose:
263 function = wrong_type_argument (Qcommandp, function);
264 goto retry;
267 else if (COMPILEDP (fun))
269 if ((XVECTOR (fun)->size & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_INTERACTIVE)
270 goto lose;
271 specs = XVECTOR (fun)->contents[COMPILED_INTERACTIVE];
273 else if (!CONSP (fun))
274 goto lose;
275 else if (funcar = XCAR (fun), EQ (funcar, Qautoload))
277 GCPRO2 (function, prefix_arg);
278 do_autoload (fun, function);
279 UNGCPRO;
280 goto retry;
282 else if (EQ (funcar, Qlambda))
284 specs = Fassq (Qinteractive, Fcdr (XCDR (fun)));
285 if (NILP (specs))
286 goto lose;
287 filter_specs = Fnth (make_number (1), specs);
288 specs = Fcar (Fcdr (specs));
290 else
291 goto lose;
293 /* If either SPECS or STRING is set to a string, use it. */
294 if (STRINGP (specs))
296 /* Make a copy of string so that if a GC relocates specs,
297 `string' will still be valid. */
298 string = (unsigned char *) alloca (SBYTES (specs) + 1);
299 bcopy (SDATA (specs), string,
300 SBYTES (specs) + 1);
302 else if (string == 0)
304 Lisp_Object input;
305 i = num_input_events;
306 input = specs;
307 /* Compute the arg values using the user's expression. */
308 GCPRO2 (input, filter_specs);
309 specs = Feval (specs);
310 UNGCPRO;
311 if (i != num_input_events || !NILP (record_flag))
313 /* We should record this command on the command history. */
314 Lisp_Object values, car;
315 /* Make a copy of the list of values, for the command history,
316 and turn them into things we can eval. */
317 values = quotify_args (Fcopy_sequence (specs));
318 /* If the list of args was produced with an explicit call to `list',
319 look for elements that were computed with (region-beginning)
320 or (region-end), and put those expressions into VALUES
321 instead of the present values. */
322 if (CONSP (input))
324 car = XCAR (input);
325 /* Skip through certain special forms. */
326 while (EQ (car, Qlet) || EQ (car, Qletx)
327 || EQ (car, Qsave_excursion)
328 || EQ (car, Qprogn))
330 while (CONSP (XCDR (input)))
331 input = XCDR (input);
332 input = XCAR (input);
333 if (!CONSP (input))
334 break;
335 car = XCAR (input);
337 if (EQ (car, Qlist))
339 Lisp_Object intail, valtail;
340 for (intail = Fcdr (input), valtail = values;
341 CONSP (valtail);
342 intail = Fcdr (intail), valtail = Fcdr (valtail))
344 Lisp_Object elt;
345 elt = Fcar (intail);
346 if (CONSP (elt))
348 Lisp_Object presflag;
349 presflag = Fmemq (Fcar (elt), preserved_fns);
350 if (!NILP (presflag))
351 Fsetcar (valtail, Fcar (intail));
356 Vcommand_history
357 = Fcons (Fcons (function, values), Vcommand_history);
359 /* Don't keep command history around forever. */
360 if (INTEGERP (Vhistory_length) && XINT (Vhistory_length) > 0)
362 teml = Fnthcdr (Vhistory_length, Vcommand_history);
363 if (CONSP (teml))
364 XSETCDR (teml, Qnil);
367 single_kboard_state ();
368 return apply1 (function, specs);
371 /* Here if function specifies a string to control parsing the defaults */
373 /* Set next_event to point to the first event with parameters. */
374 for (next_event = 0; next_event < key_count; next_event++)
375 if (EVENT_HAS_PARAMETERS (XVECTOR (keys)->contents[next_event]))
376 break;
378 /* Handle special starting chars `*' and `@'. Also `-'. */
379 /* Note that `+' is reserved for user extensions. */
380 while (1)
382 if (*string == '+')
383 error ("`+' is not used in `interactive' for ordinary commands");
384 else if (*string == '*')
386 string++;
387 if (!NILP (current_buffer->read_only))
389 if (!NILP (record_flag))
391 unsigned char *p = string;
392 while (*p)
394 if (! (*p == 'r' || *p == 'p' || *p == 'P'
395 || *p == '\n'))
396 Fbarf_if_buffer_read_only ();
397 p++;
399 record_then_fail = 1;
401 else
402 Fbarf_if_buffer_read_only ();
405 /* Ignore this for semi-compatibility with Lucid. */
406 else if (*string == '-')
407 string++;
408 else if (*string == '@')
410 Lisp_Object event;
412 event = (next_event < key_count
413 ? XVECTOR (keys)->contents[next_event]
414 : Qnil);
415 if (EVENT_HAS_PARAMETERS (event)
416 && (event = XCDR (event), CONSP (event))
417 && (event = XCAR (event), CONSP (event))
418 && (event = XCAR (event), WINDOWP (event)))
420 if (MINI_WINDOW_P (XWINDOW (event))
421 && ! (minibuf_level > 0 && EQ (event, minibuf_window)))
422 error ("Attempt to select inactive minibuffer window");
424 /* If the current buffer wants to clean up, let it. */
425 if (!NILP (Vmouse_leave_buffer_hook))
426 call1 (Vrun_hooks, Qmouse_leave_buffer_hook);
428 Fselect_window (event);
430 string++;
432 else break;
435 /* Count the number of arguments the interactive spec would have
436 us give to the function. */
437 tem = string;
438 for (j = 0; *tem; j++)
440 /* 'r' specifications ("point and mark as 2 numeric args")
441 produce *two* arguments. */
442 if (*tem == 'r') j++;
443 tem = (unsigned char *) index (tem, '\n');
444 if (tem)
445 tem++;
446 else
447 tem = (unsigned char *) "";
449 count = j;
451 args = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object));
452 visargs = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object));
453 argstrings = (unsigned char **) alloca ((count + 1) * sizeof (char *));
454 varies = (int *) alloca ((count + 1) * sizeof (int));
456 for (i = 0; i < (count + 1); i++)
458 args[i] = Qnil;
459 visargs[i] = Qnil;
460 varies[i] = 0;
463 GCPRO4 (prefix_arg, function, *args, *visargs);
464 gcpro3.nvars = (count + 1);
465 gcpro4.nvars = (count + 1);
467 if (!NILP (enable))
468 specbind (Qenable_recursive_minibuffers, Qt);
470 tem = string;
471 for (i = 1; *tem; i++)
473 strncpy (prompt1, tem + 1, sizeof prompt1 - 1);
474 prompt1[sizeof prompt1 - 1] = 0;
475 tem1 = (char *) index (prompt1, '\n');
476 if (tem1) *tem1 = 0;
477 /* Fill argstrings with a vector of C strings
478 corresponding to the Lisp strings in visargs. */
479 for (j = 1; j < i; j++)
480 argstrings[j]
481 = (EQ (visargs[j], Qnil)
482 ? (unsigned char *) ""
483 : SDATA (visargs[j]));
485 /* Process the format-string in prompt1, putting the output
486 into callint_message. Make callint_message bigger if necessary.
487 We don't use a buffer on the stack, because the contents
488 need to stay stable for a while. */
489 while (1)
491 int nchars = doprnt (callint_message, callint_message_size,
492 prompt1, (char *)0,
493 j - 1, (char **) argstrings + 1);
494 if (nchars < callint_message_size - 1)
495 break;
496 callint_message_size *= 2;
497 callint_message
498 = (char *) xrealloc (callint_message, callint_message_size);
501 switch (*tem)
503 case 'a': /* Symbol defined as a function */
504 visargs[i] = Fcompleting_read (build_string (callint_message),
505 Vobarray, Qfboundp, Qt,
506 Qnil, Qnil, Qnil, Qnil);
507 /* Passing args[i] directly stimulates compiler bug */
508 teml = visargs[i];
509 args[i] = Fintern (teml, Qnil);
510 break;
512 case 'b': /* Name of existing buffer */
513 args[i] = Fcurrent_buffer ();
514 if (EQ (selected_window, minibuf_window))
515 args[i] = Fother_buffer (args[i], Qnil, Qnil);
516 args[i] = Fread_buffer (build_string (callint_message), args[i], Qt);
517 break;
519 case 'B': /* Name of buffer, possibly nonexistent */
520 args[i] = Fread_buffer (build_string (callint_message),
521 Fother_buffer (Fcurrent_buffer (), Qnil, Qnil),
522 Qnil);
523 break;
525 case 'c': /* Character */
526 args[i] = Fread_char (build_string (callint_message), Qnil);
527 message1_nolog ((char *) 0);
528 /* Passing args[i] directly stimulates compiler bug */
529 teml = args[i];
530 visargs[i] = Fchar_to_string (teml);
531 break;
533 case 'C': /* Command: symbol with interactive function */
534 visargs[i] = Fcompleting_read (build_string (callint_message),
535 Vobarray, Qcommandp,
536 Qt, Qnil, Qnil, Qnil, Qnil);
537 /* Passing args[i] directly stimulates compiler bug */
538 teml = visargs[i];
539 args[i] = Fintern (teml, Qnil);
540 break;
542 case 'd': /* Value of point. Does not do I/O. */
543 set_marker_both (point_marker, Qnil, PT, PT_BYTE);
544 args[i] = point_marker;
545 /* visargs[i] = Qnil; */
546 varies[i] = 1;
547 break;
549 case 'D': /* Directory name. */
550 args[i] = Fread_file_name (build_string (callint_message), Qnil,
551 current_buffer->directory, Qlambda, Qnil,
552 Qfile_directory_p);
553 break;
555 case 'f': /* Existing file name. */
556 args[i] = Fread_file_name (build_string (callint_message),
557 Qnil, Qnil, Qlambda, Qnil, Qnil);
558 break;
560 case 'F': /* Possibly nonexistent file name. */
561 args[i] = Fread_file_name (build_string (callint_message),
562 Qnil, Qnil, Qnil, Qnil, Qnil);
563 break;
565 case 'i': /* Ignore an argument -- Does not do I/O */
566 varies[i] = -1;
567 break;
569 case 'k': /* Key sequence. */
571 int speccount1 = SPECPDL_INDEX ();
572 specbind (Qcursor_in_echo_area, Qt);
573 args[i] = Fread_key_sequence (build_string (callint_message),
574 Qnil, Qnil, Qnil, Qnil);
575 unbind_to (speccount1, Qnil);
576 teml = args[i];
577 visargs[i] = Fkey_description (teml);
579 /* If the key sequence ends with a down-event,
580 discard the following up-event. */
581 teml = Faref (args[i], make_number (XINT (Flength (args[i])) - 1));
582 if (CONSP (teml))
583 teml = XCAR (teml);
584 if (SYMBOLP (teml))
586 Lisp_Object tem2;
588 teml = Fget (teml, intern ("event-symbol-elements"));
589 /* Ignore first element, which is the base key. */
590 tem2 = Fmemq (intern ("down"), Fcdr (teml));
591 if (! NILP (tem2))
592 Fread_event (Qnil, Qnil);
595 break;
597 case 'K': /* Key sequence to be defined. */
599 int speccount1 = SPECPDL_INDEX ();
600 specbind (Qcursor_in_echo_area, Qt);
601 args[i] = Fread_key_sequence (build_string (callint_message),
602 Qnil, Qt, Qnil, Qnil);
603 teml = args[i];
604 visargs[i] = Fkey_description (teml);
605 unbind_to (speccount1, Qnil);
607 /* If the key sequence ends with a down-event,
608 discard the following up-event. */
609 teml = Faref (args[i], make_number (XINT (Flength (args[i])) - 1));
610 if (CONSP (teml))
611 teml = XCAR (teml);
612 if (SYMBOLP (teml))
614 Lisp_Object tem2;
616 teml = Fget (teml, intern ("event-symbol-elements"));
617 /* Ignore first element, which is the base key. */
618 tem2 = Fmemq (intern ("down"), Fcdr (teml));
619 if (! NILP (tem2))
620 Fread_event (Qnil, Qnil);
623 break;
625 case 'e': /* The invoking event. */
626 if (next_event >= key_count)
627 error ("%s must be bound to an event with parameters",
628 (SYMBOLP (function)
629 ? (char *) SDATA (SYMBOL_NAME (function))
630 : "command"));
631 args[i] = XVECTOR (keys)->contents[next_event++];
632 varies[i] = -1;
634 /* Find the next parameterized event. */
635 while (next_event < key_count
636 && ! (EVENT_HAS_PARAMETERS
637 (XVECTOR (keys)->contents[next_event])))
638 next_event++;
640 break;
642 case 'm': /* Value of mark. Does not do I/O. */
643 check_mark (0);
644 /* visargs[i] = Qnil; */
645 args[i] = current_buffer->mark;
646 varies[i] = 2;
647 break;
649 case 'M': /* String read via minibuffer with
650 inheriting the current input method. */
651 args[i] = Fread_string (build_string (callint_message),
652 Qnil, Qnil, Qnil, Qt);
653 break;
655 case 'N': /* Prefix arg, else number from minibuffer */
656 if (!NILP (prefix_arg))
657 goto have_prefix_arg;
658 case 'n': /* Read number from minibuffer. */
660 int first = 1;
663 Lisp_Object tem;
664 if (! first)
666 message ("Please enter a number.");
667 sit_for (1, 0, 0, 0, 0);
669 first = 0;
671 tem = Fread_from_minibuffer (build_string (callint_message),
672 Qnil, Qnil, Qnil, Qnil, Qnil,
673 Qnil);
674 if (! STRINGP (tem) || SCHARS (tem) == 0)
675 args[i] = Qnil;
676 else
677 args[i] = Fread (tem);
679 while (! NUMBERP (args[i]));
681 visargs[i] = last_minibuf_string;
682 break;
684 case 'P': /* Prefix arg in raw form. Does no I/O. */
685 args[i] = prefix_arg;
686 /* visargs[i] = Qnil; */
687 varies[i] = -1;
688 break;
690 case 'p': /* Prefix arg converted to number. No I/O. */
691 have_prefix_arg:
692 args[i] = Fprefix_numeric_value (prefix_arg);
693 /* visargs[i] = Qnil; */
694 varies[i] = -1;
695 break;
697 case 'r': /* Region, point and mark as 2 args. */
698 check_mark (1);
699 set_marker_both (point_marker, Qnil, PT, PT_BYTE);
700 /* visargs[i+1] = Qnil; */
701 foo = marker_position (current_buffer->mark);
702 /* visargs[i] = Qnil; */
703 args[i] = PT < foo ? point_marker : current_buffer->mark;
704 varies[i] = 3;
705 args[++i] = PT > foo ? point_marker : current_buffer->mark;
706 varies[i] = 4;
707 break;
709 case 's': /* String read via minibuffer without
710 inheriting the current input method. */
711 args[i] = Fread_string (build_string (callint_message),
712 Qnil, Qnil, Qnil, Qnil);
713 break;
715 case 'S': /* Any symbol. */
716 visargs[i] = Fread_string (build_string (callint_message),
717 Qnil, Qnil, Qnil, Qnil);
718 /* Passing args[i] directly stimulates compiler bug */
719 teml = visargs[i];
720 args[i] = Fintern (teml, Qnil);
721 break;
723 case 'v': /* Variable name: symbol that is
724 user-variable-p. */
725 args[i] = Fread_variable (build_string (callint_message), Qnil);
726 visargs[i] = last_minibuf_string;
727 break;
729 case 'x': /* Lisp expression read but not evaluated */
730 args[i] = Fread_minibuffer (build_string (callint_message), Qnil);
731 visargs[i] = last_minibuf_string;
732 break;
734 case 'X': /* Lisp expression read and evaluated */
735 args[i] = Feval_minibuffer (build_string (callint_message), Qnil);
736 visargs[i] = last_minibuf_string;
737 break;
739 case 'Z': /* Coding-system symbol, or ignore the
740 argument if no prefix */
741 if (NILP (prefix_arg))
743 args[i] = Qnil;
744 varies[i] = -1;
746 else
748 args[i]
749 = Fread_non_nil_coding_system (build_string (callint_message));
750 visargs[i] = last_minibuf_string;
752 break;
754 case 'z': /* Coding-system symbol or nil */
755 args[i] = Fread_coding_system (build_string (callint_message), Qnil);
756 visargs[i] = last_minibuf_string;
757 break;
759 /* We have a case for `+' so we get an error
760 if anyone tries to define one here. */
761 case '+':
762 default:
763 error ("Invalid control letter `%c' (%03o) in interactive calling string",
764 *tem, *tem);
767 if (varies[i] == 0)
768 arg_from_tty = 1;
770 if (NILP (visargs[i]) && STRINGP (args[i]))
771 visargs[i] = args[i];
773 tem = (unsigned char *) index (tem, '\n');
774 if (tem) tem++;
775 else tem = (unsigned char *) "";
777 unbind_to (speccount, Qnil);
779 QUIT;
781 args[0] = function;
783 if (arg_from_tty || !NILP (record_flag))
785 visargs[0] = function;
786 for (i = 1; i < count + 1; i++)
788 if (varies[i] > 0)
789 visargs[i] = Fcons (intern (callint_argfuns[varies[i]]), Qnil);
790 else
791 visargs[i] = quotify_arg (args[i]);
793 Vcommand_history = Fcons (Flist (count + 1, visargs),
794 Vcommand_history);
795 /* Don't keep command history around forever. */
796 if (INTEGERP (Vhistory_length) && XINT (Vhistory_length) > 0)
798 teml = Fnthcdr (Vhistory_length, Vcommand_history);
799 if (CONSP (teml))
800 XSETCDR (teml, Qnil);
804 /* If we used a marker to hold point, mark, or an end of the region,
805 temporarily, convert it to an integer now. */
806 for (i = 1; i <= count; i++)
807 if (varies[i] >= 1 && varies[i] <= 4)
808 XSETINT (args[i], marker_position (args[i]));
810 if (record_then_fail)
811 Fbarf_if_buffer_read_only ();
813 single_kboard_state ();
816 Lisp_Object val;
817 specbind (Qcommand_debug_status, Qnil);
819 val = Ffuncall (count + 1, args);
820 UNGCPRO;
821 return unbind_to (speccount, val);
825 DEFUN ("prefix-numeric-value", Fprefix_numeric_value, Sprefix_numeric_value,
826 1, 1, 0,
827 doc: /* Return numeric meaning of raw prefix argument RAW.
828 A raw prefix argument is what you get from `(interactive "P")'.
829 Its numeric meaning is what you would get from `(interactive "p")'. */)
830 (raw)
831 Lisp_Object raw;
833 Lisp_Object val;
835 if (NILP (raw))
836 XSETFASTINT (val, 1);
837 else if (EQ (raw, Qminus))
838 XSETINT (val, -1);
839 else if (CONSP (raw) && INTEGERP (XCAR (raw)))
840 XSETINT (val, XINT (XCAR (raw)));
841 else if (INTEGERP (raw))
842 val = raw;
843 else
844 XSETFASTINT (val, 1);
846 return val;
849 void
850 syms_of_callint ()
852 point_marker = Fmake_marker ();
853 staticpro (&point_marker);
855 preserved_fns = Fcons (intern ("region-beginning"),
856 Fcons (intern ("region-end"),
857 Fcons (intern ("point"),
858 Fcons (intern ("mark"), Qnil))));
859 staticpro (&preserved_fns);
861 Qlist = intern ("list");
862 staticpro (&Qlist);
863 Qlet = intern ("let");
864 staticpro (&Qlet);
865 Qletx = intern ("let*");
866 staticpro (&Qletx);
867 Qsave_excursion = intern ("save-excursion");
868 staticpro (&Qsave_excursion);
869 Qprogn = intern ("progn");
870 staticpro (&Qprogn);
872 Qminus = intern ("-");
873 staticpro (&Qminus);
875 Qplus = intern ("+");
876 staticpro (&Qplus);
878 Qcall_interactively = intern ("call-interactively");
879 staticpro (&Qcall_interactively);
881 Qcommand_debug_status = intern ("command-debug-status");
882 staticpro (&Qcommand_debug_status);
884 Qenable_recursive_minibuffers = intern ("enable-recursive-minibuffers");
885 staticpro (&Qenable_recursive_minibuffers);
887 Qmouse_leave_buffer_hook = intern ("mouse-leave-buffer-hook");
888 staticpro (&Qmouse_leave_buffer_hook);
890 callint_message_size = 100;
891 callint_message = (char *) xmalloc (callint_message_size);
894 DEFVAR_KBOARD ("prefix-arg", Vprefix_arg,
895 doc: /* The value of the prefix argument for the next editing command.
896 It may be a number, or the symbol `-' for just a minus sign as arg,
897 or a list whose car is a number for just one or more C-u's
898 or nil if no argument has been specified.
900 You cannot examine this variable to find the argument for this command
901 since it has been set to nil by the time you can look.
902 Instead, you should use the variable `current-prefix-arg', although
903 normally commands can get this prefix argument with (interactive "P"). */);
905 DEFVAR_KBOARD ("last-prefix-arg", Vlast_prefix_arg,
906 doc: /* The value of the prefix argument for the previous editing command.
907 See `prefix-arg' for the meaning of the value. */);
909 DEFVAR_LISP ("current-prefix-arg", &Vcurrent_prefix_arg,
910 doc: /* The value of the prefix argument for this editing command.
911 It may be a number, or the symbol `-' for just a minus sign as arg,
912 or a list whose car is a number for just one or more C-u's
913 or nil if no argument has been specified.
914 This is what `(interactive \"P\")' returns. */);
915 Vcurrent_prefix_arg = Qnil;
917 DEFVAR_LISP ("command-history", &Vcommand_history,
918 doc: /* List of recent commands that read arguments from terminal.
919 Each command is represented as a form to evaluate. */);
920 Vcommand_history = Qnil;
922 DEFVAR_LISP ("command-debug-status", &Vcommand_debug_status,
923 doc: /* Debugging status of current interactive command.
924 Bound each time `call-interactively' is called;
925 may be set by the debugger as a reminder for itself. */);
926 Vcommand_debug_status = Qnil;
928 DEFVAR_LISP ("mark-even-if-inactive", &Vmark_even_if_inactive,
929 doc: /* *Non-nil means you can use the mark even when inactive.
930 This option makes a difference in Transient Mark mode.
931 When the option is non-nil, deactivation of the mark
932 turns off region highlighting, but commands that use the mark
933 behave as if the mark were still active. */);
934 Vmark_even_if_inactive = Qnil;
936 DEFVAR_LISP ("mouse-leave-buffer-hook", &Vmouse_leave_buffer_hook,
937 doc: /* Hook to run when about to switch windows with a mouse command.
938 Its purpose is to give temporary modes such as Isearch mode
939 a way to turn themselves off when a mouse command switches windows. */);
940 Vmouse_leave_buffer_hook = Qnil;
942 defsubr (&Sinteractive);
943 defsubr (&Scall_interactively);
944 defsubr (&Sprefix_numeric_value);