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 Charcount 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 /* FSF calls Qmouse_leave_buffer_hook at all sorts of random places,
  57    including a bunch of places in their mouse.el.  If this is
  58    implemented, it has to be done cleanly. */
  59 Lisp_Object Vmouse_leave_buffer_hook, Qmouse_leave_buffer_hook;
  60 #endif
  61
  62 Lisp_Object QletX, Qsave_excursion;
  63
  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   Lisp_Object tail;
 174   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       Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (fun);
 298       if (! f->flags.interactivep)
 299         goto lose;
 300       specs = compiled_function_interactive (f);
 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;
 311           GCPRO1 (prefix);
 312           /* do_autoload GCPROs both arguments */
 313           do_autoload (fun, function);
 314           UNGCPRO;
 315           goto retry;
 316         }
 317       else if (EQ (funcar, Qlambda))
 318         {
 319           specs = Fassq (Qinteractive, Fcdr (Fcdr (fun)));
 320           if (NILP (specs))
 321             goto lose;
 322           specs = Fcar (Fcdr (specs));
 323         }
 324       else
 325         goto lose;
 326     }
 327
 328   /* FSFmacs makes an alloca() copy of prompt_data here.
 329      We're more intelligent about this and just reset prompt_data
 330      as necessary. */
 331   /* If either specs or prompt_data is set to a string, use it.  */
 332   if (!STRINGP (specs) && prompt_data == 0)
 333     {
 334       struct gcpro gcpro1, gcpro2, gcpro3;
 335       int i = num_input_chars;
 336       Lisp_Object input = specs;
 337
 338       GCPRO3 (function, specs, input);
 339       /* Compute the arg values using the user's expression.  */
 340       specs = Feval (specs);
 341       if (EQ (record_flag, Qlambda)) /* XEmacs addition */
 342         {
 343           UNGCPRO;
 344           return specs;
 345         }
 346       if (!NILP (record_flag) || i != num_input_chars)
 347         {
 348           /* We should record this command on the command history.  */
 349           /* #### The following is too specific; should have general
 350              mechanism for doing this. */
 351           Lisp_Object values, car;
 352           /* Make a copy of the list of values, for the command history,
 353              and turn them into things we can eval.  */
 354           values = quotify_args (Fcopy_sequence (specs));
 355           /* If the list of args was produced with an explicit call to `list',
 356              look for elements that were computed with (region-beginning)
 357              or (region-end), and put those expressions into VALUES
 358              instead of the present values.  */
 359           if (CONSP (input))
 360             {
 361               car = XCAR (input);
 362               /* Skip through certain special forms.  */
 363               while (EQ (car, Qlet) || EQ (car, QletX)
 364                      || EQ (car, Qsave_excursion))
 365                 {
 366                   while (CONSP (XCDR (input)))
 367                     input = XCDR (input);
 368                   input = XCAR (input);
 369                   if (!CONSP (input))
 370                     break;
 371                   car = XCAR (input);
 372                 }
 373               if (EQ (car, Qlist))
 374                 {
 375                   Lisp_Object intail, valtail;
 376                   for (intail = Fcdr (input), valtail = values;
 377                        CONSP (valtail);
 378                        intail = Fcdr (intail), valtail = Fcdr (valtail))
 379                     {
 380                       Lisp_Object elt;
 381                       elt = Fcar (intail);
 382                       if (CONSP (elt))
 383                         {
 384                           Lisp_Object eltcar = Fcar (elt);
 385                           if (EQ (eltcar, Qpoint) ||
 386                               EQ (eltcar, Qmark)  ||
 387                               EQ (eltcar, Qregion_beginning) ||
 388                               EQ (eltcar, Qregion_end))
 389                             Fsetcar (valtail, Fcar (intail));
 390                         }
 391                     }
 392                 }
 393             }
 394           Vcommand_history
 395             = Fcons (Fcons (function, values), Vcommand_history);
 396         }
 397       single_console_state ();
 398       RETURN_UNGCPRO (apply1 (fun, specs));
 399     }
 400
 401   /* Here if function specifies a string to control parsing the defaults */
 402
 403 #ifdef I18N3
 404   /* Translate interactive prompt. */
 405   if (STRINGP (specs))
 406     {
 407       Lisp_Object domain = Qnil;
 408       if (COMPILED_FUNCTIONP (fun))
 409         domain = compiled_function_domain (XCOMPILED_FUNCTION (fun));
 410       if (NILP (domain))
 411         specs = Fgettext (specs);
 412       else
 413         specs = Fdgettext (domain, specs);
 414     }
 415   else if (prompt_data)
 416     /* We do not have to worry about domains in this case because
 417        prompt_data is non-nil only for built-in functions, which
 418        always use the default domain. */
 419     prompt_data = gettext (prompt_data);
 420 #endif
 421
 422   /* Handle special starting chars `*' and `@' and `_'.  */
 423   /* Note that `+' is reserved for user extensions.  */
 424   prompt_index = 0;
 425   {
 426     struct gcpro gcpro1, gcpro2;
 427     GCPRO2 (function, specs);
 428
 429     for (;;)
 430       {
 431         if (STRINGP (specs))
 432           prompt_data = (const char *) XSTRING_DATA (specs);
 433
 434         if (prompt_data[prompt_index] == '+')
 435           error ("`+' is not used in `interactive' for ordinary commands");
 436         else if (prompt_data[prompt_index] == '*')
 437           {
 438             prompt_index++;
 439             if (!NILP (current_buffer->read_only))
 440               barf_if_buffer_read_only (current_buffer, -1, -1);
 441           }
 442         else if (prompt_data[prompt_index] == '@')
 443           {
 444             Lisp_Object event;
 445             prompt_index++;
 446
 447             if (!NILP (keys))
 448               event = extract_vector_nth_mouse_event (keys, 0);
 449             else
 450 #if 0
 451               event = extract_this_command_keys_nth_mouse_event (0);
 452 #else
 453               /* Doesn't work; see below */
 454               event = Vcurrent_mouse_event;
 455 #endif
 456             if (! NILP (event))
 457               {
 458                 Lisp_Object window = Fevent_window (event);
 459                 if (!NILP (window))
 460                   {
 461                     if (MINI_WINDOW_P (XWINDOW (window))
 462                         && ! (minibuf_level > 0 && EQ (window,
 463                                                        minibuf_window)))
 464                       error ("Attempt to select inactive minibuffer window");
 465
 466 #if 0 /* unclean! see event-stream.c */
 467                     /* If the current buffer wants to clean up, let it.  */
 468                     if (!NILP (Vmouse_leave_buffer_hook))
 469                       run_hook (Qmouse_leave_buffer_hook);
 470 #endif
 471
 472                     Fselect_window (window, Qnil);
 473                   }
 474               }
 475           }
 476         else if (prompt_data[prompt_index] == '_')
 477           {
 478             prompt_index++;
 479             set_zmacs_region_stays = 1;
 480           }
 481         else
 482           {
 483             UNGCPRO;
 484             break;
 485           }
 486       }
 487   }
 488
 489   /* Count the number of arguments the interactive spec would have
 490      us give to the function.  */
 491   argcount = 0;
 492   {
 493     const char *tem;
 494     for (tem = prompt_data + prompt_index; *tem; )
 495       {
 496         /* 'r' specifications ("point and mark as 2 numeric args")
 497            produce *two* arguments.  */
 498         if (*tem == 'r')
 499           argcount += 2;
 500         else
 501           argcount += 1;
 502         tem = (const char *) strchr (tem + 1, '\n');
 503         if (!tem)
 504           break;
 505         tem++;
 506       }
 507   }
 508
 509 #ifdef IT_SEEMS_THAT_MLY_DOESNT_LIKE_THIS
 510   if (!NILP (enable))
 511     specbind (Qenable_recursive_minibuffers, Qt);
 512 #endif
 513
 514   if (argcount == 0)
 515     {
 516       /* Interactive function or no arguments; just call it */
 517       if (EQ (record_flag, Qlambda))
 518         return Qnil;
 519       if (!NILP (record_flag))
 520         {
 521           Vcommand_history = Fcons (list1 (function), Vcommand_history);
 522         }
 523       specbind (Qcommand_debug_status, Qnil);
 524       /* XEmacs: was fun = call0 (fun), but that's backtraced wrong */
 525       {
 526         struct gcpro gcpro1;
 527
 528         GCPRO1 (fun);
 529         fun = Ffuncall (1, &fun);
 530         UNGCPRO;
 531       }
 532       if (set_zmacs_region_stays)
 533         zmacs_region_stays = 1;
 534       return unbind_to (speccount, fun);
 535     }
 536
 537   /* Read interactive arguments */
 538   {
 539     /* args[-1] is the function to call */
 540     /* args[n] is the n'th argument to the function */
 541     int alloca_size = (1        /* function to call */
 542                        + argcount /* actual arguments */
 543                        + argcount /* visargs */
 544                        + argcount /* varies */
 545                        );
 546     Lisp_Object *args = alloca_array (Lisp_Object, alloca_size) + 1;
 547     /* visargs is an array of either Qnil or user-friendlier versions (often
 548      *  strings) of previous arguments, to use in prompts for successive
 549      *  arguments.  ("Often strings" because emacs didn't used to have
 550      *  format %S and prin1-to-string.) */
 551     Lisp_Object *visargs = args + argcount;
 552     /* If varies[i] is non-null, the i'th argument shouldn't just have
 553        its value in this call quoted in the command history.  It should be
 554        recorded as a call to the function named varies[i]]. */
 555     Lisp_Object *varies = visargs + argcount;
 556     int arg_from_tty = 0;
 557     REGISTER int argnum;
 558     struct gcpro gcpro1, gcpro2;
 559
 560     args[-1] = function;
 561     for (argnum = 0; argnum < alloca_size - 1; argnum++)
 562       args[argnum] = Qnil;
 563
 564     /* Must GC-protect args[-1] (ie function) because Ffuncall doesn't */
 565     /* `function' itself isn't GC-protected -- use args[-1] from here
 566        (actually, doesn't matter since Emacs GC doesn't relocate, sigh) */
 567     GCPRO2 (prefix, args[-1]);
 568     gcpro2.nvars = alloca_size;
 569
 570     for (argnum = 0; ; argnum++)
 571       {
 572         const char *prompt_start = prompt_data + prompt_index + 1;
 573         const char *prompt_limit = (const char *) strchr (prompt_start, '\n');
 574         int prompt_length;
 575         prompt_length = ((prompt_limit)
 576                          ? (prompt_limit - prompt_start)
 577                          : (int) strlen (prompt_start));
 578         if (prompt_limit && prompt_limit[1] == 0)
 579           {
 580             prompt_limit = 0;   /* "sfoo:\n" -- strip tailing return */
 581             prompt_length -= 1;
 582           }
 583         /* This uses `visargs' instead of `args' so that global-set-key
 584            prompts with "Set key C-x C-f to command: "instead of printing
 585            event objects in there.
 586          */
 587 #define PROMPT() callint_prompt ((const Bufbyte *) prompt_start, prompt_length, visargs, argnum)
 588         switch (prompt_data[prompt_index])
 589           {
 590           case 'a':             /* Symbol defined as a function */
 591             {
 592               Lisp_Object tem = call1 (Qread_function, PROMPT ());
 593               args[argnum] = tem;
 594               arg_from_tty = 1;
 595               break;
 596             }
 597           case 'b':             /* Name of existing buffer */
 598             {
 599               Lisp_Object def = Fcurrent_buffer ();
 600               if (EQ (Fselected_window (Qnil), minibuf_window))
 601                 def = Fother_buffer (def, Qnil, Qnil);
 602               /* read-buffer returns a buffer name, not a buffer! */
 603               args[argnum] = call3 (Qread_buffer, PROMPT (), def,
 604                                     Qt);
 605               arg_from_tty = 1;
 606               break;
 607             }
 608           case 'B':             /* Name of buffer, possibly nonexistent */
 609             {
 610               /* read-buffer returns a buffer name, not a buffer! */
 611               args[argnum] = call2 (Qread_buffer, PROMPT (),
 612                                     Fother_buffer (Fcurrent_buffer (), Qnil,
 613                                                    Qnil));
 614               arg_from_tty = 1;
 615               break;
 616             }
 617           case 'c':             /* Character */
 618             {
 619               Lisp_Object tem;
 620               int shadowing_speccount = specpdl_depth ();
 621
 622               specbind (Qcursor_in_echo_area, Qt);
 623               message ("%s", XSTRING_DATA (PROMPT ()));
 624               tem = (call0 (Qread_char));
 625               args[argnum] = tem;
 626               /* visargs[argnum] = Fsingle_key_description (tem); */
 627               /* FSF has visargs[argnum] = Fchar_to_string (tem); */
 628
 629               unbind_to (shadowing_speccount, Qnil);
 630
 631               /* #### `C-x / a' should not leave the prompt in the minibuffer.
 632                  This isn't the right fix, because (message ...) (read-char)
 633                  shouldn't leave the message there either... */
 634               clear_message ();
 635
 636               arg_from_tty = 1;
 637               break;
 638             }
 639           case 'C':             /* Command: symbol with interactive function */
 640             {
 641               Lisp_Object tem = call1 (Qread_command, PROMPT ());
 642               args[argnum] = tem;
 643               arg_from_tty = 1;
 644               break;
 645             }
 646           case 'd':             /* Value of point.  Does not do I/O.  */
 647             {
 648               args[argnum] = Fcopy_marker (current_buffer->point_marker, Qt);
 649               varies[argnum] = Qpoint;
 650               break;
 651             }
 652           case 'e':
 653             {
 654               Lisp_Object event;
 655
 656               if (!NILP (keys))
 657                 event = extract_vector_nth_mouse_event (keys,
 658                                                         mouse_event_count);
 659               else
 660 #if 0
 661               /* This doesn't quite work because this-command-keys
 662                  behaves in utterly counterintuitive ways.  Sometimes
 663                  it retrieves an event back in the future, e.g. when
 664                  one command invokes another command and both are
 665                  invoked with the mouse. */
 666                 event = (extract_this_command_keys_nth_mouse_event
 667                          (mouse_event_count));
 668 #else
 669                 event = Vcurrent_mouse_event;
 670 #endif
 671
 672               if (NILP (event))
 673                 error ("%s must be bound to a mouse or misc-user event",
 674                        (SYMBOLP (function)
 675                         ? (char *) string_data (XSYMBOL (function)->name)
 676                         : "command"));
 677               args[argnum] = event;
 678               mouse_event_count++;
 679               break;
 680             }
 681           case 'D':             /* Directory name. */
 682             {
 683               args[argnum] = call4 (Qread_directory_name, PROMPT (),
 684                                     Qnil, /* dir */
 685                                     current_buffer->directory, /* default */
 686                                     Qt /* must-match */
 687                                     );
 688               arg_from_tty = 1;
 689               break;
 690             }
 691           case 'f':             /* Existing file name. */
 692             {
 693               Lisp_Object tem = call4 (Qread_file_name, PROMPT (),
 694                                        Qnil, /* dir */
 695                                        Qnil, /* default */
 696                                        Qzero /* must-match */
 697                                        );
 698               args[argnum] = tem;
 699               arg_from_tty = 1;
 700               break;
 701             }
 702           case 'F':             /* Possibly nonexistent file name. */
 703             {
 704               args[argnum] = call4 (Qread_file_name, PROMPT (),
 705                                     Qnil, /* dir */
 706                                     Qnil, /* default */
 707                                     Qnil /* must-match */
 708                                     );
 709               arg_from_tty = 1;
 710               break;
 711             }
 712           case 'i':             /* Ignore: always nil. Use to skip arguments. */
 713             {
 714               args[argnum] = Qnil;
 715               break;
 716             }
 717           case 'k':             /* Key sequence (vector of events) */
 718             {
 719               struct gcpro ngcpro1;
 720               Lisp_Object tem;
 721               Lisp_Object key_prompt = PROMPT ();
 722
 723               NGCPRO1(key_prompt);
 724               tem = Fread_key_sequence (key_prompt, Qnil, Qnil);
 725               NUNGCPRO;
 726
 727               visargs[argnum] = Fkey_description (tem);
 728               /* The following makes `describe-key' not work with
 729                  extent-local keymaps and such; and anyway, it's
 730                  contrary to the documentation. */
 731               /* args[argnum] = call1 (Qevents_to_keys, tem); */
 732               args[argnum] = tem;
 733               arg_from_tty = 1;
 734               break;
 735             }
 736           case 'K':             /* Key sequence (vector of events),
 737                                    no automatic downcasing */
 738             {
 739               struct gcpro ngcpro1;
 740               Lisp_Object tem;
 741               Lisp_Object key_prompt = PROMPT ();
 742
 743               NGCPRO1(key_prompt);
 744               tem = Fread_key_sequence (key_prompt, Qnil, Qt);
 745               NUNGCPRO;
 746
 747               visargs[argnum] = Fkey_description (tem);
 748               /* The following makes `describe-key' not work with
 749                  extent-local keymaps and such; and anyway, it's
 750                  contrary to the documentation. */
 751               /* args[argnum] = call1 (Qevents_to_keys, tem); */
 752               args[argnum] = tem;
 753               arg_from_tty = 1;
 754               break;
 755             }
 756
 757           case 'm':             /* Value of mark.  Does not do I/O.  */
 758             {
 759               args[argnum] = current_buffer->mark;
 760               varies[argnum] = Qmark;
 761               break;
 762             }
 763           case 'n':             /* Read number from minibuffer.  */
 764             {
 765             read_number:
 766               args[argnum] = call2 (Qread_number, PROMPT (), Qnil);
 767               /* numbers are too boring to go on command history */
 768               /* arg_from_tty = 1; */
 769               break;
 770             }
 771           case 'N':             /* Prefix arg, else number from minibuffer */
 772             {
 773               if (NILP (prefix))
 774                 goto read_number;
 775               else
 776                 goto prefix_value;
 777             }
 778           case 'P':             /* Prefix arg in raw form.  Does no I/O.  */
 779             {
 780               args[argnum] = prefix;
 781               break;
 782             }
 783           case 'p':             /* Prefix arg converted to number.  No I/O. */
 784             {
 785             prefix_value:
 786               {
 787                 Lisp_Object tem = Fprefix_numeric_value (prefix);
 788                 args[argnum] = tem;
 789               }
 790               break;
 791             }
 792           case 'r':             /* Region, point and mark as 2 args. */
 793             {
 794               Bufpos tem = check_mark ();
 795               args[argnum] = (BUF_PT (current_buffer) < tem
 796                               ? Fcopy_marker (current_buffer->point_marker, Qt)
 797                               : current_buffer->mark);
 798               varies[argnum] = Qregion_beginning;
 799               args[++argnum] = (BUF_PT (current_buffer) > tem
 800                                 ? Fcopy_marker (current_buffer->point_marker,
 801                                                 Qt)
 802                                 : current_buffer->mark);
 803               varies[argnum] = Qregion_end;
 804               break;
 805             }
 806           case 's':             /* String read via minibuffer.  */
 807             {
 808               args[argnum] = call1 (Qread_string, PROMPT ());
 809               arg_from_tty = 1;
 810               break;
 811             }
 812           case 'S':             /* Any symbol.  */
 813             {
 814               visargs[argnum] = Qnil;
 815               for (;;)
 816                 {
 817                   Lisp_Object tem = call5 (Qcompleting_read,
 818                                            PROMPT (),
 819                                            Vobarray,
 820                                            Qnil,
 821                                            Qnil,
 822                                            /* nil, or prev attempt */
 823                                            visargs[argnum]);
 824                   visargs[argnum] = tem;
 825                   /* I could use condition-case with this loser, but why bother?
 826                    * tem = Fread (tem); check-symbol-p;
 827                    */
 828                   tem = Fintern (tem, Qnil);
 829                   args[argnum] = tem;
 830                   if (string_length (XSYMBOL (tem)->name) > 0)
 831                     /* Don't accept the empty-named symbol.  If the loser
 832                        really wants this s/he can call completing-read
 833                        directly */
 834                     break;
 835                 }
 836               arg_from_tty = 1;
 837               break;
 838             }
 839           case 'v':             /* Variable name: user-variable-p symbol */
 840             {
 841               Lisp_Object tem = call1 (Qread_variable, PROMPT ());
 842               args[argnum] = tem;
 843               arg_from_tty = 1;
 844               break;
 845             }
 846           case 'x':             /* Lisp expression read but not evaluated */
 847             {
 848               args[argnum] = call1 (Qread_expression, PROMPT ());
 849               /* visargs[argnum] = Fprin1_to_string (args[argnum], Qnil); */
 850               arg_from_tty = 1;
 851               break;
 852             }
 853           case 'X':             /* Lisp expression read and evaluated */
 854             {
 855               Lisp_Object tem = call1 (Qread_expression, PROMPT ());
 856               /* visargs[argnum] = Fprin1_to_string (tem, Qnil); */
 857               args[argnum] = Feval (tem);
 858               arg_from_tty = 1;
 859               break;
 860             }
 861           case 'Z':             /* Coding-system symbol or nil if no prefix */
 862             {
 863 #if defined(MULE) || defined(FILE_CODING)
 864               if (NILP (prefix))
 865                 {
 866                   args[argnum] = Qnil;
 867                 }
 868               else
 869                 {
 870                   args[argnum] =
 871                     call1 (Qread_non_nil_coding_system, PROMPT ());
 872                   arg_from_tty = 1;
 873                 }
 874 #else
 875               args[argnum] = Qnil;
 876 #endif
 877               break;
 878             }
 879           case 'z':             /* Coding-system symbol */
 880             {
 881 #if defined(MULE) || defined(FILE_CODING)
 882               args[argnum] = call1 (Qread_coding_system, PROMPT ());
 883               arg_from_tty = 1;
 884 #else
 885               args[argnum] = Qnil;
 886 #endif
 887               break;
 888             }
 889
 890             /* We have a case for `+' so we get an error
 891                if anyone tries to define one here.  */
 892           case '+':
 893           default:
 894             {
 895               error ("Invalid `interactive' control letter \"%c\" (#o%03o).",
 896                      prompt_data[prompt_index],
 897                      prompt_data[prompt_index]);
 898             }
 899           }
 900 #undef PROMPT
 901         if (NILP (visargs[argnum]))
 902           visargs[argnum] = args[argnum];
 903
 904         if (!prompt_limit)
 905           break;
 906         if (STRINGP (specs))
 907           prompt_data = (const char *) XSTRING_DATA (specs);
 908         prompt_index += prompt_length + 1 + 1; /* +1 to skip spec, +1 for \n */
 909       }
 910     unbind_to (speccount, Qnil);
 911
 912     QUIT;
 913
 914     if (EQ (record_flag, Qlambda))
 915       {
 916         RETURN_UNGCPRO (Flist (argcount, args));
 917       }
 918
 919     if (arg_from_tty || !NILP (record_flag))
 920       {
 921         /* Reuse visargs as a temporary for constructing the command history */
 922         for (argnum = 0; argnum < argcount; argnum++)
 923           {
 924             if (!NILP (varies[argnum]))
 925               visargs[argnum] = list1 (varies[argnum]);
 926             else
 927               visargs[argnum] = Fquote_maybe (args[argnum]);
 928           }
 929         Vcommand_history = Fcons (Fcons (args[-1], Flist (argcount, visargs)),
 930                                   Vcommand_history);
 931       }
 932
 933     /* If we used a marker to hold point, mark, or an end of the region,
 934        temporarily, convert it to an integer now.  */
 935     for (argnum = 0; argnum < argcount; argnum++)
 936       if (!NILP (varies[argnum]))
 937         XSETINT (args[argnum], marker_position (args[argnum]));
 938
 939     single_console_state ();
 940     specbind (Qcommand_debug_status, Qnil);
 941     fun = Ffuncall (argcount + 1, args - 1);
 942     UNGCPRO;
 943     if (set_zmacs_region_stays)
 944       zmacs_region_stays = 1;
 945     return unbind_to (speccount, fun);
 946   }
 947 }
 948
 949 DEFUN ("prefix-numeric-value", Fprefix_numeric_value, 1, 1, 0, /*
 950 Return numeric meaning of raw prefix argument RAW.
 951 A raw prefix argument is what you get from `(interactive "P")'.
 952 Its numeric meaning is what you would get from `(interactive "p")'.
 953 */
 954        (raw))
 955 {
 956   if (NILP (raw))
 957     return make_int (1);
 958   if (EQ (raw, Qminus))
 959     return make_int (-1);
 960   if (INTP (raw))
 961     return raw;
 962   if (CONSP (raw) && INTP (XCAR (raw)))
 963     return XCAR (raw);
 964
 965   return make_int (1);
 966 }
 967
 968 void
 969 syms_of_callint (void)
 970 {
 971   defsymbol (&Qcall_interactively, "call-interactively");
 972   defsymbol (&Qread_from_minibuffer, "read-from-minibuffer");
 973   defsymbol (&Qcompleting_read, "completing-read");
 974   defsymbol (&Qread_file_name, "read-file-name");
 975   defsymbol (&Qread_directory_name, "read-directory-name");
 976   defsymbol (&Qread_string, "read-string");
 977   defsymbol (&Qread_buffer, "read-buffer");
 978   defsymbol (&Qread_variable, "read-variable");
 979   defsymbol (&Qread_function, "read-function");
 980   defsymbol (&Qread_command, "read-command");
 981   defsymbol (&Qread_number, "read-number");
 982   defsymbol (&Qread_expression, "read-expression");
 983 #if defined(MULE) || defined(FILE_CODING)
 984   defsymbol (&Qread_coding_system, "read-coding-system");
 985   defsymbol (&Qread_non_nil_coding_system, "read-non-nil-coding-system");
 986 #endif
 987   defsymbol (&Qevents_to_keys, "events-to-keys");
 988   defsymbol (&Qcommand_debug_status, "command-debug-status");
 989   defsymbol (&Qenable_recursive_minibuffers, "enable-recursive-minibuffers");
 990
 991   defsymbol (&QletX, "let*");
 992   defsymbol (&Qsave_excursion, "save-excursion");
 993 #if 0 /* ill-conceived */
 994   defsymbol (&Qmouse_leave_buffer_hook, "mouse-leave-buffer-hook");
 995 #endif
 996
 997   DEFSUBR (Finteractive);
 998   DEFSUBR (Fquote_maybe);
 999   DEFSUBR (Fcall_interactively);
1000   DEFSUBR (Fprefix_numeric_value);
1001 }
1002
1003 void
1004 vars_of_callint (void)
1005 {
1006   DEFVAR_LISP ("current-prefix-arg", &Vcurrent_prefix_arg /*
1007 The value of the prefix argument for this editing command.
1008 It may be a number, or the symbol `-' for just a minus sign as arg,
1009 or a list whose car is a number for just one or more C-U's
1010 or nil if no argument has been specified.
1011 This is what `(interactive "P")' returns.
1012 */ );
1013   Vcurrent_prefix_arg = Qnil;
1014
1015   DEFVAR_LISP ("command-history", &Vcommand_history /*
1016 List of recent commands that read arguments from terminal.
1017 Each command is represented as a form to evaluate.
1018 */ );
1019   Vcommand_history = Qnil;
1020
1021   DEFVAR_LISP ("command-debug-status", &Vcommand_debug_status /*
1022 Debugging status of current interactive command.
1023 Bound each time `call-interactively' is called;
1024 may be set by the debugger as a reminder for itself.
1025 */ );
1026   Vcommand_debug_status = Qnil;
1027
1028 #if 0 /* FSFmacs */
1029   xxDEFVAR_LISP ("mark-even-if-inactive", &Vmark_even_if_inactive /*
1030 *Non-nil means you can use the mark even when inactive.
1031 This option makes a difference in Transient Mark mode.
1032 When the option is non-nil, deactivation of the mark
1033 turns off region highlighting, but commands that use the mark
1034 behave as if the mark were still active.
1035 */ );
1036   Vmark_even_if_inactive = Qnil;
1037 #endif
1038
1039 #if 0 /* Doesn't work and is totally ill-conceived anyway. */
1040   xxDEFVAR_LISP ("mouse-leave-buffer-hook", &Vmouse_leave_buffer_hook /*
1041 Hook to run when about to switch windows with a mouse command.
1042 Its purpose is to give temporary modes such as Isearch mode
1043 a way to turn themselves off when a mouse command switches windows.
1044 */ );
1045   Vmouse_leave_buffer_hook = Qnil;
1046 #endif
1047 }