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