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