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