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