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