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