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