callint.c 29.5 KB
Newer Older
Michael I. Bushnell's avatar
Michael I. Bushnell committed
1
/* Call a Lisp function interactively.
2
   Copyright (C) 1985-1986, 1993-1995, 1997, 2000-2012
Glenn Morris's avatar
Glenn Morris committed
3
                 Free Software Foundation, Inc.
Michael I. Bushnell's avatar
Michael I. Bushnell committed
4 5 6

This file is part of GNU Emacs.

7
GNU Emacs is free software: you can redistribute it and/or modify
Michael I. Bushnell's avatar
Michael I. Bushnell committed
8
it under the terms of the GNU General Public License as published by
9 10
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
Michael I. Bushnell's avatar
Michael I. Bushnell committed
11 12 13 14 15 16 17

GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
18
along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
Michael I. Bushnell's avatar
Michael I. Bushnell committed
19 20


21
#include <config.h>
22
#include <setjmp.h>
23

Michael I. Bushnell's avatar
Michael I. Bushnell committed
24
#include "lisp.h"
25
#include "character.h"
Michael I. Bushnell's avatar
Michael I. Bushnell committed
26 27
#include "buffer.h"
#include "commands.h"
Jim Blandy's avatar
Jim Blandy committed
28
#include "keyboard.h"
Michael I. Bushnell's avatar
Michael I. Bushnell committed
29
#include "window.h"
Stefan Monnier's avatar
Stefan Monnier committed
30
#include "keymap.h"
Michael I. Bushnell's avatar
Michael I. Bushnell committed
31

32
Lisp_Object Qminus, Qplus;
Michael I. Bushnell's avatar
Michael I. Bushnell committed
33
Lisp_Object Qcall_interactively;
34 35
static Lisp_Object Qcommand_debug_status;
static Lisp_Object Qenable_recursive_minibuffers;
Michael I. Bushnell's avatar
Michael I. Bushnell committed
36

37
static Lisp_Object Qhandle_shift_selection;
Chong Yidong's avatar
Chong Yidong committed
38

39
Lisp_Object Qmouse_leave_buffer_hook;
40

41 42
static Lisp_Object Qlist, Qlet, Qletx, Qsave_excursion, Qprogn, Qif;
Lisp_Object Qwhen;
43 44 45 46
static Lisp_Object preserved_fns;

/* Marker used within call-interactively to refer to point.  */
static Lisp_Object point_marker;
47

48 49
/* String for the prompt text used in Fcall_interactively.  */
static Lisp_Object callint_message;
Richard M. Stallman's avatar
Richard M. Stallman committed
50

Michael I. Bushnell's avatar
Michael I. Bushnell committed
51 52
/* ARGSUSED */
DEFUN ("interactive", Finteractive, Sinteractive, 0, UNEVALLED, 0,
53 54
       doc: /* Specify a way of parsing arguments for interactive use of a function.
For example, write
55 56 57
 (defun foo (arg buf) "Doc string" (interactive "P\\nbbuffer: ") .... )
 to make ARG be the raw prefix argument, and set BUF to an existing buffer,
 when `foo' is called as a command.
58 59 60 61 62
The "call" to `interactive' is actually a declaration rather than a function;
 it tells `call-interactively' how to read arguments
 to pass to the function.
When actually called, `interactive' just returns nil.

63 64 65 66 67
Usually the argument of `interactive' is a string containing a code letter
 followed optionally by a prompt.  (Some code letters do not use I/O to get
 the argument and do not use prompts.)  To get several arguments, concatenate
 the individual strings, separating them by newline characters.
Prompts are passed to format, and may use % escapes to print the
68 69 70 71 72 73 74 75 76 77 78 79 80
 arguments that have already been read.
If the argument is not a string, it is evaluated to get a list of
 arguments to pass to the function.
Just `(interactive)' means pass no args when calling interactively.

Code letters available are:
a -- Function name: symbol with a function definition.
b -- Name of existing buffer.
B -- Name of buffer, possibly nonexistent.
c -- Character (no input method is used).
C -- Command name: symbol with interactive function definition.
d -- Value of point as number.  Does not do I/O.
D -- Directory name.
Paul Eggert's avatar
Paul Eggert committed
81
e -- Parameterized event (i.e., one that's a list) that invoked this command.
82 83 84 85
     If used more than once, the Nth `e' returns the Nth parameterized event.
     This skips events that are integers or symbols.
f -- Existing file name.
F -- Possibly nonexistent file name.
86
G -- Possibly nonexistent file name, defaulting to just directory name.
87 88 89 90 91 92
i -- Ignored, i.e. always nil.  Does not do I/O.
k -- Key sequence (downcase the last event if needed to get a definition).
K -- Key sequence to be redefined (do not downcase the last event).
m -- Value of mark as number.  Does not do I/O.
M -- Any string.  Inherits the current input method.
n -- Number read using minibuffer.
Richard M. Stallman's avatar
Richard M. Stallman committed
93
N -- Numeric prefix arg, or if none, do like code `n'.
94 95 96 97 98
p -- Prefix arg converted to number.  Does not do I/O.
P -- Prefix arg in raw form.  Does not do I/O.
r -- Region: point and mark as 2 numeric args, smallest first.  Does no I/O.
s -- Any string.  Does not inherit the current input method.
S -- Any symbol.
99
U -- Mouse up event discarded by a previous k or K argument.
100
v -- Variable name: symbol that is `custom-variable-p'.
101 102 103 104
x -- Lisp expression read but not evaluated.
X -- Lisp expression read and evaluated.
z -- Coding system.
Z -- Coding system, nil if no prefix arg.
Chong Yidong's avatar
Chong Yidong committed
105 106 107

In addition, if the string begins with `*', an error is signaled if
  the buffer is read-only.
108 109 110 111
If `@' appears at the beginning of the string, and if the key sequence
 used to invoke the command includes any mouse events, then the window
 associated with the first of those events is selected before the
 command is run.
Chong Yidong's avatar
Chong Yidong committed
112
If the string begins with `^' and `shift-select-mode' is non-nil,
113
 Emacs first calls the function `handle-shift-selection'.
Chong Yidong's avatar
Chong Yidong committed
114 115
You may use `@', `*', and `^' together.  They are processed in the
 order that they appear, before reading any arguments.
Glenn Morris's avatar
Glenn Morris committed
116
usage: (interactive &optional ARGS)  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
117
  (Lisp_Object args)
Michael I. Bushnell's avatar
Michael I. Bushnell committed
118 119 120 121 122 123
{
  return Qnil;
}

/* Quotify EXP: if EXP is constant, return it.
   If EXP is not constant, return (quote EXP).  */
124
static Lisp_Object
125
quotify_arg (register Lisp_Object exp)
Michael I. Bushnell's avatar
Michael I. Bushnell committed
126
{
127 128 129
  if (CONSP (exp)
      || (SYMBOLP (exp)
	  && !NILP (exp) && !EQ (exp, Qt)))
Michael I. Bushnell's avatar
Michael I. Bushnell committed
130 131 132 133 134 135
    return Fcons (Qquote, Fcons (exp, Qnil));

  return exp;
}

/* Modify EXP by quotifying each element (except the first).  */
136
static Lisp_Object
137
quotify_args (Lisp_Object exp)
Michael I. Bushnell's avatar
Michael I. Bushnell committed
138 139
{
  register Lisp_Object tail;
140 141
  Lisp_Object next;
  for (tail = exp; CONSP (tail); tail = next)
Michael I. Bushnell's avatar
Michael I. Bushnell committed
142
    {
143
      next = XCDR (tail);
144
      XSETCAR (tail, quotify_arg (XCAR (tail)));
Michael I. Bushnell's avatar
Michael I. Bushnell committed
145 146 147 148
    }
  return exp;
}

149
static const char *callint_argfuns[]
Michael I. Bushnell's avatar
Michael I. Bushnell committed
150 151 152
    = {"", "point", "mark", "region-beginning", "region-end"};

static void
153
check_mark (int for_region)
Michael I. Bushnell's avatar
Michael I. Bushnell committed
154
{
155
  Lisp_Object tem;
Tom Tromey's avatar
Tom Tromey committed
156
  tem = Fmarker_buffer (BVAR (current_buffer, mark));
Jim Blandy's avatar
Jim Blandy committed
157
  if (NILP (tem) || (XBUFFER (tem) != current_buffer))
158 159
    error (for_region ? "The mark is not set now, so there is no region"
	   : "The mark is not set now");
160
  if (!NILP (Vtransient_mark_mode) && NILP (Vmark_even_if_inactive)
Tom Tromey's avatar
Tom Tromey committed
161
      && NILP (BVAR (current_buffer, mark_active)))
Kim F. Storm's avatar
Kim F. Storm committed
162
    xsignal0 (Qmark_inactive);
Michael I. Bushnell's avatar
Michael I. Bushnell committed
163 164
}

Richard M. Stallman's avatar
Richard M. Stallman committed
165 166 167 168 169 170 171 172
/* If the list of args INPUT was produced with an explicit call to
   `list', look for elements that were computed with
   (region-beginning) or (region-end), and put those expressions into
   VALUES instead of the present values.

   This function doesn't return a value because it modifies elements
   of VALUES to do its job.  */

173
static void
174
fix_command (Lisp_Object input, Lisp_Object values)
175
{
176
  /* FIXME: Instead of this ugly hack, we should provide a way for an
177 178
     interactive spec to return an expression/function that will re-build the
     args without user intervention.  */
179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200
  if (CONSP (input))
    {
      Lisp_Object car;

      car = XCAR (input);
      /* Skip through certain special forms.  */
      while (EQ (car, Qlet) || EQ (car, Qletx)
	     || EQ (car, Qsave_excursion)
	     || EQ (car, Qprogn))
	{
	  while (CONSP (XCDR (input)))
	    input = XCDR (input);
	  input = XCAR (input);
	  if (!CONSP (input))
	    break;
	  car = XCAR (input);
	}
      if (EQ (car, Qlist))
	{
	  Lisp_Object intail, valtail;
	  for (intail = Fcdr (input), valtail = values;
	       CONSP (valtail);
Stefan Monnier's avatar
Stefan Monnier committed
201
	       intail = Fcdr (intail), valtail = XCDR (valtail))
202 203 204 205 206 207
	    {
	      Lisp_Object elt;
	      elt = Fcar (intail);
	      if (CONSP (elt))
		{
		  Lisp_Object presflag, carelt;
208
		  carelt = XCAR (elt);
209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234
		  /* If it is (if X Y), look at Y.  */
		  if (EQ (carelt, Qif)
		      && EQ (Fnthcdr (make_number (3), elt), Qnil))
		    elt = Fnth (make_number (2), elt);
		  /* If it is (when ... Y), look at Y.  */
		  else if (EQ (carelt, Qwhen))
		    {
		      while (CONSP (XCDR (elt)))
			elt = XCDR (elt);
		      elt = Fcar (elt);
		    }

		  /* If the function call we're looking at
		     is a special preserved one, copy the
		     whole expression for this argument.  */
		  if (CONSP (elt))
		    {
		      presflag = Fmemq (Fcar (elt), preserved_fns);
		      if (!NILP (presflag))
			Fsetcar (valtail, Fcar (intail));
		    }
		}
	    }
	}
    }
}
Michael I. Bushnell's avatar
Michael I. Bushnell committed
235

236
DEFUN ("call-interactively", Fcall_interactively, Scall_interactively, 1, 3, 0,
237
       doc: /* Call FUNCTION, providing args according to its interactive calling specs.
238 239 240 241 242 243 244 245 246
Return the value FUNCTION returns.
The function contains a specification of how to do the argument reading.
In the case of user-defined functions, this is specified by placing a call
to the function `interactive' at the top level of the function body.
See `interactive'.

Optional second arg RECORD-FLAG non-nil
means unconditionally put this command in the command-history.
Otherwise, this is done only if an arg is read using the minibuffer.
247

248
Optional third arg KEYS, if given, specifies the sequence of events to
249 250 251
supply, as a vector, if the command inquires which events were used to
invoke it.  If KEYS is omitted or nil, the return value of
`this-command-keys-vector' is used.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
252
  (Lisp_Object function, Lisp_Object record_flag, Lisp_Object keys)
Michael I. Bushnell's avatar
Michael I. Bushnell committed
253 254 255
{
  Lisp_Object *args, *visargs;
  Lisp_Object specs;
256
  Lisp_Object filter_specs;
Michael I. Bushnell's avatar
Michael I. Bushnell committed
257
  Lisp_Object teml;
258
  Lisp_Object up_event;
Richard M. Stallman's avatar
Richard M. Stallman committed
259
  Lisp_Object enable;
260
  ptrdiff_t speccount = SPECPDL_INDEX ();
Michael I. Bushnell's avatar
Michael I. Bushnell committed
261

262 263
  /* The index of the next element of this_command_keys to examine for
     the 'e' interactive code.  */
264
  ptrdiff_t next_event;
265

Michael I. Bushnell's avatar
Michael I. Bushnell committed
266
  Lisp_Object prefix_arg;
267
  char *string;
268
  const char *tem;
Jim Blandy's avatar
Jim Blandy committed
269 270 271 272

  /* If varies[i] > 0, the i'th argument shouldn't just have its value
     in this call quoted in the command history.  It should be
     recorded as a call to the function named callint_argfuns[varies[i]].  */
273
  signed char *varies;
Jim Blandy's avatar
Jim Blandy committed
274

275
  ptrdiff_t i, nargs;
276
  int foo;
Michael I. Bushnell's avatar
Michael I. Bushnell committed
277
  int arg_from_tty = 0;
278
  struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
279
  ptrdiff_t key_count;
280
  int record_then_fail = 0;
281

282 283 284 285 286
  Lisp_Object save_this_command, save_last_command;
  Lisp_Object save_this_original_command, save_real_this_command;

  save_this_command = Vthis_command;
  save_this_original_command = Vthis_original_command;
287
  save_real_this_command = Vreal_this_command;
288
  save_last_command = KVAR (current_kboard, Vlast_command);
289

290 291 292 293
  if (NILP (keys))
    keys = this_command_keys, key_count = this_command_key_count;
  else
    {
294
      CHECK_VECTOR (keys);
295
      key_count = ASIZE (keys);
296
    }
Michael I. Bushnell's avatar
Michael I. Bushnell committed
297

298
  /* Save this now, since use of minibuffer will clobber it.  */
299
  prefix_arg = Vcurrent_prefix_arg;
Michael I. Bushnell's avatar
Michael I. Bushnell committed
300

301
  if (SYMBOLP (function))
302
    enable = Fget (function, Qenable_recursive_minibuffers);
303 304
  else
    enable = Qnil;
Richard M. Stallman's avatar
Richard M. Stallman committed
305

Michael I. Bushnell's avatar
Michael I. Bushnell committed
306 307
  specs = Qnil;
  string = 0;
308 309 310 311
  /* The idea of FILTER_SPECS is to provide away to
     specify how to represent the arguments in command history.
     The feature is not fully implemented.  */
  filter_specs = Qnil;
Michael I. Bushnell's avatar
Michael I. Bushnell committed
312

313 314
  /* If k or K discard an up-event, save it here so it can be retrieved with
     U.  */
315 316
  up_event = Qnil;

317
  /* Set SPECS to the interactive form, or barf if not interactive.  */
318 319 320 321 322 323 324 325 326 327
  {
    Lisp_Object form;
    GCPRO2 (function, prefix_arg);
    form = Finteractive_form (function);
    UNGCPRO;
    if (CONSP (form))
      specs = filter_specs = Fcar (XCDR (form));
    else
      wrong_type_argument (Qcommandp, function);
  }
Michael I. Bushnell's avatar
Michael I. Bushnell committed
328

329
  /* If SPECS is set to a string, use it as an interactive prompt.  */
330
  if (STRINGP (specs))
Jim Blandy's avatar
Jim Blandy committed
331 332 333
    {
      /* Make a copy of string so that if a GC relocates specs,
	 `string' will still be valid.  */
334
      string = alloca (SBYTES (specs) + 1);
335
      memcpy (string, SSDATA (specs), SBYTES (specs) + 1);
Jim Blandy's avatar
Jim Blandy committed
336
    }
337
  else
Michael I. Bushnell's avatar
Michael I. Bushnell committed
338
    {
339
      Lisp_Object input;
340
      Lisp_Object funval = Findirect_function (function, Qt);
341
      uintmax_t events = num_input_events;
342 343
      input = specs;
      /* Compute the arg values using the user's expression.  */
344
      GCPRO2 (input, filter_specs);
345 346 347
      specs = Feval (specs,
		     CONSP (funval) && EQ (Qclosure, XCAR (funval))
		     ? Qt : Qnil);
348
      UNGCPRO;
349
      if (events != num_input_events || !NILP (record_flag))
350 351
	{
	  /* We should record this command on the command history.  */
352
	  Lisp_Object values;
353
	  Lisp_Object this_cmd;
354 355 356
	  /* Make a copy of the list of values, for the command history,
	     and turn them into things we can eval.  */
	  values = quotify_args (Fcopy_sequence (specs));
357
	  fix_command (input, values);
358 359 360 361
	  this_cmd = Fcons (function, values);
	  if (history_delete_duplicates)
	    Vcommand_history = Fdelete (this_cmd, Vcommand_history);
	  Vcommand_history = Fcons (this_cmd, Vcommand_history);
362 363

	  /* Don't keep command history around forever.  */
364
	  if (INTEGERP (Vhistory_length) && XINT (Vhistory_length) > 0)
365 366 367
	    {
	      teml = Fnthcdr (Vhistory_length, Vcommand_history);
	      if (CONSP (teml))
368
		XSETCDR (teml, Qnil);
369
	    }
370
	}
371 372 373

      Vthis_command = save_this_command;
      Vthis_original_command = save_this_original_command;
374
      Vreal_this_command = save_real_this_command;
375
      KVAR (current_kboard, Vlast_command) = save_last_command;
376

377 378
      temporarily_switch_to_single_kboard (NULL);
      return unbind_to (speccount, apply1 (function, specs));
Michael I. Bushnell's avatar
Michael I. Bushnell committed
379 380
    }

381
  /* Here if function specifies a string to control parsing the defaults.  */
Michael I. Bushnell's avatar
Michael I. Bushnell committed
382

Jim Blandy's avatar
Jim Blandy committed
383
  /* Set next_event to point to the first event with parameters.  */
384
  for (next_event = 0; next_event < key_count; next_event++)
385
    if (EVENT_HAS_PARAMETERS (AREF (keys, next_event)))
Jim Blandy's avatar
Jim Blandy committed
386
      break;
387

388
  /* Handle special starting chars `*' and `@'.  Also `-'.  */
389
  /* Note that `+' is reserved for user extensions.  */
Michael I. Bushnell's avatar
Michael I. Bushnell committed
390 391
  while (1)
    {
392
      if (*string == '+')
393 394
	error ("`+' is not used in `interactive' for ordinary commands");
      else if (*string == '*')
Michael I. Bushnell's avatar
Michael I. Bushnell committed
395 396
	{
	  string++;
Tom Tromey's avatar
Tom Tromey committed
397
	  if (!NILP (BVAR (current_buffer, read_only)))
398 399 400
	    {
	      if (!NILP (record_flag))
		{
401
		  char *p = string;
402 403 404 405 406 407 408 409 410 411 412 413
		  while (*p)
		    {
		      if (! (*p == 'r' || *p == 'p' || *p == 'P'
			     || *p == '\n'))
			Fbarf_if_buffer_read_only ();
		      p++;
		    }
		  record_then_fail = 1;
		}
	      else
		Fbarf_if_buffer_read_only ();
	    }
Michael I. Bushnell's avatar
Michael I. Bushnell committed
414
	}
415 416 417
      /* Ignore this for semi-compatibility with Lucid.  */
      else if (*string == '-')
	string++;
Michael I. Bushnell's avatar
Michael I. Bushnell committed
418 419
      else if (*string == '@')
	{
420
	  Lisp_Object event, w;
Jim Blandy's avatar
Jim Blandy committed
421

422
	  event = (next_event < key_count
423
		   ? AREF (keys, next_event)
424
		   : Qnil);
Jim Blandy's avatar
Jim Blandy committed
425
	  if (EVENT_HAS_PARAMETERS (event)
426 427 428
	      && (w = XCDR (event), CONSP (w))
	      && (w = XCAR (w), CONSP (w))
	      && (w = XCAR (w), WINDOWP (w)))
429
	    {
430 431
	      if (MINI_WINDOW_P (XWINDOW (w))
		  && ! (minibuf_level > 0 && EQ (w, minibuf_window)))
432
		error ("Attempt to select inactive minibuffer window");
433 434

	      /* If the current buffer wants to clean up, let it.  */
435
              Frun_hooks (1, &Qmouse_leave_buffer_hook);
436

437
	      Fselect_window (w, Qnil);
438
	    }
Michael I. Bushnell's avatar
Michael I. Bushnell committed
439 440
	  string++;
	}
Chong Yidong's avatar
Chong Yidong committed
441 442
      else if (*string == '^')
	{
443
	  call0 (Qhandle_shift_selection);
Chong Yidong's avatar
Chong Yidong committed
444 445
	  string++;
	}
Michael I. Bushnell's avatar
Michael I. Bushnell committed
446 447 448
      else break;
    }

449 450
  /* Count the number of arguments, which is one plus the number of arguments
     the interactive spec would have us give to the function.  */
Michael I. Bushnell's avatar
Michael I. Bushnell committed
451
  tem = string;
452
  for (nargs = 1; *tem; )
Michael I. Bushnell's avatar
Michael I. Bushnell committed
453 454 455
    {
      /* 'r' specifications ("point and mark as 2 numeric args")
	 produce *two* arguments.  */
456
      if (*tem == 'r')
457
	nargs += 2;
458
      else
459
	nargs++;
460
      tem = strchr (tem, '\n');
Michael I. Bushnell's avatar
Michael I. Bushnell committed
461
      if (tem)
462
	++tem;
Michael I. Bushnell's avatar
Michael I. Bushnell committed
463
      else
464
	break;
Michael I. Bushnell's avatar
Michael I. Bushnell committed
465 466
    }

467 468 469 470 471
  if (min (MOST_POSITIVE_FIXNUM,
	   min (PTRDIFF_MAX, SIZE_MAX) / sizeof (Lisp_Object))
      < nargs)
    memory_full (SIZE_MAX);

472 473 474
  args = alloca (nargs * sizeof *args);
  visargs = alloca (nargs * sizeof *visargs);
  varies = alloca (nargs * sizeof *varies);
Michael I. Bushnell's avatar
Michael I. Bushnell committed
475

476
  for (i = 0; i < nargs; i++)
Michael I. Bushnell's avatar
Michael I. Bushnell committed
477 478 479 480 481 482
    {
      args[i] = Qnil;
      visargs[i] = Qnil;
      varies[i] = 0;
    }

483
  GCPRO5 (prefix_arg, function, *args, *visargs, up_event);
484 485
  gcpro3.nvars = nargs;
  gcpro4.nvars = nargs;
Michael I. Bushnell's avatar
Michael I. Bushnell committed
486

Richard M. Stallman's avatar
Richard M. Stallman committed
487 488 489
  if (!NILP (enable))
    specbind (Qenable_recursive_minibuffers, Qt);

Michael I. Bushnell's avatar
Michael I. Bushnell committed
490
  tem = string;
491
  for (i = 1; *tem; i++)
Michael I. Bushnell's avatar
Michael I. Bushnell committed
492
    {
493 494
      visargs[0] = make_string (tem + 1, strcspn (tem + 1, "\n"));
      if (strchr (SSDATA (visargs[0]), '%'))
495 496 497
	callint_message = Fformat (i, visargs);
      else
	callint_message = visargs[0];
Michael I. Bushnell's avatar
Michael I. Bushnell committed
498 499 500 501

      switch (*tem)
	{
	case 'a':		/* Symbol defined as a function */
502
	  visargs[i] = Fcompleting_read (callint_message,
503
					 Vobarray, Qfboundp, Qt,
504
					 Qnil, Qnil, Qnil, Qnil);
Michael I. Bushnell's avatar
Michael I. Bushnell committed
505 506 507 508 509 510
	  /* Passing args[i] directly stimulates compiler bug */
	  teml = visargs[i];
	  args[i] = Fintern (teml, Qnil);
	  break;

	case 'b':   		/* Name of existing buffer */
511 512 513 514 515 516
	  args[i] = Fcurrent_buffer ();
	  if (EQ (selected_window, minibuf_window))
	    args[i] = Fother_buffer (args[i], Qnil, Qnil);
	  args[i] = Fread_buffer (callint_message, args[i], Qt);
	  break;

Michael I. Bushnell's avatar
Michael I. Bushnell committed
517
	case 'B':		/* Name of buffer, possibly nonexistent */
518 519 520
	  args[i] = Fread_buffer (callint_message,
				  Fother_buffer (Fcurrent_buffer (), Qnil, Qnil),
				  Qnil);
Michael I. Bushnell's avatar
Michael I. Bushnell committed
521 522 523
	  break;

        case 'c':		/* Character */
524 525 526 527
	  /* Prompt in `minibuffer-prompt' face.  */
	  Fput_text_property (make_number (0),
			      make_number (SCHARS (callint_message)),
			      Qface, Qminibuffer_prompt, callint_message);
528
	  args[i] = Fread_char (callint_message, Qnil, Qnil);
529
	  message1_nolog ((char *) 0);
Michael I. Bushnell's avatar
Michael I. Bushnell committed
530 531
	  /* Passing args[i] directly stimulates compiler bug */
	  teml = args[i];
Glenn Morris's avatar
Glenn Morris committed
532 533
	  /* See bug#8479.  */
	  if (! CHARACTERP (teml)) error ("Non-character input-event");
Michael I. Bushnell's avatar
Michael I. Bushnell committed
534 535 536 537
	  visargs[i] = Fchar_to_string (teml);
	  break;

	case 'C':		/* Command: symbol with interactive function */
538
	  visargs[i] = Fcompleting_read (callint_message,
539
					 Vobarray, Qcommandp,
540
					 Qt, Qnil, Qnil, Qnil, Qnil);
Michael I. Bushnell's avatar
Michael I. Bushnell committed
541 542 543 544 545 546
	  /* Passing args[i] directly stimulates compiler bug */
	  teml = visargs[i];
	  args[i] = Fintern (teml, Qnil);
	  break;

	case 'd':		/* Value of point.  Does not do I/O.  */
547
	  set_marker_both (point_marker, Qnil, PT, PT_BYTE);
548
	  args[i] = point_marker;
Michael I. Bushnell's avatar
Michael I. Bushnell committed
549 550 551 552 553
	  /* visargs[i] = Qnil; */
	  varies[i] = 1;
	  break;

	case 'D':		/* Directory name. */
554
	  args[i] = Fread_file_name (callint_message, Qnil,
Tom Tromey's avatar
Tom Tromey committed
555
				     BVAR (current_buffer, directory), Qlambda, Qnil,
556
				     Qfile_directory_p);
Michael I. Bushnell's avatar
Michael I. Bushnell committed
557 558 559
	  break;

	case 'f':		/* Existing file name. */
560
	  args[i] = Fread_file_name (callint_message,
561
				     Qnil, Qnil, Qlambda, Qnil, Qnil);
Michael I. Bushnell's avatar
Michael I. Bushnell committed
562 563 564
	  break;

	case 'F':		/* Possibly nonexistent file name. */
565
	  args[i] = Fread_file_name (callint_message,
566
				     Qnil, Qnil, Qnil, Qnil, Qnil);
Michael I. Bushnell's avatar
Michael I. Bushnell committed
567 568
	  break;

569 570
	case 'G':		/* Possibly nonexistent file name,
				   default to directory alone. */
571
	  args[i] = Fread_file_name (callint_message,
572
				     Qnil, Qnil, Qnil, empty_unibyte_string, Qnil);
573 574
	  break;

575 576 577 578
	case 'i':		/* Ignore an argument -- Does not do I/O */
	  varies[i] = -1;
	  break;

579
	case 'k':		/* Key sequence. */
580
	  {
581
	    ptrdiff_t speccount1 = SPECPDL_INDEX ();
582
	    specbind (Qcursor_in_echo_area, Qt);
583 584 585 586
	    /* Prompt in `minibuffer-prompt' face.  */
	    Fput_text_property (make_number (0),
				make_number (SCHARS (callint_message)),
				Qface, Qminibuffer_prompt, callint_message);
587
	    args[i] = Fread_key_sequence (callint_message,
588
					  Qnil, Qnil, Qnil, Qnil);
589 590
	    unbind_to (speccount1, Qnil);
	    teml = args[i];
591
	    visargs[i] = Fkey_description (teml, Qnil);
592 593 594 595 596

	    /* If the key sequence ends with a down-event,
	       discard the following up-event.  */
	    teml = Faref (args[i], make_number (XINT (Flength (args[i])) - 1));
	    if (CONSP (teml))
597
	      teml = XCAR (teml);
598 599 600 601 602
	    if (SYMBOLP (teml))
	      {
		Lisp_Object tem2;

		teml = Fget (teml, intern ("event-symbol-elements"));
603 604
		/* Ignore first element, which is the base key.  */
		tem2 = Fmemq (intern ("down"), Fcdr (teml));
605
		if (! NILP (tem2))
Chong Yidong's avatar
Chong Yidong committed
606
		  up_event = Fread_event (Qnil, Qnil, Qnil);
607
	      }
608
	  }
609 610 611
	  break;

	case 'K':		/* Key sequence to be defined. */
612
	  {
613
	    ptrdiff_t speccount1 = SPECPDL_INDEX ();
614
	    specbind (Qcursor_in_echo_area, Qt);
615 616 617 618
	    /* Prompt in `minibuffer-prompt' face.  */
	    Fput_text_property (make_number (0),
				make_number (SCHARS (callint_message)),
				Qface, Qminibuffer_prompt, callint_message);
619
	    args[i] = Fread_key_sequence (callint_message,
620
					  Qnil, Qt, Qnil, Qnil);
621
	    teml = args[i];
622
	    visargs[i] = Fkey_description (teml, Qnil);
623
	    unbind_to (speccount1, Qnil);
624 625 626 627 628

	    /* If the key sequence ends with a down-event,
	       discard the following up-event.  */
	    teml = Faref (args[i], make_number (XINT (Flength (args[i])) - 1));
	    if (CONSP (teml))
629
	      teml = XCAR (teml);
630 631 632 633 634
	    if (SYMBOLP (teml))
	      {
		Lisp_Object tem2;

		teml = Fget (teml, intern ("event-symbol-elements"));
635 636
		/* Ignore first element, which is the base key.  */
		tem2 = Fmemq (intern ("down"), Fcdr (teml));
637
		if (! NILP (tem2))
Chong Yidong's avatar
Chong Yidong committed
638
		  up_event = Fread_event (Qnil, Qnil, Qnil);
639
	      }
640
	  }
Michael I. Bushnell's avatar
Michael I. Bushnell committed
641 642
	  break;

643 644 645 646 647 648 649 650 651 652
	case 'U':		/* Up event from last k or K */
	  if (!NILP (up_event))
	    {
	      args[i] = Fmake_vector (make_number (1), up_event);
	      up_event = Qnil;
	      teml = args[i];
	      visargs[i] = Fkey_description (teml, Qnil);
	    }
	  break;

653
	case 'e':		/* The invoking event.  */
654
	  if (next_event >= key_count)
655
	    error ("%s must be bound to an event with parameters",
656
		   (SYMBOLP (function)
657
		    ? SSDATA (SYMBOL_NAME (function))
658
		    : "command"));
659 660
	  args[i] = AREF (keys, next_event);
	  next_event++;
Jim Blandy's avatar
Jim Blandy committed
661
	  varies[i] = -1;
Jim Blandy's avatar
Jim Blandy committed
662 663

	  /* Find the next parameterized event.  */
664
	  while (next_event < key_count
665
		 && !(EVENT_HAS_PARAMETERS (AREF (keys, next_event))))
Jim Blandy's avatar
Jim Blandy committed
666 667
	    next_event++;

Jim Blandy's avatar
Jim Blandy committed
668 669
	  break;

Michael I. Bushnell's avatar
Michael I. Bushnell committed
670
	case 'm':		/* Value of mark.  Does not do I/O.  */
671
	  check_mark (0);
Michael I. Bushnell's avatar
Michael I. Bushnell committed
672
	  /* visargs[i] = Qnil; */
Tom Tromey's avatar
Tom Tromey committed
673
	  args[i] = BVAR (current_buffer, mark);
Michael I. Bushnell's avatar
Michael I. Bushnell committed
674 675 676
	  varies[i] = 2;
	  break;

677 678
	case 'M':		/* String read via minibuffer with
				   inheriting the current input method.  */
679
	  args[i] = Fread_string (callint_message,
680 681 682
				  Qnil, Qnil, Qnil, Qt);
	  break;

Richard M. Stallman's avatar
Richard M. Stallman committed
683
	case 'N':		/* Prefix arg as number, else number from minibuffer */
Jim Blandy's avatar
Jim Blandy committed
684
	  if (!NILP (prefix_arg))
Michael I. Bushnell's avatar
Michael I. Bushnell committed
685 686
	    goto have_prefix_arg;
	case 'n':		/* Read number from minibuffer.  */
687 688 689 690
	  {
	    int first = 1;
	    do
	      {
691
		Lisp_Object str;
692
		if (! first)
693 694
		  {
		    message ("Please enter a number.");
695
		    sit_for (make_number (1), 0, 0);
696 697 698
		  }
		first = 0;

699
		str = Fread_from_minibuffer (callint_message,
700
					     Qnil, Qnil, Qnil, Qnil, Qnil,
701
					     Qnil);
702
		if (! STRINGP (str) || SCHARS (str) == 0)
703 704
		  args[i] = Qnil;
		else
705
		  args[i] = Fread (str);
706 707 708
	      }
	    while (! NUMBERP (args[i]));
	  }
709
	  visargs[i] = args[i];
Michael I. Bushnell's avatar
Michael I. Bushnell committed
710 711 712 713 714 715 716 717 718
	  break;

	case 'P':		/* Prefix arg in raw form.  Does no I/O.  */
	  args[i] = prefix_arg;
	  /* visargs[i] = Qnil; */
	  varies[i] = -1;
	  break;

	case 'p':		/* Prefix arg converted to number.  No I/O. */
719
	have_prefix_arg:
Michael I. Bushnell's avatar
Michael I. Bushnell committed
720 721 722 723 724 725
	  args[i] = Fprefix_numeric_value (prefix_arg);
	  /* visargs[i] = Qnil; */
	  varies[i] = -1;
	  break;

	case 'r':		/* Region, point and mark as 2 args. */
726
	  check_mark (1);
727
	  set_marker_both (point_marker, Qnil, PT, PT_BYTE);
Michael I. Bushnell's avatar
Michael I. Bushnell committed
728
	  /* visargs[i+1] = Qnil; */
Tom Tromey's avatar
Tom Tromey committed
729
	  foo = marker_position (BVAR (current_buffer, mark));
Michael I. Bushnell's avatar
Michael I. Bushnell committed
730
	  /* visargs[i] = Qnil; */
Tom Tromey's avatar
Tom Tromey committed
731
	  args[i] = PT < foo ? point_marker : BVAR (current_buffer, mark);
Michael I. Bushnell's avatar
Michael I. Bushnell committed
732
	  varies[i] = 3;
Tom Tromey's avatar
Tom Tromey committed
733
	  args[++i] = PT > foo ? point_marker : BVAR (current_buffer, mark);
Michael I. Bushnell's avatar
Michael I. Bushnell committed
734 735 736
	  varies[i] = 4;
	  break;

737 738
	case 's':		/* String read via minibuffer without
				   inheriting the current input method.  */
739
	  args[i] = Fread_string (callint_message,
740
				  Qnil, Qnil, Qnil, Qnil);
Michael I. Bushnell's avatar
Michael I. Bushnell committed
741 742 743
	  break;

	case 'S':		/* Any symbol.  */
744
	  visargs[i] = Fread_string (callint_message,
745
				     Qnil, Qnil, Qnil, Qnil);
Michael I. Bushnell's avatar
Michael I. Bushnell committed
746 747 748 749 750 751
	  /* Passing args[i] directly stimulates compiler bug */
	  teml = visargs[i];
	  args[i] = Fintern (teml, Qnil);
	  break;

	case 'v':		/* Variable name: symbol that is
752
				   custom-variable-p. */
753
	  args[i] = Fread_variable (callint_message, Qnil);
Michael I. Bushnell's avatar
Michael I. Bushnell committed
754 755 756 757
	  visargs[i] = last_minibuf_string;
	  break;

	case 'x':		/* Lisp expression read but not evaluated */
758
	  args[i] = Fread_minibuffer (callint_message, Qnil);
Michael I. Bushnell's avatar
Michael I. Bushnell committed
759 760 761 762
	  visargs[i] = last_minibuf_string;
	  break;

	case 'X':		/* Lisp expression read and evaluated */
763
	  args[i] = Feval_minibuffer (callint_message, Qnil);
Michael I. Bushnell's avatar
Michael I. Bushnell committed
764 765 766
	  visargs[i] = last_minibuf_string;
 	  break;

767 768 769 770 771 772 773
	case 'Z':		/* Coding-system symbol, or ignore the
				   argument if no prefix */
	  if (NILP (prefix_arg))
	    {
	      args[i] = Qnil;
	      varies[i] = -1;
	    }
774
	  else
775 776
	    {
	      args[i]
777
		= Fread_non_nil_coding_system (callint_message);
778 779 780 781 782
	      visargs[i] = last_minibuf_string;
	    }
	  break;

	case 'z':		/* Coding-system symbol or nil */
783
	  args[i] = Fread_coding_system (callint_message, Qnil);
784 785 786
	  visargs[i] = last_minibuf_string;
	  break;

787 788 789
	  /* We have a case for `+' so we get an error
	     if anyone tries to define one here.  */
	case '+':
Michael I. Bushnell's avatar
Michael I. Bushnell committed
790
	default:
791 792 793 794
	  error ("Invalid control letter `%c' (#o%03o, #x%04x) in interactive calling string",
		 STRING_CHAR ((unsigned char *) tem),
		 (unsigned) STRING_CHAR ((unsigned char *) tem),
		 (unsigned) STRING_CHAR ((unsigned char *) tem));
Michael I. Bushnell's avatar
Michael I. Bushnell committed
795 796 797 798 799
	}

      if (varies[i] == 0)
	arg_from_tty = 1;

800
      if (NILP (visargs[i]) && STRINGP (args[i]))
Michael I. Bushnell's avatar
Michael I. Bushnell committed
801 802
	visargs[i] = args[i];

803
      tem = strchr (tem, '\n');
Michael I. Bushnell's avatar
Michael I. Bushnell committed
804
      if (tem) tem++;
805
      else tem = "";
Michael I. Bushnell's avatar
Michael I. Bushnell committed
806
    }
Richard M. Stallman's avatar
Richard M. Stallman committed
807
  unbind_to (speccount, Qnil);
Michael I. Bushnell's avatar
Michael I. Bushnell committed
808 809 810 811 812

  QUIT;

  args[0] = function;

813
  if (arg_from_tty || !NILP (record_flag))
Michael I. Bushnell's avatar
Michael I. Bushnell committed
814 815
    {
      visargs[0] = function;
816
      for (i = 1; i < nargs; i++)
817 818 819 820 821 822
	{
	  if (varies[i] > 0)
	    visargs[i] = Fcons (intern (callint_argfuns[varies[i]]), Qnil);
	  else
	    visargs[i] = quotify_arg (args[i]);
	}
823
      Vcommand_history = Fcons (Flist (nargs, visargs),
Michael I. Bushnell's avatar
Michael I. Bushnell committed
824
				Vcommand_history);
825
      /* Don't keep command history around forever.  */
826
      if (INTEGERP (Vhistory_length) && XINT (Vhistory_length) > 0)
827 828 829
	{
	  teml = Fnthcdr (Vhistory_length, Vcommand_history);
	  if (CONSP (teml))
830
	    XSETCDR (teml, Qnil);
831
	}
Michael I. Bushnell's avatar
Michael I. Bushnell committed
832 833
    }

834 835
  /* If we used a marker to hold point, mark, or an end of the region,
     temporarily, convert it to an integer now.  */
836
  for (i = 1; i < nargs; i++)
837 838 839
    if (varies[i] >= 1 && varies[i] <= 4)
      XSETINT (args[i], marker_position (args[i]));

840 841 842
  if (record_then_fail)
    Fbarf_if_buffer_read_only ();

843 844
  Vthis_command = save_this_command;
  Vthis_original_command = save_this_original_command;
845
  Vreal_this_command = save_real_this_command;
846
  KVAR (current_kboard, Vlast_command) = save_last_command;
847

Michael I. Bushnell's avatar
Michael I. Bushnell committed
848 849 850 851
  {
    Lisp_Object val;
    specbind (Qcommand_debug_status, Qnil);

852
    temporarily_switch_to_single_kboard (NULL);
853
    val = Ffuncall (nargs, args);
Michael I. Bushnell's avatar
Michael I. Bushnell committed
854 855 856
    UNGCPRO;
    return unbind_to (speccount, val);
  }
857
}
Michael I. Bushnell's avatar
Michael I. Bushnell committed
858

Paul Eggert's avatar
Paul Eggert committed
859
DEFUN ("prefix-numeric-value", Fprefix_numeric_value, Sprefix_numeric_value,
860 861 862 863
       1, 1, 0,
       doc: /* Return numeric meaning of raw prefix argument RAW.
A raw prefix argument is what you get from `(interactive "P")'.
Its numeric meaning is what you would get from `(interactive "p")'.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
864
  (Lisp_Object raw)
Michael I. Bushnell's avatar
Michael I. Bushnell committed
865 866
{
  Lisp_Object val;
867

Jim Blandy's avatar
Jim Blandy committed
868
  if (NILP (raw))
869
    XSETFASTINT (val, 1);
870
  else if (EQ (raw, Qminus))
Michael I. Bushnell's avatar
Michael I. Bushnell committed
871
    XSETINT (val, -1);
872 873
  else if (CONSP (raw) && INTEGERP (XCAR (raw)))
    XSETINT (val, XINT (XCAR (raw)));
874
  else if (INTEGERP (raw))
Michael I. Bushnell's avatar
Michael I. Bushnell committed
875 876
    val = raw;
  else
877
    XSETFASTINT (val, 1);
Michael I. Bushnell's avatar
Michael I. Bushnell committed
878 879 880 881

  return val;
}

Andreas Schwab's avatar
Andreas Schwab committed
882
void
883
syms_of_callint (void)
Michael I. Bushnell's avatar
Michael I. Bushnell committed
884
{
885 886 887
  point_marker = Fmake_marker ();
  staticpro (&point_marker);

888 889 890
  callint_message = Qnil;
  staticpro (&callint_message);

Dan Nicolaescu's avatar
Dan Nicolaescu committed
891 892 893 894
  preserved_fns = pure_cons (intern_c_string ("region-beginning"),
			 pure_cons (intern_c_string ("region-end"),
				pure_cons (intern_c_string ("point"),
				       pure_cons (intern_c_string ("mark"), Qnil))));
895

896 897 898 899 900 901 902 903 904 905 906 907 908 909
  DEFSYM (Qlist, "list");
  DEFSYM (Qlet, "let");
  DEFSYM (Qif, "if");
  DEFSYM (Qwhen, "when");
  DEFSYM (Qletx, "let*");
  DEFSYM (Qsave_excursion, "save-excursion");
  DEFSYM (Qprogn, "progn");
  DEFSYM (Qminus, "-");
  DEFSYM (Qplus, "+");
  DEFSYM (Qhandle_shift_selection, "handle-shift-selection");
  DEFSYM (Qcall_interactively, "call-interactively");
  DEFSYM (Qcommand_debug_status, "command-debug-status");
  DEFSYM (Qenable_recursive_minibuffers, "enable-recursive-minibuffers");
  DEFSYM (Qmouse_leave_buffer_hook, "mouse-leave-buffer-hook");
910

911
  DEFVAR_KBOARD ("prefix-arg", Vprefix_arg,
912 913 914 915 916 917 918 919 920
		 doc: /* The value of the prefix argument for the next editing command.
It may be a number, or the symbol `-' for just a minus sign as arg,
or a list whose car is a number for just one or more C-u's
or nil if no argument has been specified.

You cannot examine this variable to find the argument for this command
since it has been set to nil by the time you can look.
Instead, you should use the variable `current-prefix-arg', although
normally commands can get this prefix argument with (interactive "P").  */);
921

922
  DEFVAR_KBOARD ("last-prefix-arg", Vlast_prefix_arg,
923 924
		 doc: /* The value of the prefix argument for the previous editing command.
See `prefix-arg' for the meaning of the value.  */);
925

926
  DEFVAR_LISP ("current-prefix-arg", Vcurrent_prefix_arg,
927 928 929 930 931
	       doc: /* The value of the prefix argument for this editing command.
It may be a number, or the symbol `-' for just a minus sign as arg,
or a list whose car is a number for just one or more C-u's
or nil if no argument has been specified.
This is what `(interactive \"P\")' returns.  */);
932 933
  Vcurrent_prefix_arg = Qnil;

934
  DEFVAR_LISP ("command-history", Vcommand_history,
935
	       doc: /* List of recent commands that read arguments from terminal.
936 937 938 939
Each command is represented as a form to evaluate.

Maximum length of the history list is determined by the value
of `history-length', which see.  */);
Michael I. Bushnell's avatar
Michael I. Bushnell committed
940 941
  Vcommand_history = Qnil;

942
  DEFVAR_LISP ("command-debug-status", Vcommand_debug_status,
943 944 945
	       doc: /* Debugging status of current interactive command.
Bound each time `call-interactively' is called;
may be set by the debugger as a reminder for itself.  */);
Michael I. Bushnell's avatar
Michael I. Bushnell committed
946 947
  Vcommand_debug_status = Qnil;

948
  DEFVAR_LISP ("mark-even-if-inactive", Vmark_even_if_inactive,
949
	       doc: /* Non-nil means you can use the mark even when inactive.
950 951 952 953
This option makes a difference in Transient Mark mode.
When the option is non-nil, deactivation of the mark
turns off region highlighting, but commands that use the mark
behave as if the mark were still active.  */);
954
  Vmark_even_if_inactive = Qt;
955

956
  DEFVAR_LISP ("mouse-leave-buffer-hook", Vmouse_leave_buffer_hook,
957 958 959
	       doc: /* Hook to run when about to switch windows with a mouse command.
Its purpose is to give temporary modes such as Isearch mode
a way to turn themselves off when a mouse command switches windows.  */);
960 961
  Vmouse_leave_buffer_hook = Qnil;

Michael I. Bushnell's avatar
Michael I. Bushnell committed
962 963 964 965
  defsubr (&Sinteractive);
  defsubr (&Scall_interactively);
  defsubr (&Sprefix_numeric_value);
}