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