(install-arch-indep): Delete .#* when copying subdirs.
[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 {
cd8b5aa3
KH
299#ifdef MULTI_KBOARD
300 kboard_locked = 1;
887e0cba
KH
301#endif
302 return ml_apply (fun, Qinteractive);
303 }
ec28a64d
MB
304 else
305 goto lose;
306
46947372 307 /* If either specs or string is set to a string, use it. */
6e54b3de 308 if (STRINGP (specs))
46947372
JB
309 {
310 /* Make a copy of string so that if a GC relocates specs,
311 `string' will still be valid. */
e5d77022 312 string = (unsigned char *) alloca (XSTRING (specs)->size + 1);
46947372
JB
313 bcopy (XSTRING (specs)->data, string, XSTRING (specs)->size + 1);
314 }
ec28a64d
MB
315 else if (string == 0)
316 {
03e130d5 317 Lisp_Object input;
ec28a64d 318 i = num_input_chars;
03e130d5
RS
319 input = specs;
320 /* Compute the arg values using the user's expression. */
ec28a64d 321 specs = Feval (specs);
265a9e55 322 if (i != num_input_chars || !NILP (record))
03e130d5
RS
323 {
324 /* We should record this command on the command history. */
325 Lisp_Object values, car;
326 /* Make a copy of the list of values, for the command history,
327 and turn them into things we can eval. */
328 values = quotify_args (Fcopy_sequence (specs));
329 /* If the list of args was produced with an explicit call to `list',
330 look for elements that were computed with (region-beginning)
331 or (region-end), and put those expressions into VALUES
332 instead of the present values. */
333 car = Fcar (input);
334 if (EQ (car, Qlist))
335 {
336 Lisp_Object intail, valtail;
337 for (intail = Fcdr (input), valtail = values;
338 CONSP (valtail);
339 intail = Fcdr (intail), valtail = Fcdr (valtail))
340 {
341 Lisp_Object elt;
342 elt = Fcar (intail);
343 if (CONSP (elt))
344 {
345 Lisp_Object presflag;
346 presflag = Fmemq (Fcar (elt), preserved_fns);
347 if (!NILP (presflag))
348 Fsetcar (valtail, Fcar (intail));
349 }
350 }
351 }
352 Vcommand_history
353 = Fcons (Fcons (function, values), Vcommand_history);
354 }
cd8b5aa3
KH
355#ifdef MULTI_KBOARD
356 kboard_locked = 1;
887e0cba 357#endif
ec28a64d
MB
358 return apply1 (function, specs);
359 }
360
361 /* Here if function specifies a string to control parsing the defaults */
362
dbc4e1c1
JB
363 /* Set next_event to point to the first event with parameters. */
364 for (next_event = 0; next_event < this_command_key_count; next_event++)
365 if (EVENT_HAS_PARAMETERS
366 (XVECTOR (this_command_keys)->contents[next_event]))
367 break;
368
42bb2790 369 /* Handle special starting chars `*' and `@'. Also `-'. */
e92d107b 370 /* Note that `+' is reserved for user extensions. */
ec28a64d
MB
371 while (1)
372 {
e92d107b
RS
373 if (*string = '+')
374 error ("`+' is not used in `interactive' for ordinary commands");
375 else if (*string == '*')
ec28a64d
MB
376 {
377 string++;
265a9e55 378 if (!NILP (current_buffer->read_only))
ec28a64d
MB
379 Fbarf_if_buffer_read_only ();
380 }
42bb2790
RS
381 /* Ignore this for semi-compatibility with Lucid. */
382 else if (*string == '-')
383 string++;
ec28a64d
MB
384 else if (*string == '@')
385 {
86c1cf23 386 Lisp_Object event;
dbc4e1c1 387
86c1cf23 388 event = XVECTOR (this_command_keys)->contents[next_event];
dbc4e1c1 389 if (EVENT_HAS_PARAMETERS (event)
6e54b3de
KH
390 && (event = XCONS (event)->car, CONSP (event))
391 && (event = XCONS (event)->car, CONSP (event))
392 && (event = XCONS (event)->car), WINDOWP (event))
d1fa2e8a 393 {
d68807fc 394 if (MINI_WINDOW_P (XWINDOW (event))
42bb2790 395 && ! (minibuf_level > 0 && EQ (event, minibuf_window)))
d1fa2e8a 396 error ("Attempt to select inactive minibuffer window");
ef2515c0
RS
397
398 /* If the current buffer wants to clean up, let it. */
399 if (!NILP (Vmouse_leave_buffer_hook))
400 call1 (Vrun_hooks, Qmouse_leave_buffer_hook);
401
d1fa2e8a
KH
402 Fselect_window (event);
403 }
ec28a64d 404 string++;
ec28a64d
MB
405 }
406 else break;
407 }
408
409 /* Count the number of arguments the interactive spec would have
410 us give to the function. */
411 tem = string;
412 for (j = 0; *tem; j++)
413 {
414 /* 'r' specifications ("point and mark as 2 numeric args")
415 produce *two* arguments. */
416 if (*tem == 'r') j++;
417 tem = (unsigned char *) index (tem, '\n');
418 if (tem)
419 tem++;
420 else
421 tem = (unsigned char *) "";
422 }
423 count = j;
424
425 args = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object));
426 visargs = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object));
427 argstrings = (unsigned char **) alloca ((count + 1) * sizeof (char *));
428 varies = (int *) alloca ((count + 1) * sizeof (int));
429
430 for (i = 0; i < (count + 1); i++)
431 {
432 args[i] = Qnil;
433 visargs[i] = Qnil;
434 varies[i] = 0;
435 }
436
437 GCPRO4 (prefix_arg, function, *args, *visargs);
438 gcpro3.nvars = (count + 1);
439 gcpro4.nvars = (count + 1);
440
52614803
RS
441 if (!NILP (enable))
442 specbind (Qenable_recursive_minibuffers, Qt);
443
ec28a64d 444 tem = string;
46947372 445 for (i = 1; *tem; i++)
ec28a64d
MB
446 {
447 strncpy (prompt1, tem + 1, sizeof prompt1 - 1);
448 prompt1[sizeof prompt1 - 1] = 0;
449 tem1 = index (prompt1, '\n');
450 if (tem1) *tem1 = 0;
451 /* Fill argstrings with a vector of C strings
452 corresponding to the Lisp strings in visargs. */
453 for (j = 1; j < i; j++)
454 argstrings[j]
455 = EQ (visargs[j], Qnil)
456 ? (unsigned char *) ""
46947372 457 : XSTRING (visargs[j])->data;
ec28a64d
MB
458
459 doprnt (prompt, sizeof prompt, prompt1, 0, j - 1, argstrings + 1);
460
461 switch (*tem)
462 {
463 case 'a': /* Symbol defined as a function */
464 visargs[i] = Fcompleting_read (build_string (prompt),
465 Vobarray, Qfboundp, Qt, Qnil, Qnil);
466 /* Passing args[i] directly stimulates compiler bug */
467 teml = visargs[i];
468 args[i] = Fintern (teml, Qnil);
469 break;
470
471 case 'b': /* Name of existing buffer */
472 args[i] = Fcurrent_buffer ();
473 if (EQ (selected_window, minibuf_window))
9262fcb6 474 args[i] = Fother_buffer (args[i], Qnil);
ec28a64d
MB
475 args[i] = Fread_buffer (build_string (prompt), args[i], Qt);
476 break;
477
478 case 'B': /* Name of buffer, possibly nonexistent */
479 args[i] = Fread_buffer (build_string (prompt),
9262fcb6
RS
480 Fother_buffer (Fcurrent_buffer (), Qnil),
481 Qnil);
ec28a64d
MB
482 break;
483
484 case 'c': /* Character */
485 message1 (prompt);
486 args[i] = Fread_char ();
487 /* Passing args[i] directly stimulates compiler bug */
488 teml = args[i];
489 visargs[i] = Fchar_to_string (teml);
490 break;
491
492 case 'C': /* Command: symbol with interactive function */
493 visargs[i] = Fcompleting_read (build_string (prompt),
494 Vobarray, Qcommandp, Qt, Qnil, Qnil);
495 /* Passing args[i] directly stimulates compiler bug */
496 teml = visargs[i];
497 args[i] = Fintern (teml, Qnil);
498 break;
499
500 case 'd': /* Value of point. Does not do I/O. */
824977b6
RS
501 Fset_marker (point_marker, make_number (PT), Qnil);
502 args[i] = point_marker;
ec28a64d
MB
503 /* visargs[i] = Qnil; */
504 varies[i] = 1;
505 break;
506
ec28a64d
MB
507 case 'D': /* Directory name. */
508 args[i] = Fread_file_name (build_string (prompt), Qnil,
509 current_buffer->directory, Qlambda, Qnil);
510 break;
511
512 case 'f': /* Existing file name. */
513 args[i] = Fread_file_name (build_string (prompt),
514 Qnil, Qnil, Qlambda, Qnil);
515 break;
516
517 case 'F': /* Possibly nonexistent file name. */
518 args[i] = Fread_file_name (build_string (prompt),
519 Qnil, Qnil, Qnil, Qnil);
520 break;
521
1989e7bc 522 case 'k': /* Key sequence. */
44820cc3 523 args[i] = Fread_key_sequence (build_string (prompt), 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. */
44820cc3 529 args[i] = Fread_key_sequence (build_string (prompt), 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. */
bc78232c
JB
535 if (next_event >= this_command_key_count)
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"));
7e6491d3 540 args[i] = XVECTOR (this_command_keys)->contents[next_event++];
e5d77022 541 varies[i] = -1;
dbc4e1c1
JB
542
543 /* Find the next parameterized event. */
544 while (next_event < this_command_key_count
545 && ! (EVENT_HAS_PARAMETERS
546 (XVECTOR (this_command_keys)->contents[next_event])))
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
563 args[i] = Fread_minibuffer (build_string (prompt), 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. */
569 have_prefix_arg:
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. */
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. */
80896ab4 594 args[i] = Fread_string (build_string (prompt), Qnil, Qnil);
ec28a64d
MB
595 break;
596
597 case 'S': /* Any symbol. */
80896ab4 598 visargs[i] = Fread_string (build_string (prompt), Qnil, Qnil);
ec28a64d
MB
599 /* Passing args[i] directly stimulates compiler bug */
600 teml = visargs[i];
601 args[i] = Fintern (teml, Qnil);
602 break;
603
604 case 'v': /* Variable name: symbol that is
605 user-variable-p. */
606 args[i] = Fread_variable (build_string (prompt));
607 visargs[i] = last_minibuf_string;
608 break;
609
610 case 'x': /* Lisp expression read but not evaluated */
611 args[i] = Fread_minibuffer (build_string (prompt), Qnil);
612 visargs[i] = last_minibuf_string;
613 break;
614
615 case 'X': /* Lisp expression read and evaluated */
616 args[i] = Feval_minibuffer (build_string (prompt), Qnil);
617 visargs[i] = last_minibuf_string;
618 break;
619
e92d107b
RS
620 /* We have a case for `+' so we get an error
621 if anyone tries to define one here. */
622 case '+':
ec28a64d 623 default:
e92d107b 624 error ("Invalid control letter `%c' (%03o) in interactive calling string",
ec28a64d
MB
625 *tem, *tem);
626 }
627
628 if (varies[i] == 0)
629 arg_from_tty = 1;
630
6e54b3de 631 if (NILP (visargs[i]) && STRINGP (args[i]))
ec28a64d
MB
632 visargs[i] = args[i];
633
634 tem = (unsigned char *) index (tem, '\n');
635 if (tem) tem++;
636 else tem = (unsigned char *) "";
637 }
52614803 638 unbind_to (speccount, Qnil);
ec28a64d
MB
639
640 QUIT;
641
642 args[0] = function;
643
265a9e55 644 if (arg_from_tty || !NILP (record))
ec28a64d
MB
645 {
646 visargs[0] = function;
63007de2 647 for (i = 1; i < count + 1; i++)
824977b6
RS
648 {
649 if (varies[i] > 0)
650 visargs[i] = Fcons (intern (callint_argfuns[varies[i]]), Qnil);
651 else
652 visargs[i] = quotify_arg (args[i]);
653 }
ec28a64d
MB
654 Vcommand_history = Fcons (Flist (count + 1, visargs),
655 Vcommand_history);
656 }
657
824977b6
RS
658 /* If we used a marker to hold point, mark, or an end of the region,
659 temporarily, convert it to an integer now. */
f4c8ded2 660 for (i = 1; i <= count; i++)
824977b6
RS
661 if (varies[i] >= 1 && varies[i] <= 4)
662 XSETINT (args[i], marker_position (args[i]));
663
cd8b5aa3
KH
664#ifdef MULTI_KBOARD
665 kboard_locked = 1;
ebfbe249
KH
666#endif
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,
680 "Return numeric meaning of raw prefix argument ARG.\n\
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
MB
691 XSETINT (val, -1);
692 else if (CONSP (raw))
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
1cf9cfc6
KH
702DEFUN ("universal-argument", Funiversal_argument, Suniversal_argument, 0, 0, "",
703 "Begin a numeric argument for the following command.\n\
704Digits or minus sign following \\[universal-argument] make up the numeric argument.\n\
705\\[universal-argument] following the digits or minus sign ends the argument.\n\
706\\[universal-argument] without digits or minus sign provides 4 as argument.\n\
707Repeating \\[universal-argument] without digits or minus sign\n\
708 multiplies the argument by 4 each time.")
709 ()
710{
711 if (!current_prefix_partial)
712 {
713 /* First C-u */
cd8b5aa3
KH
714 XSETFASTINT (current_kboard->prefix_factor, 4);
715 current_kboard->prefix_value = Qnil;
716 current_kboard->prefix_sign = 1;
717 current_kboard->prefix_partial = 1;
1cf9cfc6 718 }
cd8b5aa3 719 else if (!NILP (current_kboard->prefix_factor))
1cf9cfc6
KH
720 {
721 /* Subsequent C-u */
cd8b5aa3
KH
722 XSETINT (current_kboard->prefix_factor,
723 XINT (current_kboard->prefix_factor) * 4);
724 current_kboard->prefix_partial = 1;
1cf9cfc6
KH
725 }
726 else
727 {
728 /* Terminating C-u */
729 finalize_prefix_arg ();
730 describe_prefix_arg ();
731 }
732}
733
734DEFUN ("negative-argument", Fnegative_argument, Snegative_argument, 0, 0, "",
735 "Begin a negative numeric argument for the next command.\n\
736\\[universal-argument] following digits or minus sign ends the argument.")
737 ()
738{
cd8b5aa3
KH
739 current_kboard->prefix_factor = Qnil;
740 current_kboard->prefix_sign *= -1;
741 current_kboard->prefix_partial = 1;
1cf9cfc6
KH
742}
743
744DEFUN ("digit-argument", Fdigit_argument, Sdigit_argument, 0, 0, "",
745 "Part of the numeric argument for the next command.\n\
746\\[universal-argument] following digits or minus sign ends the argument.")
747 ()
748{
749 int c;
750 if (!(INTEGERP (last_command_char)
751 && (c = (XINT (last_command_char) & 0177)) >= '0' && c <= '9'))
752 error("digit-argument must be bound to a digit key");
cd8b5aa3
KH
753 current_kboard->prefix_factor = Qnil;
754 if (NILP (current_kboard->prefix_value))
755 XSETFASTINT (current_kboard->prefix_value, 0);
756 XSETINT (current_kboard->prefix_value,
757 XINT (current_kboard->prefix_value) * 10 + (c - '0'));
758 current_kboard->prefix_partial = 1;
1cf9cfc6
KH
759}
760
ec28a64d
MB
761syms_of_callint ()
762{
824977b6
RS
763 point_marker = Fmake_marker ();
764 staticpro (&point_marker);
765
03e130d5
RS
766 preserved_fns = Fcons (intern ("region-beginning"),
767 Fcons (intern ("region-end"),
768 Fcons (intern ("point"),
769 Fcons (intern ("mark"), Qnil))));
770 staticpro (&preserved_fns);
771
772 Qlist = intern ("list");
773 staticpro (&Qlist);
774
ec28a64d
MB
775 Qminus = intern ("-");
776 staticpro (&Qminus);
777
fdb4a38c
RS
778 Qplus = intern ("+");
779 staticpro (&Qplus);
780
ec28a64d
MB
781 Qcall_interactively = intern ("call-interactively");
782 staticpro (&Qcall_interactively);
783
784 Qcommand_debug_status = intern ("command-debug-status");
785 staticpro (&Qcommand_debug_status);
786
52614803
RS
787 Qenable_recursive_minibuffers = intern ("enable-recursive-minibuffers");
788 staticpro (&Qenable_recursive_minibuffers);
789
ef2515c0
RS
790 Qmouse_leave_buffer_hook = intern ("mouse-leave-buffer-hook");
791 staticpro (&Qmouse_leave_buffer_hook);
792
8c917bf2
KH
793 DEFVAR_LISP ("prefix-arg", &Vprefix_arg,
794 "The value of the prefix argument for the next editing command.\n\
795It may be a number, or the symbol `-' for just a minus sign as arg,\n\
796or a list whose car is a number for just one or more C-U's\n\
797or nil if no argument has been specified.\n\
798\n\
799You cannot examine this variable to find the argument for this command\n\
800since it has been set to nil by the time you can look.\n\
801Instead, you should use the variable `current-prefix-arg', although\n\
802normally commands can get this prefix argument with (interactive \"P\").");
803 Vprefix_arg = Qnil;
804
805 DEFVAR_LISP ("current-prefix-arg", &Vcurrent_prefix_arg,
806 "The value of the prefix argument for this editing command.\n\
807It may be a number, or the symbol `-' for just a minus sign as arg,\n\
808or a list whose car is a number for just one or more C-U's\n\
809or nil if no argument has been specified.\n\
810This is what `(interactive \"P\")' returns.");
811 Vcurrent_prefix_arg = Qnil;
812
ec28a64d
MB
813 DEFVAR_LISP ("command-history", &Vcommand_history,
814 "List of recent commands that read arguments from terminal.\n\
815Each command is represented as a form to evaluate.");
816 Vcommand_history = Qnil;
817
818 DEFVAR_LISP ("command-debug-status", &Vcommand_debug_status,
819 "Debugging status of current interactive command.\n\
820Bound each time `call-interactively' is called;\n\
821may be set by the debugger as a reminder for itself.");
822 Vcommand_debug_status = Qnil;
823
2ad6c959 824 DEFVAR_LISP ("mark-even-if-inactive", &Vmark_even_if_inactive,
9f315aeb
RS
825 "*Non-nil means you can use the mark even when inactive.\n\
826This option makes a difference in Transient Mark mode.\n\
827When the option is non-nil, deactivation of the mark\n\
828turns off region highlighting, but commands that use the mark\n\
829behave as if the mark were still active.");
830 Vmark_even_if_inactive = Qnil;
831
ef2515c0
RS
832 DEFVAR_LISP ("mouse-leave-buffer-hook", &Vmouse_leave_buffer_hook,
833 "Hook to run when about to switch windows with a mouse command.\n\
834Its purpose is to give temporary modes such as Isearch mode\n\
835a way to turn themselves off when a mouse command switches windows.");
836 Vmouse_leave_buffer_hook = Qnil;
837
ec28a64d
MB
838 defsubr (&Sinteractive);
839 defsubr (&Scall_interactively);
840 defsubr (&Sprefix_numeric_value);
1cf9cfc6
KH
841 defsubr (&Suniversal_argument);
842 defsubr (&Snegative_argument);
843 defsubr (&Sdigit_argument);
ec28a64d 844}