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