Update FSF's address in the preamble.
[bpt/emacs.git] / src / callint.c
CommitLineData
ec28a64d 1/* Call a Lisp function interactively.
4e87700b 2 Copyright (C) 1985, 1986, 1993, 1994, 1995 Free Software Foundation, Inc.
ec28a64d
MB
3
4This file is part of GNU Emacs.
5
6GNU Emacs is free software; you can redistribute it and/or modify
7it under the terms of the GNU General Public License as published by
dbc4e1c1 8the Free Software Foundation; either version 2, or (at your option)
ec28a64d
MB
9any later version.
10
11GNU Emacs is distributed in the hope that it will be useful,
12but WITHOUT ANY WARRANTY; without even the implied warranty of
13MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14GNU General Public License for more details.
15
16You should have received a copy of the GNU General Public License
17along with GNU Emacs; see the file COPYING. If not, write to
3b7ad313
EN
18the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19Boston, MA 02111-1307, USA. */
ec28a64d
MB
20
21
18160b98 22#include <config.h>
ec28a64d
MB
23#include "lisp.h"
24#include "buffer.h"
25#include "commands.h"
760cbdd3 26#include "keyboard.h"
ec28a64d
MB
27#include "window.h"
28#include "mocklisp.h"
29
30extern char *index ();
31
1e0c5826 32Lisp_Object Vcurrent_prefix_arg, Qminus, Qplus;
ec28a64d
MB
33Lisp_Object Qcall_interactively;
34Lisp_Object Vcommand_history;
35
36Lisp_Object Vcommand_debug_status, Qcommand_debug_status;
52614803 37Lisp_Object Qenable_recursive_minibuffers;
ec28a64d 38
9f315aeb
RS
39/* Non-nil means treat the mark as active
40 even if mark_active is 0. */
41Lisp_Object Vmark_even_if_inactive;
42
ef2515c0
RS
43Lisp_Object Vmouse_leave_buffer_hook, Qmouse_leave_buffer_hook;
44
8450690a 45Lisp_Object Qlist, Qlet, Qletx, Qsave_excursion;
824977b6
RS
46static Lisp_Object preserved_fns;
47
48/* Marker used within call-interactively to refer to point. */
49static Lisp_Object point_marker;
03e130d5 50
df31bc64
RS
51/* Buffer for the prompt text used in Fcall_interactively. */
52static char *callint_message;
53
54/* Allocated length of that buffer. */
55static int callint_message_size;
1cf9cfc6 56
ec28a64d
MB
57/* This comment supplies the doc string for interactive,
58 for make-docfile to see. We cannot put this in the real DEFUN
59 due to limits in the Unix cpp.
60
61DEFUN ("interactive", Ffoo, Sfoo, 0, 0, 0,
62 "Specify a way of parsing arguments for interactive use of a function.\n\
63For example, write\n\
64 (defun foo (arg) \"Doc string\" (interactive \"p\") ...use arg...)\n\
65to make ARG be the prefix argument when `foo' is called as a command.\n\
66The \"call\" to `interactive' is actually a declaration rather than a function;\n\
67 it tells `call-interactively' how to read arguments\n\
68 to pass to the function.\n\
69When actually called, `interactive' just returns nil.\n\
70\n\
71The argument of `interactive' is usually a string containing a code letter\n\
72 followed by a prompt. (Some code letters do not use I/O to get\n\
73 the argument and do not need prompts.) To prompt for multiple arguments,\n\
74 give a code letter, its prompt, a newline, and another code letter, etc.\n\
75 Prompts are passed to format, and may use % escapes to print the\n\
76 arguments that have already been read.\n\
77If the argument is not a string, it is evaluated to get a list of\n\
78 arguments to pass to the function.\n\
79Just `(interactive)' means pass no args when calling interactively.\n\
80\nCode letters available are:\n\
81a -- Function name: symbol with a function definition.\n\
82b -- Name of existing buffer.\n\
83B -- Name of buffer, possibly nonexistent.\n\
84c -- Character.\n\
85C -- Command name: symbol with interactive function definition.\n\
86d -- Value of point as number. Does not do I/O.\n\
87D -- Directory name.\n\
4d1f43c0
RS
88e -- Parametrized event (i.e., one that's a list) that invoked this command.\n\
89 If used more than once, the Nth `e' returns the Nth parameterized event.\n\
90 This skips events that are integers or symbols.\n\
ec28a64d
MB
91f -- Existing file name.\n\
92F -- Possibly nonexistent file name.\n\
b631003b
RS
93k -- Key sequence (downcase the last event if needed to get a definition).\n\
94K -- Key sequence to be redefined (do not downcase the last event).\n\
ec28a64d
MB
95m -- Value of mark as number. Does not do I/O.\n\
96n -- Number read using minibuffer.\n\
701ca6c0 97N -- Raw prefix arg, or if none, do like code `n'.\n\
ec28a64d
MB
98p -- Prefix arg converted to number. Does not do I/O.\n\
99P -- Prefix arg in raw form. Does not do I/O.\n\
100r -- Region: point and mark as 2 numeric args, smallest first. Does no I/O.\n\
101s -- Any string.\n\
102S -- Any symbol.\n\
103v -- Variable name: symbol that is user-variable-p.\n\
104x -- Lisp expression read but not evaluated.\n\
105X -- Lisp expression read and evaluated.\n\
106In addition, if the string begins with `*'\n\
107 then an error is signaled if the buffer is read-only.\n\
108 This happens before reading any arguments.\n\
dbc4e1c1
JB
109If the string begins with `@', then Emacs searches the key sequence\n\
110 which invoked the command for its first mouse click (or any other\n\
111 event which specifies a window), and selects that window before\n\
112 reading any arguments. You may use both `@' and `*'; they are\n\
113 processed in the order that they appear." */
ec28a64d
MB
114
115/* ARGSUSED */
116DEFUN ("interactive", Finteractive, Sinteractive, 0, UNEVALLED, 0,
117 0 /* See immediately above */)
118 (args)
119 Lisp_Object args;
120{
121 return Qnil;
122}
123
124/* Quotify EXP: if EXP is constant, return it.
125 If EXP is not constant, return (quote EXP). */
126Lisp_Object
127quotify_arg (exp)
128 register Lisp_Object exp;
129{
6e54b3de 130 if (!INTEGERP (exp) && !STRINGP (exp)
265a9e55 131 && !NILP (exp) && !EQ (exp, Qt))
ec28a64d
MB
132 return Fcons (Qquote, Fcons (exp, Qnil));
133
134 return exp;
135}
136
137/* Modify EXP by quotifying each element (except the first). */
138Lisp_Object
139quotify_args (exp)
140 Lisp_Object exp;
141{
142 register Lisp_Object tail;
143 register struct Lisp_Cons *ptr;
144 for (tail = exp; CONSP (tail); tail = ptr->cdr)
145 {
146 ptr = XCONS (tail);
147 ptr->car = quotify_arg (ptr->car);
148 }
149 return exp;
150}
151
152char *callint_argfuns[]
153 = {"", "point", "mark", "region-beginning", "region-end"};
154
155static void
156check_mark ()
157{
86c1cf23
KH
158 Lisp_Object tem;
159 tem = Fmarker_buffer (current_buffer->mark);
265a9e55 160 if (NILP (tem) || (XBUFFER (tem) != current_buffer))
ec28a64d 161 error ("The mark is not set now");
6497d2d8
RM
162 if (!NILP (Vtransient_mark_mode) && NILP (Vmark_even_if_inactive)
163 && NILP (current_buffer->mark_active))
164 Fsignal (Qmark_inactive, Qnil);
ec28a64d
MB
165}
166
167
d455db8e 168DEFUN ("call-interactively", Fcall_interactively, Scall_interactively, 1, 3, 0,
ec28a64d 169 "Call FUNCTION, reading args according to its interactive calling specs.\n\
994662ce 170Return the value FUNCTION returns.\n\
ec28a64d
MB
171The function contains a specification of how to do the argument reading.\n\
172In the case of user-defined functions, this is specified by placing a call\n\
173to the function `interactive' at the top level of the function body.\n\
174See `interactive'.\n\
175\n\
176Optional second arg RECORD-FLAG non-nil\n\
177means unconditionally put this command in the command-history.\n\
6bc1abf2 178Otherwise, this is done only if an arg is read using the minibuffer.")
7868a977
EN
179 (function, record_flag, keys)
180 Lisp_Object function, record_flag, keys;
ec28a64d
MB
181{
182 Lisp_Object *args, *visargs;
183 unsigned char **argstrings;
184 Lisp_Object fun;
185 Lisp_Object funcar;
186 Lisp_Object specs;
187 Lisp_Object teml;
52614803
RS
188 Lisp_Object enable;
189 int speccount = specpdl_ptr - specpdl;
ec28a64d 190
bc78232c
JB
191 /* The index of the next element of this_command_keys to examine for
192 the 'e' interactive code. */
dbc4e1c1 193 int next_event;
bc78232c 194
ec28a64d
MB
195 Lisp_Object prefix_arg;
196 unsigned char *string;
197 unsigned char *tem;
63007de2
JB
198
199 /* If varies[i] > 0, the i'th argument shouldn't just have its value
200 in this call quoted in the command history. It should be
201 recorded as a call to the function named callint_argfuns[varies[i]]. */
ec28a64d 202 int *varies;
63007de2 203
ec28a64d
MB
204 register int i, j;
205 int count, foo;
ec28a64d
MB
206 char prompt1[100];
207 char *tem1;
208 int arg_from_tty = 0;
209 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
d455db8e
RS
210 int key_count;
211
212 if (NILP (keys))
213 keys = this_command_keys, key_count = this_command_key_count;
214 else
215 {
216 CHECK_VECTOR (keys, 3);
217 key_count = XVECTOR (keys)->size;
218 }
ec28a64d 219
e5d77022 220 /* Save this now, since use of minibuffer will clobber it. */
8c917bf2 221 prefix_arg = Vcurrent_prefix_arg;
ec28a64d 222
46947372 223 retry:
ec28a64d 224
6e54b3de 225 if (SYMBOLP (function))
afa4c0f3 226 enable = Fget (function, Qenable_recursive_minibuffers);
52614803 227
ffd56f97 228 fun = indirect_function (function);
ec28a64d
MB
229
230 specs = Qnil;
231 string = 0;
232
233 /* Decode the kind of function. Either handle it and return,
234 or go to `lose' if not interactive, or go to `retry'
235 to specify a different function, or set either STRING or SPECS. */
236
6e54b3de 237 if (SUBRP (fun))
ec28a64d
MB
238 {
239 string = (unsigned char *) XSUBR (fun)->prompt;
240 if (!string)
241 {
242 lose:
b37902c8 243 function = wrong_type_argument (Qcommandp, function);
ec28a64d
MB
244 goto retry;
245 }
132b9337 246 if ((EMACS_INT) string == 1)
ec28a64d
MB
247 /* Let SPECS (which is nil) be used as the args. */
248 string = 0;
249 }
6e54b3de 250 else if (COMPILEDP (fun))
ec28a64d 251 {
f9b4aacf 252 if ((XVECTOR (fun)->size & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_INTERACTIVE)
ec28a64d
MB
253 goto lose;
254 specs = XVECTOR (fun)->contents[COMPILED_INTERACTIVE];
255 }
256 else if (!CONSP (fun))
257 goto lose;
258 else if (funcar = Fcar (fun), EQ (funcar, Qautoload))
259 {
260 GCPRO2 (function, prefix_arg);
261 do_autoload (fun, function);
262 UNGCPRO;
263 goto retry;
264 }
265 else if (EQ (funcar, Qlambda))
266 {
267 specs = Fassq (Qinteractive, Fcdr (Fcdr (fun)));
265a9e55 268 if (NILP (specs))
ec28a64d
MB
269 goto lose;
270 specs = Fcar (Fcdr (specs));
271 }
272 else if (EQ (funcar, Qmocklisp))
887e0cba 273 {
652e2240 274 single_kboard_state ();
887e0cba
KH
275 return ml_apply (fun, Qinteractive);
276 }
ec28a64d
MB
277 else
278 goto lose;
279
46947372 280 /* If either specs or string is set to a string, use it. */
6e54b3de 281 if (STRINGP (specs))
46947372
JB
282 {
283 /* Make a copy of string so that if a GC relocates specs,
284 `string' will still be valid. */
e5d77022 285 string = (unsigned char *) alloca (XSTRING (specs)->size + 1);
46947372
JB
286 bcopy (XSTRING (specs)->data, string, XSTRING (specs)->size + 1);
287 }
ec28a64d
MB
288 else if (string == 0)
289 {
03e130d5 290 Lisp_Object input;
ec28a64d 291 i = num_input_chars;
03e130d5
RS
292 input = specs;
293 /* Compute the arg values using the user's expression. */
6bc1abf2 294 specs = Feval (specs);
7868a977 295 if (i != num_input_chars || !NILP (record_flag))
03e130d5
RS
296 {
297 /* We should record this command on the command history. */
298 Lisp_Object values, car;
299 /* Make a copy of the list of values, for the command history,
300 and turn them into things we can eval. */
301 values = quotify_args (Fcopy_sequence (specs));
302 /* If the list of args was produced with an explicit call to `list',
303 look for elements that were computed with (region-beginning)
304 or (region-end), and put those expressions into VALUES
305 instead of the present values. */
8450690a 306 if (CONSP (input))
03e130d5 307 {
8450690a
RS
308 car = XCONS (input)->car;
309 /* Skip through certain special forms. */
310 while (EQ (car, Qlet) || EQ (car, Qletx)
311 || EQ (car, Qsave_excursion))
03e130d5 312 {
8450690a
RS
313 while (CONSP (XCONS (input)->cdr))
314 input = XCONS (input)->cdr;
315 input = XCONS (input)->car;
316 if (!CONSP (input))
317 break;
318 car = XCONS (input)->car;
319 }
320 if (EQ (car, Qlist))
321 {
322 Lisp_Object intail, valtail;
323 for (intail = Fcdr (input), valtail = values;
324 CONSP (valtail);
325 intail = Fcdr (intail), valtail = Fcdr (valtail))
03e130d5 326 {
8450690a
RS
327 Lisp_Object elt;
328 elt = Fcar (intail);
329 if (CONSP (elt))
330 {
331 Lisp_Object presflag;
332 presflag = Fmemq (Fcar (elt), preserved_fns);
333 if (!NILP (presflag))
334 Fsetcar (valtail, Fcar (intail));
335 }
03e130d5
RS
336 }
337 }
338 }
339 Vcommand_history
340 = Fcons (Fcons (function, values), Vcommand_history);
341 }
652e2240 342 single_kboard_state ();
ec28a64d
MB
343 return apply1 (function, specs);
344 }
345
346 /* Here if function specifies a string to control parsing the defaults */
347
dbc4e1c1 348 /* Set next_event to point to the first event with parameters. */
d455db8e
RS
349 for (next_event = 0; next_event < key_count; next_event++)
350 if (EVENT_HAS_PARAMETERS (XVECTOR (keys)->contents[next_event]))
dbc4e1c1
JB
351 break;
352
42bb2790 353 /* Handle special starting chars `*' and `@'. Also `-'. */
e92d107b 354 /* Note that `+' is reserved for user extensions. */
ec28a64d
MB
355 while (1)
356 {
fb775602 357 if (*string == '+')
e92d107b
RS
358 error ("`+' is not used in `interactive' for ordinary commands");
359 else if (*string == '*')
ec28a64d
MB
360 {
361 string++;
265a9e55 362 if (!NILP (current_buffer->read_only))
ec28a64d
MB
363 Fbarf_if_buffer_read_only ();
364 }
42bb2790
RS
365 /* Ignore this for semi-compatibility with Lucid. */
366 else if (*string == '-')
367 string++;
ec28a64d
MB
368 else if (*string == '@')
369 {
86c1cf23 370 Lisp_Object event;
dbc4e1c1 371
d455db8e 372 event = XVECTOR (keys)->contents[next_event];
dbc4e1c1 373 if (EVENT_HAS_PARAMETERS (event)
21ba0e68 374 && (event = XCONS (event)->cdr, CONSP (event))
6e54b3de 375 && (event = XCONS (event)->car, CONSP (event))
a6d1245e 376 && (event = XCONS (event)->car, WINDOWP (event)))
d1fa2e8a 377 {
d68807fc 378 if (MINI_WINDOW_P (XWINDOW (event))
42bb2790 379 && ! (minibuf_level > 0 && EQ (event, minibuf_window)))
d1fa2e8a 380 error ("Attempt to select inactive minibuffer window");
ef2515c0
RS
381
382 /* If the current buffer wants to clean up, let it. */
383 if (!NILP (Vmouse_leave_buffer_hook))
384 call1 (Vrun_hooks, Qmouse_leave_buffer_hook);
385
d1fa2e8a
KH
386 Fselect_window (event);
387 }
ec28a64d 388 string++;
ec28a64d
MB
389 }
390 else break;
391 }
392
393 /* Count the number of arguments the interactive spec would have
394 us give to the function. */
395 tem = string;
396 for (j = 0; *tem; j++)
397 {
398 /* 'r' specifications ("point and mark as 2 numeric args")
399 produce *two* arguments. */
400 if (*tem == 'r') j++;
401 tem = (unsigned char *) index (tem, '\n');
402 if (tem)
403 tem++;
404 else
405 tem = (unsigned char *) "";
406 }
6bc1abf2 407 count = j;
ec28a64d
MB
408
409 args = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object));
410 visargs = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object));
411 argstrings = (unsigned char **) alloca ((count + 1) * sizeof (char *));
412 varies = (int *) alloca ((count + 1) * sizeof (int));
413
414 for (i = 0; i < (count + 1); i++)
415 {
416 args[i] = Qnil;
417 visargs[i] = Qnil;
418 varies[i] = 0;
419 }
420
421 GCPRO4 (prefix_arg, function, *args, *visargs);
422 gcpro3.nvars = (count + 1);
423 gcpro4.nvars = (count + 1);
424
52614803
RS
425 if (!NILP (enable))
426 specbind (Qenable_recursive_minibuffers, Qt);
427
ec28a64d 428 tem = string;
6bc1abf2 429 for (i = 1; *tem; i++)
ec28a64d
MB
430 {
431 strncpy (prompt1, tem + 1, sizeof prompt1 - 1);
432 prompt1[sizeof prompt1 - 1] = 0;
433 tem1 = index (prompt1, '\n');
434 if (tem1) *tem1 = 0;
435 /* Fill argstrings with a vector of C strings
436 corresponding to the Lisp strings in visargs. */
437 for (j = 1; j < i; j++)
438 argstrings[j]
439 = EQ (visargs[j], Qnil)
440 ? (unsigned char *) ""
46947372 441 : XSTRING (visargs[j])->data;
ec28a64d 442
df31bc64
RS
443 /* Process the format-string in prompt1, putting the output
444 into callint_message. Make callint_message bigger if necessary.
445 We don't use a buffer on the stack, because the contents
446 need to stay stable for a while. */
447 while (1)
448 {
449 int nchars = doprnt (callint_message, callint_message_size,
450 prompt1, (char *)0,
451 j - 1, argstrings + 1);
452 if (nchars < callint_message_size)
453 break;
454 callint_message_size *= 2;
455 callint_message
456 = (char *) xrealloc (callint_message, callint_message_size);
457 }
ec28a64d
MB
458
459 switch (*tem)
460 {
461 case 'a': /* Symbol defined as a function */
df31bc64 462 visargs[i] = Fcompleting_read (build_string (callint_message),
ec28a64d
MB
463 Vobarray, Qfboundp, Qt, Qnil, Qnil);
464 /* Passing args[i] directly stimulates compiler bug */
465 teml = visargs[i];
466 args[i] = Fintern (teml, Qnil);
467 break;
468
469 case 'b': /* Name of existing buffer */
470 args[i] = Fcurrent_buffer ();
471 if (EQ (selected_window, minibuf_window))
9262fcb6 472 args[i] = Fother_buffer (args[i], Qnil);
df31bc64 473 args[i] = Fread_buffer (build_string (callint_message), args[i], Qt);
ec28a64d
MB
474 break;
475
476 case 'B': /* Name of buffer, possibly nonexistent */
df31bc64 477 args[i] = Fread_buffer (build_string (callint_message),
9262fcb6
RS
478 Fother_buffer (Fcurrent_buffer (), Qnil),
479 Qnil);
ec28a64d
MB
480 break;
481
482 case 'c': /* Character */
453ed650 483 message1_nolog (callint_message);
ec28a64d 484 args[i] = Fread_char ();
453ed650 485 message1_nolog ((char *) 0);
ec28a64d
MB
486 /* Passing args[i] directly stimulates compiler bug */
487 teml = args[i];
488 visargs[i] = Fchar_to_string (teml);
489 break;
490
491 case 'C': /* Command: symbol with interactive function */
df31bc64 492 visargs[i] = Fcompleting_read (build_string (callint_message),
ec28a64d
MB
493 Vobarray, Qcommandp, Qt, Qnil, Qnil);
494 /* Passing args[i] directly stimulates compiler bug */
495 teml = visargs[i];
496 args[i] = Fintern (teml, Qnil);
497 break;
498
499 case 'd': /* Value of point. Does not do I/O. */
824977b6
RS
500 Fset_marker (point_marker, make_number (PT), Qnil);
501 args[i] = point_marker;
ec28a64d
MB
502 /* visargs[i] = Qnil; */
503 varies[i] = 1;
504 break;
505
ec28a64d 506 case 'D': /* Directory name. */
df31bc64 507 args[i] = Fread_file_name (build_string (callint_message), Qnil,
ec28a64d
MB
508 current_buffer->directory, Qlambda, Qnil);
509 break;
510
511 case 'f': /* Existing file name. */
df31bc64 512 args[i] = Fread_file_name (build_string (callint_message),
ec28a64d
MB
513 Qnil, Qnil, Qlambda, Qnil);
514 break;
515
516 case 'F': /* Possibly nonexistent file name. */
df31bc64 517 args[i] = Fread_file_name (build_string (callint_message),
ec28a64d
MB
518 Qnil, Qnil, Qnil, Qnil);
519 break;
520
1989e7bc 521 case 'k': /* Key sequence. */
df31bc64
RS
522 args[i] = Fread_key_sequence (build_string (callint_message),
523 Qnil, Qnil, Qnil);
1989e7bc
RS
524 teml = args[i];
525 visargs[i] = Fkey_description (teml);
526 break;
527
528 case 'K': /* Key sequence to be defined. */
df31bc64
RS
529 args[i] = Fread_key_sequence (build_string (callint_message),
530 Qnil, Qt, Qnil);
ec28a64d
MB
531 teml = args[i];
532 visargs[i] = Fkey_description (teml);
533 break;
534
bc78232c 535 case 'e': /* The invoking event. */
d455db8e 536 if (next_event >= key_count)
bc78232c 537 error ("%s must be bound to an event with parameters",
6e54b3de 538 (SYMBOLP (function)
63007de2 539 ? (char *) XSYMBOL (function)->name->data
bc78232c 540 : "command"));
d455db8e 541 args[i] = XVECTOR (keys)->contents[next_event++];
e5d77022 542 varies[i] = -1;
dbc4e1c1
JB
543
544 /* Find the next parameterized event. */
d455db8e 545 while (next_event < key_count
dbc4e1c1 546 && ! (EVENT_HAS_PARAMETERS
d455db8e 547 (XVECTOR (keys)->contents[next_event])))
dbc4e1c1
JB
548 next_event++;
549
63007de2
JB
550 break;
551
ec28a64d
MB
552 case 'm': /* Value of mark. Does not do I/O. */
553 check_mark ();
554 /* visargs[i] = Qnil; */
824977b6 555 args[i] = current_buffer->mark;
ec28a64d
MB
556 varies[i] = 2;
557 break;
558
559 case 'N': /* Prefix arg, else number from minibuffer */
265a9e55 560 if (!NILP (prefix_arg))
ec28a64d
MB
561 goto have_prefix_arg;
562 case 'n': /* Read number from minibuffer. */
563 do
df31bc64 564 args[i] = Fread_minibuffer (build_string (callint_message), Qnil);
4746118a 565 while (! NUMBERP (args[i]));
ec28a64d
MB
566 visargs[i] = last_minibuf_string;
567 break;
568
569 case 'P': /* Prefix arg in raw form. Does no I/O. */
ec28a64d
MB
570 args[i] = prefix_arg;
571 /* visargs[i] = Qnil; */
572 varies[i] = -1;
573 break;
574
575 case 'p': /* Prefix arg converted to number. No I/O. */
71eda2d5 576 have_prefix_arg:
ec28a64d
MB
577 args[i] = Fprefix_numeric_value (prefix_arg);
578 /* visargs[i] = Qnil; */
579 varies[i] = -1;
580 break;
581
582 case 'r': /* Region, point and mark as 2 args. */
583 check_mark ();
824977b6 584 Fset_marker (point_marker, make_number (PT), Qnil);
ec28a64d
MB
585 /* visargs[i+1] = Qnil; */
586 foo = marker_position (current_buffer->mark);
587 /* visargs[i] = Qnil; */
824977b6 588 args[i] = point < foo ? point_marker : current_buffer->mark;
ec28a64d 589 varies[i] = 3;
824977b6 590 args[++i] = point > foo ? point_marker : current_buffer->mark;
ec28a64d
MB
591 varies[i] = 4;
592 break;
593
594 case 's': /* String read via minibuffer. */
df31bc64 595 args[i] = Fread_string (build_string (callint_message), Qnil, Qnil);
ec28a64d
MB
596 break;
597
598 case 'S': /* Any symbol. */
df31bc64
RS
599 visargs[i] = Fread_string (build_string (callint_message),
600 Qnil, Qnil);
ec28a64d
MB
601 /* Passing args[i] directly stimulates compiler bug */
602 teml = visargs[i];
603 args[i] = Fintern (teml, Qnil);
604 break;
605
606 case 'v': /* Variable name: symbol that is
607 user-variable-p. */
df31bc64 608 args[i] = Fread_variable (build_string (callint_message));
ec28a64d
MB
609 visargs[i] = last_minibuf_string;
610 break;
611
612 case 'x': /* Lisp expression read but not evaluated */
df31bc64 613 args[i] = Fread_minibuffer (build_string (callint_message), Qnil);
ec28a64d
MB
614 visargs[i] = last_minibuf_string;
615 break;
616
617 case 'X': /* Lisp expression read and evaluated */
df31bc64 618 args[i] = Feval_minibuffer (build_string (callint_message), Qnil);
ec28a64d
MB
619 visargs[i] = last_minibuf_string;
620 break;
621
e92d107b
RS
622 /* We have a case for `+' so we get an error
623 if anyone tries to define one here. */
624 case '+':
ec28a64d 625 default:
e92d107b 626 error ("Invalid control letter `%c' (%03o) in interactive calling string",
ec28a64d
MB
627 *tem, *tem);
628 }
629
630 if (varies[i] == 0)
631 arg_from_tty = 1;
632
6e54b3de 633 if (NILP (visargs[i]) && STRINGP (args[i]))
ec28a64d
MB
634 visargs[i] = args[i];
635
636 tem = (unsigned char *) index (tem, '\n');
637 if (tem) tem++;
638 else tem = (unsigned char *) "";
639 }
52614803 640 unbind_to (speccount, Qnil);
ec28a64d
MB
641
642 QUIT;
643
644 args[0] = function;
645
7868a977 646 if (arg_from_tty || !NILP (record_flag))
ec28a64d
MB
647 {
648 visargs[0] = function;
63007de2 649 for (i = 1; i < count + 1; i++)
824977b6
RS
650 {
651 if (varies[i] > 0)
652 visargs[i] = Fcons (intern (callint_argfuns[varies[i]]), Qnil);
653 else
654 visargs[i] = quotify_arg (args[i]);
655 }
ec28a64d
MB
656 Vcommand_history = Fcons (Flist (count + 1, visargs),
657 Vcommand_history);
658 }
659
824977b6
RS
660 /* If we used a marker to hold point, mark, or an end of the region,
661 temporarily, convert it to an integer now. */
f4c8ded2 662 for (i = 1; i <= count; i++)
824977b6
RS
663 if (varies[i] >= 1 && varies[i] <= 4)
664 XSETINT (args[i], marker_position (args[i]));
665
652e2240 666 single_kboard_state ();
ebfbe249 667
ec28a64d
MB
668 {
669 Lisp_Object val;
ec28a64d
MB
670 specbind (Qcommand_debug_status, Qnil);
671
672 val = Ffuncall (count + 1, args);
673 UNGCPRO;
674 return unbind_to (speccount, val);
675 }
676}
677
678DEFUN ("prefix-numeric-value", Fprefix_numeric_value, Sprefix_numeric_value,
679 1, 1, 0,
7868a977 680 "Return numeric meaning of raw prefix argument RAW.\n\
ec28a64d
MB
681A raw prefix argument is what you get from `(interactive \"P\")'.\n\
682Its numeric meaning is what you would get from `(interactive \"p\")'.")
683 (raw)
684 Lisp_Object raw;
685{
686 Lisp_Object val;
687
265a9e55 688 if (NILP (raw))
acab6442 689 XSETFASTINT (val, 1);
fd5285f3 690 else if (EQ (raw, Qminus))
ec28a64d 691 XSETINT (val, -1);
3399a477 692 else if (CONSP (raw) && INTEGERP (XCONS (raw)->car))
ec28a64d 693 XSETINT (val, XINT (XCONS (raw)->car));
6e54b3de 694 else if (INTEGERP (raw))
ec28a64d
MB
695 val = raw;
696 else
acab6442 697 XSETFASTINT (val, 1);
ec28a64d
MB
698
699 return val;
700}
701
702syms_of_callint ()
703{
824977b6
RS
704 point_marker = Fmake_marker ();
705 staticpro (&point_marker);
706
03e130d5
RS
707 preserved_fns = Fcons (intern ("region-beginning"),
708 Fcons (intern ("region-end"),
709 Fcons (intern ("point"),
710 Fcons (intern ("mark"), Qnil))));
711 staticpro (&preserved_fns);
712
713 Qlist = intern ("list");
714 staticpro (&Qlist);
8450690a
RS
715 Qlet = intern ("let");
716 staticpro (&Qlet);
717 Qletx = intern ("let*");
718 staticpro (&Qletx);
719 Qsave_excursion = intern ("save-excursion");
720 staticpro (&Qsave_excursion);
03e130d5 721
ec28a64d
MB
722 Qminus = intern ("-");
723 staticpro (&Qminus);
724
fdb4a38c
RS
725 Qplus = intern ("+");
726 staticpro (&Qplus);
727
ec28a64d
MB
728 Qcall_interactively = intern ("call-interactively");
729 staticpro (&Qcall_interactively);
730
731 Qcommand_debug_status = intern ("command-debug-status");
732 staticpro (&Qcommand_debug_status);
733
52614803
RS
734 Qenable_recursive_minibuffers = intern ("enable-recursive-minibuffers");
735 staticpro (&Qenable_recursive_minibuffers);
736
ef2515c0
RS
737 Qmouse_leave_buffer_hook = intern ("mouse-leave-buffer-hook");
738 staticpro (&Qmouse_leave_buffer_hook);
739
df31bc64
RS
740 callint_message_size = 100;
741 callint_message = (char *) xmalloc (callint_message_size);
742
743
1e0c5826 744 DEFVAR_KBOARD ("prefix-arg", Vprefix_arg,
8c917bf2
KH
745 "The value of the prefix argument for the next editing command.\n\
746It may be a number, or the symbol `-' for just a minus sign as arg,\n\
747or a list whose car is a number for just one or more C-U's\n\
748or nil if no argument has been specified.\n\
749\n\
750You cannot examine this variable to find the argument for this command\n\
751since it has been set to nil by the time you can look.\n\
752Instead, you should use the variable `current-prefix-arg', although\n\
753normally commands can get this prefix argument with (interactive \"P\").");
8c917bf2
KH
754
755 DEFVAR_LISP ("current-prefix-arg", &Vcurrent_prefix_arg,
756 "The value of the prefix argument for this editing command.\n\
757It may be a number, or the symbol `-' for just a minus sign as arg,\n\
758or a list whose car is a number for just one or more C-U's\n\
759or nil if no argument has been specified.\n\
760This is what `(interactive \"P\")' returns.");
761 Vcurrent_prefix_arg = Qnil;
762
ec28a64d
MB
763 DEFVAR_LISP ("command-history", &Vcommand_history,
764 "List of recent commands that read arguments from terminal.\n\
765Each command is represented as a form to evaluate.");
766 Vcommand_history = Qnil;
767
768 DEFVAR_LISP ("command-debug-status", &Vcommand_debug_status,
769 "Debugging status of current interactive command.\n\
770Bound each time `call-interactively' is called;\n\
771may be set by the debugger as a reminder for itself.");
772 Vcommand_debug_status = Qnil;
773
2ad6c959 774 DEFVAR_LISP ("mark-even-if-inactive", &Vmark_even_if_inactive,
9f315aeb
RS
775 "*Non-nil means you can use the mark even when inactive.\n\
776This option makes a difference in Transient Mark mode.\n\
777When the option is non-nil, deactivation of the mark\n\
778turns off region highlighting, but commands that use the mark\n\
779behave as if the mark were still active.");
780 Vmark_even_if_inactive = Qnil;
781
ef2515c0
RS
782 DEFVAR_LISP ("mouse-leave-buffer-hook", &Vmouse_leave_buffer_hook,
783 "Hook to run when about to switch windows with a mouse command.\n\
784Its purpose is to give temporary modes such as Isearch mode\n\
785a way to turn themselves off when a mouse command switches windows.");
786 Vmouse_leave_buffer_hook = Qnil;
787
ec28a64d
MB
788 defsubr (&Sinteractive);
789 defsubr (&Scall_interactively);
790 defsubr (&Sprefix_numeric_value);
791}