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 *fcall= alloca_array(Lisp_Object, alloca_size);
 531                 Lisp_Object *args = fcall+1;
 532                 /* visargs is an array of either Qnil or user-friendlier
 533                     versions (often
 534                  *  strings) of previous arguments, to use in prompts for
 535                     successive
 536                  *  arguments.  ("Often strings" because emacs didn't used to
 537                     have
 538                  *  format %S and prin1-to-string.) */
 539                 Lisp_Object *visargs = args + argcount;
 540                 /* If varies[i] is non-null, the i'th argument shouldn't just
 541                    have its value in this call quoted in the command history.
 542                    It should be recorded as a call to the function named
 543                    varies[i]]. */
 544                 Lisp_Object *varies = visargs + argcount;
 545                 int arg_from_tty = 0;
 546                 REGISTER int argnum;
 547                 struct gcpro gcpro1, gcpro2;
 548
 549                 fcall[0] = function;
 550                 for (argnum = 0; argnum < alloca_size - 1; argnum++)
 551                         args[argnum] = Qnil;
 552
 553                 /* Must GC-protect args[-1] (ie function) because Ffuncall
 554                    doesn't */
 555                 /* `function' itself isn't GC-protected -- use args[-1] from
 556                    here (actually, doesn't matter since Emacs GC doesn't
 557                    relocate, sigh) */
 558                 GCPRO1n(prefix, &args[-1], alloca_size);
 559
 560                 for (argnum = 0;; argnum++) {
 561                         const char *prompt_start =
 562                                 prompt_data + prompt_index + 1;
 563                         char *prompt_limit =
 564                                 (char *)strchr(prompt_start, '\n');
 565                         int prompt_length;
 566                         prompt_length = ((prompt_limit)
 567                                          ? (prompt_limit - prompt_start)
 568                                          : (int)strlen(prompt_start));
 569                         if (prompt_limit && prompt_limit[1] == 0) {
 570                                 /* "sfoo:\n" -- strip tailing return */
 571                                 prompt_limit = 0;
 572                                 prompt_length -= 1;
 573                         }
 574                         /* This uses `visargs' instead of `args' so that
 575                            global-set-key prompts with "Set key C-x C-f to
 576                            command: "instead of printing event objects in there.
 577                          */
 578 #define PROMPT() callint_prompt ((const Bufbyte *) prompt_start,        \
 579                                  prompt_length, visargs, argnum)
 580                         switch (prompt_data[prompt_index]) {
 581                         case 'a': {
 582                                 /* Symbol defined as a function */
 583                                 Lisp_Object tem = call1(
 584                                         Qread_function, PROMPT());
 585                                 args[argnum] = tem;
 586                                 arg_from_tty = 1;
 587                                 break;
 588                         }
 589                         case 'b': {
 590                                 /* Name of existing buffer */
 591                                 Lisp_Object def = Fcurrent_buffer();
 592                                 if (EQ(Fselected_window(Qnil),
 593                                        minibuf_window))
 594                                         def = Fother_buffer(def, Qnil, Qnil);
 595                                 /* read-buffer returns a buffer name, not a
 596                                    buffer! */
 597                                 args[argnum] = call3(
 598                                         Qread_buffer, PROMPT(), def, Qt);
 599                                 arg_from_tty = 1;
 600                                 break;
 601                         }
 602                         case 'B': {
 603                                 /* Name of buffer, possibly nonexistent */
 604                                 /* read-buffer returns a buffer name, not a
 605                                    buffer! */
 606                                 args[argnum] = call2(Qread_buffer, PROMPT(),
 607                                                      Fother_buffer(
 608                                                              Fcurrent_buffer(),
 609                                                              Qnil, Qnil));
 610                                 arg_from_tty = 1;
 611                                 break;
 612                         }
 613                         case 'c': {
 614                                 /* Character */
 615                                 Lisp_Object tem;
 616                                 int shadowing_speccount =
 617                                         specpdl_depth();
 618
 619                                 specbind(Qcursor_in_echo_area, Qt);
 620                                 {
 621                                         Lisp_Object tmp = PROMPT();
 622                                         message("%s", XSTRING_DATA(tmp));
 623                                 }
 624                                 tem = (call0(Qread_char));
 625                                 args[argnum] = tem;
 626                                 /* visargs[argnum] = Fsingle_key_description
 627                                    (tem); */
 628                                 /* FSF has visargs[argnum] = Fchar_to_string
 629                                    (tem); */
 630
 631                                 unbind_to(shadowing_speccount, Qnil);
 632
 633                                 /* #### `C-x / a' should not leave the prompt in
 634                                    #### the minibuffer.
 635                                    This isn't the right fix, because (message
 636                                    ...) (read-char) shouldn't leave the message
 637                                    there either... */
 638                                 clear_message();
 639
 640                                 arg_from_tty = 1;
 641                                 break;
 642                         }
 643                         case 'C': {
 644                                 /* Command: symbol with interactive function */
 645                                 Lisp_Object tem =
 646                                         call1(Qread_command, PROMPT());
 647                                 args[argnum] = tem;
 648                                 arg_from_tty = 1;
 649                                 break;
 650                         }
 651                         case 'd': {
 652                                 /* Value of point.  Does not do I/O.  */
 653                                 args[argnum] = Fcopy_marker(current_buffer->
 654                                                             point_marker, Qt);
 655                                 varies[argnum] = Qpoint;
 656                                 break;
 657                         }
 658                         case 'e':
 659                                 {
 660                                         Lisp_Object event;
 661
 662                                         if (!NILP(keys))
 663                                                 event =
 664                                                     extract_vector_nth_mouse_event
 665                                                     (keys, mouse_event_count);
 666                                         else
 667 #if 0
 668                                                 /* This doesn't quite work because this-command-keys
 669                                                    behaves in utterly counterintuitive ways.  Sometimes
 670                                                    it retrieves an event back in the future, e.g. when
 671                                                    one command invokes another command and both are
 672                                                    invoked with the mouse. */
 673                                                 event =
 674                                                     (extract_this_command_keys_nth_mouse_event
 675                                                      (mouse_event_count));
 676 #else
 677                                                 event = Vcurrent_mouse_event;
 678 #endif
 679
 680                                         if (NILP(event))
 681                                                 error
 682                                                     ("%s must be bound to a mouse or misc-user event",
 683                                                      (SYMBOLP(function)
 684                                                       ? (char *)
 685                                                       string_data(XSYMBOL
 686                                                                   (function)->
 687                                                                   name)
 688                                                       : "command"));
 689                                         args[argnum] = event;
 690                                         mouse_event_count++;
 691                                         break;
 692                                 }
 693                         case 'D':       /* Directory name. */
 694                                 {
 695                                         args[argnum] = call4(Qread_directory_name, PROMPT(), Qnil,      /* dir */
 696                                                              current_buffer->directory, /* default */
 697                                                              Qt /* must-match */
 698                                             );
 699                                         arg_from_tty = 1;
 700                                         break;
 701                                 }
 702                         case 'f':       /* Existing file name. */
 703                                 {
 704                                         Lisp_Object tem =
 705                                             call4(Qread_file_name, PROMPT(),
 706                                                   Qnil, /* dir */
 707                                                   Qnil, /* default */
 708                                                   Qzero /* must-match */
 709                                             );
 710                                         args[argnum] = tem;
 711                                         arg_from_tty = 1;
 712                                         break;
 713                                 }
 714                         case 'F':       /* Possibly nonexistent file name. */
 715                                 {
 716                                         args[argnum] = call4(Qread_file_name, PROMPT(), Qnil,   /* dir */
 717                                                              Qnil,      /* default */
 718                                                              Qnil       /* must-match */
 719                                             );
 720                                         arg_from_tty = 1;
 721                                         break;
 722                                 }
 723                         case 'i':       /* Ignore: always nil. Use to skip arguments. */
 724                                 {
 725                                         args[argnum] = Qnil;
 726                                         break;
 727                                 }
 728                         case 'k':       /* Key sequence (vector of events) */
 729                                 {
 730                                         struct gcpro ngcpro1;
 731                                         Lisp_Object tem;
 732                                         Lisp_Object key_prompt = PROMPT();
 733
 734                                         NGCPRO1(key_prompt);
 735                                         tem =
 736                                             Fread_key_sequence(key_prompt, Qnil,
 737                                                                Qnil);
 738                                         NUNGCPRO;
 739
 740                                         visargs[argnum] = Fkey_description(tem);
 741                                         /* The following makes `describe-key' not work with
 742                                            extent-local keymaps and such; and anyway, it's
 743                                            contrary to the documentation. */
 744                                         /* args[argnum] = call1 (Qevents_to_keys, tem); */
 745                                         args[argnum] = tem;
 746                                         arg_from_tty = 1;
 747                                         break;
 748                                 }
 749                         case 'K':       /* Key sequence (vector of events),
 750                                            no automatic downcasing */
 751                                 {
 752                                         struct gcpro ngcpro1;
 753                                         Lisp_Object tem;
 754                                         Lisp_Object key_prompt = PROMPT();
 755
 756                                         NGCPRO1(key_prompt);
 757                                         tem =
 758                                             Fread_key_sequence(key_prompt, Qnil,
 759                                                                Qt);
 760                                         NUNGCPRO;
 761
 762                                         visargs[argnum] = Fkey_description(tem);
 763                                         /* The following makes `describe-key' not work with
 764                                            extent-local keymaps and such; and anyway, it's
 765                                            contrary to the documentation. */
 766                                         /* args[argnum] = call1 (Qevents_to_keys, tem); */
 767                                         args[argnum] = tem;
 768                                         arg_from_tty = 1;
 769                                         break;
 770                                 }
 771
 772                         case 'm':       /* Value of mark.  Does not do I/O.  */
 773                                 {
 774                                         args[argnum] = current_buffer->mark;
 775                                         varies[argnum] = Qmark;
 776                                         break;
 777                                 }
 778                         case 'n':       /* Read number from minibuffer.  */
 779                                 {
 780                                       read_number:
 781                                         args[argnum] =
 782                                             call2(Qread_number, PROMPT(), Qnil);
 783                                         /* numbers are too boring to go on command history */
 784                                         /* arg_from_tty = 1; */
 785                                         break;
 786                                 }
 787                         case 'N':       /* Prefix arg, else number from minibuffer */
 788                                 {
 789                                         if (NILP(prefix))
 790                                                 goto read_number;
 791                                         else
 792                                                 goto prefix_value;
 793                                 }
 794                         case 'P':       /* Prefix arg in raw form.  Does no I/O.  */
 795                                 {
 796                                         args[argnum] = prefix;
 797                                         break;
 798                                 }
 799                         case 'p':       /* Prefix arg converted to number.  No I/O. */
 800                                 {
 801                                       prefix_value:
 802                                         {
 803                                                 Lisp_Object tem =
 804                                                     Fprefix_numeric_value
 805                                                     (prefix);
 806                                                 args[argnum] = tem;
 807                                         }
 808                                         break;
 809                                 }
 810                         case 'r':       /* Region, point and mark as 2 args. */
 811                                 {
 812                                         Bufpos tem = check_mark();
 813                                         args[argnum] =
 814                                             (BUF_PT(current_buffer) <
 815                                              tem ? Fcopy_marker(current_buffer->
 816                                                                 point_marker,
 817                                                                 Qt)
 818                                              : current_buffer->mark);
 819                                         varies[argnum] = Qregion_beginning;
 820                                         args[++argnum] =
 821                                             (BUF_PT(current_buffer) >
 822                                              tem ? Fcopy_marker(current_buffer->
 823                                                                 point_marker,
 824                                                                 Qt)
 825                                              : current_buffer->mark);
 826                                         varies[argnum] = Qregion_end;
 827                                         break;
 828                                 }
 829                         case 's':       /* String read via minibuffer.  */
 830                                 {
 831                                         args[argnum] =
 832                                             call1(Qread_string, PROMPT());
 833                                         arg_from_tty = 1;
 834                                         break;
 835                                 }
 836                         case 'S':       /* Any symbol.  */
 837                                 {
 838                                         visargs[argnum] = Qnil;
 839                                         for (;;) {
 840                                                 Lisp_Object tem =
 841                                                     call5(Qcompleting_read,
 842                                                           PROMPT(),
 843                                                           Vobarray,
 844                                                           Qnil,
 845                                                           Qnil,
 846                                                           /* nil, or prev attempt */
 847                                                           visargs[argnum]);
 848                                                 visargs[argnum] = tem;
 849                                                 /* I could use condition-case with this loser, but why bother?
 850                                                  * tem = Fread (tem); check-symbol-p;
 851                                                  */
 852                                                 tem = Fintern(tem, Qnil);
 853                                                 args[argnum] = tem;
 854                                                 if (string_length
 855                                                     (XSYMBOL(tem)->name) > 0)
 856                                                         /* Don't accept the empty-named symbol.  If the loser
 857                                                            really wants this s/he can call completing-read
 858                                                            directly */
 859                                                         break;
 860                                         }
 861                                         arg_from_tty = 1;
 862                                         break;
 863                                 }
 864                         case 'v':       /* Variable name: user-variable-p symbol */
 865                                 {
 866                                         Lisp_Object tem =
 867                                             call1(Qread_variable, PROMPT());
 868                                         args[argnum] = tem;
 869                                         arg_from_tty = 1;
 870                                         break;
 871                                 }
 872                         case 'x':       /* Lisp expression read but not evaluated */
 873                                 {
 874                                         args[argnum] =
 875                                             call1(Qread_expression, PROMPT());
 876                                         /* visargs[argnum] = Fprin1_to_string (args[argnum], Qnil); */
 877                                         arg_from_tty = 1;
 878                                         break;
 879                                 }
 880                         case 'X':       /* Lisp expression read and evaluated */
 881                                 {
 882                                         Lisp_Object tem =
 883                                             call1(Qread_expression, PROMPT());
 884                                         /* visargs[argnum] = Fprin1_to_string (tem, Qnil); */
 885                                         args[argnum] = Feval(tem);
 886                                         arg_from_tty = 1;
 887                                         break;
 888                                 }
 889                         case 'Z':       /* Coding-system symbol or nil if no prefix */
 890                                 {
 891 #if defined(MULE) || defined(FILE_CODING)
 892                                         if (NILP(prefix)) {
 893                                                 args[argnum] = Qnil;
 894                                         } else {
 895                                                 args[argnum] =
 896                                                     call1
 897                                                     (Qread_non_nil_coding_system,
 898                                                      PROMPT());
 899                                                 arg_from_tty = 1;
 900                                         }
 901 #else
 902                                         args[argnum] = Qnil;
 903 #endif
 904                                         break;
 905                                 }
 906                         case 'z':       /* Coding-system symbol */
 907                                 {
 908 #if defined(MULE) || defined(FILE_CODING)
 909                                         args[argnum] =
 910                                             call1(Qread_coding_system,
 911                                                   PROMPT());
 912                                         arg_from_tty = 1;
 913 #else
 914                                         args[argnum] = Qnil;
 915 #endif
 916                                         break;
 917                                 }
 918
 919                                 /* We have a case for `+' so we get an error
 920                                    if anyone tries to define one here.  */
 921                         case '+':
 922                         default:
 923                                 {
 924                                         error
 925                                             ("Invalid `interactive' control letter \"%c\" (#o%03o).",
 926                                              prompt_data[prompt_index],
 927                                              prompt_data[prompt_index]);
 928                                 }
 929                         }
 930 #undef PROMPT
 931                         if (NILP(visargs[argnum]))
 932                                 visargs[argnum] = args[argnum];
 933
 934                         if (!prompt_limit)
 935                                 break;
 936                         if (STRINGP(specs)) {
 937                                 prompt_data = (char *)XSTRING_DATA(specs);
 938                         }
 939                         /* +1 to skip spec, +1 for \n */
 940                         prompt_index += prompt_length + 1 + 1;
 941                 }
 942                 unbind_to(speccount, Qnil);
 943
 944                 QUIT;
 945
 946                 if (EQ(record_flag, Qlambda)) {
 947                         RETURN_UNGCPRO(Flist(argcount, args));
 948                 }
 949
 950                 if (arg_from_tty || !NILP(record_flag)) {
 951                         /* Reuse visargs as a temporary for constructing the command history */
 952                         for (argnum = 0; argnum < argcount; argnum++) {
 953                                 if (!NILP(varies[argnum]))
 954                                         visargs[argnum] = list1(varies[argnum]);
 955                                 else
 956                                         visargs[argnum] =
 957                                             Fquote_maybe(args[argnum]);
 958                         }
 959                         Vcommand_history =
 960                             Fcons(Fcons(args[-1], Flist(argcount, visargs)),
 961                                   Vcommand_history);
 962                 }
 963
 964                 /* If we used a marker to hold point, mark, or an end of the region,
 965                    temporarily, convert it to an integer now.  */
 966                 for (argnum = 0; argnum < argcount; argnum++)
 967                         if (!NILP(varies[argnum]))
 968                                 XSETINT(args[argnum],
 969                                         marker_position(args[argnum]));
 970
 971                 single_console_state();
 972                 specbind(Qcommand_debug_status, Qnil);
 973                 fun = Ffuncall(argcount + 1, args - 1);
 974                 UNGCPRO;
 975                 if (set_zmacs_region_stays)
 976                         zmacs_region_stays = 1;
 977                 return unbind_to(speccount, fun);
 978         }
 979 }
 980
 981 DEFUN("prefix-numeric-value", Fprefix_numeric_value, 1, 1, 0,   /*
 982 Return numeric meaning of raw prefix argument RAW.
 983 A raw prefix argument is what you get from `(interactive "P")'.
 984 Its numeric meaning is what you would get from `(interactive "p")'.
 985 */
 986       (raw))
 987 {
 988         if (NILP(raw))
 989                 return make_int(1);
 990         if (EQ(raw, Qminus))
 991                 return make_int(-1);
 992         if (INTP(raw))
 993                 return raw;
 994         if (CONSP(raw) && INTP(XCAR(raw)))
 995                 return XCAR(raw);
 996
 997         return make_int(1);
 998 }
 999
1000 void syms_of_callint(void)
1001 {
1002         defsymbol(&Qcall_interactively, "call-interactively");
1003         defsymbol(&Qread_from_minibuffer, "read-from-minibuffer");
1004         defsymbol(&Qcompleting_read, "completing-read");
1005         defsymbol(&Qread_file_name, "read-file-name");
1006         defsymbol(&Qread_directory_name, "read-directory-name");
1007         defsymbol(&Qread_string, "read-string");
1008         defsymbol(&Qread_buffer, "read-buffer");
1009         defsymbol(&Qread_variable, "read-variable");
1010         defsymbol(&Qread_function, "read-function");
1011         defsymbol(&Qread_command, "read-command");
1012         defsymbol(&Qread_number, "read-number");
1013         defsymbol(&Qread_expression, "read-expression");
1014 #if defined(MULE) || defined(FILE_CODING)
1015         defsymbol(&Qread_coding_system, "read-coding-system");
1016         defsymbol(&Qread_non_nil_coding_system, "read-non-nil-coding-system");
1017 #endif
1018         defsymbol(&Qevents_to_keys, "events-to-keys");
1019         defsymbol(&Qcommand_debug_status, "command-debug-status");
1020         defsymbol(&Qenable_recursive_minibuffers,
1021                   "enable-recursive-minibuffers");
1022
1023         defsymbol(&QletX, "let*");
1024         defsymbol(&Qsave_excursion, "save-excursion");
1025 #if 0                           /* ill-conceived */
1026         defsymbol(&Qmouse_leave_buffer_hook, "mouse-leave-buffer-hook");
1027 #endif
1028
1029         DEFSUBR(Finteractive);
1030         DEFSUBR(Fquote_maybe);
1031         DEFSUBR(Fcall_interactively);
1032         DEFSUBR(Fprefix_numeric_value);
1033 }
1034
1035 void vars_of_callint(void)
1036 {
1037         DEFVAR_LISP("current-prefix-arg", &Vcurrent_prefix_arg  /*
1038 The value of the prefix argument for this editing command.
1039 It may be a number, or the symbol `-' for just a minus sign as arg,
1040 or a list whose car is a number for just one or more C-U's
1041 or nil if no argument has been specified.
1042 This is what `(interactive "P")' returns.
1043                                                                  */ );
1044         Vcurrent_prefix_arg = Qnil;
1045
1046         DEFVAR_LISP("command-history", &Vcommand_history        /*
1047 List of recent commands that read arguments from terminal.
1048 Each command is represented as a form to evaluate.
1049                                                                  */ );
1050         Vcommand_history = Qnil;
1051
1052         DEFVAR_LISP("command-debug-status", &Vcommand_debug_status      /*
1053 Debugging status of current interactive command.
1054 Bound each time `call-interactively' is called;
1055 may be set by the debugger as a reminder for itself.
1056                                                                          */ );
1057         Vcommand_debug_status = Qnil;
1058
1059 #if 0                           /* FSFmacs */
1060         xxDEFVAR_LISP("mark-even-if-inactive", &Vmark_even_if_inactive  /*
1061 *Non-nil means you can use the mark even when inactive.
1062 This option makes a difference in Transient Mark mode.
1063 When the option is non-nil, deactivation of the mark
1064 turns off region highlighting, but commands that use the mark
1065 behave as if the mark were still active.
1066                                                                          */ );
1067         Vmark_even_if_inactive = Qnil;
1068 #endif
1069
1070 #if 0                           /* Doesn't work and is totally ill-conceived anyway. */
1071         xxDEFVAR_LISP("mouse-leave-buffer-hook", &Vmouse_leave_buffer_hook      /*
1072 Hook to run when about to switch windows with a mouse command.
1073 Its purpose is to give temporary modes such as Isearch mode
1074 a way to turn themselves off when a mouse command switches windows.
1075                                                                                  */ );
1076         Vmouse_leave_buffer_hook = Qnil;
1077 #endif
1078 }