src/callint.c

   1 /* Call a Lisp function interactively.
   2    Copyright (C) 1985-1986, 1993-1995, 1997, 2000-2018 Free Software
   3    Foundation, Inc.
   4
   5 This file is part of GNU Emacs.
   6
   7 GNU Emacs 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 (at
  10 your option) any later version.
  11
  12 GNU Emacs 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 GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
  19
  20
  21 #include <config.h>
  22
  23 #include "lisp.h"
  24 #include "ptr-bounds.h"
  25 #include "character.h"
  26 #include "buffer.h"
  27 #include "keyboard.h"
  28 #include "window.h"
  29
  30 static Lisp_Object preserved_fns;
  31
  32 /* Marker used within call-interactively to refer to point.  */
  33 static Lisp_Object point_marker;
  34
  35 /* String for the prompt text used in Fcall_interactively.  */
  36 static Lisp_Object callint_message;
  37 \f
  38 /* ARGSUSED */
  39 DEFUN ("interactive", Finteractive, Sinteractive, 0, UNEVALLED, 0,
  40        doc: /* Specify a way of parsing arguments for interactive use of a function.
  41 For example, write
  42  (defun foo (arg buf) "Doc string" (interactive "P\\nbbuffer: ") .... )
  43  to make ARG be the raw prefix argument, and set BUF to an existing buffer,
  44  when `foo' is called as a command.
  45
  46 The "call" to `interactive' is actually a declaration rather than a
  47  function; it tells `call-interactively' how to read arguments to pass
  48  to the function.  When actually called, `interactive' just returns
  49  nil.
  50
  51 Usually the argument of `interactive' is a string containing a code
  52  letter followed optionally by a prompt.  (Some code letters do not
  53  use I/O to get the argument and do not use prompts.)  To pass several
  54  arguments to the command, concatenate the individual strings,
  55  separating them by newline characters.
  56
  57 Prompts are passed to `format', and may use % escapes to print the
  58  arguments that have already been read.
  59 If the argument is not a string, it is evaluated to get a list of
  60  arguments to pass to the command.
  61 Just `(interactive)' means pass no arguments to the command when
  62  calling interactively.
  63
  64 Code letters available are:
  65 a -- Function name: symbol with a function definition.
  66 b -- Name of existing buffer.
  67 B -- Name of buffer, possibly nonexistent.
  68 c -- Character (no input method is used).
  69 C -- Command name: symbol with interactive function definition.
  70 d -- Value of point as number.  Does not do I/O.
  71 D -- Directory name.
  72 e -- Parameterized event (i.e., one that's a list) that invoked this command.
  73      If used more than once, the Nth `e' returns the Nth parameterized event.
  74      This skips events that are integers or symbols.
  75 f -- Existing file name.
  76 F -- Possibly nonexistent file name.
  77 G -- Possibly nonexistent file name, defaulting to just directory name.
  78 i -- Ignored, i.e. always nil.  Does not do I/O.
  79 k -- Key sequence (downcase the last event if needed to get a definition).
  80 K -- Key sequence to be redefined (do not downcase the last event).
  81 m -- Value of mark as number.  Does not do I/O.
  82 M -- Any string.  Inherits the current input method.
  83 n -- Number read using minibuffer.
  84 N -- Numeric prefix arg, or if none, do like code `n'.
  85 p -- Prefix arg converted to number.  Does not do I/O.
  86 P -- Prefix arg in raw form.  Does not do I/O.
  87 r -- Region: point and mark as 2 numeric args, smallest first.  Does no I/O.
  88 s -- Any string.  Does not inherit the current input method.
  89 S -- Any symbol.
  90 U -- Mouse up event discarded by a previous k or K argument.
  91 v -- Variable name: symbol that is `custom-variable-p'.
  92 x -- Lisp expression read but not evaluated.
  93 X -- Lisp expression read and evaluated.
  94 z -- Coding system.
  95 Z -- Coding system, nil if no prefix arg.
  96
  97 In addition, if the string begins with `*', an error is signaled if
  98   the buffer is read-only.
  99 If `@' appears at the beginning of the string, and if the key sequence
 100  used to invoke the command includes any mouse events, then the window
 101  associated with the first of those events is selected before the
 102  command is run.
 103 If the string begins with `^' and `shift-select-mode' is non-nil,
 104  Emacs first calls the function `handle-shift-selection'.
 105 You may use `@', `*', and `^' together.  They are processed in the
 106  order that they appear, before reading any arguments.
 107 usage: (interactive &optional ARG-DESCRIPTOR)  */
 108        attributes: const)
 109   (Lisp_Object args)
 110 {
 111   return Qnil;
 112 }
 113
 114 /* Quotify EXP: if EXP is constant, return it.
 115    If EXP is not constant, return (quote EXP).  */
 116 static Lisp_Object
 117 quotify_arg (register Lisp_Object exp)
 118 {
 119   if (CONSP (exp)
 120       || (SYMBOLP (exp)
 121           && !NILP (exp) && !EQ (exp, Qt)))
 122     return list2 (Qquote, exp);
 123
 124   return exp;
 125 }
 126
 127 /* Modify EXP by quotifying each element (except the first).  */
 128 static Lisp_Object
 129 quotify_args (Lisp_Object exp)
 130 {
 131   register Lisp_Object tail;
 132   Lisp_Object next;
 133   for (tail = exp; CONSP (tail); tail = next)
 134     {
 135       next = XCDR (tail);
 136       XSETCAR (tail, quotify_arg (XCAR (tail)));
 137     }
 138   return exp;
 139 }
 140
 141 static const char *callint_argfuns[]
 142     = {"", "point", "mark", "region-beginning", "region-end"};
 143
 144 static void
 145 check_mark (bool for_region)
 146 {
 147   Lisp_Object tem;
 148   tem = Fmarker_buffer (BVAR (current_buffer, mark));
 149   if (NILP (tem) || (XBUFFER (tem) != current_buffer))
 150     error (for_region ? "The mark is not set now, so there is no region"
 151            : "The mark is not set now");
 152   if (!NILP (Vtransient_mark_mode) && NILP (Vmark_even_if_inactive)
 153       && NILP (BVAR (current_buffer, mark_active)))
 154     xsignal0 (Qmark_inactive);
 155 }
 156
 157 /* If the list of args INPUT was produced with an explicit call to
 158    `list', look for elements that were computed with
 159    (region-beginning) or (region-end), and put those expressions into
 160    VALUES instead of the present values.
 161
 162    This function doesn't return a value because it modifies elements
 163    of VALUES to do its job.  */
 164
 165 static void
 166 fix_command (Lisp_Object input, Lisp_Object values)
 167 {
 168   /* FIXME: Instead of this ugly hack, we should provide a way for an
 169      interactive spec to return an expression/function that will re-build the
 170      args without user intervention.  */
 171   if (CONSP (input))
 172     {
 173       Lisp_Object car;
 174
 175       car = XCAR (input);
 176       /* Skip through certain special forms.  */
 177       while (EQ (car, Qlet) || EQ (car, Qletx)
 178              || EQ (car, Qsave_excursion)
 179              || EQ (car, Qprogn))
 180         {
 181           while (CONSP (XCDR (input)))
 182             input = XCDR (input);
 183           input = XCAR (input);
 184           if (!CONSP (input))
 185             break;
 186           car = XCAR (input);
 187         }
 188       if (EQ (car, Qlist))
 189         {
 190           Lisp_Object intail, valtail;
 191           for (intail = Fcdr (input), valtail = values;
 192                CONSP (valtail);
 193                intail = Fcdr (intail), valtail = XCDR (valtail))
 194             {
 195               Lisp_Object elt;
 196               elt = Fcar (intail);
 197               if (CONSP (elt))
 198                 {
 199                   Lisp_Object presflag, carelt;
 200                   carelt = XCAR (elt);
 201                   /* If it is (if X Y), look at Y.  */
 202                   if (EQ (carelt, Qif)
 203                       && EQ (Fnthcdr (make_number (3), elt), Qnil))
 204                     elt = Fnth (make_number (2), elt);
 205                   /* If it is (when ... Y), look at Y.  */
 206                   else if (EQ (carelt, Qwhen))
 207                     {
 208                       while (CONSP (XCDR (elt)))
 209                         elt = XCDR (elt);
 210                       elt = Fcar (elt);
 211                     }
 212
 213                   /* If the function call we're looking at
 214                      is a special preserved one, copy the
 215                      whole expression for this argument.  */
 216                   if (CONSP (elt))
 217                     {
 218                       presflag = Fmemq (Fcar (elt), preserved_fns);
 219                       if (!NILP (presflag))
 220                         Fsetcar (valtail, Fcar (intail));
 221                     }
 222                 }
 223             }
 224         }
 225     }
 226 }
 227
 228 /* Helper function to call `read-file-name' from C.  */
 229
 230 static Lisp_Object
 231 read_file_name (Lisp_Object default_filename, Lisp_Object mustmatch,
 232                 Lisp_Object initial, Lisp_Object predicate)
 233 {
 234   return CALLN (Ffuncall, intern ("read-file-name"),
 235                 callint_message, Qnil, default_filename,
 236                 mustmatch, initial, predicate);
 237 }
 238
 239 /* BEWARE: Calling this directly from C would defeat the purpose!  */
 240 DEFUN ("funcall-interactively", Ffuncall_interactively, Sfuncall_interactively,
 241        1, MANY, 0, doc: /* Like `funcall' but marks the call as interactive.
 242 I.e. arrange that within the called function `called-interactively-p' will
 243 return non-nil.
 244 usage: (funcall-interactively FUNCTION &rest ARGUMENTS)  */)
 245      (ptrdiff_t nargs, Lisp_Object *args)
 246 {
 247   ptrdiff_t speccount = SPECPDL_INDEX ();
 248   temporarily_switch_to_single_kboard (NULL);
 249
 250   /* Nothing special to do here, all the work is inside
 251      `called-interactively-p'.  Which will look for us as a marker in the
 252      backtrace.  */
 253   return unbind_to (speccount, Ffuncall (nargs, args));
 254 }
 255
 256 DEFUN ("call-interactively", Fcall_interactively, Scall_interactively, 1, 3, 0,
 257        doc: /* Call FUNCTION, providing args according to its interactive calling specs.
 258 Return the value FUNCTION returns.
 259 The function contains a specification of how to do the argument reading.
 260 In the case of user-defined functions, this is specified by placing a call
 261 to the function `interactive' at the top level of the function body.
 262 See `interactive'.
 263
 264 Optional second arg RECORD-FLAG non-nil
 265 means unconditionally put this command in the command-history.
 266 Otherwise, this is done only if an arg is read using the minibuffer.
 267
 268 Optional third arg KEYS, if given, specifies the sequence of events to
 269 supply, as a vector, if the command inquires which events were used to
 270 invoke it.  If KEYS is omitted or nil, the return value of
 271 `this-command-keys-vector' is used.  */)
 272   (Lisp_Object function, Lisp_Object record_flag, Lisp_Object keys)
 273 {
 274   /* `args' will contain the array of arguments to pass to the function.
 275      `visargs' will contain the same list but in a nicer form, so that if we
 276      pass it to Fformat_message it will be understandable to a human.  */
 277   Lisp_Object *args, *visargs;
 278   Lisp_Object specs;
 279   Lisp_Object filter_specs;
 280   Lisp_Object teml;
 281   Lisp_Object up_event;
 282   Lisp_Object enable;
 283   USE_SAFE_ALLOCA;
 284   ptrdiff_t speccount = SPECPDL_INDEX ();
 285
 286   /* The index of the next element of this_command_keys to examine for
 287      the 'e' interactive code.  */
 288   ptrdiff_t next_event;
 289
 290   Lisp_Object prefix_arg;
 291   char *string, *string_end;
 292   ptrdiff_t string_len;
 293   const char *tem;
 294
 295   /* If varies[i] > 0, the i'th argument shouldn't just have its value
 296      in this call quoted in the command history.  It should be
 297      recorded as a call to the function named callint_argfuns[varies[i]].  */
 298   signed char *varies;
 299
 300   ptrdiff_t i, nargs;
 301   ptrdiff_t mark;
 302   bool arg_from_tty = 0;
 303   ptrdiff_t key_count;
 304   bool record_then_fail = 0;
 305
 306   Lisp_Object save_this_command, save_last_command;
 307   Lisp_Object save_this_original_command, save_real_this_command;
 308
 309   save_this_command = Vthis_command;
 310   save_this_original_command = Vthis_original_command;
 311   save_real_this_command = Vreal_this_command;
 312   save_last_command = KVAR (current_kboard, Vlast_command);
 313
 314   if (NILP (keys))
 315     keys = this_command_keys, key_count = this_command_key_count;
 316   else
 317     {
 318       CHECK_VECTOR (keys);
 319       key_count = ASIZE (keys);
 320     }
 321
 322   /* Save this now, since use of minibuffer will clobber it.  */
 323   prefix_arg = Vcurrent_prefix_arg;
 324
 325   if (SYMBOLP (function))
 326     enable = Fget (function, Qenable_recursive_minibuffers);
 327   else
 328     enable = Qnil;
 329
 330   specs = Qnil;
 331   string = 0;
 332   /* The idea of FILTER_SPECS is to provide a way to
 333      specify how to represent the arguments in command history.
 334      The feature is not fully implemented.  */
 335   filter_specs = Qnil;
 336
 337   /* If k or K discard an up-event, save it here so it can be retrieved with
 338      U.  */
 339   up_event = Qnil;
 340
 341   /* Set SPECS to the interactive form, or barf if not interactive.  */
 342   {
 343     Lisp_Object form;
 344     form = Finteractive_form (function);
 345     if (CONSP (form))
 346       specs = filter_specs = Fcar (XCDR (form));
 347     else
 348       wrong_type_argument (Qcommandp, function);
 349   }
 350
 351   /* If SPECS is not a string, invent one.  */
 352   if (! STRINGP (specs))
 353     {
 354       Lisp_Object input;
 355       Lisp_Object funval = Findirect_function (function, Qt);
 356       uintmax_t events = num_input_events;
 357       input = specs;
 358       /* Compute the arg values using the user's expression.  */
 359       specs = Feval (specs,
 360                      CONSP (funval) && EQ (Qclosure, XCAR (funval))
 361                      ? CAR_SAFE (XCDR (funval)) : Qnil);
 362       if (events != num_input_events || !NILP (record_flag))
 363         {
 364           /* We should record this command on the command history.  */
 365           Lisp_Object values;
 366           Lisp_Object this_cmd;
 367           /* Make a copy of the list of values, for the command history,
 368              and turn them into things we can eval.  */
 369           values = quotify_args (Fcopy_sequence (specs));
 370           fix_command (input, values);
 371           this_cmd = Fcons (function, values);
 372           if (history_delete_duplicates)
 373             Vcommand_history = Fdelete (this_cmd, Vcommand_history);
 374           Vcommand_history = Fcons (this_cmd, Vcommand_history);
 375
 376           /* Don't keep command history around forever.  */
 377           if (INTEGERP (Vhistory_length) && XINT (Vhistory_length) > 0)
 378             {
 379               teml = Fnthcdr (Vhistory_length, Vcommand_history);
 380               if (CONSP (teml))
 381                 XSETCDR (teml, Qnil);
 382             }
 383         }
 384
 385       Vthis_command = save_this_command;
 386       Vthis_original_command = save_this_original_command;
 387       Vreal_this_command = save_real_this_command;
 388       kset_last_command (current_kboard, save_last_command);
 389
 390       Lisp_Object result
 391         = unbind_to (speccount, CALLN (Fapply, Qfuncall_interactively,
 392                                        function, specs));
 393       SAFE_FREE ();
 394       return result;
 395     }
 396
 397   /* SPECS is set to a string; use it as an interactive prompt.
 398      Copy it so that STRING will be valid even if a GC relocates SPECS.  */
 399   SAFE_ALLOCA_STRING (string, specs);
 400   string_len = SBYTES (specs);
 401   string_end = string + string_len;
 402
 403   /* Here if function specifies a string to control parsing the defaults.  */
 404
 405   /* Set next_event to point to the first event with parameters.  */
 406   for (next_event = 0; next_event < key_count; next_event++)
 407     if (EVENT_HAS_PARAMETERS (AREF (keys, next_event)))
 408       break;
 409
 410   /* Handle special starting chars `*' and `@'.  Also `-'.  */
 411   /* Note that `+' is reserved for user extensions.  */
 412   while (1)
 413     {
 414       if (*string == '+')
 415         error ("`+' is not used in `interactive' for ordinary commands");
 416       else if (*string == '*')
 417         {
 418           string++;
 419           if (!NILP (BVAR (current_buffer, read_only)))
 420             {
 421               if (!NILP (record_flag))
 422                 {
 423                   char *p = string;
 424                   while (p < string_end)
 425                     {
 426                       if (! (*p == 'r' || *p == 'p' || *p == 'P'
 427                              || *p == '\n'))
 428                         Fbarf_if_buffer_read_only (Qnil);
 429                       p++;
 430                     }
 431                   record_then_fail = 1;
 432                 }
 433               else
 434                 Fbarf_if_buffer_read_only (Qnil);
 435             }
 436         }
 437       /* Ignore this for semi-compatibility with Lucid.  */
 438       else if (*string == '-')
 439         string++;
 440       else if (*string == '@')
 441         {
 442           Lisp_Object event, w;
 443
 444           event = (next_event < key_count
 445                    ? AREF (keys, next_event)
 446                    : Qnil);
 447           if (EVENT_HAS_PARAMETERS (event)
 448               && (w = XCDR (event), CONSP (w))
 449               && (w = XCAR (w), CONSP (w))
 450               && (w = XCAR (w), WINDOWP (w)))
 451             {
 452               if (MINI_WINDOW_P (XWINDOW (w))
 453                   && ! (minibuf_level > 0 && EQ (w, minibuf_window)))
 454                 error ("Attempt to select inactive minibuffer window");
 455
 456               /* If the current buffer wants to clean up, let it.  */
 457               run_hook (Qmouse_leave_buffer_hook);
 458
 459               Fselect_window (w, Qnil);
 460             }
 461           string++;
 462         }
 463       else if (*string == '^')
 464         {
 465           call0 (Qhandle_shift_selection);
 466           string++;
 467         }
 468       else break;
 469     }
 470
 471   /* Count the number of arguments, which is two (the function itself and
 472      `funcall-interactively') plus the number of arguments the interactive spec
 473      would have us give to the function.  */
 474   tem = string;
 475   for (nargs = 2; tem < string_end; )
 476     {
 477       /* 'r' specifications ("point and mark as 2 numeric args")
 478          produce *two* arguments.  */
 479       if (*tem == 'r')
 480         nargs += 2;
 481       else
 482         nargs++;
 483       tem = memchr (tem, '\n', string_len - (tem - string));
 484       if (tem)
 485         ++tem;
 486       else
 487         break;
 488     }
 489
 490   if (MOST_POSITIVE_FIXNUM < min (PTRDIFF_MAX, SIZE_MAX) / word_size
 491       && MOST_POSITIVE_FIXNUM < nargs)
 492     memory_full (SIZE_MAX);
 493
 494   /* Allocate them all at one go.  This wastes a bit of memory, but
 495      it's OK to trade space for speed.  */
 496   SAFE_NALLOCA (args, 3, nargs);
 497   visargs = args + nargs;
 498   varies = (signed char *) (visargs + nargs);
 499
 500   memclear (args, nargs * (2 * word_size + 1));
 501   args = ptr_bounds_clip (args, nargs * sizeof *args);
 502   visargs = ptr_bounds_clip (visargs, nargs * sizeof *visargs);
 503   varies = ptr_bounds_clip (varies, nargs * sizeof *varies);
 504
 505   if (!NILP (enable))
 506     specbind (Qenable_recursive_minibuffers, Qt);
 507
 508   tem = string;
 509   for (i = 2; tem < string_end; i++)
 510     {
 511       char *pnl = memchr (tem + 1, '\n', string_len - (tem + 1 - string));
 512       ptrdiff_t sz = pnl ? pnl - (tem + 1) : string_end - (tem + 1);
 513
 514       visargs[1] = make_string (tem + 1, sz);
 515       callint_message = Fformat_message (i - 1, visargs + 1);
 516
 517       switch (*tem)
 518         {
 519         case 'a':               /* Symbol defined as a function.  */
 520           visargs[i] = Fcompleting_read (callint_message,
 521                                          Vobarray, Qfboundp, Qt,
 522                                          Qnil, Qnil, Qnil, Qnil);
 523           /* Passing args[i] directly stimulates compiler bug.  */
 524           teml = visargs[i];
 525           args[i] = Fintern (teml, Qnil);
 526           break;
 527
 528         case 'b':               /* Name of existing buffer.  */
 529           args[i] = Fcurrent_buffer ();
 530           if (EQ (selected_window, minibuf_window))
 531             args[i] = Fother_buffer (args[i], Qnil, Qnil);
 532           args[i] = Fread_buffer (callint_message, args[i], Qt, Qnil);
 533           break;
 534
 535         case 'B':               /* Name of buffer, possibly nonexistent.  */
 536           args[i] = Fread_buffer (callint_message,
 537                                   Fother_buffer (Fcurrent_buffer (), Qnil, Qnil),
 538                                   Qnil, Qnil);
 539           break;
 540
 541         case 'c':               /* Character.  */
 542           /* Prompt in `minibuffer-prompt' face.  */
 543           Fput_text_property (make_number (0),
 544                               make_number (SCHARS (callint_message)),
 545                               Qface, Qminibuffer_prompt, callint_message);
 546           args[i] = Fread_char (callint_message, Qnil, Qnil);
 547           message1_nolog (0);
 548           /* Passing args[i] directly stimulates compiler bug.  */
 549           teml = args[i];
 550           /* See bug#8479.  */
 551           if (! CHARACTERP (teml)) error ("Non-character input-event");
 552           visargs[i] = Fchar_to_string (teml);
 553           break;
 554
 555         case 'C':             /* Command: symbol with interactive function.  */
 556           visargs[i] = Fcompleting_read (callint_message,
 557                                          Vobarray, Qcommandp,
 558                                          Qt, Qnil, Qnil, Qnil, Qnil);
 559           /* Passing args[i] directly stimulates compiler bug.  */
 560           teml = visargs[i];
 561           args[i] = Fintern (teml, Qnil);
 562           break;
 563
 564         case 'd':               /* Value of point.  Does not do I/O.  */
 565           set_marker_both (point_marker, Qnil, PT, PT_BYTE);
 566           args[i] = point_marker;
 567           /* visargs[i] = Qnil; */
 568           varies[i] = 1;
 569           break;
 570
 571         case 'D':               /* Directory name.  */
 572           args[i] = read_file_name (BVAR (current_buffer, directory), Qlambda, Qnil,
 573                                     Qfile_directory_p);
 574           break;
 575
 576         case 'f':               /* Existing file name.  */
 577           args[i] = read_file_name (Qnil, Qlambda, Qnil, Qnil);
 578           break;
 579
 580         case 'F':               /* Possibly nonexistent file name.  */
 581           args[i] = read_file_name (Qnil, Qnil, Qnil, Qnil);
 582           break;
 583
 584         case 'G':               /* Possibly nonexistent file name,
 585                                    default to directory alone.  */
 586           args[i] = read_file_name (Qnil, Qnil, empty_unibyte_string, Qnil);
 587           break;
 588
 589         case 'i':               /* Ignore an argument -- Does not do I/O.  */
 590           varies[i] = -1;
 591           break;
 592
 593         case 'k':               /* Key sequence.  */
 594           {
 595             ptrdiff_t speccount1 = SPECPDL_INDEX ();
 596             specbind (Qcursor_in_echo_area, Qt);
 597             /* Prompt in `minibuffer-prompt' face.  */
 598             Fput_text_property (make_number (0),
 599                                 make_number (SCHARS (callint_message)),
 600                                 Qface, Qminibuffer_prompt, callint_message);
 601             args[i] = Fread_key_sequence (callint_message,
 602                                           Qnil, Qnil, Qnil, Qnil);
 603             unbind_to (speccount1, Qnil);
 604             teml = args[i];
 605             visargs[i] = Fkey_description (teml, Qnil);
 606
 607             /* If the key sequence ends with a down-event,
 608                discard the following up-event.  */
 609             teml = Faref (args[i], make_number (XINT (Flength (args[i])) - 1));
 610             if (CONSP (teml))
 611               teml = XCAR (teml);
 612             if (SYMBOLP (teml))
 613               {
 614                 Lisp_Object tem2;
 615
 616                 teml = Fget (teml, Qevent_symbol_elements);
 617                 /* Ignore first element, which is the base key.  */
 618                 tem2 = Fmemq (Qdown, Fcdr (teml));
 619                 if (! NILP (tem2))
 620                   up_event = Fread_event (Qnil, Qnil, Qnil);
 621               }
 622           }
 623           break;
 624
 625         case 'K':               /* Key sequence to be defined.  */
 626           {
 627             ptrdiff_t speccount1 = SPECPDL_INDEX ();
 628             specbind (Qcursor_in_echo_area, Qt);
 629             /* Prompt in `minibuffer-prompt' face.  */
 630             Fput_text_property (make_number (0),
 631                                 make_number (SCHARS (callint_message)),
 632                                 Qface, Qminibuffer_prompt, callint_message);
 633             args[i] = Fread_key_sequence_vector (callint_message,
 634                                                  Qnil, Qt, Qnil, Qnil);
 635             teml = args[i];
 636             visargs[i] = Fkey_description (teml, Qnil);
 637             unbind_to (speccount1, Qnil);
 638
 639             /* If the key sequence ends with a down-event,
 640                discard the following up-event.  */
 641             teml = Faref (args[i], make_number (XINT (Flength (args[i])) - 1));
 642             if (CONSP (teml))
 643               teml = XCAR (teml);
 644             if (SYMBOLP (teml))
 645               {
 646                 Lisp_Object tem2;
 647
 648                 teml = Fget (teml, Qevent_symbol_elements);
 649                 /* Ignore first element, which is the base key.  */
 650                 tem2 = Fmemq (Qdown, Fcdr (teml));
 651                 if (! NILP (tem2))
 652                   up_event = Fread_event (Qnil, Qnil, Qnil);
 653               }
 654           }
 655           break;
 656
 657         case 'U':               /* Up event from last k or K.  */
 658           if (!NILP (up_event))
 659             {
 660               args[i] = Fmake_vector (make_number (1), up_event);
 661               up_event = Qnil;
 662               teml = args[i];
 663               visargs[i] = Fkey_description (teml, Qnil);
 664             }
 665           break;
 666
 667         case 'e':               /* The invoking event.  */
 668           if (next_event >= key_count)
 669             error ("%s must be bound to an event with parameters",
 670                    (SYMBOLP (function)
 671                     ? SSDATA (SYMBOL_NAME (function))
 672                     : "command"));
 673           args[i] = AREF (keys, next_event);
 674           next_event++;
 675           varies[i] = -1;
 676
 677           /* Find the next parameterized event.  */
 678           while (next_event < key_count
 679                  && !(EVENT_HAS_PARAMETERS (AREF (keys, next_event))))
 680             next_event++;
 681
 682           break;
 683
 684         case 'm':               /* Value of mark.  Does not do I/O.  */
 685           check_mark (0);
 686           /* visargs[i] = Qnil; */
 687           args[i] = BVAR (current_buffer, mark);
 688           varies[i] = 2;
 689           break;
 690
 691         case 'M':               /* String read via minibuffer with
 692                                    inheriting the current input method.  */
 693           args[i] = Fread_string (callint_message,
 694                                   Qnil, Qnil, Qnil, Qt);
 695           break;
 696
 697         case 'N':     /* Prefix arg as number, else number from minibuffer.  */
 698           if (!NILP (prefix_arg))
 699             goto have_prefix_arg;
 700           FALLTHROUGH;
 701         case 'n':               /* Read number from minibuffer.  */
 702           args[i] = call1 (Qread_number, callint_message);
 703           /* Passing args[i] directly stimulates compiler bug.  */
 704           teml = args[i];
 705           visargs[i] = Fnumber_to_string (teml);
 706           break;
 707
 708         case 'P':               /* Prefix arg in raw form.  Does no I/O.  */
 709           args[i] = prefix_arg;
 710           /* visargs[i] = Qnil; */
 711           varies[i] = -1;
 712           break;
 713
 714         case 'p':               /* Prefix arg converted to number.  No I/O.  */
 715         have_prefix_arg:
 716           args[i] = Fprefix_numeric_value (prefix_arg);
 717           /* visargs[i] = Qnil; */
 718           varies[i] = -1;
 719           break;
 720
 721         case 'r':               /* Region, point and mark as 2 args.  */
 722           check_mark (1);
 723           set_marker_both (point_marker, Qnil, PT, PT_BYTE);
 724           /* visargs[i+1] = Qnil; */
 725           mark = marker_position (BVAR (current_buffer, mark));
 726           /* visargs[i] = Qnil; */
 727           args[i] = PT < mark ? point_marker : BVAR (current_buffer, mark);
 728           varies[i] = 3;
 729           args[++i] = PT > mark ? point_marker : BVAR (current_buffer, mark);
 730           varies[i] = 4;
 731           break;
 732
 733         case 's':               /* String read via minibuffer without
 734                                    inheriting the current input method.  */
 735           args[i] = Fread_string (callint_message,
 736                                   Qnil, Qnil, Qnil, Qnil);
 737           break;
 738
 739         case 'S':               /* Any symbol.  */
 740           visargs[i] = Fread_string (callint_message,
 741                                      Qnil, Qnil, Qnil, Qnil);
 742           /* Passing args[i] directly stimulates compiler bug.  */
 743           teml = visargs[i];
 744           args[i] = Fintern (teml, Qnil);
 745           break;
 746
 747         case 'v':               /* Variable name: symbol that is
 748                                    custom-variable-p.  */
 749           args[i] = Fread_variable (callint_message, Qnil);
 750           visargs[i] = last_minibuf_string;
 751           break;
 752
 753         case 'x':               /* Lisp expression read but not evaluated.  */
 754           args[i] = call1 (intern ("read-minibuffer"), callint_message);
 755           visargs[i] = last_minibuf_string;
 756           break;
 757
 758         case 'X':               /* Lisp expression read and evaluated.  */
 759           args[i] = call1 (intern ("eval-minibuffer"), callint_message);
 760           visargs[i] = last_minibuf_string;
 761           break;
 762
 763         case 'Z':               /* Coding-system symbol, or ignore the
 764                                    argument if no prefix.  */
 765           if (NILP (prefix_arg))
 766             {
 767               /* args[i] = Qnil; */
 768               varies[i] = -1;
 769             }
 770           else
 771             {
 772               args[i]
 773                 = Fread_non_nil_coding_system (callint_message);
 774               visargs[i] = last_minibuf_string;
 775             }
 776           break;
 777
 778         case 'z':               /* Coding-system symbol or nil.  */
 779           args[i] = Fread_coding_system (callint_message, Qnil);
 780           visargs[i] = last_minibuf_string;
 781           break;
 782
 783           /* We have a case for `+' so we get an error
 784              if anyone tries to define one here.  */
 785         case '+':
 786         default:
 787           {
 788             /* How many bytes are left unprocessed in the specs string?
 789                (Note that this excludes the trailing null byte.)  */
 790             ptrdiff_t bytes_left = string_len - (tem - string);
 791             unsigned letter;
 792
 793             /* If we have enough bytes left to treat the sequence as a
 794                character, show that character's codepoint; otherwise
 795                show only its first byte.  */
 796             if (bytes_left >= BYTES_BY_CHAR_HEAD (*((unsigned char *) tem)))
 797               letter = STRING_CHAR ((unsigned char *) tem);
 798             else
 799               letter = *((unsigned char *) tem);
 800
 801             error ("Invalid control letter `%c' (#o%03o, #x%04x) in interactive calling string",
 802                    (int) letter, letter, letter);
 803           }
 804         }
 805
 806       if (varies[i] == 0)
 807         arg_from_tty = 1;
 808
 809       if (NILP (visargs[i]) && STRINGP (args[i]))
 810         visargs[i] = args[i];
 811
 812       tem = memchr (tem, '\n', string_len - (tem - string));
 813       if (tem) tem++;
 814       else tem = string_end;
 815     }
 816   unbind_to (speccount, Qnil);
 817
 818   maybe_quit ();
 819
 820   args[0] = Qfuncall_interactively;
 821   args[1] = function;
 822
 823   if (arg_from_tty || !NILP (record_flag))
 824     {
 825       /* We don't need `visargs' any more, so let's recycle it since we need
 826          an array of just the same size.  */
 827       visargs[1] = function;
 828       for (i = 2; i < nargs; i++)
 829         {
 830           if (varies[i] > 0)
 831             visargs[i] = list1 (intern (callint_argfuns[varies[i]]));
 832           else
 833             visargs[i] = quotify_arg (args[i]);
 834         }
 835       Vcommand_history = Fcons (Flist (nargs - 1, visargs + 1),
 836                                 Vcommand_history);
 837       /* Don't keep command history around forever.  */
 838       if (INTEGERP (Vhistory_length) && XINT (Vhistory_length) > 0)
 839         {
 840           teml = Fnthcdr (Vhistory_length, Vcommand_history);
 841           if (CONSP (teml))
 842             XSETCDR (teml, Qnil);
 843         }
 844     }
 845
 846   /* If we used a marker to hold point, mark, or an end of the region,
 847      temporarily, convert it to an integer now.  */
 848   for (i = 2; i < nargs; i++)
 849     if (varies[i] >= 1 && varies[i] <= 4)
 850       XSETINT (args[i], marker_position (args[i]));
 851
 852   if (record_then_fail)
 853     Fbarf_if_buffer_read_only (Qnil);
 854
 855   Vthis_command = save_this_command;
 856   Vthis_original_command = save_this_original_command;
 857   Vreal_this_command = save_real_this_command;
 858   kset_last_command (current_kboard, save_last_command);
 859
 860   {
 861     Lisp_Object val;
 862     specbind (Qcommand_debug_status, Qnil);
 863
 864     val = Ffuncall (nargs, args);
 865     val = unbind_to (speccount, val);
 866     SAFE_FREE ();
 867     return val;
 868   }
 869 }
 870
 871 DEFUN ("prefix-numeric-value", Fprefix_numeric_value, Sprefix_numeric_value,
 872        1, 1, 0,
 873        doc: /* Return numeric meaning of raw prefix argument RAW.
 874 A raw prefix argument is what you get from `(interactive "P")'.
 875 Its numeric meaning is what you would get from `(interactive "p")'.  */)
 876   (Lisp_Object raw)
 877 {
 878   Lisp_Object val;
 879
 880   if (NILP (raw))
 881     XSETFASTINT (val, 1);
 882   else if (EQ (raw, Qminus))
 883     XSETINT (val, -1);
 884   else if (CONSP (raw) && INTEGERP (XCAR (raw)))
 885     XSETINT (val, XINT (XCAR (raw)));
 886   else if (INTEGERP (raw))
 887     val = raw;
 888   else
 889     XSETFASTINT (val, 1);
 890
 891   return val;
 892 }
 893
 894 void
 895 syms_of_callint (void)
 896 {
 897   point_marker = Fmake_marker ();
 898   staticpro (&point_marker);
 899
 900   callint_message = Qnil;
 901   staticpro (&callint_message);
 902
 903   preserved_fns = listn (CONSTYPE_PURE, 4,
 904                          intern_c_string ("region-beginning"),
 905                          intern_c_string ("region-end"),
 906                          intern_c_string ("point"),
 907                          intern_c_string ("mark"));
 908
 909   DEFSYM (Qlist, "list");
 910   DEFSYM (Qlet, "let");
 911   DEFSYM (Qif, "if");
 912   DEFSYM (Qwhen, "when");
 913   DEFSYM (Qletx, "let*");
 914   DEFSYM (Qsave_excursion, "save-excursion");
 915   DEFSYM (Qprogn, "progn");
 916   DEFSYM (Qminus, "-");
 917   DEFSYM (Qplus, "+");
 918   DEFSYM (Qhandle_shift_selection, "handle-shift-selection");
 919   DEFSYM (Qread_number, "read-number");
 920   DEFSYM (Qfuncall_interactively, "funcall-interactively");
 921   DEFSYM (Qcommand_debug_status, "command-debug-status");
 922   DEFSYM (Qenable_recursive_minibuffers, "enable-recursive-minibuffers");
 923   DEFSYM (Qmouse_leave_buffer_hook, "mouse-leave-buffer-hook");
 924
 925   DEFVAR_KBOARD ("prefix-arg", Vprefix_arg,
 926                  doc: /* The value of the prefix argument for the next editing command.
 927 It may be a number, or the symbol `-' for just a minus sign as arg,
 928 or a list whose car is a number for just one or more C-u's
 929 or nil if no argument has been specified.
 930
 931 You cannot examine this variable to find the argument for this command
 932 since it has been set to nil by the time you can look.
 933 Instead, you should use the variable `current-prefix-arg', although
 934 normally commands can get this prefix argument with (interactive "P").  */);
 935
 936   DEFVAR_KBOARD ("last-prefix-arg", Vlast_prefix_arg,
 937                  doc: /* The value of the prefix argument for the previous editing command.
 938 See `prefix-arg' for the meaning of the value.  */);
 939
 940   DEFVAR_LISP ("current-prefix-arg", Vcurrent_prefix_arg,
 941                doc: /* The value of the prefix argument for this editing command.
 942 It may be a number, or the symbol `-' for just a minus sign as arg,
 943 or a list whose car is a number for just one or more C-u's
 944 or nil if no argument has been specified.
 945 This is what `(interactive \"P\")' returns.  */);
 946   Vcurrent_prefix_arg = Qnil;
 947
 948   DEFVAR_LISP ("command-history", Vcommand_history,
 949                doc: /* List of recent commands that read arguments from terminal.
 950 Each command is represented as a form to evaluate.
 951
 952 Maximum length of the history list is determined by the value
 953 of `history-length', which see.  */);
 954   Vcommand_history = Qnil;
 955
 956   DEFVAR_LISP ("command-debug-status", Vcommand_debug_status,
 957                doc: /* Debugging status of current interactive command.
 958 Bound each time `call-interactively' is called;
 959 may be set by the debugger as a reminder for itself.  */);
 960   Vcommand_debug_status = Qnil;
 961
 962   DEFVAR_LISP ("mark-even-if-inactive", Vmark_even_if_inactive,
 963                doc: /* Non-nil means you can use the mark even when inactive.
 964 This option makes a difference in Transient Mark mode.
 965 When the option is non-nil, deactivation of the mark
 966 turns off region highlighting, but commands that use the mark
 967 behave as if the mark were still active.  */);
 968   Vmark_even_if_inactive = Qt;
 969
 970   DEFVAR_LISP ("mouse-leave-buffer-hook", Vmouse_leave_buffer_hook,
 971                doc: /* Hook to run when about to switch windows with a mouse command.
 972 Its purpose is to give temporary modes such as Isearch mode
 973 a way to turn themselves off when a mouse command switches windows.  */);
 974   Vmouse_leave_buffer_hook = Qnil;
 975
 976   defsubr (&Sinteractive);
 977   defsubr (&Scall_interactively);
 978   defsubr (&Sfuncall_interactively);
 979   defsubr (&Sprefix_numeric_value);
 980 }