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