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-2011
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 25 26
#include "lisp.h"
#include "buffer.h"
#include "commands.h"
Jim Blandy's avatar
Jim Blandy committed
27
#include "keyboard.h"
Michael I. Bushnell's avatar
Michael I. Bushnell committed
28
#include "window.h"
Stefan Monnier's avatar
Stefan Monnier committed
29
#include "keymap.h"
Michael I. Bushnell's avatar
Michael I. Bushnell committed
30

31
Lisp_Object Qminus, Qplus;
Michael I. Bushnell's avatar
Michael I. Bushnell committed
32
Lisp_Object Qcall_interactively;
33
Lisp_Object Qcommand_debug_status;
Richard M. Stallman's avatar
Richard M. Stallman committed
34
Lisp_Object Qenable_recursive_minibuffers;
Michael I. Bushnell's avatar
Michael I. Bushnell committed
35

36
Lisp_Object Qhandle_shift_selection;
Chong Yidong's avatar
Chong Yidong committed
37

38
Lisp_Object Qmouse_leave_buffer_hook;
39

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

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

46 47
/* String for the prompt text used in Fcall_interactively.  */
static Lisp_Object callint_message;
Richard M. Stallman's avatar
Richard M. Stallman committed
48

Michael I. Bushnell's avatar
Michael I. Bushnell committed
49 50
/* ARGSUSED */
DEFUN ("interactive", Finteractive, Sinteractive, 0, UNEVALLED, 0,
51 52
       doc: /* Specify a way of parsing arguments for interactive use of a function.
For example, write
53 54 55
 (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.
56 57 58 59 60
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.

61 62 63 64 65
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
66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83
 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.
e -- Parametrized event (i.e., one that's a list) that invoked this command.
     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.
84
G -- Possibly nonexistent file name, defaulting to just directory name.
85 86 87 88 89 90
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
91
N -- Numeric prefix arg, or if none, do like code `n'.
92 93 94 95 96
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.
97
U -- Mouse up event discarded by a previous k or K argument.
98 99 100 101 102
v -- Variable name: symbol that is user-variable-p.
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
103 104 105 106 107 108 109

In addition, if the string begins with `*', an error is signaled if
  the buffer is read-only.
If the string begins with `@', Emacs searches the key sequence which
 invoked the command for its first mouse click (or any other event
 which specifies a window).
If the string begins with `^' and `shift-select-mode' is non-nil,
110
 Emacs first calls the function `handle-shift-selection'.
Chong Yidong's avatar
Chong Yidong committed
111 112
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
113
usage: (interactive &optional ARGS)  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
114
  (Lisp_Object args)
Michael I. Bushnell's avatar
Michael I. Bushnell committed
115 116 117 118 119 120 121
{
  return Qnil;
}

/* Quotify EXP: if EXP is constant, return it.
   If EXP is not constant, return (quote EXP).  */
Lisp_Object
122
quotify_arg (register Lisp_Object exp)
Michael I. Bushnell's avatar
Michael I. Bushnell committed
123
{
124
  if (!INTEGERP (exp) && !STRINGP (exp)
Jim Blandy's avatar
Jim Blandy committed
125
      && !NILP (exp) && !EQ (exp, Qt))
Michael I. Bushnell's avatar
Michael I. Bushnell committed
126 127 128 129 130 131 132
    return Fcons (Qquote, Fcons (exp, Qnil));

  return exp;
}

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

145
static const char *callint_argfuns[]
Michael I. Bushnell's avatar
Michael I. Bushnell committed
146 147 148
    = {"", "point", "mark", "region-beginning", "region-end"};

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

Richard M. Stallman's avatar
Richard M. Stallman committed
161 162 163 164 165 166 167 168
/* 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.  */

169
static void
170
fix_command (Lisp_Object input, Lisp_Object values)
171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193
{
  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
194
	       intail = Fcdr (intail), valtail = XCDR (valtail))
195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227
	    {
	      Lisp_Object elt;
	      elt = Fcar (intail);
	      if (CONSP (elt))
		{
		  Lisp_Object presflag, carelt;
		  carelt = Fcar (elt);
		  /* 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
228

229
DEFUN ("call-interactively", Fcall_interactively, Scall_interactively, 1, 3, 0,
230 231 232 233 234 235 236 237 238 239
       doc: /* Call FUNCTION, reading args according to its interactive calling specs.
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.
240

241
Optional third arg KEYS, if given, specifies the sequence of events to
242 243 244
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
245
  (Lisp_Object function, Lisp_Object record_flag, Lisp_Object keys)
Michael I. Bushnell's avatar
Michael I. Bushnell committed
246 247 248
{
  Lisp_Object *args, *visargs;
  Lisp_Object specs;
249
  Lisp_Object filter_specs;
Michael I. Bushnell's avatar
Michael I. Bushnell committed
250
  Lisp_Object teml;
251
  Lisp_Object up_event;
Richard M. Stallman's avatar
Richard M. Stallman committed
252
  Lisp_Object enable;
Juanma Barranquero's avatar
Juanma Barranquero committed
253
  int speccount = SPECPDL_INDEX ();
Michael I. Bushnell's avatar
Michael I. Bushnell committed
254

255 256
  /* The index of the next element of this_command_keys to examine for
     the 'e' interactive code.  */
Jim Blandy's avatar
Jim Blandy committed
257
  int next_event;
258

Michael I. Bushnell's avatar
Michael I. Bushnell committed
259 260 261
  Lisp_Object prefix_arg;
  unsigned char *string;
  unsigned char *tem;
Jim Blandy's avatar
Jim Blandy committed
262 263 264 265

  /* 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]].  */
Michael I. Bushnell's avatar
Michael I. Bushnell committed
266
  int *varies;
Jim Blandy's avatar
Jim Blandy committed
267

Michael I. Bushnell's avatar
Michael I. Bushnell committed
268 269 270 271 272
  register int i, j;
  int count, foo;
  char prompt1[100];
  char *tem1;
  int arg_from_tty = 0;
273
  struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
274
  int key_count;
275
  int record_then_fail = 0;
276

277 278 279 280 281 282 283 284
  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;
  save_real_this_command = real_this_command;
  save_last_command = current_kboard->Vlast_command;

285 286 287 288
  if (NILP (keys))
    keys = this_command_keys, key_count = this_command_key_count;
  else
    {
289
      CHECK_VECTOR (keys);
290 291
      key_count = XVECTOR (keys)->size;
    }
Michael I. Bushnell's avatar
Michael I. Bushnell committed
292

Jim Blandy's avatar
Jim Blandy committed
293
  /* Save this now, since use of minibuffer will clobber it. */
294
  prefix_arg = Vcurrent_prefix_arg;
Michael I. Bushnell's avatar
Michael I. Bushnell committed
295

296
  if (SYMBOLP (function))
297
    enable = Fget (function, Qenable_recursive_minibuffers);
298 299
  else
    enable = Qnil;
Richard M. Stallman's avatar
Richard M. Stallman committed
300

Michael I. Bushnell's avatar
Michael I. Bushnell committed
301 302
  specs = Qnil;
  string = 0;
303 304 305 306
  /* 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
307

308 309 310
  /* If k or K discard an up-event, save it here so it can be retrieved with U */
  up_event = Qnil;

311
  /* Set SPECS to the interactive form, or barf if not interactive.  */
312 313 314 315 316 317 318 319 320 321
  {
    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
322

323
  /* If SPECS is set to a string, use it as an interactive prompt.  */
324
  if (STRINGP (specs))
Jim Blandy's avatar
Jim Blandy committed
325 326 327
    {
      /* Make a copy of string so that if a GC relocates specs,
	 `string' will still be valid.  */
328
      string = (unsigned char *) alloca (SBYTES (specs) + 1);
329
      memcpy (string, SDATA (specs), SBYTES (specs) + 1);
Jim Blandy's avatar
Jim Blandy committed
330
    }
331
  else
Michael I. Bushnell's avatar
Michael I. Bushnell committed
332
    {
333
      Lisp_Object input;
334
      i = num_input_events;
335 336
      input = specs;
      /* Compute the arg values using the user's expression.  */
337
      GCPRO2 (input, filter_specs);
338
      specs = Feval (specs);
339
      UNGCPRO;
340
      if (i != num_input_events || !NILP (record_flag))
341 342
	{
	  /* We should record this command on the command history.  */
343
	  Lisp_Object values;
344
	  Lisp_Object this_cmd;
345 346 347
	  /* 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));
348
	  fix_command (input, values);
349 350 351 352
	  this_cmd = Fcons (function, values);
	  if (history_delete_duplicates)
	    Vcommand_history = Fdelete (this_cmd, Vcommand_history);
	  Vcommand_history = Fcons (this_cmd, Vcommand_history);
353 354

	  /* Don't keep command history around forever.  */
355
	  if (INTEGERP (Vhistory_length) && XINT (Vhistory_length) > 0)
356 357 358
	    {
	      teml = Fnthcdr (Vhistory_length, Vcommand_history);
	      if (CONSP (teml))
359
		XSETCDR (teml, Qnil);
360
	    }
361
	}
362 363 364 365 366 367

      Vthis_command = save_this_command;
      Vthis_original_command = save_this_original_command;
      real_this_command= save_real_this_command;
      current_kboard->Vlast_command = save_last_command;

368 369
      temporarily_switch_to_single_kboard (NULL);
      return unbind_to (speccount, apply1 (function, specs));
Michael I. Bushnell's avatar
Michael I. Bushnell committed
370 371 372 373
    }

  /* Here if function specifies a string to control parsing the defaults */

Jim Blandy's avatar
Jim Blandy committed
374
  /* Set next_event to point to the first event with parameters.  */
375
  for (next_event = 0; next_event < key_count; next_event++)
376
    if (EVENT_HAS_PARAMETERS (AREF (keys, next_event)))
Jim Blandy's avatar
Jim Blandy committed
377
      break;
378

379
  /* Handle special starting chars `*' and `@'.  Also `-'.  */
380
  /* Note that `+' is reserved for user extensions.  */
Michael I. Bushnell's avatar
Michael I. Bushnell committed
381 382
  while (1)
    {
383
      if (*string == '+')
384 385
	error ("`+' is not used in `interactive' for ordinary commands");
      else if (*string == '*')
Michael I. Bushnell's avatar
Michael I. Bushnell committed
386 387
	{
	  string++;
Jim Blandy's avatar
Jim Blandy committed
388
	  if (!NILP (current_buffer->read_only))
389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404
	    {
	      if (!NILP (record_flag))
		{
		  unsigned char *p = string;
		  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
405
	}
406 407 408
      /* Ignore this for semi-compatibility with Lucid.  */
      else if (*string == '-')
	string++;
Michael I. Bushnell's avatar
Michael I. Bushnell committed
409 410
      else if (*string == '@')
	{
411
	  Lisp_Object event, tem;
Jim Blandy's avatar
Jim Blandy committed
412

413
	  event = (next_event < key_count
414
		   ? AREF (keys, next_event)
415
		   : Qnil);
Jim Blandy's avatar
Jim Blandy committed
416
	  if (EVENT_HAS_PARAMETERS (event)
417 418 419
	      && (tem = XCDR (event), CONSP (tem))
	      && (tem = XCAR (tem), CONSP (tem))
	      && (tem = XCAR (tem), WINDOWP (tem)))
420
	    {
421 422
	      if (MINI_WINDOW_P (XWINDOW (tem))
		  && ! (minibuf_level > 0 && EQ (tem, minibuf_window)))
423
		error ("Attempt to select inactive minibuffer window");
424 425 426 427 428

	      /* If the current buffer wants to clean up, let it.  */
	      if (!NILP (Vmouse_leave_buffer_hook))
		call1 (Vrun_hooks, Qmouse_leave_buffer_hook);

429
	      Fselect_window (tem, Qnil);
430
	    }
Michael I. Bushnell's avatar
Michael I. Bushnell committed
431 432
	  string++;
	}
Chong Yidong's avatar
Chong Yidong committed
433 434
      else if (*string == '^')
	{
435
	  call0 (Qhandle_shift_selection);
Chong Yidong's avatar
Chong Yidong committed
436 437
	  string++;
	}
Michael I. Bushnell's avatar
Michael I. Bushnell committed
438 439 440 441 442 443
      else break;
    }

  /* Count the number of arguments the interactive spec would have
     us give to the function.  */
  tem = string;
444
  for (j = 0; *tem;)
Michael I. Bushnell's avatar
Michael I. Bushnell committed
445 446 447
    {
      /* 'r' specifications ("point and mark as 2 numeric args")
	 produce *two* arguments.  */
448 449 450 451
      if (*tem == 'r')
	j += 2;
      else
	j++;
452
      tem = (unsigned char *) strchr (tem, '\n');
Michael I. Bushnell's avatar
Michael I. Bushnell committed
453
      if (tem)
454
	++tem;
Michael I. Bushnell's avatar
Michael I. Bushnell committed
455
      else
456
	break;
Michael I. Bushnell's avatar
Michael I. Bushnell committed
457
    }
458
  count = j;
Michael I. Bushnell's avatar
Michael I. Bushnell committed
459 460 461 462 463 464 465 466 467 468 469 470

  args = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object));
  visargs = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object));
  varies = (int *) alloca ((count + 1) * sizeof (int));

  for (i = 0; i < (count + 1); i++)
    {
      args[i] = Qnil;
      visargs[i] = Qnil;
      varies[i] = 0;
    }

471
  GCPRO5 (prefix_arg, function, *args, *visargs, up_event);
Michael I. Bushnell's avatar
Michael I. Bushnell committed
472 473 474
  gcpro3.nvars = (count + 1);
  gcpro4.nvars = (count + 1);

Richard M. Stallman's avatar
Richard M. Stallman committed
475 476 477
  if (!NILP (enable))
    specbind (Qenable_recursive_minibuffers, Qt);

Michael I. Bushnell's avatar
Michael I. Bushnell committed
478
  tem = string;
479
  for (i = 1; *tem; i++)
Michael I. Bushnell's avatar
Michael I. Bushnell committed
480 481 482
    {
      strncpy (prompt1, tem + 1, sizeof prompt1 - 1);
      prompt1[sizeof prompt1 - 1] = 0;
483
      tem1 = strchr (prompt1, '\n');
Michael I. Bushnell's avatar
Michael I. Bushnell committed
484
      if (tem1) *tem1 = 0;
485 486

      visargs[0] = build_string (prompt1);
487
      if (strchr (prompt1, '%'))
488 489 490
	callint_message = Fformat (i, visargs);
      else
	callint_message = visargs[0];
Michael I. Bushnell's avatar
Michael I. Bushnell committed
491 492 493 494

      switch (*tem)
	{
	case 'a':		/* Symbol defined as a function */
495
	  visargs[i] = Fcompleting_read (callint_message,
496
					 Vobarray, Qfboundp, Qt,
497
					 Qnil, Qnil, Qnil, Qnil);
Michael I. Bushnell's avatar
Michael I. Bushnell committed
498 499 500 501 502 503
	  /* Passing args[i] directly stimulates compiler bug */
	  teml = visargs[i];
	  args[i] = Fintern (teml, Qnil);
	  break;

	case 'b':   		/* Name of existing buffer */
504 505 506 507 508 509
	  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
510
	case 'B':		/* Name of buffer, possibly nonexistent */
511 512 513
	  args[i] = Fread_buffer (callint_message,
				  Fother_buffer (Fcurrent_buffer (), Qnil, Qnil),
				  Qnil);
Michael I. Bushnell's avatar
Michael I. Bushnell committed
514 515 516
	  break;

        case 'c':		/* Character */
517 518 519 520
	  /* Prompt in `minibuffer-prompt' face.  */
	  Fput_text_property (make_number (0),
			      make_number (SCHARS (callint_message)),
			      Qface, Qminibuffer_prompt, callint_message);
521
	  args[i] = Fread_char (callint_message, Qnil, Qnil);
522
	  message1_nolog ((char *) 0);
Michael I. Bushnell's avatar
Michael I. Bushnell committed
523 524 525 526 527 528
	  /* Passing args[i] directly stimulates compiler bug */
	  teml = args[i];
	  visargs[i] = Fchar_to_string (teml);
	  break;

	case 'C':		/* Command: symbol with interactive function */
529
	  visargs[i] = Fcompleting_read (callint_message,
530
					 Vobarray, Qcommandp,
531
					 Qt, Qnil, Qnil, Qnil, Qnil);
Michael I. Bushnell's avatar
Michael I. Bushnell committed
532 533 534 535 536 537
	  /* 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.  */
538
	  set_marker_both (point_marker, Qnil, PT, PT_BYTE);
539
	  args[i] = point_marker;
Michael I. Bushnell's avatar
Michael I. Bushnell committed
540 541 542 543 544
	  /* visargs[i] = Qnil; */
	  varies[i] = 1;
	  break;

	case 'D':		/* Directory name. */
545
	  args[i] = Fread_file_name (callint_message, Qnil,
546 547
				     current_buffer->directory, Qlambda, Qnil,
				     Qfile_directory_p);
Michael I. Bushnell's avatar
Michael I. Bushnell committed
548 549 550
	  break;

	case 'f':		/* Existing file name. */
551
	  args[i] = Fread_file_name (callint_message,
552
				     Qnil, Qnil, Qlambda, Qnil, Qnil);
Michael I. Bushnell's avatar
Michael I. Bushnell committed
553 554 555
	  break;

	case 'F':		/* Possibly nonexistent file name. */
556
	  args[i] = Fread_file_name (callint_message,
557
				     Qnil, Qnil, Qnil, Qnil, Qnil);
Michael I. Bushnell's avatar
Michael I. Bushnell committed
558 559
	  break;

560 561
	case 'G':		/* Possibly nonexistent file name,
				   default to directory alone. */
562
	  args[i] = Fread_file_name (callint_message,
563
				     Qnil, Qnil, Qnil, empty_unibyte_string, Qnil);
564 565
	  break;

566 567 568 569
	case 'i':		/* Ignore an argument -- Does not do I/O */
	  varies[i] = -1;
	  break;

570
	case 'k':		/* Key sequence. */
571
	  {
Juanma Barranquero's avatar
Juanma Barranquero committed
572
	    int speccount1 = SPECPDL_INDEX ();
573
	    specbind (Qcursor_in_echo_area, Qt);
574 575 576 577
	    /* Prompt in `minibuffer-prompt' face.  */
	    Fput_text_property (make_number (0),
				make_number (SCHARS (callint_message)),
				Qface, Qminibuffer_prompt, callint_message);
578
	    args[i] = Fread_key_sequence (callint_message,
579
					  Qnil, Qnil, Qnil, Qnil);
580 581
	    unbind_to (speccount1, Qnil);
	    teml = args[i];
582
	    visargs[i] = Fkey_description (teml, Qnil);
583 584 585 586 587

	    /* 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))
588
	      teml = XCAR (teml);
589 590 591 592 593
	    if (SYMBOLP (teml))
	      {
		Lisp_Object tem2;

		teml = Fget (teml, intern ("event-symbol-elements"));
594 595
		/* Ignore first element, which is the base key.  */
		tem2 = Fmemq (intern ("down"), Fcdr (teml));
596
		if (! NILP (tem2))
Chong Yidong's avatar
Chong Yidong committed
597
		  up_event = Fread_event (Qnil, Qnil, Qnil);
598
	      }
599
	  }
600 601 602
	  break;

	case 'K':		/* Key sequence to be defined. */
603
	  {
Juanma Barranquero's avatar
Juanma Barranquero committed
604
	    int speccount1 = SPECPDL_INDEX ();
605
	    specbind (Qcursor_in_echo_area, Qt);
606 607 608 609
	    /* Prompt in `minibuffer-prompt' face.  */
	    Fput_text_property (make_number (0),
				make_number (SCHARS (callint_message)),
				Qface, Qminibuffer_prompt, callint_message);
610
	    args[i] = Fread_key_sequence (callint_message,
611
					  Qnil, Qt, Qnil, Qnil);
612
	    teml = args[i];
613
	    visargs[i] = Fkey_description (teml, Qnil);
614
	    unbind_to (speccount1, Qnil);
615 616 617 618 619

	    /* 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))
620
	      teml = XCAR (teml);
621 622 623 624 625
	    if (SYMBOLP (teml))
	      {
		Lisp_Object tem2;

		teml = Fget (teml, intern ("event-symbol-elements"));
626 627
		/* Ignore first element, which is the base key.  */
		tem2 = Fmemq (intern ("down"), Fcdr (teml));
628
		if (! NILP (tem2))
Chong Yidong's avatar
Chong Yidong committed
629
		  up_event = Fread_event (Qnil, Qnil, Qnil);
630
	      }
631
	  }
Michael I. Bushnell's avatar
Michael I. Bushnell committed
632 633
	  break;

634 635 636 637 638 639 640 641 642 643
	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;

644
	case 'e':		/* The invoking event.  */
645
	  if (next_event >= key_count)
646
	    error ("%s must be bound to an event with parameters",
647
		   (SYMBOLP (function)
648
		    ? SSDATA (SYMBOL_NAME (function))
649
		    : "command"));
650 651
	  args[i] = AREF (keys, next_event);
	  next_event++;
Jim Blandy's avatar
Jim Blandy committed
652
	  varies[i] = -1;
Jim Blandy's avatar
Jim Blandy committed
653 654

	  /* Find the next parameterized event.  */
655
	  while (next_event < key_count
656
		 && !(EVENT_HAS_PARAMETERS (AREF (keys, next_event))))
Jim Blandy's avatar
Jim Blandy committed
657 658
	    next_event++;

Jim Blandy's avatar
Jim Blandy committed
659 660
	  break;

Michael I. Bushnell's avatar
Michael I. Bushnell committed
661
	case 'm':		/* Value of mark.  Does not do I/O.  */
662
	  check_mark (0);
Michael I. Bushnell's avatar
Michael I. Bushnell committed
663
	  /* visargs[i] = Qnil; */
664
	  args[i] = current_buffer->mark;
Michael I. Bushnell's avatar
Michael I. Bushnell committed
665 666 667
	  varies[i] = 2;
	  break;

668 669
	case 'M':		/* String read via minibuffer with
				   inheriting the current input method.  */
670
	  args[i] = Fread_string (callint_message,
671 672 673
				  Qnil, Qnil, Qnil, Qt);
	  break;

Richard M. Stallman's avatar
Richard M. Stallman committed
674
	case 'N':		/* Prefix arg as number, else number from minibuffer */
Jim Blandy's avatar
Jim Blandy committed
675
	  if (!NILP (prefix_arg))
Michael I. Bushnell's avatar
Michael I. Bushnell committed
676 677
	    goto have_prefix_arg;
	case 'n':		/* Read number from minibuffer.  */
678 679 680 681 682
	  {
	    int first = 1;
	    do
	      {
		Lisp_Object tem;
683
		if (! first)
684 685
		  {
		    message ("Please enter a number.");
686
		    sit_for (make_number (1), 0, 0);
687 688 689
		  }
		first = 0;

690
		tem = Fread_from_minibuffer (callint_message,
691
					     Qnil, Qnil, Qnil, Qnil, Qnil,
692
					     Qnil);
693
		if (! STRINGP (tem) || SCHARS (tem) == 0)
694 695 696 697 698 699
		  args[i] = Qnil;
		else
		  args[i] = Fread (tem);
	      }
	    while (! NUMBERP (args[i]));
	  }
700
	  visargs[i] = args[i];
Michael I. Bushnell's avatar
Michael I. Bushnell committed
701 702 703 704 705 706 707 708 709
	  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. */
710
	have_prefix_arg:
Michael I. Bushnell's avatar
Michael I. Bushnell committed
711 712 713 714 715 716
	  args[i] = Fprefix_numeric_value (prefix_arg);
	  /* visargs[i] = Qnil; */
	  varies[i] = -1;
	  break;

	case 'r':		/* Region, point and mark as 2 args. */
717
	  check_mark (1);
718
	  set_marker_both (point_marker, Qnil, PT, PT_BYTE);
Michael I. Bushnell's avatar
Michael I. Bushnell committed
719 720 721
	  /* visargs[i+1] = Qnil; */
	  foo = marker_position (current_buffer->mark);
	  /* visargs[i] = Qnil; */
722
	  args[i] = PT < foo ? point_marker : current_buffer->mark;
Michael I. Bushnell's avatar
Michael I. Bushnell committed
723
	  varies[i] = 3;
724
	  args[++i] = PT > foo ? point_marker : current_buffer->mark;
Michael I. Bushnell's avatar
Michael I. Bushnell committed
725 726 727
	  varies[i] = 4;
	  break;

728 729
	case 's':		/* String read via minibuffer without
				   inheriting the current input method.  */
730
	  args[i] = Fread_string (callint_message,
731
				  Qnil, Qnil, Qnil, Qnil);
Michael I. Bushnell's avatar
Michael I. Bushnell committed
732 733 734
	  break;

	case 'S':		/* Any symbol.  */
735
	  visargs[i] = Fread_string (callint_message,
736
				     Qnil, Qnil, Qnil, Qnil);
Michael I. Bushnell's avatar
Michael I. Bushnell committed
737 738 739 740 741 742 743
	  /* Passing args[i] directly stimulates compiler bug */
	  teml = visargs[i];
	  args[i] = Fintern (teml, Qnil);
	  break;

	case 'v':		/* Variable name: symbol that is
				   user-variable-p. */
744
	  args[i] = Fread_variable (callint_message, Qnil);
Michael I. Bushnell's avatar
Michael I. Bushnell committed
745 746 747 748
	  visargs[i] = last_minibuf_string;
	  break;

	case 'x':		/* Lisp expression read but not evaluated */
749
	  args[i] = Fread_minibuffer (callint_message, Qnil);
Michael I. Bushnell's avatar
Michael I. Bushnell committed
750 751 752 753
	  visargs[i] = last_minibuf_string;
	  break;

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

758 759 760 761 762 763 764
	case 'Z':		/* Coding-system symbol, or ignore the
				   argument if no prefix */
	  if (NILP (prefix_arg))
	    {
	      args[i] = Qnil;
	      varies[i] = -1;
	    }
765
	  else
766 767
	    {
	      args[i]
768
		= Fread_non_nil_coding_system (callint_message);
769 770 771 772 773
	      visargs[i] = last_minibuf_string;
	    }
	  break;

	case 'z':		/* Coding-system symbol or nil */
774
	  args[i] = Fread_coding_system (callint_message, Qnil);
775 776 777
	  visargs[i] = last_minibuf_string;
	  break;

778 779 780
	  /* 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
781
	default:
782
	  error ("Invalid control letter `%c' (%03o) in interactive calling string",
Michael I. Bushnell's avatar
Michael I. Bushnell committed
783 784 785 786 787 788
		 *tem, *tem);
	}

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

789
      if (NILP (visargs[i]) && STRINGP (args[i]))
Michael I. Bushnell's avatar
Michael I. Bushnell committed
790 791
	visargs[i] = args[i];

792
      tem = (unsigned char *) strchr (tem, '\n');
Michael I. Bushnell's avatar
Michael I. Bushnell committed
793 794 795
      if (tem) tem++;
      else tem = (unsigned char *) "";
    }
Richard M. Stallman's avatar
Richard M. Stallman committed
796
  unbind_to (speccount, Qnil);
Michael I. Bushnell's avatar
Michael I. Bushnell committed
797 798 799 800 801

  QUIT;

  args[0] = function;

802
  if (arg_from_tty || !NILP (record_flag))
Michael I. Bushnell's avatar
Michael I. Bushnell committed
803 804
    {
      visargs[0] = function;
Jim Blandy's avatar
Jim Blandy committed
805
      for (i = 1; i < count + 1; i++)
806 807 808 809 810 811
	{
	  if (varies[i] > 0)
	    visargs[i] = Fcons (intern (callint_argfuns[varies[i]]), Qnil);
	  else
	    visargs[i] = quotify_arg (args[i]);
	}
Michael I. Bushnell's avatar
Michael I. Bushnell committed
812 813
      Vcommand_history = Fcons (Flist (count + 1, visargs),
				Vcommand_history);
814
      /* Don't keep command history around forever.  */
815
      if (INTEGERP (Vhistory_length) && XINT (Vhistory_length) > 0)
816 817 818
	{
	  teml = Fnthcdr (Vhistory_length, Vcommand_history);
	  if (CONSP (teml))
819
	    XSETCDR (teml, Qnil);
820
	}
Michael I. Bushnell's avatar
Michael I. Bushnell committed
821 822
    }

823 824
  /* If we used a marker to hold point, mark, or an end of the region,
     temporarily, convert it to an integer now.  */
825
  for (i = 1; i <= count; i++)
826 827 828
    if (varies[i] >= 1 && varies[i] <= 4)
      XSETINT (args[i], marker_position (args[i]));

829 830 831
  if (record_then_fail)
    Fbarf_if_buffer_read_only ();

832 833 834 835 836
  Vthis_command = save_this_command;
  Vthis_original_command = save_this_original_command;
  real_this_command= save_real_this_command;
  current_kboard->Vlast_command = save_last_command;

Michael I. Bushnell's avatar
Michael I. Bushnell committed
837 838 839 840
  {
    Lisp_Object val;
    specbind (Qcommand_debug_status, Qnil);

841
    temporarily_switch_to_single_kboard (NULL);
Michael I. Bushnell's avatar
Michael I. Bushnell committed
842 843 844 845
    val = Ffuncall (count + 1, args);
    UNGCPRO;
    return unbind_to (speccount, val);
  }
846
}
Michael I. Bushnell's avatar
Michael I. Bushnell committed
847 848

DEFUN ("prefix-numeric-value", Fprefix_numeric_value, Sprefix_numeric_value,
849 850 851 852
       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
853
  (Lisp_Object raw)
Michael I. Bushnell's avatar
Michael I. Bushnell committed
854 855
{
  Lisp_Object val;
856

Jim Blandy's avatar
Jim Blandy committed
857
  if (NILP (raw))
858
    XSETFASTINT (val, 1);
859
  else if (EQ (raw, Qminus))
Michael I. Bushnell's avatar
Michael I. Bushnell committed
860
    XSETINT (val, -1);
861 862
  else if (CONSP (raw) && INTEGERP (XCAR (raw)))
    XSETINT (val, XINT (XCAR (raw)));
863
  else if (INTEGERP (raw))
Michael I. Bushnell's avatar
Michael I. Bushnell committed
864 865
    val = raw;
  else
866
    XSETFASTINT (val, 1);
Michael I. Bushnell's avatar
Michael I. Bushnell committed
867 868 869 870

  return val;
}

Andreas Schwab's avatar
Andreas Schwab committed
871
void
872
syms_of_callint (void)
Michael I. Bushnell's avatar
Michael I. Bushnell committed
873
{
874 875 876
  point_marker = Fmake_marker ();
  staticpro (&point_marker);

877 878 879
  callint_message = Qnil;
  staticpro (&callint_message);

Dan Nicolaescu's avatar
Dan Nicolaescu committed
880 881 882 883
  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))));
884

Dan Nicolaescu's avatar
Dan Nicolaescu committed
885
  Qlist = intern_c_string ("list");
886
  staticpro (&Qlist);
Dan Nicolaescu's avatar
Dan Nicolaescu committed
887
  Qlet = intern_c_string ("let");
888
  staticpro (&Qlet);
Dan Nicolaescu's avatar
Dan Nicolaescu committed
889
  Qif = intern_c_string ("if");
890
  staticpro (&Qif);
Dan Nicolaescu's avatar
Dan Nicolaescu committed
891
  Qwhen = intern_c_string ("when");
892
  staticpro (&Qwhen);
Dan Nicolaescu's avatar
Dan Nicolaescu committed
893
  Qletx = intern_c_string ("let*");
894
  staticpro (&Qletx);
Dan Nicolaescu's avatar
Dan Nicolaescu committed
895
  Qsave_excursion = intern_c_string ("save-excursion");
896
  staticpro (&Qsave_excursion);
Dan Nicolaescu's avatar
Dan Nicolaescu committed
897
  Qprogn = intern_c_string ("progn");
898
  staticpro (&Qprogn);
899

Dan Nicolaescu's avatar
Dan Nicolaescu committed
900
  Qminus = intern_c_string ("-");
Michael I. Bushnell's avatar
Michael I. Bushnell committed
901 902
  staticpro (&Qminus);

Dan Nicolaescu's avatar
Dan Nicolaescu committed
903
  Qplus = intern_c_string ("+");