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