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