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