XEmacs 21.2.20 "Yoko".
[chise/xemacs-chise.git.1] / src / callint.c
1 /* Call a Lisp function interactively.
2    Copyright (C) 1985, 1986, 1992, 1993, 1994 Free Software Foundation, Inc.
3    Copyright (C) 1995, 1996 Ben Wing.
4
5 This file is part of XEmacs.
6
7 XEmacs is free software; you can redistribute it and/or modify it
8 under the terms of the GNU General Public License as published by the
9 Free Software Foundation; either version 2, or (at your option) any
10 later version.
11
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
15 for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with XEmacs; 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 /* Synched up with: FSF 19.30, Mule 2.0. */
23
24 /* Authorship:
25
26    FSF: long ago.
27    Mly or JWZ: various changes.
28  */
29
30 #include <config.h>
31 #include "lisp.h"
32
33 #include "buffer.h"
34 #include "bytecode.h"
35 #include "commands.h"
36 #include "events.h"
37 #include "insdel.h"
38 #include "window.h"
39
40 extern int num_input_chars;
41
42 Lisp_Object Vcurrent_prefix_arg;
43 Lisp_Object Qcall_interactively;
44 Lisp_Object Vcommand_history;
45
46 Lisp_Object Vcommand_debug_status, Qcommand_debug_status;
47 Lisp_Object Qenable_recursive_minibuffers;
48
49 #if 0 /* FSFmacs */
50 /* Non-nil means treat the mark as active
51    even if mark_active is 0.  */
52 Lisp_Object Vmark_even_if_inactive;
53 #endif
54
55 #if 0 /* ill-conceived */
56 Lisp_Object Vmouse_leave_buffer_hook, Qmouse_leave_buffer_hook;
57 #endif
58
59 Lisp_Object Qlet, QletX, Qsave_excursion;
60
61 Lisp_Object Qread_from_minibuffer;
62 Lisp_Object Qread_file_name;
63 Lisp_Object Qread_directory_name;
64 Lisp_Object Qcompleting_read;
65 Lisp_Object Qread_buffer;
66 Lisp_Object Qread_function;
67 Lisp_Object Qread_variable;
68 Lisp_Object Qread_expression;
69 Lisp_Object Qread_command;
70 Lisp_Object Qread_number;
71 Lisp_Object Qread_string;
72 Lisp_Object Qevents_to_keys;
73
74 #if defined(MULE) || defined(FILE_CODING)
75 Lisp_Object Qread_coding_system;
76 Lisp_Object Qread_non_nil_coding_system;
77 #endif
78
79 /* ARGSUSED */
80 DEFUN ("interactive", Finteractive, 0, UNEVALLED, 0, /*
81 Specify a way of parsing arguments for interactive use of a function.
82 For example, write
83   (defun foo (arg) "Doc string" (interactive "p") ...use arg...)
84 to make ARG be the prefix argument when `foo' is called as a command.
85 The "call" to `interactive' is actually a declaration rather than a function;
86  it tells `call-interactively' how to read arguments
87  to pass to the function.
88 When actually called, `interactive' just returns nil.
89
90 The argument of `interactive' is usually a string containing a code letter
91  followed by a prompt.  (Some code letters do not use I/O to get
92  the argument and do not need prompts.)  To prompt for multiple arguments,
93  give a code letter, its prompt, a newline, and another code letter, etc.
94  Prompts are passed to format, and may use % escapes to print the
95  arguments that have already been read.
96 If the argument is not a string, it is evaluated to get a list of
97  arguments to pass to the function.
98 Just `(interactive)' means pass no args when calling interactively.
99
100 Code letters available are:
101 a -- Function name: symbol with a function definition.
102 b -- Name of existing buffer.
103 B -- Name of buffer, possibly nonexistent.
104 c -- Character.
105 C -- Command name: symbol with interactive function definition.
106 d -- Value of point as number.  Does not do I/O.
107 D -- Directory name.
108 e -- Last mouse-button or misc-user event that invoked this command.
109      If used more than once, the Nth `e' returns the Nth such event.
110      Does not do I/O.
111 f -- Existing file name.
112 F -- Possibly nonexistent file name.
113 i -- Always nil, ignore.  Use to skip arguments when interactive.
114 k -- Key sequence (a vector of events).
115 K -- Key sequence to be redefined (do not automatically down-case).
116 m -- Value of mark as number.  Does not do I/O.
117 n -- Number read using minibuffer.
118 N -- Prefix arg converted to number, or if none, do like code `n'.
119 p -- Prefix arg converted to number.  Does not do I/O.
120 P -- Prefix arg in raw form.  Does not do I/O.
121 r -- Region: point and mark as 2 numeric args, smallest first.  Does no I/O.
122 s -- Any string.
123 S -- Any symbol.
124 v -- Variable name: symbol that is user-variable-p.
125 x -- Lisp expression read but not evaluated.
126 X -- Lisp expression read and evaluated.
127 z -- Coding system. (Always nil if no Mule support.)
128 Z -- Coding system, nil if no prefix arg. (Always nil if no Mule support.)
129 In addition, if the string begins with `*'
130  then an error is signaled if the buffer is read-only.
131  This happens before reading any arguments.
132 If the string begins with `@', then the window the mouse is over is selected
133  before anything else is done.
134 If the string begins with `_', then this command will not cause the region
135  to be deactivated when it completes; that is, `zmacs-region-stays' will be
136  set to t when the command exits successfully.
137 You may use any of `@', `*' and `_' at the beginning of the string;
138  they are processed in the order that they appear.
139 */
140        (args))
141 {
142   return Qnil;
143 }
144
145 /* Originally, this was just a function -- but `custom' used a
146    garden-variety version, so why not make it a subr?  */
147 /* #### Move it to another file! */
148 DEFUN ("quote-maybe", Fquote_maybe, 1, 1, 0, /*
149 Quote EXPR if it is not self quoting.
150 */
151        (expr))
152 {
153   return ((NILP (expr)
154            || EQ (expr, Qt)
155            || INTP (expr)
156            || FLOATP (expr)
157            || CHARP (expr)
158            || STRINGP (expr)
159            || VECTORP (expr)
160            || KEYWORDP (expr)
161            || BIT_VECTORP (expr)
162            || (CONSP (expr) && EQ (XCAR (expr), Qlambda)))
163           ? expr : list2 (Qquote, expr));
164 }
165
166 /* Modify EXPR by quotifying each element (except the first).  */
167 static Lisp_Object
168 quotify_args (Lisp_Object expr)
169 {
170   REGISTER Lisp_Object tail;
171   REGISTER struct Lisp_Cons *ptr;
172   for (tail = expr; CONSP (tail); tail = ptr->cdr)
173     {
174       ptr = XCONS (tail);
175       ptr->car = Fquote_maybe (ptr->car);
176     }
177   return expr;
178 }
179
180 static Bufpos
181 check_mark (void)
182 {
183   Lisp_Object tem;
184
185   if (zmacs_regions && !zmacs_region_active_p)
186     error ("The region is not active now");
187
188   tem = Fmarker_buffer (current_buffer->mark);
189   if (NILP (tem) || (XBUFFER (tem) != current_buffer))
190     error ("The mark is not set now");
191
192   return marker_position (current_buffer->mark);
193 }
194
195 static Lisp_Object
196 callint_prompt (CONST Bufbyte *prompt_start, Bytecount prompt_length,
197                 CONST Lisp_Object *args, int nargs)
198 {
199   Lisp_Object s = make_string (prompt_start, prompt_length);
200   struct gcpro gcpro1;
201
202   /* Fformat no longer smashes its arg vector, so no need to copy it. */
203
204   if (!strchr ((char *) XSTRING_DATA (s), '%'))
205     return s;
206   GCPRO1 (s);
207   RETURN_UNGCPRO (emacs_doprnt_string_lisp (0, s, 0, nargs, args));
208 }
209
210 /* `lambda' for RECORD-FLAG is an XEmacs addition. */
211
212 DEFUN ("call-interactively", Fcall_interactively, 1, 3, 0, /*
213 Call FUNCTION, reading args according to its interactive calling specs.
214 Return the value FUNCTION returns.
215 The function contains a specification of how to do the argument reading.
216 In the case of user-defined functions, this is specified by placing a call
217 to the function `interactive' at the top level of the function body.
218 See `interactive'.
219
220 If optional second arg RECORD-FLAG is the symbol `lambda', the interactive
221 calling arguments for FUNCTION are read and returned as a list,
222 but the function is not called on them.
223
224 If RECORD-FLAG is `t' then unconditionally put this command in the
225 command-history.  Otherwise, this is done only if an arg is read using
226 the minibuffer.
227
228 The argument KEYS specifies the value to use instead of (this-command-keys)
229 when reading the arguments.
230 */
231        (function, record_flag, keys))
232 {
233   /* This function can GC */
234   int speccount = specpdl_depth ();
235   Lisp_Object prefix;
236
237   Lisp_Object fun;
238   Lisp_Object specs = Qnil;
239 #ifdef IT_SEEMS_THAT_MLY_DOESNT_LIKE_THIS
240   Lisp_Object enable;
241 #endif
242   /* If SPECS is a string, we reset prompt_data to string_data
243    * (XSTRING (specs)) every time a GC might have occurred */
244   CONST char *prompt_data = 0;
245   int prompt_index = 0;
246   int argcount;
247   int set_zmacs_region_stays = 0;
248   int mouse_event_count = 0;
249
250   if (!NILP (keys))
251     {
252       int i, len;
253
254       CHECK_VECTOR (keys);
255       len = XVECTOR_LENGTH (keys);
256       for (i = 0; i < len; i++)
257         CHECK_LIVE_EVENT (XVECTOR_DATA (keys)[i]);
258     }
259
260   /* Save this now, since use of minibuffer will clobber it. */
261   prefix = Vcurrent_prefix_arg;
262
263  retry:
264
265 #ifdef IT_SEEMS_THAT_MLY_DOESNT_LIKE_THIS
266   /* Marginal kludge.  Use an evaluated interactive spec instead of this! */
267   if (SYMBOLP (function))
268     enable = Fget (function, Qenable_recursive_minibuffers, Qnil);
269 #endif
270
271   fun = indirect_function (function, 1);
272
273   /* Decode the kind of function.  Either handle it and return,
274      or go to `lose' if not interactive, or go to `retry'
275      to specify a different function, or set either PROMPT_DATA or SPECS. */
276
277   if (SUBRP (fun))
278     {
279       prompt_data = XSUBR (fun)->prompt;
280       if (!prompt_data)
281         {
282         lose:
283           function = wrong_type_argument (Qcommandp, function);
284           goto retry;
285         }
286 #if 0 /* FSFmacs */ /* Huh? Where is this used? */
287       if ((EMACS_INT) prompt_data == 1)
288         /* Let SPECS (which is nil) be used as the args.  */
289         prompt_data = 0;
290 #endif
291     }
292   else if (COMPILED_FUNCTIONP (fun))
293     {
294       Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (fun);
295       if (! f->flags.interactivep)
296         goto lose;
297       specs = compiled_function_interactive (f);
298     }
299   else if (!CONSP (fun))
300     goto lose;
301   else
302     {
303       Lisp_Object funcar = Fcar (fun);
304
305       if (EQ (funcar, Qautoload))
306         {
307           struct gcpro gcpro1, gcpro2;
308           GCPRO2 (function, prefix);
309           do_autoload (fun, function);
310           UNGCPRO;
311           goto retry;
312         }
313       else if (EQ (funcar, Qlambda))
314         {
315           specs = Fassq (Qinteractive, Fcdr (Fcdr (fun)));
316           if (NILP (specs))
317             goto lose;
318           specs = Fcar (Fcdr (specs));
319         }
320       else
321         goto lose;
322     }
323
324   /* FSFmacs makes an alloca() copy of prompt_data here.
325      We're more intelligent about this and just reset prompt_data
326      as necessary. */
327   /* If either specs or prompt_data is set to a string, use it.  */
328   if (!STRINGP (specs) && prompt_data == 0)
329     {
330       struct gcpro gcpro1, gcpro2, gcpro3;
331       int i = num_input_chars;
332       Lisp_Object input = specs;
333
334       GCPRO3 (function, specs, input);
335       /* Compute the arg values using the user's expression.  */
336       specs = Feval (specs);
337       if (EQ (record_flag, Qlambda)) /* XEmacs addition */
338         {
339           UNGCPRO;
340           return specs;
341         }
342       if (!NILP (record_flag) || i != num_input_chars)
343         {
344           /* We should record this command on the command history.  */
345           /* #### The following is too specific; should have general
346              mechanism for doing this. */
347           Lisp_Object values, car;
348           /* Make a copy of the list of values, for the command history,
349              and turn them into things we can eval.  */
350           values = quotify_args (Fcopy_sequence (specs));
351           /* If the list of args was produced with an explicit call to `list',
352              look for elements that were computed with (region-beginning)
353              or (region-end), and put those expressions into VALUES
354              instead of the present values.  */
355           if (CONSP (input))
356             {
357               car = XCAR (input);
358               /* Skip through certain special forms.  */
359               while (EQ (car, Qlet) || EQ (car, QletX)
360                      || EQ (car, Qsave_excursion))
361                 {
362                   while (CONSP (XCDR (input)))
363                     input = XCDR (input);
364                   input = XCAR (input);
365                   if (!CONSP (input))
366                     break;
367                   car = XCAR (input);
368                 }
369               if (EQ (car, Qlist))
370                 {
371                   Lisp_Object intail, valtail;
372                   for (intail = Fcdr (input), valtail = values;
373                        CONSP (valtail);
374                        intail = Fcdr (intail), valtail = Fcdr (valtail))
375                     {
376                       Lisp_Object elt;
377                       elt = Fcar (intail);
378                       if (CONSP (elt))
379                         {
380                           Lisp_Object eltcar = Fcar (elt);
381                           if (EQ (eltcar, Qpoint) ||
382                               EQ (eltcar, Qmark)  ||
383                               EQ (eltcar, Qregion_beginning) ||
384                               EQ (eltcar, Qregion_end))
385                             Fsetcar (valtail, Fcar (intail));
386                         }
387                     }
388                 }
389             }
390           Vcommand_history
391             = Fcons (Fcons (function, values), Vcommand_history);
392         }
393       single_console_state ();
394       RETURN_UNGCPRO (apply1 (fun, specs));
395     }
396
397   /* Here if function specifies a string to control parsing the defaults */
398
399 #ifdef I18N3
400   /* Translate interactive prompt. */
401   if (STRINGP (specs))
402     {
403       Lisp_Object domain = Qnil;
404       if (COMPILED_FUNCTIONP (fun))
405         domain = compiled_function_domain (XCOMPILED_FUNCTION (fun));
406       if (NILP (domain))
407         specs = Fgettext (specs);
408       else
409         specs = Fdgettext (domain, specs);
410     }
411   else if (prompt_data)
412     /* We do not have to worry about domains in this case because
413        prompt_data is non-nil only for built-in functions, which
414        always use the default domain. */
415     prompt_data = gettext (prompt_data);
416 #endif
417
418   /* Handle special starting chars `*' and `@' and `_'.  */
419   /* Note that `+' is reserved for user extensions.  */
420   prompt_index = 0;
421   {
422     struct gcpro gcpro1, gcpro2;
423     GCPRO2 (function, specs);
424
425     for (;;)
426       {
427         if (STRINGP (specs))
428           prompt_data = (CONST char *) XSTRING_DATA (specs);
429
430         if (prompt_data[prompt_index] == '+')
431           error ("`+' is not used in `interactive' for ordinary commands");
432         else if (prompt_data[prompt_index] == '*')
433           {
434             prompt_index++;
435             if (!NILP (current_buffer->read_only))
436               barf_if_buffer_read_only (current_buffer, -1, -1);
437           }
438         else if (prompt_data[prompt_index] == '@')
439           {
440             Lisp_Object event;
441             prompt_index++;
442
443             if (!NILP (keys))
444               event = extract_vector_nth_mouse_event (keys, 0);
445             else
446 #if 0
447               event = extract_this_command_keys_nth_mouse_event (0);
448 #else
449               /* Doesn't work; see below */
450               event = Vcurrent_mouse_event;
451 #endif
452             if (! NILP (event))
453               {
454                 Lisp_Object window = Fevent_window (event);
455                 if (!NILP (window))
456                   {
457                     if (MINI_WINDOW_P (XWINDOW (window))
458                         && ! (minibuf_level > 0 && EQ (window,
459                                                        minibuf_window)))
460                       error ("Attempt to select inactive minibuffer window");
461
462 #if 0 /* unclean! see event-stream.c */
463                     /* If the current buffer wants to clean up, let it.  */
464                     if (!NILP (Vmouse_leave_buffer_hook))
465                       run_hook (Qmouse_leave_buffer_hook);
466 #endif
467
468                     Fselect_window (window, Qnil);
469                   }
470               }
471           }
472         else if (prompt_data[prompt_index] == '_')
473           {
474             prompt_index++;
475             set_zmacs_region_stays = 1;
476           }
477         else
478           {
479             UNGCPRO;
480             break;
481           }
482       }
483   }
484
485   /* Count the number of arguments the interactive spec would have
486      us give to the function.  */
487   argcount = 0;
488   {
489     CONST char *tem;
490     for (tem = prompt_data + prompt_index; *tem; )
491       {
492         /* 'r' specifications ("point and mark as 2 numeric args")
493            produce *two* arguments.  */
494         if (*tem == 'r')
495           argcount += 2;
496         else
497           argcount += 1;
498         tem = (CONST char *) strchr (tem + 1, '\n');
499         if (!tem)
500           break;
501         tem++;
502       }
503   }
504
505 #ifdef IT_SEEMS_THAT_MLY_DOESNT_LIKE_THIS
506   if (!NILP (enable))
507     specbind (Qenable_recursive_minibuffers, Qt);
508 #endif
509
510   if (argcount == 0)
511     {
512       /* Interactive function or no arguments; just call it */
513       if (EQ (record_flag, Qlambda))
514         return Qnil;
515       if (!NILP (record_flag))
516         {
517           Vcommand_history = Fcons (list1 (function), Vcommand_history);
518         }
519       specbind (Qcommand_debug_status, Qnil);
520       /* XEmacs: was fun = call0 (fun), but that's backtraced wrong */
521       {
522         struct gcpro gcpro1;
523
524         GCPRO1 (fun);
525         fun = Ffuncall (1, &fun);
526         UNGCPRO;
527       }
528       if (set_zmacs_region_stays)
529         zmacs_region_stays = 1;
530       return unbind_to (speccount, fun);
531     }
532
533   /* Read interactive arguments */
534   {
535     /* args[-1] is the function to call */
536     /* args[n] is the n'th argument to the function */
537     int alloca_size = (1        /* function to call */
538                        + argcount /* actual arguments */
539                        + argcount /* visargs */
540                        + argcount /* varies */
541                        );
542     Lisp_Object *args = alloca_array (Lisp_Object, alloca_size) + 1;
543     /* visargs is an array of either Qnil or user-friendlier versions (often
544      *  strings) of previous arguments, to use in prompts for successive
545      *  arguments.  ("Often strings" because emacs didn't used to have
546      *  format %S and prin1-to-string.) */
547     Lisp_Object *visargs = args + argcount;
548     /* If varies[i] is non-null, the i'th argument shouldn't just have
549        its value in this call quoted in the command history.  It should be
550        recorded as a call to the function named varies[i]]. */
551     Lisp_Object *varies = visargs + argcount;
552     int arg_from_tty = 0;
553     REGISTER int argnum;
554     struct gcpro gcpro1, gcpro2;
555
556     args[-1] = function;
557     for (argnum = 0; argnum < alloca_size - 1; argnum++)
558       args[argnum] = Qnil;
559
560     /* Must GC-protect args[-1] (ie function) because Ffuncall doesn't */
561     /* `function' itself isn't GC-protected -- use args[-1] from here
562        (actually, doesn't matter since Emacs GC doesn't relocate, sigh) */
563     GCPRO2 (prefix, args[-1]);
564     gcpro2.nvars = alloca_size;
565
566     for (argnum = 0; ; argnum++)
567       {
568         CONST char *prompt_start = prompt_data + prompt_index + 1;
569         CONST char *prompt_limit = (CONST char *) strchr (prompt_start, '\n');
570         int prompt_length;
571         prompt_length = ((prompt_limit)
572                          ? (prompt_limit - prompt_start)
573                          : strlen (prompt_start));
574         if (prompt_limit && prompt_limit[1] == 0)
575           {
576             prompt_limit = 0;   /* "sfoo:\n" -- strip tailing return */
577             prompt_length -= 1;
578           }
579         /* This uses `visargs' instead of `args' so that global-set-key
580            prompts with "Set key C-x C-f to command: "instead of printing
581            event objects in there.
582          */
583 #define PROMPT() callint_prompt ((CONST Bufbyte *) prompt_start, prompt_length, visargs, argnum)
584         switch (prompt_data[prompt_index])
585           {
586           case 'a':             /* Symbol defined as a function */
587             {
588               Lisp_Object tem = call1 (Qread_function, PROMPT ());
589               args[argnum] = tem;
590               arg_from_tty = 1;
591               break;
592             }
593           case 'b':             /* Name of existing buffer */
594             {
595               Lisp_Object def = Fcurrent_buffer ();
596               if (EQ (Fselected_window (Qnil), minibuf_window))
597                 def = Fother_buffer (def, Qnil, Qnil);
598               /* read-buffer returns a buffer name, not a buffer! */
599               args[argnum] = call3 (Qread_buffer, PROMPT (), def,
600                                     Qt);
601               arg_from_tty = 1;
602               break;
603             }
604           case 'B':             /* Name of buffer, possibly nonexistent */
605             {
606               /* read-buffer returns a buffer name, not a buffer! */
607               args[argnum] = call2 (Qread_buffer, PROMPT (),
608                                     Fother_buffer (Fcurrent_buffer (), Qnil,
609                                                    Qnil));
610               arg_from_tty = 1;
611               break;
612             }
613           case 'c':             /* Character */
614             {
615               Lisp_Object tem;
616               int shadowing_speccount = specpdl_depth ();
617
618               specbind (Qcursor_in_echo_area, Qt);
619               message ("%s", XSTRING_DATA (PROMPT ()));
620               tem = (call0 (Qread_char));
621               args[argnum] = tem;
622               /* visargs[argnum] = Fsingle_key_description (tem); */
623               /* FSF has visargs[argnum] = Fchar_to_string (tem); */
624
625               unbind_to (shadowing_speccount, Qnil);
626
627               /* #### `C-x / a' should not leave the prompt in the minibuffer.
628                  This isn't the right fix, because (message ...) (read-char)
629                  shouldn't leave the message there either... */
630               clear_message ();
631
632               arg_from_tty = 1;
633               break;
634             }
635           case 'C':             /* Command: symbol with interactive function */
636             {
637               Lisp_Object tem = call1 (Qread_command, PROMPT ());
638               args[argnum] = tem;
639               arg_from_tty = 1;
640               break;
641             }
642           case 'd':             /* Value of point.  Does not do I/O.  */
643             {
644               args[argnum] = Fcopy_marker (current_buffer->point_marker, Qt);
645               varies[argnum] = Qpoint;
646               break;
647             }
648           case 'e':
649             {
650               Lisp_Object event;
651
652               if (!NILP (keys))
653                 event = extract_vector_nth_mouse_event (keys,
654                                                         mouse_event_count);
655               else
656 #if 0
657               /* This doesn't quite work because this-command-keys
658                  behaves in utterly counterintuitive ways.  Sometimes
659                  it retrieves an event back in the future, e.g. when
660                  one command invokes another command and both are
661                  invoked with the mouse. */
662                 event = (extract_this_command_keys_nth_mouse_event
663                          (mouse_event_count));
664 #else
665                 event = Vcurrent_mouse_event;
666 #endif
667
668               if (NILP (event))
669                 error ("%s must be bound to a mouse or misc-user event",
670                        (SYMBOLP (function)
671                         ? (char *) string_data (XSYMBOL (function)->name)
672                         : "command"));
673               args[argnum] = event;
674               mouse_event_count++;
675               break;
676             }
677           case 'D':             /* Directory name. */
678             {
679               args[argnum] = call4 (Qread_directory_name, PROMPT (),
680                                     Qnil, /* dir */
681                                     current_buffer->directory, /* default */
682                                     Qt /* must-match */
683                                     );
684               arg_from_tty = 1;
685               break;
686             }
687           case 'f':             /* Existing file name. */
688             {
689               Lisp_Object tem = call4 (Qread_file_name, PROMPT (),
690                                        Qnil, /* dir */
691                                        Qnil, /* default */
692                                        Qzero /* must-match */
693                                        );
694               args[argnum] = tem;
695               arg_from_tty = 1;
696               break;
697             }
698           case 'F':             /* Possibly nonexistent file name. */
699             {
700               args[argnum] = call4 (Qread_file_name, PROMPT (),
701                                     Qnil, /* dir */
702                                     Qnil, /* default */
703                                     Qnil /* must-match */
704                                     );
705               arg_from_tty = 1;
706               break;
707             }
708           case 'i':             /* Ignore: always nil. Use to skip arguments. */
709             {
710               args[argnum] = Qnil;
711               break;
712             }
713           case 'k':             /* Key sequence (vector of events) */
714             {
715               struct gcpro ngcpro1;
716               Lisp_Object tem;
717               Lisp_Object key_prompt = PROMPT ();
718
719               NGCPRO1(key_prompt);
720               tem = Fread_key_sequence (key_prompt, Qnil, Qnil);
721               NUNGCPRO;
722
723               visargs[argnum] = Fkey_description (tem);
724               /* The following makes `describe-key' not work with
725                  extent-local keymaps and such; and anyway, it's
726                  contrary to the documentation. */
727               /* args[argnum] = call1 (Qevents_to_keys, tem); */
728               args[argnum] = tem;
729               arg_from_tty = 1;
730               break;
731             }
732           case 'K':             /* Key sequence (vector of events),
733                                    no automatic downcasing */
734             {
735               struct gcpro ngcpro1;
736               Lisp_Object tem;
737               Lisp_Object key_prompt = PROMPT ();
738
739               NGCPRO1(key_prompt);
740               tem = Fread_key_sequence (key_prompt, Qnil, Qt);
741               NUNGCPRO;
742
743               visargs[argnum] = Fkey_description (tem);
744               /* The following makes `describe-key' not work with
745                  extent-local keymaps and such; and anyway, it's
746                  contrary to the documentation. */
747               /* args[argnum] = call1 (Qevents_to_keys, tem); */
748               args[argnum] = tem;
749               arg_from_tty = 1;
750               break;
751             }
752
753           case 'm':             /* Value of mark.  Does not do I/O.  */
754             {
755               args[argnum] = current_buffer->mark;
756               varies[argnum] = Qmark;
757               break;
758             }
759           case 'n':             /* Read number from minibuffer.  */
760             {
761             read_number:
762               args[argnum] = call2 (Qread_number, PROMPT (), Qnil);
763               /* numbers are too boring to go on command history */
764               /* arg_from_tty = 1; */
765               break;
766             }
767           case 'N':             /* Prefix arg, else number from minibuffer */
768             {
769               if (NILP (prefix))
770                 goto read_number;
771               else
772                 goto prefix_value;
773             }
774           case 'P':             /* Prefix arg in raw form.  Does no I/O.  */
775             {
776               args[argnum] = prefix;
777               break;
778             }
779           case 'p':             /* Prefix arg converted to number.  No I/O. */
780             {
781             prefix_value:
782               {
783                 Lisp_Object tem = Fprefix_numeric_value (prefix);
784                 args[argnum] = tem;
785               }
786               break;
787             }
788           case 'r':             /* Region, point and mark as 2 args. */
789             {
790               Bufpos tem = check_mark ();
791               args[argnum] = (BUF_PT (current_buffer) < tem
792                               ? Fcopy_marker (current_buffer->point_marker, Qt)
793                               : current_buffer->mark);
794               varies[argnum] = Qregion_beginning;
795               args[++argnum] = (BUF_PT (current_buffer) > tem
796                                 ? Fcopy_marker (current_buffer->point_marker,
797                                                 Qt)
798                                 : current_buffer->mark);
799               varies[argnum] = Qregion_end;
800               break;
801             }
802           case 's':             /* String read via minibuffer.  */
803             {
804               args[argnum] = call1 (Qread_string, PROMPT ());
805               arg_from_tty = 1;
806               break;
807             }
808           case 'S':             /* Any symbol.  */
809             {
810 #if 0                           /* Historical crock */
811               Lisp_Object tem = intern ("minibuffer-local-ns-map");
812               tem = find_symbol_value (tem);
813               if (UNBOUNDP (tem)) tem = Qnil;
814               tem = call3 (Qread_from_minibuffer, PROMPT (), Qnil,
815                            tem);
816               args[argnum] = Fintern (tem, Qnil);
817 #else /* 1 */
818               visargs[argnum] = Qnil;
819               for (;;)
820                 {
821                   Lisp_Object tem = call5 (Qcompleting_read,
822                                            PROMPT (),
823                                            Vobarray,
824                                            Qnil,
825                                            Qnil,
826                                            /* nil, or prev attempt */
827                                            visargs[argnum]);
828                   visargs[argnum] = tem;
829                   /* I could use condition-case with this loser, but why bother?
830                    * tem = Fread (tem); check-symbol-p;
831                    */
832                   tem = Fintern (tem, Qnil);
833                   args[argnum] = tem;
834                   if (string_length (XSYMBOL (tem)->name) > 0)
835                     /* Don't accept the empty-named symbol.  If the loser
836                        really wants this s/he can call completing-read
837                        directly */
838                     break;
839                 }
840 #endif /* 1 */
841               arg_from_tty = 1;
842               break;
843             }
844           case 'v':             /* Variable name: user-variable-p symbol */
845             {
846               Lisp_Object tem = call1 (Qread_variable, PROMPT ());
847               args[argnum] = tem;
848               arg_from_tty = 1;
849               break;
850             }
851           case 'x':             /* Lisp expression read but not evaluated */
852             {
853               args[argnum] = call1 (Qread_expression, PROMPT ());
854               /* visargs[argnum] = Fprin1_to_string (args[argnum], Qnil); */
855               arg_from_tty = 1;
856               break;
857             }
858           case 'X':             /* Lisp expression read and evaluated */
859             {
860               Lisp_Object tem = call1 (Qread_expression, PROMPT ());
861               /* visargs[argnum] = Fprin1_to_string (tem, Qnil); */
862               args[argnum] = Feval (tem);
863               arg_from_tty = 1;
864               break;
865             }
866           case 'Z':             /* Coding-system symbol or nil if no prefix */
867             {
868 #if defined(MULE) || defined(FILE_CODING)
869               if (NILP (prefix))
870                 {
871                   args[argnum] = Qnil;
872                 }
873               else
874                 {
875                   args[argnum] =
876                     call1 (Qread_non_nil_coding_system, PROMPT ());
877                   arg_from_tty = 1;
878                 }
879 #else
880               args[argnum] = Qnil;
881 #endif
882               break;
883             }
884           case 'z':             /* Coding-system symbol */
885             {
886 #if defined(MULE) || defined(FILE_CODING)
887               args[argnum] = call1 (Qread_coding_system, PROMPT ());
888               arg_from_tty = 1;
889 #else
890               args[argnum] = Qnil;
891 #endif
892               break;
893             }
894
895             /* We have a case for `+' so we get an error
896                if anyone tries to define one here.  */
897           case '+':
898           default:
899             {
900               error ("Invalid `interactive' control letter \"%c\" (#o%03o).",
901                      prompt_data[prompt_index],
902                      prompt_data[prompt_index]);
903             }
904           }
905 #undef PROMPT
906         if (NILP (visargs[argnum]))
907           visargs[argnum] = args[argnum];
908
909         if (!prompt_limit)
910           break;
911         if (STRINGP (specs))
912           prompt_data = (CONST char *) XSTRING_DATA (specs);
913         prompt_index += prompt_length + 1 + 1; /* +1 to skip spec, +1 for \n */
914       }
915     unbind_to (speccount, Qnil);
916
917     QUIT;
918
919     if (EQ (record_flag, Qlambda))
920       {
921         RETURN_UNGCPRO (Flist (argcount, args));
922       }
923
924     if (arg_from_tty || !NILP (record_flag))
925       {
926         /* Reuse visargs as a temporary for constructing the command history */
927         for (argnum = 0; argnum < argcount; argnum++)
928           {
929             if (!NILP (varies[argnum]))
930               visargs[argnum] = list1 (varies[argnum]);
931             else
932               visargs[argnum] = Fquote_maybe (args[argnum]);
933           }
934         Vcommand_history = Fcons (Fcons (args[-1], Flist (argcount, visargs)),
935                                   Vcommand_history);
936       }
937
938     /* If we used a marker to hold point, mark, or an end of the region,
939        temporarily, convert it to an integer now.  */
940     for (argnum = 0; argnum < argcount; argnum++)
941       if (!NILP (varies[argnum]))
942         XSETINT (args[argnum], marker_position (args[argnum]));
943
944     single_console_state ();
945     specbind (Qcommand_debug_status, Qnil);
946     fun = Ffuncall (argcount + 1, args - 1);
947     UNGCPRO;
948     if (set_zmacs_region_stays)
949       zmacs_region_stays = 1;
950     return unbind_to (speccount, fun);
951   }
952 }
953
954 DEFUN ("prefix-numeric-value", Fprefix_numeric_value, 1, 1, 0, /*
955 Return numeric meaning of raw prefix argument ARG.
956 A raw prefix argument is what you get from `(interactive "P")'.
957 Its numeric meaning is what you would get from `(interactive "p")'.
958 */
959        (raw))
960 {
961   if (NILP (raw))
962     return make_int (1);
963   if (EQ (raw, Qminus))
964     return make_int (-1);
965   if (INTP (raw))
966     return raw;
967   if (CONSP (raw) && INTP (XCAR (raw)))
968     return XCAR (raw);
969
970   return make_int (1);
971 }
972
973 void
974 syms_of_callint (void)
975 {
976   defsymbol (&Qcall_interactively, "call-interactively");
977   defsymbol (&Qread_from_minibuffer, "read-from-minibuffer");
978   defsymbol (&Qcompleting_read, "completing-read");
979   defsymbol (&Qread_file_name, "read-file-name");
980   defsymbol (&Qread_directory_name, "read-directory-name");
981   defsymbol (&Qread_string, "read-string");
982   defsymbol (&Qread_buffer, "read-buffer");
983   defsymbol (&Qread_variable, "read-variable");
984   defsymbol (&Qread_function, "read-function");
985   defsymbol (&Qread_command, "read-command");
986   defsymbol (&Qread_number, "read-number");
987   defsymbol (&Qread_expression, "read-expression");
988 #if defined(MULE) || defined(FILE_CODING)
989   defsymbol (&Qread_coding_system, "read-coding-system");
990   defsymbol (&Qread_non_nil_coding_system, "read-non-nil-coding-system");
991 #endif
992   defsymbol (&Qevents_to_keys, "events-to-keys");
993   defsymbol (&Qcommand_debug_status, "command-debug-status");
994   defsymbol (&Qenable_recursive_minibuffers, "enable-recursive-minibuffers");
995
996   defsymbol (&Qlet, "let");
997   defsymbol (&QletX, "let*");
998   defsymbol (&Qsave_excursion, "save-excursion");
999 #if 0 /* ill-conceived */
1000   defsymbol (&Qmouse_leave_buffer_hook, "mouse-leave-buffer-hook");
1001 #endif
1002
1003   DEFSUBR (Finteractive);
1004   DEFSUBR (Fquote_maybe);
1005   DEFSUBR (Fcall_interactively);
1006   DEFSUBR (Fprefix_numeric_value);
1007 }
1008
1009 void
1010 vars_of_callint (void)
1011 {
1012   DEFVAR_LISP ("current-prefix-arg", &Vcurrent_prefix_arg /*
1013 The value of the prefix argument for this editing command.
1014 It may be a number, or the symbol `-' for just a minus sign as arg,
1015 or a list whose car is a number for just one or more C-U's
1016 or nil if no argument has been specified.
1017 This is what `(interactive "P")' returns.
1018 */ );
1019   Vcurrent_prefix_arg = Qnil;
1020
1021   DEFVAR_LISP ("command-history", &Vcommand_history /*
1022 List of recent commands that read arguments from terminal.
1023 Each command is represented as a form to evaluate.
1024 */ );
1025   Vcommand_history = Qnil;
1026
1027   DEFVAR_LISP ("command-debug-status", &Vcommand_debug_status /*
1028 Debugging status of current interactive command.
1029 Bound each time `call-interactively' is called;
1030 may be set by the debugger as a reminder for itself.
1031 */ );
1032   Vcommand_debug_status = Qnil;
1033
1034 #if 0 /* FSFmacs */
1035   xxDEFVAR_LISP ("mark-even-if-inactive", &Vmark_even_if_inactive /*
1036 *Non-nil means you can use the mark even when inactive.
1037 This option makes a difference in Transient Mark mode.
1038 When the option is non-nil, deactivation of the mark
1039 turns off region highlighting, but commands that use the mark
1040 behave as if the mark were still active.
1041 */ );
1042   Vmark_even_if_inactive = Qnil;
1043 #endif
1044
1045 #if 0 /* Doesn't work and is totally ill-conceived anyway. */
1046   xxDEFVAR_LISP ("mouse-leave-buffer-hook", &Vmouse_leave_buffer_hook /*
1047 Hook to run when about to switch windows with a mouse command.
1048 Its purpose is to give temporary modes such as Isearch mode
1049 a way to turn themselves off when a mouse command switches windows.
1050 */ );
1051   Vmouse_leave_buffer_hook = Qnil;
1052 #endif
1053 }