(Ftranspose_regions): Pass 0 as NOMARKERS to replace_range.
[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\
88c -- Character.\n\
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 */
88bc3111 501 /* Use message_with_string rather than message1_nolog here,
491ee841
RS
502 so that nothing bad happens if callint_message is changed
503 within Fread_char (by a timer, for example). */
88bc3111 504 message_with_string ("%s", build_string (callint_message), 0);
ec28a64d 505 args[i] = Fread_char ();
453ed650 506 message1_nolog ((char *) 0);
ec28a64d
MB
507 /* Passing args[i] directly stimulates compiler bug */
508 teml = args[i];
509 visargs[i] = Fchar_to_string (teml);
510 break;
511
512 case 'C': /* Command: symbol with interactive function */
df31bc64 513 visargs[i] = Fcompleting_read (build_string (callint_message),
ff9cd111 514 Vobarray, Qcommandp,
93fb51ae 515 Qt, Qnil, Qnil, Qnil, Qnil);
ec28a64d
MB
516 /* Passing args[i] directly stimulates compiler bug */
517 teml = visargs[i];
518 args[i] = Fintern (teml, Qnil);
519 break;
520
521 case 'd': /* Value of point. Does not do I/O. */
dc330139 522 set_marker_both (point_marker, Qnil, PT, PT_BYTE);
824977b6 523 args[i] = point_marker;
ec28a64d
MB
524 /* visargs[i] = Qnil; */
525 varies[i] = 1;
526 break;
527
ec28a64d 528 case 'D': /* Directory name. */
df31bc64 529 args[i] = Fread_file_name (build_string (callint_message), Qnil,
ec28a64d
MB
530 current_buffer->directory, Qlambda, Qnil);
531 break;
532
533 case 'f': /* Existing file name. */
df31bc64 534 args[i] = Fread_file_name (build_string (callint_message),
ec28a64d
MB
535 Qnil, Qnil, Qlambda, Qnil);
536 break;
537
538 case 'F': /* Possibly nonexistent file name. */
df31bc64 539 args[i] = Fread_file_name (build_string (callint_message),
ec28a64d
MB
540 Qnil, Qnil, Qnil, Qnil);
541 break;
542
40b2421c
KH
543 case 'i': /* Ignore an argument -- Does not do I/O */
544 varies[i] = -1;
545 break;
546
1989e7bc 547 case 'k': /* Key sequence. */
c631c234
RS
548 {
549 int speccount1 = specpdl_ptr - specpdl;
550 specbind (Qcursor_in_echo_area, Qt);
551 args[i] = Fread_key_sequence (build_string (callint_message),
ad4ac475 552 Qnil, Qnil, Qnil, Qnil);
c631c234
RS
553 unbind_to (speccount1, Qnil);
554 teml = args[i];
555 visargs[i] = Fkey_description (teml);
cdfac812
RS
556
557 /* If the key sequence ends with a down-event,
558 discard the following up-event. */
559 teml = Faref (args[i], make_number (XINT (Flength (args[i])) - 1));
560 if (CONSP (teml))
561 teml = XCONS (teml)->car;
562 if (SYMBOLP (teml))
563 {
564 Lisp_Object tem2;
565
566 teml = Fget (teml, intern ("event-symbol-elements"));
567 tem2 = Fmemq (intern ("down"), teml);
568 if (! NILP (tem2))
569 Fread_event ();
570 }
c631c234 571 }
1989e7bc
RS
572 break;
573
574 case 'K': /* Key sequence to be defined. */
c631c234
RS
575 {
576 int speccount1 = specpdl_ptr - specpdl;
577 specbind (Qcursor_in_echo_area, Qt);
578 args[i] = Fread_key_sequence (build_string (callint_message),
ad4ac475 579 Qnil, Qt, Qnil, Qnil);
c631c234
RS
580 teml = args[i];
581 visargs[i] = Fkey_description (teml);
582 unbind_to (speccount1, Qnil);
cdfac812
RS
583
584 /* If the key sequence ends with a down-event,
585 discard the following up-event. */
586 teml = Faref (args[i], make_number (XINT (Flength (args[i])) - 1));
587 if (CONSP (teml))
588 teml = XCONS (teml)->car;
589 if (SYMBOLP (teml))
590 {
591 Lisp_Object tem2;
592
593 teml = Fget (teml, intern ("event-symbol-elements"));
594 tem2 = Fmemq (intern ("down"), teml);
595 if (! NILP (tem2))
596 Fread_event ();
597 }
c631c234 598 }
ec28a64d
MB
599 break;
600
bc78232c 601 case 'e': /* The invoking event. */
d455db8e 602 if (next_event >= key_count)
bc78232c 603 error ("%s must be bound to an event with parameters",
6e54b3de 604 (SYMBOLP (function)
63007de2 605 ? (char *) XSYMBOL (function)->name->data
bc78232c 606 : "command"));
d455db8e 607 args[i] = XVECTOR (keys)->contents[next_event++];
e5d77022 608 varies[i] = -1;
dbc4e1c1
JB
609
610 /* Find the next parameterized event. */
d455db8e 611 while (next_event < key_count
dbc4e1c1 612 && ! (EVENT_HAS_PARAMETERS
d455db8e 613 (XVECTOR (keys)->contents[next_event])))
dbc4e1c1
JB
614 next_event++;
615
63007de2
JB
616 break;
617
ec28a64d
MB
618 case 'm': /* Value of mark. Does not do I/O. */
619 check_mark ();
620 /* visargs[i] = Qnil; */
824977b6 621 args[i] = current_buffer->mark;
ec28a64d
MB
622 varies[i] = 2;
623 break;
624
93fb51ae
KH
625 case 'M': /* String read via minibuffer with
626 inheriting the current input method. */
627 args[i] = Fread_string (build_string (callint_message),
628 Qnil, Qnil, Qnil, Qt);
629 break;
630
ec28a64d 631 case 'N': /* Prefix arg, else number from minibuffer */
265a9e55 632 if (!NILP (prefix_arg))
ec28a64d
MB
633 goto have_prefix_arg;
634 case 'n': /* Read number from minibuffer. */
f0490a0b
RS
635 {
636 int first = 1;
637 do
638 {
639 Lisp_Object tem;
640 if (! first)
641 {
642 message ("Please enter a number.");
56fe6fc0 643 sit_for (1, 0, 0, 0, 0);
f0490a0b
RS
644 }
645 first = 0;
646
647 tem = Fread_from_minibuffer (build_string (callint_message),
93fb51ae
KH
648 Qnil, Qnil, Qnil, Qnil, Qnil,
649 Qnil);
f0490a0b
RS
650 if (! STRINGP (tem) || XSTRING (tem)->size == 0)
651 args[i] = Qnil;
652 else
653 args[i] = Fread (tem);
654 }
655 while (! NUMBERP (args[i]));
656 }
ec28a64d
MB
657 visargs[i] = last_minibuf_string;
658 break;
659
660 case 'P': /* Prefix arg in raw form. Does no I/O. */
ec28a64d
MB
661 args[i] = prefix_arg;
662 /* visargs[i] = Qnil; */
663 varies[i] = -1;
664 break;
665
666 case 'p': /* Prefix arg converted to number. No I/O. */
71eda2d5 667 have_prefix_arg:
ec28a64d
MB
668 args[i] = Fprefix_numeric_value (prefix_arg);
669 /* visargs[i] = Qnil; */
670 varies[i] = -1;
671 break;
672
673 case 'r': /* Region, point and mark as 2 args. */
674 check_mark ();
dc330139 675 set_marker_both (point_marker, Qnil, PT, PT_BYTE);
ec28a64d
MB
676 /* visargs[i+1] = Qnil; */
677 foo = marker_position (current_buffer->mark);
678 /* visargs[i] = Qnil; */
6ec8bbd2 679 args[i] = PT < foo ? point_marker : current_buffer->mark;
ec28a64d 680 varies[i] = 3;
6ec8bbd2 681 args[++i] = PT > foo ? point_marker : current_buffer->mark;
ec28a64d
MB
682 varies[i] = 4;
683 break;
684
93fb51ae
KH
685 case 's': /* String read via minibuffer without
686 inheriting the current input method. */
55c4d99f 687 args[i] = Fread_string (build_string (callint_message),
93fb51ae 688 Qnil, Qnil, Qnil, Qnil);
ec28a64d
MB
689 break;
690
691 case 'S': /* Any symbol. */
df31bc64 692 visargs[i] = Fread_string (build_string (callint_message),
93fb51ae 693 Qnil, Qnil, Qnil, Qnil);
ec28a64d
MB
694 /* Passing args[i] directly stimulates compiler bug */
695 teml = visargs[i];
696 args[i] = Fintern (teml, Qnil);
697 break;
698
699 case 'v': /* Variable name: symbol that is
700 user-variable-p. */
ff9cd111 701 args[i] = Fread_variable (build_string (callint_message), Qnil);
ec28a64d
MB
702 visargs[i] = last_minibuf_string;
703 break;
704
705 case 'x': /* Lisp expression read but not evaluated */
df31bc64 706 args[i] = Fread_minibuffer (build_string (callint_message), Qnil);
ec28a64d
MB
707 visargs[i] = last_minibuf_string;
708 break;
709
710 case 'X': /* Lisp expression read and evaluated */
df31bc64 711 args[i] = Feval_minibuffer (build_string (callint_message), Qnil);
ec28a64d
MB
712 visargs[i] = last_minibuf_string;
713 break;
714
40b2421c
KH
715 case 'Z': /* Coding-system symbol, or ignore the
716 argument if no prefix */
717 if (NILP (prefix_arg))
718 {
719 args[i] = Qnil;
720 varies[i] = -1;
721 }
722 else
723 {
724 args[i]
725 = Fread_non_nil_coding_system (build_string (callint_message));
726 visargs[i] = last_minibuf_string;
727 }
728 break;
729
730 case 'z': /* Coding-system symbol or nil */
024d8713 731 args[i] = Fread_coding_system (build_string (callint_message), Qnil);
40b2421c
KH
732 visargs[i] = last_minibuf_string;
733 break;
734
e92d107b
RS
735 /* We have a case for `+' so we get an error
736 if anyone tries to define one here. */
737 case '+':
ec28a64d 738 default:
e92d107b 739 error ("Invalid control letter `%c' (%03o) in interactive calling string",
ec28a64d
MB
740 *tem, *tem);
741 }
742
743 if (varies[i] == 0)
744 arg_from_tty = 1;
745
6e54b3de 746 if (NILP (visargs[i]) && STRINGP (args[i]))
ec28a64d
MB
747 visargs[i] = args[i];
748
749 tem = (unsigned char *) index (tem, '\n');
750 if (tem) tem++;
751 else tem = (unsigned char *) "";
752 }
52614803 753 unbind_to (speccount, Qnil);
ec28a64d
MB
754
755 QUIT;
756
757 args[0] = function;
758
7868a977 759 if (arg_from_tty || !NILP (record_flag))
ec28a64d
MB
760 {
761 visargs[0] = function;
63007de2 762 for (i = 1; i < count + 1; i++)
824977b6
RS
763 {
764 if (varies[i] > 0)
765 visargs[i] = Fcons (intern (callint_argfuns[varies[i]]), Qnil);
766 else
767 visargs[i] = quotify_arg (args[i]);
768 }
ec28a64d
MB
769 Vcommand_history = Fcons (Flist (count + 1, visargs),
770 Vcommand_history);
225c2157
RS
771 /* Don't keep command history around forever. */
772 if (NUMBERP (Vhistory_length) && XINT (Vhistory_length) > 0)
773 {
774 teml = Fnthcdr (Vhistory_length, Vcommand_history);
775 if (CONSP (teml))
776 XCONS (teml)->cdr = Qnil;
777 }
ec28a64d
MB
778 }
779
824977b6
RS
780 /* If we used a marker to hold point, mark, or an end of the region,
781 temporarily, convert it to an integer now. */
f4c8ded2 782 for (i = 1; i <= count; i++)
824977b6
RS
783 if (varies[i] >= 1 && varies[i] <= 4)
784 XSETINT (args[i], marker_position (args[i]));
785
652e2240 786 single_kboard_state ();
ebfbe249 787
ec28a64d
MB
788 {
789 Lisp_Object val;
ec28a64d
MB
790 specbind (Qcommand_debug_status, Qnil);
791
792 val = Ffuncall (count + 1, args);
793 UNGCPRO;
794 return unbind_to (speccount, val);
795 }
796}
797
798DEFUN ("prefix-numeric-value", Fprefix_numeric_value, Sprefix_numeric_value,
799 1, 1, 0,
7868a977 800 "Return numeric meaning of raw prefix argument RAW.\n\
ec28a64d
MB
801A raw prefix argument is what you get from `(interactive \"P\")'.\n\
802Its numeric meaning is what you would get from `(interactive \"p\")'.")
803 (raw)
804 Lisp_Object raw;
805{
806 Lisp_Object val;
807
265a9e55 808 if (NILP (raw))
acab6442 809 XSETFASTINT (val, 1);
fd5285f3 810 else if (EQ (raw, Qminus))
ec28a64d 811 XSETINT (val, -1);
3399a477 812 else if (CONSP (raw) && INTEGERP (XCONS (raw)->car))
ec28a64d 813 XSETINT (val, XINT (XCONS (raw)->car));
6e54b3de 814 else if (INTEGERP (raw))
ec28a64d
MB
815 val = raw;
816 else
acab6442 817 XSETFASTINT (val, 1);
ec28a64d
MB
818
819 return val;
820}
821
dfcf069d 822void
ec28a64d
MB
823syms_of_callint ()
824{
824977b6
RS
825 point_marker = Fmake_marker ();
826 staticpro (&point_marker);
827
03e130d5
RS
828 preserved_fns = Fcons (intern ("region-beginning"),
829 Fcons (intern ("region-end"),
830 Fcons (intern ("point"),
831 Fcons (intern ("mark"), Qnil))));
832 staticpro (&preserved_fns);
833
834 Qlist = intern ("list");
835 staticpro (&Qlist);
8450690a
RS
836 Qlet = intern ("let");
837 staticpro (&Qlet);
838 Qletx = intern ("let*");
839 staticpro (&Qletx);
840 Qsave_excursion = intern ("save-excursion");
841 staticpro (&Qsave_excursion);
03e130d5 842
ec28a64d
MB
843 Qminus = intern ("-");
844 staticpro (&Qminus);
845
fdb4a38c
RS
846 Qplus = intern ("+");
847 staticpro (&Qplus);
848
ec28a64d
MB
849 Qcall_interactively = intern ("call-interactively");
850 staticpro (&Qcall_interactively);
851
852 Qcommand_debug_status = intern ("command-debug-status");
853 staticpro (&Qcommand_debug_status);
854
52614803
RS
855 Qenable_recursive_minibuffers = intern ("enable-recursive-minibuffers");
856 staticpro (&Qenable_recursive_minibuffers);
857
ef2515c0
RS
858 Qmouse_leave_buffer_hook = intern ("mouse-leave-buffer-hook");
859 staticpro (&Qmouse_leave_buffer_hook);
860
df31bc64
RS
861 callint_message_size = 100;
862 callint_message = (char *) xmalloc (callint_message_size);
863
864
1e0c5826 865 DEFVAR_KBOARD ("prefix-arg", Vprefix_arg,
8c917bf2
KH
866 "The value of the prefix argument for the next editing command.\n\
867It may be a number, or the symbol `-' for just a minus sign as arg,\n\
868or a list whose car is a number for just one or more C-U's\n\
869or nil if no argument has been specified.\n\
870\n\
871You cannot examine this variable to find the argument for this command\n\
872since it has been set to nil by the time you can look.\n\
873Instead, you should use the variable `current-prefix-arg', although\n\
874normally commands can get this prefix argument with (interactive \"P\").");
8c917bf2 875
fe3fbdcc
RS
876 DEFVAR_KBOARD ("last-prefix-arg", Vlast_prefix_arg,
877 "The value of the prefix argument for the previous editing command.\n\
878See `prefix-arg' for the meaning of the value.");
879
8c917bf2
KH
880 DEFVAR_LISP ("current-prefix-arg", &Vcurrent_prefix_arg,
881 "The value of the prefix argument for this editing command.\n\
882It may be a number, or the symbol `-' for just a minus sign as arg,\n\
883or a list whose car is a number for just one or more C-U's\n\
884or nil if no argument has been specified.\n\
885This is what `(interactive \"P\")' returns.");
886 Vcurrent_prefix_arg = Qnil;
887
ec28a64d
MB
888 DEFVAR_LISP ("command-history", &Vcommand_history,
889 "List of recent commands that read arguments from terminal.\n\
890Each command is represented as a form to evaluate.");
891 Vcommand_history = Qnil;
892
893 DEFVAR_LISP ("command-debug-status", &Vcommand_debug_status,
894 "Debugging status of current interactive command.\n\
895Bound each time `call-interactively' is called;\n\
896may be set by the debugger as a reminder for itself.");
897 Vcommand_debug_status = Qnil;
898
2ad6c959 899 DEFVAR_LISP ("mark-even-if-inactive", &Vmark_even_if_inactive,
9f315aeb
RS
900 "*Non-nil means you can use the mark even when inactive.\n\
901This option makes a difference in Transient Mark mode.\n\
902When the option is non-nil, deactivation of the mark\n\
903turns off region highlighting, but commands that use the mark\n\
904behave as if the mark were still active.");
905 Vmark_even_if_inactive = Qnil;
906
ef2515c0
RS
907 DEFVAR_LISP ("mouse-leave-buffer-hook", &Vmouse_leave_buffer_hook,
908 "Hook to run when about to switch windows with a mouse command.\n\
909Its purpose is to give temporary modes such as Isearch mode\n\
910a way to turn themselves off when a mouse command switches windows.");
911 Vmouse_leave_buffer_hook = Qnil;
912
ec28a64d
MB
913 defsubr (&Sinteractive);
914 defsubr (&Scall_interactively);
915 defsubr (&Sprefix_numeric_value);
916}