(lm-last-modified-date) Fixed return bug.
[emacs.git] / src / callint.c
blob0528fe78f2dedaf85fd88f2d6531e70388d51fc4
1 /* Call a Lisp function interactively.
2 Copyright (C) 1985, 1986, 1993 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
9 any later version.
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
21 #include "config.h"
22 #include "lisp.h"
23 #include "buffer.h"
24 #include "commands.h"
25 #include "keyboard.h"
26 #include "window.h"
27 #include "mocklisp.h"
29 extern char *index ();
31 Lisp_Object Vprefix_arg, Vcurrent_prefix_arg, Qminus;
32 Lisp_Object Qcall_interactively;
33 Lisp_Object Vcommand_history;
35 Lisp_Object Vcommand_debug_status, Qcommand_debug_status;
36 Lisp_Object Qenable_recursive_minibuffers;
38 Lisp_Object Qlist;
39 Lisp_Object preserved_fns;
41 /* This comment supplies the doc string for interactive,
42 for make-docfile to see. We cannot put this in the real DEFUN
43 due to limits in the Unix cpp.
45 DEFUN ("interactive", Ffoo, Sfoo, 0, 0, 0,
46 "Specify a way of parsing arguments for interactive use of a function.\n\
47 For example, write\n\
48 (defun foo (arg) \"Doc string\" (interactive \"p\") ...use arg...)\n\
49 to make ARG be the prefix argument when `foo' is called as a command.\n\
50 The \"call\" to `interactive' is actually a declaration rather than a function;\n\
51 it tells `call-interactively' how to read arguments\n\
52 to pass to the function.\n\
53 When actually called, `interactive' just returns nil.\n\
54 \n\
55 The argument of `interactive' is usually a string containing a code letter\n\
56 followed by a prompt. (Some code letters do not use I/O to get\n\
57 the argument and do not need prompts.) To prompt for multiple arguments,\n\
58 give a code letter, its prompt, a newline, and another code letter, etc.\n\
59 Prompts are passed to format, and may use % escapes to print the\n\
60 arguments that have already been read.\n\
61 If the argument is not a string, it is evaluated to get a list of\n\
62 arguments to pass to the function.\n\
63 Just `(interactive)' means pass no args when calling interactively.\n\
64 \nCode letters available are:\n\
65 a -- Function name: symbol with a function definition.\n\
66 b -- Name of existing buffer.\n\
67 B -- Name of buffer, possibly nonexistent.\n\
68 c -- Character.\n\
69 C -- Command name: symbol with interactive function definition.\n\
70 d -- Value of point as number. Does not do I/O.\n\
71 D -- Directory name.\n\
72 e -- Parametrized event (i.e., one that's a list) that invoked this command.\n\
73 If used more than once, the Nth `e' returns the Nth parameterized event.\n\
74 This skips events that are integers or symbols.\n\
75 f -- Existing file name.\n\
76 F -- Possibly nonexistent file name.\n\
77 k -- Key sequence (string).\n\
78 m -- Value of mark as number. Does not do I/O.\n\
79 n -- Number read using minibuffer.\n\
80 N -- Prefix arg converted to number, or if none, do like code `n'.\n\
81 p -- Prefix arg converted to number. Does not do I/O.\n\
82 P -- Prefix arg in raw form. Does not do I/O.\n\
83 r -- Region: point and mark as 2 numeric args, smallest first. Does no I/O.\n\
84 s -- Any string.\n\
85 S -- Any symbol.\n\
86 v -- Variable name: symbol that is user-variable-p.\n\
87 x -- Lisp expression read but not evaluated.\n\
88 X -- Lisp expression read and evaluated.\n\
89 In addition, if the string begins with `*'\n\
90 then an error is signaled if the buffer is read-only.\n\
91 This happens before reading any arguments.\n\
92 If the string begins with `@', then Emacs searches the key sequence\n\
93 which invoked the command for its first mouse click (or any other\n\
94 event which specifies a window), and selects that window before\n\
95 reading any arguments. You may use both `@' and `*'; they are\n\
96 processed in the order that they appear." */
98 /* ARGSUSED */
99 DEFUN ("interactive", Finteractive, Sinteractive, 0, UNEVALLED, 0,
100 0 /* See immediately above */)
101 (args)
102 Lisp_Object args;
104 return Qnil;
107 /* Quotify EXP: if EXP is constant, return it.
108 If EXP is not constant, return (quote EXP). */
109 Lisp_Object
110 quotify_arg (exp)
111 register Lisp_Object exp;
113 if (XTYPE (exp) != Lisp_Int && XTYPE (exp) != Lisp_String
114 && !NILP (exp) && !EQ (exp, Qt))
115 return Fcons (Qquote, Fcons (exp, Qnil));
117 return exp;
120 /* Modify EXP by quotifying each element (except the first). */
121 Lisp_Object
122 quotify_args (exp)
123 Lisp_Object exp;
125 register Lisp_Object tail;
126 register struct Lisp_Cons *ptr;
127 for (tail = exp; CONSP (tail); tail = ptr->cdr)
129 ptr = XCONS (tail);
130 ptr->car = quotify_arg (ptr->car);
132 return exp;
135 char *callint_argfuns[]
136 = {"", "point", "mark", "region-beginning", "region-end"};
138 static void
139 check_mark ()
141 Lisp_Object tem = Fmarker_buffer (current_buffer->mark);
142 if (NILP (tem) || (XBUFFER (tem) != current_buffer))
143 error ("The mark is not set now");
144 if (NILP (current_buffer->mark_active))
145 error ("The mark is not active now");
149 DEFUN ("call-interactively", Fcall_interactively, Scall_interactively, 1, 2, 0,
150 "Call FUNCTION, reading args according to its interactive calling specs.\n\
151 The function contains a specification of how to do the argument reading.\n\
152 In the case of user-defined functions, this is specified by placing a call\n\
153 to the function `interactive' at the top level of the function body.\n\
154 See `interactive'.\n\
156 Optional second arg RECORD-FLAG non-nil\n\
157 means unconditionally put this command in the command-history.\n\
158 Otherwise, this is done only if an arg is read using the minibuffer.")
159 (function, record)
160 Lisp_Object function, record;
162 Lisp_Object *args, *visargs;
163 unsigned char **argstrings;
164 Lisp_Object fun;
165 Lisp_Object funcar;
166 Lisp_Object specs;
167 Lisp_Object teml;
168 Lisp_Object enable;
169 int speccount = specpdl_ptr - specpdl;
171 /* The index of the next element of this_command_keys to examine for
172 the 'e' interactive code. */
173 int next_event;
175 Lisp_Object prefix_arg;
176 unsigned char *string;
177 unsigned char *tem;
179 /* If varies[i] > 0, the i'th argument shouldn't just have its value
180 in this call quoted in the command history. It should be
181 recorded as a call to the function named callint_argfuns[varies[i]]. */
182 int *varies;
184 register int i, j;
185 int count, foo;
186 char prompt[100];
187 char prompt1[100];
188 char *tem1;
189 int arg_from_tty = 0;
190 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
192 /* Save this now, since use of minibuffer will clobber it. */
193 prefix_arg = Vcurrent_prefix_arg;
195 retry:
197 if (XTYPE (function) == Lisp_Symbol)
198 enable = Fget (function, Qenable_recursive_minibuffers);
200 fun = indirect_function (function);
202 specs = Qnil;
203 string = 0;
205 /* Decode the kind of function. Either handle it and return,
206 or go to `lose' if not interactive, or go to `retry'
207 to specify a different function, or set either STRING or SPECS. */
209 if (XTYPE (fun) == Lisp_Subr)
211 string = (unsigned char *) XSUBR (fun)->prompt;
212 if (!string)
214 lose:
215 function = wrong_type_argument (Qcommandp, function);
216 goto retry;
218 if ((int) string == 1)
219 /* Let SPECS (which is nil) be used as the args. */
220 string = 0;
222 else if (XTYPE (fun) == Lisp_Compiled)
224 if (XVECTOR (fun)->size <= COMPILED_INTERACTIVE)
225 goto lose;
226 specs = XVECTOR (fun)->contents[COMPILED_INTERACTIVE];
228 else if (!CONSP (fun))
229 goto lose;
230 else if (funcar = Fcar (fun), EQ (funcar, Qautoload))
232 GCPRO2 (function, prefix_arg);
233 do_autoload (fun, function);
234 UNGCPRO;
235 goto retry;
237 else if (EQ (funcar, Qlambda))
239 specs = Fassq (Qinteractive, Fcdr (Fcdr (fun)));
240 if (NILP (specs))
241 goto lose;
242 specs = Fcar (Fcdr (specs));
244 else if (EQ (funcar, Qmocklisp))
245 return ml_apply (fun, Qinteractive);
246 else
247 goto lose;
249 /* If either specs or string is set to a string, use it. */
250 if (XTYPE (specs) == Lisp_String)
252 /* Make a copy of string so that if a GC relocates specs,
253 `string' will still be valid. */
254 string = (unsigned char *) alloca (XSTRING (specs)->size + 1);
255 bcopy (XSTRING (specs)->data, string, XSTRING (specs)->size + 1);
257 else if (string == 0)
259 Lisp_Object input;
260 i = num_input_chars;
261 input = specs;
262 /* Compute the arg values using the user's expression. */
263 specs = Feval (specs);
264 if (i != num_input_chars || !NILP (record))
266 /* We should record this command on the command history. */
267 Lisp_Object values, car;
268 /* Make a copy of the list of values, for the command history,
269 and turn them into things we can eval. */
270 values = quotify_args (Fcopy_sequence (specs));
271 /* If the list of args was produced with an explicit call to `list',
272 look for elements that were computed with (region-beginning)
273 or (region-end), and put those expressions into VALUES
274 instead of the present values. */
275 car = Fcar (input);
276 if (EQ (car, Qlist))
278 Lisp_Object intail, valtail;
279 for (intail = Fcdr (input), valtail = values;
280 CONSP (valtail);
281 intail = Fcdr (intail), valtail = Fcdr (valtail))
283 Lisp_Object elt;
284 elt = Fcar (intail);
285 if (CONSP (elt))
287 Lisp_Object presflag;
288 presflag = Fmemq (Fcar (elt), preserved_fns);
289 if (!NILP (presflag))
290 Fsetcar (valtail, Fcar (intail));
294 Vcommand_history
295 = Fcons (Fcons (function, values), Vcommand_history);
297 return apply1 (function, specs);
300 /* Here if function specifies a string to control parsing the defaults */
302 /* Set next_event to point to the first event with parameters. */
303 for (next_event = 0; next_event < this_command_key_count; next_event++)
304 if (EVENT_HAS_PARAMETERS
305 (XVECTOR (this_command_keys)->contents[next_event]))
306 break;
308 /* Handle special starting chars `*' and `@'. */
309 while (1)
311 if (*string == '*')
313 string++;
314 if (!NILP (current_buffer->read_only))
315 Fbarf_if_buffer_read_only ();
317 else if (*string == '@')
319 Lisp_Object event =
320 XVECTOR (this_command_keys)->contents[next_event];
322 if (EVENT_HAS_PARAMETERS (event)
323 && XTYPE (event = XCONS (event)->cdr) == Lisp_Cons
324 && XTYPE (event = XCONS (event)->car) == Lisp_Cons
325 && XTYPE (event = XCONS (event)->car) == Lisp_Window)
326 Fselect_window (event);
327 string++;
329 else break;
332 /* Count the number of arguments the interactive spec would have
333 us give to the function. */
334 tem = string;
335 for (j = 0; *tem; j++)
337 /* 'r' specifications ("point and mark as 2 numeric args")
338 produce *two* arguments. */
339 if (*tem == 'r') j++;
340 tem = (unsigned char *) index (tem, '\n');
341 if (tem)
342 tem++;
343 else
344 tem = (unsigned char *) "";
346 count = j;
348 args = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object));
349 visargs = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object));
350 argstrings = (unsigned char **) alloca ((count + 1) * sizeof (char *));
351 varies = (int *) alloca ((count + 1) * sizeof (int));
353 for (i = 0; i < (count + 1); i++)
355 args[i] = Qnil;
356 visargs[i] = Qnil;
357 varies[i] = 0;
360 GCPRO4 (prefix_arg, function, *args, *visargs);
361 gcpro3.nvars = (count + 1);
362 gcpro4.nvars = (count + 1);
364 if (!NILP (enable))
365 specbind (Qenable_recursive_minibuffers, Qt);
367 tem = string;
368 for (i = 1; *tem; i++)
370 strncpy (prompt1, tem + 1, sizeof prompt1 - 1);
371 prompt1[sizeof prompt1 - 1] = 0;
372 tem1 = index (prompt1, '\n');
373 if (tem1) *tem1 = 0;
374 /* Fill argstrings with a vector of C strings
375 corresponding to the Lisp strings in visargs. */
376 for (j = 1; j < i; j++)
377 argstrings[j]
378 = EQ (visargs[j], Qnil)
379 ? (unsigned char *) ""
380 : XSTRING (visargs[j])->data;
382 doprnt (prompt, sizeof prompt, prompt1, 0, j - 1, argstrings + 1);
384 switch (*tem)
386 case 'a': /* Symbol defined as a function */
387 visargs[i] = Fcompleting_read (build_string (prompt),
388 Vobarray, Qfboundp, Qt, Qnil, Qnil);
389 /* Passing args[i] directly stimulates compiler bug */
390 teml = visargs[i];
391 args[i] = Fintern (teml, Qnil);
392 break;
394 case 'b': /* Name of existing buffer */
395 args[i] = Fcurrent_buffer ();
396 if (EQ (selected_window, minibuf_window))
397 args[i] = Fother_buffer (args[i], Qnil);
398 args[i] = Fread_buffer (build_string (prompt), args[i], Qt);
399 break;
401 case 'B': /* Name of buffer, possibly nonexistent */
402 args[i] = Fread_buffer (build_string (prompt),
403 Fother_buffer (Fcurrent_buffer (), Qnil),
404 Qnil);
405 break;
407 case 'c': /* Character */
408 message1 (prompt);
409 args[i] = Fread_char ();
410 /* Passing args[i] directly stimulates compiler bug */
411 teml = args[i];
412 visargs[i] = Fchar_to_string (teml);
413 break;
415 case 'C': /* Command: symbol with interactive function */
416 visargs[i] = Fcompleting_read (build_string (prompt),
417 Vobarray, Qcommandp, Qt, Qnil, Qnil);
418 /* Passing args[i] directly stimulates compiler bug */
419 teml = visargs[i];
420 args[i] = Fintern (teml, Qnil);
421 break;
423 case 'd': /* Value of point. Does not do I/O. */
424 XFASTINT (args[i]) = point;
425 /* visargs[i] = Qnil; */
426 varies[i] = 1;
427 break;
429 case 'D': /* Directory name. */
430 args[i] = Fread_file_name (build_string (prompt), Qnil,
431 current_buffer->directory, Qlambda, Qnil);
432 break;
434 case 'f': /* Existing file name. */
435 args[i] = Fread_file_name (build_string (prompt),
436 Qnil, Qnil, Qlambda, Qnil);
437 break;
439 case 'F': /* Possibly nonexistent file name. */
440 args[i] = Fread_file_name (build_string (prompt),
441 Qnil, Qnil, Qnil, Qnil);
442 break;
444 case 'k': /* Key sequence (string) */
445 args[i] = Fread_key_sequence (build_string (prompt), Qnil);
446 teml = args[i];
447 visargs[i] = Fkey_description (teml);
448 break;
450 case 'e': /* The invoking event. */
451 if (next_event >= this_command_key_count)
452 error ("%s must be bound to an event with parameters",
453 (XTYPE (function) == Lisp_Symbol
454 ? (char *) XSYMBOL (function)->name->data
455 : "command"));
456 args[i] = XVECTOR (this_command_keys)->contents[next_event++];
457 varies[i] = -1;
459 /* Find the next parameterized event. */
460 while (next_event < this_command_key_count
461 && ! (EVENT_HAS_PARAMETERS
462 (XVECTOR (this_command_keys)->contents[next_event])))
463 next_event++;
465 break;
467 case 'm': /* Value of mark. Does not do I/O. */
468 check_mark ();
469 /* visargs[i] = Qnil; */
470 XFASTINT (args[i]) = marker_position (current_buffer->mark);
471 varies[i] = 2;
472 break;
474 case 'N': /* Prefix arg, else number from minibuffer */
475 if (!NILP (prefix_arg))
476 goto have_prefix_arg;
477 case 'n': /* Read number from minibuffer. */
479 args[i] = Fread_minibuffer (build_string (prompt), Qnil);
480 while (! NUMBERP (args[i]));
481 visargs[i] = last_minibuf_string;
482 break;
484 case 'P': /* Prefix arg in raw form. Does no I/O. */
485 have_prefix_arg:
486 args[i] = prefix_arg;
487 /* visargs[i] = Qnil; */
488 varies[i] = -1;
489 break;
491 case 'p': /* Prefix arg converted to number. No I/O. */
492 args[i] = Fprefix_numeric_value (prefix_arg);
493 /* visargs[i] = Qnil; */
494 varies[i] = -1;
495 break;
497 case 'r': /* Region, point and mark as 2 args. */
498 check_mark ();
499 /* visargs[i+1] = Qnil; */
500 foo = marker_position (current_buffer->mark);
501 /* visargs[i] = Qnil; */
502 XFASTINT (args[i]) = point < foo ? point : foo;
503 varies[i] = 3;
504 XFASTINT (args[++i]) = point > foo ? point : foo;
505 varies[i] = 4;
506 break;
508 case 's': /* String read via minibuffer. */
509 args[i] = Fread_string (build_string (prompt), Qnil);
510 break;
512 case 'S': /* Any symbol. */
513 visargs[i] = Fread_string (build_string (prompt), Qnil);
514 /* Passing args[i] directly stimulates compiler bug */
515 teml = visargs[i];
516 args[i] = Fintern (teml, Qnil);
517 break;
519 case 'v': /* Variable name: symbol that is
520 user-variable-p. */
521 args[i] = Fread_variable (build_string (prompt));
522 visargs[i] = last_minibuf_string;
523 break;
525 case 'x': /* Lisp expression read but not evaluated */
526 args[i] = Fread_minibuffer (build_string (prompt), Qnil);
527 visargs[i] = last_minibuf_string;
528 break;
530 case 'X': /* Lisp expression read and evaluated */
531 args[i] = Feval_minibuffer (build_string (prompt), Qnil);
532 visargs[i] = last_minibuf_string;
533 break;
535 default:
536 error ("Invalid control letter \"%c\" (%03o) in interactive calling string",
537 *tem, *tem);
540 if (varies[i] == 0)
541 arg_from_tty = 1;
543 if (NILP (visargs[i]) && XTYPE (args[i]) == Lisp_String)
544 visargs[i] = args[i];
546 tem = (unsigned char *) index (tem, '\n');
547 if (tem) tem++;
548 else tem = (unsigned char *) "";
550 unbind_to (speccount, Qnil);
552 QUIT;
554 args[0] = function;
556 if (arg_from_tty || !NILP (record))
558 visargs[0] = function;
559 for (i = 1; i < count + 1; i++)
560 if (varies[i] > 0)
561 visargs[i] = Fcons (intern (callint_argfuns[varies[i]]), Qnil);
562 else
563 visargs[i] = quotify_arg (args[i]);
564 Vcommand_history = Fcons (Flist (count + 1, visargs),
565 Vcommand_history);
569 Lisp_Object val;
570 specbind (Qcommand_debug_status, Qnil);
572 val = Ffuncall (count + 1, args);
573 UNGCPRO;
574 return unbind_to (speccount, val);
578 DEFUN ("prefix-numeric-value", Fprefix_numeric_value, Sprefix_numeric_value,
579 1, 1, 0,
580 "Return numeric meaning of raw prefix argument ARG.\n\
581 A raw prefix argument is what you get from `(interactive \"P\")'.\n\
582 Its numeric meaning is what you would get from `(interactive \"p\")'.")
583 (raw)
584 Lisp_Object raw;
586 Lisp_Object val;
588 /* Tag val as an integer, so the rest of the assignments
589 may use XSETINT. */
590 XFASTINT (val) = 0;
592 if (NILP (raw))
593 XFASTINT (val) = 1;
594 else if (EQ (raw, Qminus))
595 XSETINT (val, -1);
596 else if (CONSP (raw))
597 XSETINT (val, XINT (XCONS (raw)->car));
598 else if (XTYPE (raw) == Lisp_Int)
599 val = raw;
600 else
601 XFASTINT (val) = 1;
603 return val;
606 syms_of_callint ()
608 preserved_fns = Fcons (intern ("region-beginning"),
609 Fcons (intern ("region-end"),
610 Fcons (intern ("point"),
611 Fcons (intern ("mark"), Qnil))));
612 staticpro (&preserved_fns);
614 Qlist = intern ("list");
615 staticpro (&Qlist);
617 Qminus = intern ("-");
618 staticpro (&Qminus);
620 Qcall_interactively = intern ("call-interactively");
621 staticpro (&Qcall_interactively);
623 Qcommand_debug_status = intern ("command-debug-status");
624 staticpro (&Qcommand_debug_status);
626 Qenable_recursive_minibuffers = intern ("enable-recursive-minibuffers");
627 staticpro (&Qenable_recursive_minibuffers);
629 DEFVAR_LISP ("prefix-arg", &Vprefix_arg,
630 "The value of the prefix argument for the next editing command.\n\
631 It may be a number, or the symbol `-' for just a minus sign as arg,\n\
632 or a list whose car is a number for just one or more C-U's\n\
633 or nil if no argument has been specified.\n\
635 You cannot examine this variable to find the argument for this command\n\
636 since it has been set to nil by the time you can look.\n\
637 Instead, you should use the variable `current-prefix-arg', although\n\
638 normally commands can get this prefix argument with (interactive \"P\").");
639 Vprefix_arg = Qnil;
641 DEFVAR_LISP ("current-prefix-arg", &Vcurrent_prefix_arg,
642 "The value of the prefix argument for this editing command.\n\
643 It may be a number, or the symbol `-' for just a minus sign as arg,\n\
644 or a list whose car is a number for just one or more C-U's\n\
645 or nil if no argument has been specified.\n\
646 This is what `(interactive \"P\")' returns.");
647 Vcurrent_prefix_arg = Qnil;
649 DEFVAR_LISP ("command-history", &Vcommand_history,
650 "List of recent commands that read arguments from terminal.\n\
651 Each command is represented as a form to evaluate.");
652 Vcommand_history = Qnil;
654 DEFVAR_LISP ("command-debug-status", &Vcommand_debug_status,
655 "Debugging status of current interactive command.\n\
656 Bound each time `call-interactively' is called;\n\
657 may be set by the debugger as a reminder for itself.");
658 Vcommand_debug_status = Qnil;
660 defsubr (&Sinteractive);
661 defsubr (&Scall_interactively);
662 defsubr (&Sprefix_numeric_value);