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