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