(x_y_to_hpos_vpos, fast_find_position) [HAVE_CARBON]:
[bpt/emacs.git] / src / callint.c
CommitLineData
ec28a64d 1/* Call a Lisp function interactively.
429ab54e 2 Copyright (C) 1985, 1986, 1993, 1994, 1995, 1997, 2000, 2001, 2002,
8cabe764
GM
3 2003, 2004, 2005, 2006, 2007, 2008
4 Free Software Foundation, Inc.
ec28a64d
MB
5
6This file is part of GNU Emacs.
7
8GNU Emacs is free software; you can redistribute it and/or modify
9it under the terms of the GNU General Public License as published by
684d6f5b 10the Free Software Foundation; either version 3, or (at your option)
ec28a64d
MB
11any later version.
12
13GNU Emacs is distributed in the hope that it will be useful,
14but WITHOUT ANY WARRANTY; without even the implied warranty of
15MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16GNU General Public License for more details.
17
18You should have received a copy of the GNU General Public License
19along with GNU Emacs; see the file COPYING. If not, write to
4fc5845f
LK
20the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
21Boston, MA 02110-1301, USA. */
ec28a64d
MB
22
23
18160b98 24#include <config.h>
fdb82f93 25
ec28a64d
MB
26#include "lisp.h"
27#include "buffer.h"
28#include "commands.h"
760cbdd3 29#include "keyboard.h"
ec28a64d 30#include "window.h"
8feddab4 31#include "keymap.h"
ec28a64d 32
8892f40b
GM
33#ifdef HAVE_INDEX
34extern char *index P_ ((const char *, int));
a847af86 35#endif
ec28a64d 36
c631c234 37extern Lisp_Object Qcursor_in_echo_area;
93ed5f9d 38extern Lisp_Object Qfile_directory_p;
c631c234 39
1e0c5826 40Lisp_Object Vcurrent_prefix_arg, Qminus, Qplus;
ec28a64d
MB
41Lisp_Object Qcall_interactively;
42Lisp_Object Vcommand_history;
43
225c2157 44extern Lisp_Object Vhistory_length;
0605dd79 45extern Lisp_Object Vthis_original_command, real_this_command;
225c2157 46
ec28a64d 47Lisp_Object Vcommand_debug_status, Qcommand_debug_status;
52614803 48Lisp_Object Qenable_recursive_minibuffers;
ec28a64d 49
9f315aeb
RS
50/* Non-nil means treat the mark as active
51 even if mark_active is 0. */
52Lisp_Object Vmark_even_if_inactive;
53
ef2515c0
RS
54Lisp_Object Vmouse_leave_buffer_hook, Qmouse_leave_buffer_hook;
55
120d0a23 56Lisp_Object Qlist, Qlet, Qletx, Qsave_excursion, Qprogn, Qif, Qwhen;
824977b6
RS
57static Lisp_Object preserved_fns;
58
59/* Marker used within call-interactively to refer to point. */
60static Lisp_Object point_marker;
03e130d5 61
55b41ef5
CY
62/* String for the prompt text used in Fcall_interactively. */
63static Lisp_Object callint_message;
425b457e 64\f
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.
75f9fbe8 99G -- Possibly nonexistent file name, defaulting to just directory name.
fdb82f93
PJ
100i -- Ignored, i.e. always nil. Does not do I/O.
101k -- Key sequence (downcase the last event if needed to get a definition).
102K -- Key sequence to be redefined (do not downcase the last event).
103m -- Value of mark as number. Does not do I/O.
104M -- Any string. Inherits the current input method.
105n -- Number read using minibuffer.
425b457e 106N -- Numeric prefix arg, or if none, do like code `n'.
fdb82f93
PJ
107p -- Prefix arg converted to number. Does not do I/O.
108P -- Prefix arg in raw form. Does not do I/O.
109r -- Region: point and mark as 2 numeric args, smallest first. Does no I/O.
110s -- Any string. Does not inherit the current input method.
111S -- Any symbol.
39900c4e 112U -- Mouse up event discarded by a previous k or K argument.
fdb82f93
PJ
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))
f439241f 175 xsignal0 (Qmark_inactive);
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.
2a95a27c 258
fdb82f93 259Optional third arg KEYS, if given, specifies the sequence of events to
2a95a27c
CY
260supply, as a vector, if the command inquires which events were used to
261invoke it. If KEYS is omitted or nil, the return value of
262`this-command-keys-vector' is used. */)
fdb82f93 263 (function, record_flag, keys)
7868a977 264 Lisp_Object function, record_flag, keys;
ec28a64d
MB
265{
266 Lisp_Object *args, *visargs;
ec28a64d 267 Lisp_Object fun;
ec28a64d 268 Lisp_Object specs;
079e479f 269 Lisp_Object filter_specs;
ec28a64d 270 Lisp_Object teml;
39900c4e 271 Lisp_Object up_event;
52614803 272 Lisp_Object enable;
aed13378 273 int speccount = SPECPDL_INDEX ();
ec28a64d 274
bc78232c
JB
275 /* The index of the next element of this_command_keys to examine for
276 the 'e' interactive code. */
dbc4e1c1 277 int next_event;
bc78232c 278
ec28a64d
MB
279 Lisp_Object prefix_arg;
280 unsigned char *string;
281 unsigned char *tem;
63007de2
JB
282
283 /* If varies[i] > 0, the i'th argument shouldn't just have its value
284 in this call quoted in the command history. It should be
285 recorded as a call to the function named callint_argfuns[varies[i]]. */
ec28a64d 286 int *varies;
63007de2 287
ec28a64d
MB
288 register int i, j;
289 int count, foo;
ec28a64d
MB
290 char prompt1[100];
291 char *tem1;
292 int arg_from_tty = 0;
39900c4e 293 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
d455db8e 294 int key_count;
09c886dc 295 int record_then_fail = 0;
d455db8e 296
0605dd79
RS
297 Lisp_Object save_this_command, save_last_command;
298 Lisp_Object save_this_original_command, save_real_this_command;
299
300 save_this_command = Vthis_command;
301 save_this_original_command = Vthis_original_command;
302 save_real_this_command = real_this_command;
303 save_last_command = current_kboard->Vlast_command;
304
d455db8e
RS
305 if (NILP (keys))
306 keys = this_command_keys, key_count = this_command_key_count;
307 else
308 {
b7826503 309 CHECK_VECTOR (keys);
d455db8e
RS
310 key_count = XVECTOR (keys)->size;
311 }
ec28a64d 312
e5d77022 313 /* Save this now, since use of minibuffer will clobber it. */
8c917bf2 314 prefix_arg = Vcurrent_prefix_arg;
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 329
39900c4e
KS
330 /* If k or K discard an up-event, save it here so it can be retrieved with U */
331 up_event = Qnil;
332
ec28a64d 333 /* Decode the kind of function. Either handle it and return,
b08b1fc9 334 or go to `lose' if not interactive, or set either STRING or SPECS. */
ec28a64d 335
6e54b3de 336 if (SUBRP (fun))
ec28a64d
MB
337 {
338 string = (unsigned char *) XSUBR (fun)->prompt;
339 if (!string)
340 {
341 lose:
b08b1fc9 342 wrong_type_argument (Qcommandp, function);
ec28a64d 343 }
ec28a64d 344 }
6e54b3de 345 else if (COMPILEDP (fun))
ec28a64d 346 {
f9b4aacf 347 if ((XVECTOR (fun)->size & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_INTERACTIVE)
ec28a64d
MB
348 goto lose;
349 specs = XVECTOR (fun)->contents[COMPILED_INTERACTIVE];
350 }
1e0b36be 351 else
ec28a64d 352 {
1e0b36be 353 Lisp_Object form;
ec28a64d 354 GCPRO2 (function, prefix_arg);
f817f028 355 form = Finteractive_form (function);
ec28a64d 356 UNGCPRO;
1e0b36be
SM
357 if (CONSP (form))
358 specs = filter_specs = Fcar (XCDR (form));
359 else
ec28a64d 360 goto lose;
ec28a64d 361 }
ec28a64d 362
09c886dc 363 /* If either SPECS or STRING is set to a string, use it. */
6e54b3de 364 if (STRINGP (specs))
46947372
JB
365 {
366 /* Make a copy of string so that if a GC relocates specs,
367 `string' will still be valid. */
d5db4077
KR
368 string = (unsigned char *) alloca (SBYTES (specs) + 1);
369 bcopy (SDATA (specs), string,
370 SBYTES (specs) + 1);
46947372 371 }
ec28a64d
MB
372 else if (string == 0)
373 {
03e130d5 374 Lisp_Object input;
91a6ba78 375 i = num_input_events;
03e130d5
RS
376 input = specs;
377 /* Compute the arg values using the user's expression. */
079e479f 378 GCPRO2 (input, filter_specs);
6bc1abf2 379 specs = Feval (specs);
079e479f 380 UNGCPRO;
91a6ba78 381 if (i != num_input_events || !NILP (record_flag))
03e130d5
RS
382 {
383 /* We should record this command on the command history. */
f1321dc3 384 Lisp_Object values;
03e130d5
RS
385 /* Make a copy of the list of values, for the command history,
386 and turn them into things we can eval. */
387 values = quotify_args (Fcopy_sequence (specs));
120d0a23 388 fix_command (input, values);
03e130d5
RS
389 Vcommand_history
390 = Fcons (Fcons (function, values), Vcommand_history);
225c2157
RS
391
392 /* Don't keep command history around forever. */
b9f0b172 393 if (INTEGERP (Vhistory_length) && XINT (Vhistory_length) > 0)
225c2157
RS
394 {
395 teml = Fnthcdr (Vhistory_length, Vcommand_history);
396 if (CONSP (teml))
f3fbd155 397 XSETCDR (teml, Qnil);
225c2157 398 }
03e130d5 399 }
0605dd79
RS
400
401 Vthis_command = save_this_command;
402 Vthis_original_command = save_this_original_command;
403 real_this_command= save_real_this_command;
404 current_kboard->Vlast_command = save_last_command;
405
652e2240 406 single_kboard_state ();
ec28a64d
MB
407 return apply1 (function, specs);
408 }
409
410 /* Here if function specifies a string to control parsing the defaults */
411
dbc4e1c1 412 /* Set next_event to point to the first event with parameters. */
d455db8e
RS
413 for (next_event = 0; next_event < key_count; next_event++)
414 if (EVENT_HAS_PARAMETERS (XVECTOR (keys)->contents[next_event]))
dbc4e1c1 415 break;
09c886dc 416
42bb2790 417 /* Handle special starting chars `*' and `@'. Also `-'. */
e92d107b 418 /* Note that `+' is reserved for user extensions. */
ec28a64d
MB
419 while (1)
420 {
fb775602 421 if (*string == '+')
e92d107b
RS
422 error ("`+' is not used in `interactive' for ordinary commands");
423 else if (*string == '*')
ec28a64d
MB
424 {
425 string++;
265a9e55 426 if (!NILP (current_buffer->read_only))
09c886dc
RS
427 {
428 if (!NILP (record_flag))
429 {
430 unsigned char *p = string;
431 while (*p)
432 {
433 if (! (*p == 'r' || *p == 'p' || *p == 'P'
434 || *p == '\n'))
435 Fbarf_if_buffer_read_only ();
436 p++;
437 }
438 record_then_fail = 1;
439 }
440 else
441 Fbarf_if_buffer_read_only ();
442 }
ec28a64d 443 }
42bb2790
RS
444 /* Ignore this for semi-compatibility with Lucid. */
445 else if (*string == '-')
446 string++;
ec28a64d
MB
447 else if (*string == '@')
448 {
c9aa6a41 449 Lisp_Object event, tem;
dbc4e1c1 450
170d3006
AS
451 event = (next_event < key_count
452 ? XVECTOR (keys)->contents[next_event]
453 : Qnil);
dbc4e1c1 454 if (EVENT_HAS_PARAMETERS (event)
c9aa6a41
RS
455 && (tem = XCDR (event), CONSP (tem))
456 && (tem = XCAR (tem), CONSP (tem))
457 && (tem = XCAR (tem), WINDOWP (tem)))
d1fa2e8a 458 {
c9aa6a41
RS
459 if (MINI_WINDOW_P (XWINDOW (tem))
460 && ! (minibuf_level > 0 && EQ (tem, minibuf_window)))
d1fa2e8a 461 error ("Attempt to select inactive minibuffer window");
ef2515c0
RS
462
463 /* If the current buffer wants to clean up, let it. */
464 if (!NILP (Vmouse_leave_buffer_hook))
465 call1 (Vrun_hooks, Qmouse_leave_buffer_hook);
466
c9aa6a41 467 Fselect_window (tem, Qnil);
d1fa2e8a 468 }
ec28a64d 469 string++;
ec28a64d
MB
470 }
471 else break;
472 }
473
474 /* Count the number of arguments the interactive spec would have
475 us give to the function. */
476 tem = string;
477 for (j = 0; *tem; j++)
478 {
479 /* 'r' specifications ("point and mark as 2 numeric args")
480 produce *two* arguments. */
481 if (*tem == 'r') j++;
482 tem = (unsigned char *) index (tem, '\n');
483 if (tem)
484 tem++;
485 else
486 tem = (unsigned char *) "";
487 }
6bc1abf2 488 count = j;
ec28a64d
MB
489
490 args = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object));
491 visargs = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object));
ec28a64d
MB
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
39900c4e 501 GCPRO5 (prefix_arg, function, *args, *visargs, up_event);
ec28a64d
MB
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 514 if (tem1) *tem1 = 0;
55b41ef5
CY
515
516 visargs[0] = build_string (prompt1);
517 if (index (prompt1, '%'))
518 callint_message = Fformat (i, visargs);
519 else
520 callint_message = visargs[0];
ec28a64d
MB
521
522 switch (*tem)
523 {
524 case 'a': /* Symbol defined as a function */
55b41ef5 525 visargs[i] = Fcompleting_read (callint_message,
ff9cd111 526 Vobarray, Qfboundp, Qt,
93fb51ae 527 Qnil, Qnil, Qnil, Qnil);
ec28a64d
MB
528 /* Passing args[i] directly stimulates compiler bug */
529 teml = visargs[i];
530 args[i] = Fintern (teml, Qnil);
531 break;
532
533 case 'b': /* Name of existing buffer */
534 args[i] = Fcurrent_buffer ();
535 if (EQ (selected_window, minibuf_window))
34c5d0ed 536 args[i] = Fother_buffer (args[i], Qnil, Qnil);
55b41ef5 537 args[i] = Fread_buffer (callint_message, args[i], Qt);
ec28a64d
MB
538 break;
539
540 case 'B': /* Name of buffer, possibly nonexistent */
55b41ef5 541 args[i] = Fread_buffer (callint_message,
34c5d0ed 542 Fother_buffer (Fcurrent_buffer (), Qnil, Qnil),
9262fcb6 543 Qnil);
ec28a64d
MB
544 break;
545
546 case 'c': /* Character */
55b41ef5 547 args[i] = Fread_char (callint_message, Qnil, Qnil);
453ed650 548 message1_nolog ((char *) 0);
ec28a64d
MB
549 /* Passing args[i] directly stimulates compiler bug */
550 teml = args[i];
551 visargs[i] = Fchar_to_string (teml);
552 break;
553
554 case 'C': /* Command: symbol with interactive function */
55b41ef5 555 visargs[i] = Fcompleting_read (callint_message,
ff9cd111 556 Vobarray, Qcommandp,
93fb51ae 557 Qt, Qnil, Qnil, Qnil, Qnil);
ec28a64d
MB
558 /* Passing args[i] directly stimulates compiler bug */
559 teml = visargs[i];
560 args[i] = Fintern (teml, Qnil);
561 break;
562
563 case 'd': /* Value of point. Does not do I/O. */
dc330139 564 set_marker_both (point_marker, Qnil, PT, PT_BYTE);
824977b6 565 args[i] = point_marker;
ec28a64d
MB
566 /* visargs[i] = Qnil; */
567 varies[i] = 1;
568 break;
569
ec28a64d 570 case 'D': /* Directory name. */
55b41ef5 571 args[i] = Fread_file_name (callint_message, Qnil,
93ed5f9d
KS
572 current_buffer->directory, Qlambda, Qnil,
573 Qfile_directory_p);
ec28a64d
MB
574 break;
575
576 case 'f': /* Existing file name. */
55b41ef5 577 args[i] = Fread_file_name (callint_message,
93ed5f9d 578 Qnil, Qnil, Qlambda, Qnil, Qnil);
ec28a64d
MB
579 break;
580
581 case 'F': /* Possibly nonexistent file name. */
55b41ef5 582 args[i] = Fread_file_name (callint_message,
93ed5f9d 583 Qnil, Qnil, Qnil, Qnil, Qnil);
ec28a64d
MB
584 break;
585
75f9fbe8
RS
586 case 'G': /* Possibly nonexistent file name,
587 default to directory alone. */
55b41ef5 588 args[i] = Fread_file_name (callint_message,
75f9fbe8
RS
589 Qnil, Qnil, Qnil, build_string (""), Qnil);
590 break;
591
40b2421c
KH
592 case 'i': /* Ignore an argument -- Does not do I/O */
593 varies[i] = -1;
594 break;
595
1989e7bc 596 case 'k': /* Key sequence. */
c631c234 597 {
aed13378 598 int speccount1 = SPECPDL_INDEX ();
c631c234 599 specbind (Qcursor_in_echo_area, Qt);
55b41ef5 600 args[i] = Fread_key_sequence (callint_message,
ad4ac475 601 Qnil, Qnil, Qnil, Qnil);
c631c234
RS
602 unbind_to (speccount1, Qnil);
603 teml = args[i];
a1bfe073 604 visargs[i] = Fkey_description (teml, Qnil);
cdfac812
RS
605
606 /* If the key sequence ends with a down-event,
607 discard the following up-event. */
608 teml = Faref (args[i], make_number (XINT (Flength (args[i])) - 1));
609 if (CONSP (teml))
70949dac 610 teml = XCAR (teml);
cdfac812
RS
611 if (SYMBOLP (teml))
612 {
613 Lisp_Object tem2;
614
615 teml = Fget (teml, intern ("event-symbol-elements"));
4b27f17c
AS
616 /* Ignore first element, which is the base key. */
617 tem2 = Fmemq (intern ("down"), Fcdr (teml));
cdfac812 618 if (! NILP (tem2))
43811b4e 619 up_event = Fread_event (Qnil, Qnil, Qnil);
cdfac812 620 }
c631c234 621 }
1989e7bc
RS
622 break;
623
624 case 'K': /* Key sequence to be defined. */
c631c234 625 {
aed13378 626 int speccount1 = SPECPDL_INDEX ();
c631c234 627 specbind (Qcursor_in_echo_area, Qt);
55b41ef5 628 args[i] = Fread_key_sequence (callint_message,
ad4ac475 629 Qnil, Qt, Qnil, Qnil);
c631c234 630 teml = args[i];
a1bfe073 631 visargs[i] = Fkey_description (teml, Qnil);
c631c234 632 unbind_to (speccount1, Qnil);
cdfac812
RS
633
634 /* If the key sequence ends with a down-event,
635 discard the following up-event. */
636 teml = Faref (args[i], make_number (XINT (Flength (args[i])) - 1));
637 if (CONSP (teml))
70949dac 638 teml = XCAR (teml);
cdfac812
RS
639 if (SYMBOLP (teml))
640 {
641 Lisp_Object tem2;
642
643 teml = Fget (teml, intern ("event-symbol-elements"));
4b27f17c
AS
644 /* Ignore first element, which is the base key. */
645 tem2 = Fmemq (intern ("down"), Fcdr (teml));
cdfac812 646 if (! NILP (tem2))
43811b4e 647 up_event = Fread_event (Qnil, Qnil, Qnil);
cdfac812 648 }
c631c234 649 }
ec28a64d
MB
650 break;
651
39900c4e
KS
652 case 'U': /* Up event from last k or K */
653 if (!NILP (up_event))
654 {
655 args[i] = Fmake_vector (make_number (1), up_event);
656 up_event = Qnil;
657 teml = args[i];
658 visargs[i] = Fkey_description (teml, Qnil);
659 }
660 break;
661
bc78232c 662 case 'e': /* The invoking event. */
d455db8e 663 if (next_event >= key_count)
bc78232c 664 error ("%s must be bound to an event with parameters",
6e54b3de 665 (SYMBOLP (function)
d5db4077 666 ? (char *) SDATA (SYMBOL_NAME (function))
bc78232c 667 : "command"));
d455db8e 668 args[i] = XVECTOR (keys)->contents[next_event++];
e5d77022 669 varies[i] = -1;
dbc4e1c1
JB
670
671 /* Find the next parameterized event. */
d455db8e 672 while (next_event < key_count
dbc4e1c1 673 && ! (EVENT_HAS_PARAMETERS
d455db8e 674 (XVECTOR (keys)->contents[next_event])))
dbc4e1c1
JB
675 next_event++;
676
63007de2
JB
677 break;
678
ec28a64d 679 case 'm': /* Value of mark. Does not do I/O. */
f203cf07 680 check_mark (0);
ec28a64d 681 /* visargs[i] = Qnil; */
824977b6 682 args[i] = current_buffer->mark;
ec28a64d
MB
683 varies[i] = 2;
684 break;
685
93fb51ae
KH
686 case 'M': /* String read via minibuffer with
687 inheriting the current input method. */
55b41ef5 688 args[i] = Fread_string (callint_message,
93fb51ae
KH
689 Qnil, Qnil, Qnil, Qt);
690 break;
691
425b457e 692 case 'N': /* Prefix arg as number, else number from minibuffer */
265a9e55 693 if (!NILP (prefix_arg))
ec28a64d
MB
694 goto have_prefix_arg;
695 case 'n': /* Read number from minibuffer. */
f0490a0b
RS
696 {
697 int first = 1;
698 do
699 {
700 Lisp_Object tem;
e7c4e229 701 if (! first)
f0490a0b
RS
702 {
703 message ("Please enter a number.");
e7c4e229 704 sit_for (make_number (1), 0, 0);
f0490a0b
RS
705 }
706 first = 0;
707
55b41ef5 708 tem = Fread_from_minibuffer (callint_message,
93fb51ae 709 Qnil, Qnil, Qnil, Qnil, Qnil,
ae4c2a3b 710 Qnil);
d5db4077 711 if (! STRINGP (tem) || SCHARS (tem) == 0)
f0490a0b
RS
712 args[i] = Qnil;
713 else
714 args[i] = Fread (tem);
715 }
716 while (! NUMBERP (args[i]));
717 }
55b41ef5 718 visargs[i] = args[i];
ec28a64d
MB
719 break;
720
721 case 'P': /* Prefix arg in raw form. Does no I/O. */
ec28a64d
MB
722 args[i] = prefix_arg;
723 /* visargs[i] = Qnil; */
724 varies[i] = -1;
725 break;
726
727 case 'p': /* Prefix arg converted to number. No I/O. */
71eda2d5 728 have_prefix_arg:
ec28a64d
MB
729 args[i] = Fprefix_numeric_value (prefix_arg);
730 /* visargs[i] = Qnil; */
731 varies[i] = -1;
732 break;
733
734 case 'r': /* Region, point and mark as 2 args. */
f203cf07 735 check_mark (1);
dc330139 736 set_marker_both (point_marker, Qnil, PT, PT_BYTE);
ec28a64d
MB
737 /* visargs[i+1] = Qnil; */
738 foo = marker_position (current_buffer->mark);
739 /* visargs[i] = Qnil; */
6ec8bbd2 740 args[i] = PT < foo ? point_marker : current_buffer->mark;
ec28a64d 741 varies[i] = 3;
6ec8bbd2 742 args[++i] = PT > foo ? point_marker : current_buffer->mark;
ec28a64d
MB
743 varies[i] = 4;
744 break;
745
93fb51ae
KH
746 case 's': /* String read via minibuffer without
747 inheriting the current input method. */
55b41ef5 748 args[i] = Fread_string (callint_message,
93fb51ae 749 Qnil, Qnil, Qnil, Qnil);
ec28a64d
MB
750 break;
751
752 case 'S': /* Any symbol. */
55b41ef5 753 visargs[i] = Fread_string (callint_message,
93fb51ae 754 Qnil, Qnil, Qnil, Qnil);
ec28a64d
MB
755 /* Passing args[i] directly stimulates compiler bug */
756 teml = visargs[i];
757 args[i] = Fintern (teml, Qnil);
758 break;
759
760 case 'v': /* Variable name: symbol that is
761 user-variable-p. */
55b41ef5 762 args[i] = Fread_variable (callint_message, Qnil);
ec28a64d
MB
763 visargs[i] = last_minibuf_string;
764 break;
765
766 case 'x': /* Lisp expression read but not evaluated */
55b41ef5 767 args[i] = Fread_minibuffer (callint_message, Qnil);
ec28a64d
MB
768 visargs[i] = last_minibuf_string;
769 break;
770
771 case 'X': /* Lisp expression read and evaluated */
55b41ef5 772 args[i] = Feval_minibuffer (callint_message, Qnil);
ec28a64d
MB
773 visargs[i] = last_minibuf_string;
774 break;
775
40b2421c
KH
776 case 'Z': /* Coding-system symbol, or ignore the
777 argument if no prefix */
778 if (NILP (prefix_arg))
779 {
780 args[i] = Qnil;
781 varies[i] = -1;
782 }
177c0ea7 783 else
40b2421c
KH
784 {
785 args[i]
55b41ef5 786 = Fread_non_nil_coding_system (callint_message);
40b2421c
KH
787 visargs[i] = last_minibuf_string;
788 }
789 break;
790
791 case 'z': /* Coding-system symbol or nil */
55b41ef5 792 args[i] = Fread_coding_system (callint_message, Qnil);
40b2421c
KH
793 visargs[i] = last_minibuf_string;
794 break;
795
e92d107b
RS
796 /* We have a case for `+' so we get an error
797 if anyone tries to define one here. */
798 case '+':
ec28a64d 799 default:
e92d107b 800 error ("Invalid control letter `%c' (%03o) in interactive calling string",
ec28a64d
MB
801 *tem, *tem);
802 }
803
804 if (varies[i] == 0)
805 arg_from_tty = 1;
806
6e54b3de 807 if (NILP (visargs[i]) && STRINGP (args[i]))
ec28a64d
MB
808 visargs[i] = args[i];
809
810 tem = (unsigned char *) index (tem, '\n');
811 if (tem) tem++;
812 else tem = (unsigned char *) "";
813 }
52614803 814 unbind_to (speccount, Qnil);
ec28a64d
MB
815
816 QUIT;
817
818 args[0] = function;
819
7868a977 820 if (arg_from_tty || !NILP (record_flag))
ec28a64d
MB
821 {
822 visargs[0] = function;
63007de2 823 for (i = 1; i < count + 1; i++)
824977b6
RS
824 {
825 if (varies[i] > 0)
826 visargs[i] = Fcons (intern (callint_argfuns[varies[i]]), Qnil);
827 else
828 visargs[i] = quotify_arg (args[i]);
829 }
ec28a64d
MB
830 Vcommand_history = Fcons (Flist (count + 1, visargs),
831 Vcommand_history);
225c2157 832 /* Don't keep command history around forever. */
b9f0b172 833 if (INTEGERP (Vhistory_length) && XINT (Vhistory_length) > 0)
225c2157
RS
834 {
835 teml = Fnthcdr (Vhistory_length, Vcommand_history);
836 if (CONSP (teml))
f3fbd155 837 XSETCDR (teml, Qnil);
225c2157 838 }
ec28a64d
MB
839 }
840
824977b6
RS
841 /* If we used a marker to hold point, mark, or an end of the region,
842 temporarily, convert it to an integer now. */
f4c8ded2 843 for (i = 1; i <= count; i++)
824977b6
RS
844 if (varies[i] >= 1 && varies[i] <= 4)
845 XSETINT (args[i], marker_position (args[i]));
846
09c886dc
RS
847 if (record_then_fail)
848 Fbarf_if_buffer_read_only ();
849
0605dd79
RS
850 Vthis_command = save_this_command;
851 Vthis_original_command = save_this_original_command;
852 real_this_command= save_real_this_command;
853 current_kboard->Vlast_command = save_last_command;
854
652e2240 855 single_kboard_state ();
ebfbe249 856
ec28a64d
MB
857 {
858 Lisp_Object val;
ec28a64d
MB
859 specbind (Qcommand_debug_status, Qnil);
860
861 val = Ffuncall (count + 1, args);
862 UNGCPRO;
863 return unbind_to (speccount, val);
864 }
177c0ea7 865}
ec28a64d
MB
866
867DEFUN ("prefix-numeric-value", Fprefix_numeric_value, Sprefix_numeric_value,
fdb82f93
PJ
868 1, 1, 0,
869 doc: /* Return numeric meaning of raw prefix argument RAW.
870A raw prefix argument is what you get from `(interactive "P")'.
871Its numeric meaning is what you would get from `(interactive "p")'. */)
872 (raw)
ec28a64d
MB
873 Lisp_Object raw;
874{
875 Lisp_Object val;
177c0ea7 876
265a9e55 877 if (NILP (raw))
acab6442 878 XSETFASTINT (val, 1);
fd5285f3 879 else if (EQ (raw, Qminus))
ec28a64d 880 XSETINT (val, -1);
70949dac
KR
881 else if (CONSP (raw) && INTEGERP (XCAR (raw)))
882 XSETINT (val, XINT (XCAR (raw)));
6e54b3de 883 else if (INTEGERP (raw))
ec28a64d
MB
884 val = raw;
885 else
acab6442 886 XSETFASTINT (val, 1);
ec28a64d
MB
887
888 return val;
889}
890
dfcf069d 891void
ec28a64d
MB
892syms_of_callint ()
893{
824977b6
RS
894 point_marker = Fmake_marker ();
895 staticpro (&point_marker);
896
55b41ef5
CY
897 callint_message = Qnil;
898 staticpro (&callint_message);
899
03e130d5
RS
900 preserved_fns = Fcons (intern ("region-beginning"),
901 Fcons (intern ("region-end"),
902 Fcons (intern ("point"),
903 Fcons (intern ("mark"), Qnil))));
904 staticpro (&preserved_fns);
905
906 Qlist = intern ("list");
907 staticpro (&Qlist);
8450690a
RS
908 Qlet = intern ("let");
909 staticpro (&Qlet);
120d0a23
RS
910 Qif = intern ("if");
911 staticpro (&Qif);
912 Qwhen = intern ("when");
913 staticpro (&Qwhen);
8450690a
RS
914 Qletx = intern ("let*");
915 staticpro (&Qletx);
916 Qsave_excursion = intern ("save-excursion");
917 staticpro (&Qsave_excursion);
079e479f
RS
918 Qprogn = intern ("progn");
919 staticpro (&Qprogn);
03e130d5 920
ec28a64d
MB
921 Qminus = intern ("-");
922 staticpro (&Qminus);
923
fdb4a38c
RS
924 Qplus = intern ("+");
925 staticpro (&Qplus);
926
ec28a64d
MB
927 Qcall_interactively = intern ("call-interactively");
928 staticpro (&Qcall_interactively);
929
930 Qcommand_debug_status = intern ("command-debug-status");
931 staticpro (&Qcommand_debug_status);
932
52614803
RS
933 Qenable_recursive_minibuffers = intern ("enable-recursive-minibuffers");
934 staticpro (&Qenable_recursive_minibuffers);
935
ef2515c0
RS
936 Qmouse_leave_buffer_hook = intern ("mouse-leave-buffer-hook");
937 staticpro (&Qmouse_leave_buffer_hook);
938
1e0c5826 939 DEFVAR_KBOARD ("prefix-arg", Vprefix_arg,
fdb82f93
PJ
940 doc: /* The value of the prefix argument for the next editing command.
941It may be a number, or the symbol `-' for just a minus sign as arg,
942or a list whose car is a number for just one or more C-u's
943or nil if no argument has been specified.
944
945You cannot examine this variable to find the argument for this command
946since it has been set to nil by the time you can look.
947Instead, you should use the variable `current-prefix-arg', although
948normally commands can get this prefix argument with (interactive "P"). */);
8c917bf2 949
fe3fbdcc 950 DEFVAR_KBOARD ("last-prefix-arg", Vlast_prefix_arg,
fdb82f93
PJ
951 doc: /* The value of the prefix argument for the previous editing command.
952See `prefix-arg' for the meaning of the value. */);
fe3fbdcc 953
8c917bf2 954 DEFVAR_LISP ("current-prefix-arg", &Vcurrent_prefix_arg,
fdb82f93
PJ
955 doc: /* The value of the prefix argument for this editing command.
956It may be a number, or the symbol `-' for just a minus sign as arg,
957or a list whose car is a number for just one or more C-u's
958or nil if no argument has been specified.
959This is what `(interactive \"P\")' returns. */);
8c917bf2
KH
960 Vcurrent_prefix_arg = Qnil;
961
ec28a64d 962 DEFVAR_LISP ("command-history", &Vcommand_history,
fdb82f93 963 doc: /* List of recent commands that read arguments from terminal.
b014713c
EZ
964Each command is represented as a form to evaluate.
965
966Maximum length of the history list is determined by the value
967of `history-length', which see. */);
ec28a64d
MB
968 Vcommand_history = Qnil;
969
970 DEFVAR_LISP ("command-debug-status", &Vcommand_debug_status,
fdb82f93
PJ
971 doc: /* Debugging status of current interactive command.
972Bound each time `call-interactively' is called;
973may be set by the debugger as a reminder for itself. */);
ec28a64d
MB
974 Vcommand_debug_status = Qnil;
975
2ad6c959 976 DEFVAR_LISP ("mark-even-if-inactive", &Vmark_even_if_inactive,
fdb82f93
PJ
977 doc: /* *Non-nil means you can use the mark even when inactive.
978This option makes a difference in Transient Mark mode.
979When the option is non-nil, deactivation of the mark
980turns off region highlighting, but commands that use the mark
981behave as if the mark were still active. */);
9f315aeb
RS
982 Vmark_even_if_inactive = Qnil;
983
ef2515c0 984 DEFVAR_LISP ("mouse-leave-buffer-hook", &Vmouse_leave_buffer_hook,
fdb82f93
PJ
985 doc: /* Hook to run when about to switch windows with a mouse command.
986Its purpose is to give temporary modes such as Isearch mode
987a way to turn themselves off when a mouse command switches windows. */);
ef2515c0
RS
988 Vmouse_leave_buffer_hook = Qnil;
989
ec28a64d
MB
990 defsubr (&Sinteractive);
991 defsubr (&Scall_interactively);
992 defsubr (&Sprefix_numeric_value);
993}
ab5796a9
MB
994
995/* arch-tag: a3a7cad7-bcac-42ce-916e-1bd2546ebf37
996 (do not change this comment) */