(syms_of_alloc): Set up Lisp variables ...-consed,
[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 */
491ee841
RS
483 /* Use message_nolog rather than message1_nolog here,
484 so that nothing bad happens if callint_message is changed
485 within Fread_char (by a timer, for example). */
486 message_nolog ("%s", callint_message);
ec28a64d 487 args[i] = Fread_char ();
453ed650 488 message1_nolog ((char *) 0);
ec28a64d
MB
489 /* Passing args[i] directly stimulates compiler bug */
490 teml = args[i];
491 visargs[i] = Fchar_to_string (teml);
492 break;
493
494 case 'C': /* Command: symbol with interactive function */
df31bc64 495 visargs[i] = Fcompleting_read (build_string (callint_message),
ec28a64d
MB
496 Vobarray, Qcommandp, Qt, Qnil, Qnil);
497 /* Passing args[i] directly stimulates compiler bug */
498 teml = visargs[i];
499 args[i] = Fintern (teml, Qnil);
500 break;
501
502 case 'd': /* Value of point. Does not do I/O. */
824977b6
RS
503 Fset_marker (point_marker, make_number (PT), Qnil);
504 args[i] = point_marker;
ec28a64d
MB
505 /* visargs[i] = Qnil; */
506 varies[i] = 1;
507 break;
508
ec28a64d 509 case 'D': /* Directory name. */
df31bc64 510 args[i] = Fread_file_name (build_string (callint_message), Qnil,
ec28a64d
MB
511 current_buffer->directory, Qlambda, Qnil);
512 break;
513
514 case 'f': /* Existing file name. */
df31bc64 515 args[i] = Fread_file_name (build_string (callint_message),
ec28a64d
MB
516 Qnil, Qnil, Qlambda, Qnil);
517 break;
518
519 case 'F': /* Possibly nonexistent file name. */
df31bc64 520 args[i] = Fread_file_name (build_string (callint_message),
ec28a64d
MB
521 Qnil, Qnil, Qnil, Qnil);
522 break;
523
1989e7bc 524 case 'k': /* Key sequence. */
df31bc64
RS
525 args[i] = Fread_key_sequence (build_string (callint_message),
526 Qnil, Qnil, Qnil);
1989e7bc
RS
527 teml = args[i];
528 visargs[i] = Fkey_description (teml);
529 break;
530
531 case 'K': /* Key sequence to be defined. */
df31bc64
RS
532 args[i] = Fread_key_sequence (build_string (callint_message),
533 Qnil, Qt, Qnil);
ec28a64d
MB
534 teml = args[i];
535 visargs[i] = Fkey_description (teml);
536 break;
537
bc78232c 538 case 'e': /* The invoking event. */
d455db8e 539 if (next_event >= key_count)
bc78232c 540 error ("%s must be bound to an event with parameters",
6e54b3de 541 (SYMBOLP (function)
63007de2 542 ? (char *) XSYMBOL (function)->name->data
bc78232c 543 : "command"));
d455db8e 544 args[i] = XVECTOR (keys)->contents[next_event++];
e5d77022 545 varies[i] = -1;
dbc4e1c1
JB
546
547 /* Find the next parameterized event. */
d455db8e 548 while (next_event < key_count
dbc4e1c1 549 && ! (EVENT_HAS_PARAMETERS
d455db8e 550 (XVECTOR (keys)->contents[next_event])))
dbc4e1c1
JB
551 next_event++;
552
63007de2
JB
553 break;
554
ec28a64d
MB
555 case 'm': /* Value of mark. Does not do I/O. */
556 check_mark ();
557 /* visargs[i] = Qnil; */
824977b6 558 args[i] = current_buffer->mark;
ec28a64d
MB
559 varies[i] = 2;
560 break;
561
562 case 'N': /* Prefix arg, else number from minibuffer */
265a9e55 563 if (!NILP (prefix_arg))
ec28a64d
MB
564 goto have_prefix_arg;
565 case 'n': /* Read number from minibuffer. */
566 do
df31bc64 567 args[i] = Fread_minibuffer (build_string (callint_message), Qnil);
4746118a 568 while (! NUMBERP (args[i]));
ec28a64d
MB
569 visargs[i] = last_minibuf_string;
570 break;
571
572 case 'P': /* Prefix arg in raw form. Does no I/O. */
ec28a64d
MB
573 args[i] = prefix_arg;
574 /* visargs[i] = Qnil; */
575 varies[i] = -1;
576 break;
577
578 case 'p': /* Prefix arg converted to number. No I/O. */
71eda2d5 579 have_prefix_arg:
ec28a64d
MB
580 args[i] = Fprefix_numeric_value (prefix_arg);
581 /* visargs[i] = Qnil; */
582 varies[i] = -1;
583 break;
584
585 case 'r': /* Region, point and mark as 2 args. */
586 check_mark ();
824977b6 587 Fset_marker (point_marker, make_number (PT), Qnil);
ec28a64d
MB
588 /* visargs[i+1] = Qnil; */
589 foo = marker_position (current_buffer->mark);
590 /* visargs[i] = Qnil; */
824977b6 591 args[i] = point < foo ? point_marker : current_buffer->mark;
ec28a64d 592 varies[i] = 3;
824977b6 593 args[++i] = point > foo ? point_marker : current_buffer->mark;
ec28a64d
MB
594 varies[i] = 4;
595 break;
596
597 case 's': /* String read via minibuffer. */
df31bc64 598 args[i] = Fread_string (build_string (callint_message), Qnil, Qnil);
ec28a64d
MB
599 break;
600
601 case 'S': /* Any symbol. */
df31bc64
RS
602 visargs[i] = Fread_string (build_string (callint_message),
603 Qnil, Qnil);
ec28a64d
MB
604 /* Passing args[i] directly stimulates compiler bug */
605 teml = visargs[i];
606 args[i] = Fintern (teml, Qnil);
607 break;
608
609 case 'v': /* Variable name: symbol that is
610 user-variable-p. */
df31bc64 611 args[i] = Fread_variable (build_string (callint_message));
ec28a64d
MB
612 visargs[i] = last_minibuf_string;
613 break;
614
615 case 'x': /* Lisp expression read but not evaluated */
df31bc64 616 args[i] = Fread_minibuffer (build_string (callint_message), Qnil);
ec28a64d
MB
617 visargs[i] = last_minibuf_string;
618 break;
619
620 case 'X': /* Lisp expression read and evaluated */
df31bc64 621 args[i] = Feval_minibuffer (build_string (callint_message), Qnil);
ec28a64d
MB
622 visargs[i] = last_minibuf_string;
623 break;
624
e92d107b
RS
625 /* We have a case for `+' so we get an error
626 if anyone tries to define one here. */
627 case '+':
ec28a64d 628 default:
e92d107b 629 error ("Invalid control letter `%c' (%03o) in interactive calling string",
ec28a64d
MB
630 *tem, *tem);
631 }
632
633 if (varies[i] == 0)
634 arg_from_tty = 1;
635
6e54b3de 636 if (NILP (visargs[i]) && STRINGP (args[i]))
ec28a64d
MB
637 visargs[i] = args[i];
638
639 tem = (unsigned char *) index (tem, '\n');
640 if (tem) tem++;
641 else tem = (unsigned char *) "";
642 }
52614803 643 unbind_to (speccount, Qnil);
ec28a64d
MB
644
645 QUIT;
646
647 args[0] = function;
648
7868a977 649 if (arg_from_tty || !NILP (record_flag))
ec28a64d
MB
650 {
651 visargs[0] = function;
63007de2 652 for (i = 1; i < count + 1; i++)
824977b6
RS
653 {
654 if (varies[i] > 0)
655 visargs[i] = Fcons (intern (callint_argfuns[varies[i]]), Qnil);
656 else
657 visargs[i] = quotify_arg (args[i]);
658 }
ec28a64d
MB
659 Vcommand_history = Fcons (Flist (count + 1, visargs),
660 Vcommand_history);
661 }
662
824977b6
RS
663 /* If we used a marker to hold point, mark, or an end of the region,
664 temporarily, convert it to an integer now. */
f4c8ded2 665 for (i = 1; i <= count; i++)
824977b6
RS
666 if (varies[i] >= 1 && varies[i] <= 4)
667 XSETINT (args[i], marker_position (args[i]));
668
652e2240 669 single_kboard_state ();
ebfbe249 670
ec28a64d
MB
671 {
672 Lisp_Object val;
ec28a64d
MB
673 specbind (Qcommand_debug_status, Qnil);
674
675 val = Ffuncall (count + 1, args);
676 UNGCPRO;
677 return unbind_to (speccount, val);
678 }
679}
680
681DEFUN ("prefix-numeric-value", Fprefix_numeric_value, Sprefix_numeric_value,
682 1, 1, 0,
7868a977 683 "Return numeric meaning of raw prefix argument RAW.\n\
ec28a64d
MB
684A raw prefix argument is what you get from `(interactive \"P\")'.\n\
685Its numeric meaning is what you would get from `(interactive \"p\")'.")
686 (raw)
687 Lisp_Object raw;
688{
689 Lisp_Object val;
690
265a9e55 691 if (NILP (raw))
acab6442 692 XSETFASTINT (val, 1);
fd5285f3 693 else if (EQ (raw, Qminus))
ec28a64d 694 XSETINT (val, -1);
3399a477 695 else if (CONSP (raw) && INTEGERP (XCONS (raw)->car))
ec28a64d 696 XSETINT (val, XINT (XCONS (raw)->car));
6e54b3de 697 else if (INTEGERP (raw))
ec28a64d
MB
698 val = raw;
699 else
acab6442 700 XSETFASTINT (val, 1);
ec28a64d
MB
701
702 return val;
703}
704
705syms_of_callint ()
706{
824977b6
RS
707 point_marker = Fmake_marker ();
708 staticpro (&point_marker);
709
03e130d5
RS
710 preserved_fns = Fcons (intern ("region-beginning"),
711 Fcons (intern ("region-end"),
712 Fcons (intern ("point"),
713 Fcons (intern ("mark"), Qnil))));
714 staticpro (&preserved_fns);
715
716 Qlist = intern ("list");
717 staticpro (&Qlist);
8450690a
RS
718 Qlet = intern ("let");
719 staticpro (&Qlet);
720 Qletx = intern ("let*");
721 staticpro (&Qletx);
722 Qsave_excursion = intern ("save-excursion");
723 staticpro (&Qsave_excursion);
03e130d5 724
ec28a64d
MB
725 Qminus = intern ("-");
726 staticpro (&Qminus);
727
fdb4a38c
RS
728 Qplus = intern ("+");
729 staticpro (&Qplus);
730
ec28a64d
MB
731 Qcall_interactively = intern ("call-interactively");
732 staticpro (&Qcall_interactively);
733
734 Qcommand_debug_status = intern ("command-debug-status");
735 staticpro (&Qcommand_debug_status);
736
52614803
RS
737 Qenable_recursive_minibuffers = intern ("enable-recursive-minibuffers");
738 staticpro (&Qenable_recursive_minibuffers);
739
ef2515c0
RS
740 Qmouse_leave_buffer_hook = intern ("mouse-leave-buffer-hook");
741 staticpro (&Qmouse_leave_buffer_hook);
742
df31bc64
RS
743 callint_message_size = 100;
744 callint_message = (char *) xmalloc (callint_message_size);
745
746
1e0c5826 747 DEFVAR_KBOARD ("prefix-arg", Vprefix_arg,
8c917bf2
KH
748 "The value of the prefix argument for the next editing command.\n\
749It may be a number, or the symbol `-' for just a minus sign as arg,\n\
750or a list whose car is a number for just one or more C-U's\n\
751or nil if no argument has been specified.\n\
752\n\
753You cannot examine this variable to find the argument for this command\n\
754since it has been set to nil by the time you can look.\n\
755Instead, you should use the variable `current-prefix-arg', although\n\
756normally commands can get this prefix argument with (interactive \"P\").");
8c917bf2
KH
757
758 DEFVAR_LISP ("current-prefix-arg", &Vcurrent_prefix_arg,
759 "The value of the prefix argument for this editing command.\n\
760It may be a number, or the symbol `-' for just a minus sign as arg,\n\
761or a list whose car is a number for just one or more C-U's\n\
762or nil if no argument has been specified.\n\
763This is what `(interactive \"P\")' returns.");
764 Vcurrent_prefix_arg = Qnil;
765
ec28a64d
MB
766 DEFVAR_LISP ("command-history", &Vcommand_history,
767 "List of recent commands that read arguments from terminal.\n\
768Each command is represented as a form to evaluate.");
769 Vcommand_history = Qnil;
770
771 DEFVAR_LISP ("command-debug-status", &Vcommand_debug_status,
772 "Debugging status of current interactive command.\n\
773Bound each time `call-interactively' is called;\n\
774may be set by the debugger as a reminder for itself.");
775 Vcommand_debug_status = Qnil;
776
2ad6c959 777 DEFVAR_LISP ("mark-even-if-inactive", &Vmark_even_if_inactive,
9f315aeb
RS
778 "*Non-nil means you can use the mark even when inactive.\n\
779This option makes a difference in Transient Mark mode.\n\
780When the option is non-nil, deactivation of the mark\n\
781turns off region highlighting, but commands that use the mark\n\
782behave as if the mark were still active.");
783 Vmark_even_if_inactive = Qnil;
784
ef2515c0
RS
785 DEFVAR_LISP ("mouse-leave-buffer-hook", &Vmouse_leave_buffer_hook,
786 "Hook to run when about to switch windows with a mouse command.\n\
787Its purpose is to give temporary modes such as Isearch mode\n\
788a way to turn themselves off when a mouse command switches windows.");
789 Vmouse_leave_buffer_hook = Qnil;
790
ec28a64d
MB
791 defsubr (&Sinteractive);
792 defsubr (&Scall_interactively);
793 defsubr (&Sprefix_numeric_value);
794}