1 /* Call a Lisp function interactively.
2 Copyright (C) 1985, 1986, 1993, 1994, 1995 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)
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. */
29 extern char *index ();
31 Lisp_Object Qminus
, Qplus
;
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 /* Non-nil means treat the mark as active
39 even if mark_active is 0. */
40 Lisp_Object Vmark_even_if_inactive
;
42 Lisp_Object Vmouse_leave_buffer_hook
, Qmouse_leave_buffer_hook
;
45 Lisp_Object preserved_fns
;
47 /* This comment supplies the doc string for interactive,
48 for make-docfile to see. We cannot put this in the real DEFUN
49 due to limits in the Unix cpp.
51 DEFUN ("interactive", Ffoo, Sfoo, 0, 0, 0,
52 "Specify a way of parsing arguments for interactive use of a function.\n\
54 (defun foo (arg) \"Doc string\" (interactive \"p\") ...use arg...)\n\
55 to make ARG be the prefix argument when `foo' is called as a command.\n\
56 The \"call\" to `interactive' is actually a declaration rather than a function;\n\
57 it tells `call-interactively' how to read arguments\n\
58 to pass to the function.\n\
59 When actually called, `interactive' just returns nil.\n\
61 The argument of `interactive' is usually a string containing a code letter\n\
62 followed by a prompt. (Some code letters do not use I/O to get\n\
63 the argument and do not need prompts.) To prompt for multiple arguments,\n\
64 give a code letter, its prompt, a newline, and another code letter, etc.\n\
65 Prompts are passed to format, and may use % escapes to print the\n\
66 arguments that have already been read.\n\
67 If the argument is not a string, it is evaluated to get a list of\n\
68 arguments to pass to the function.\n\
69 Just `(interactive)' means pass no args when calling interactively.\n\
70 \nCode letters available are:\n\
71 a -- Function name: symbol with a function definition.\n\
72 b -- Name of existing buffer.\n\
73 B -- Name of buffer, possibly nonexistent.\n\
75 C -- Command name: symbol with interactive function definition.\n\
76 d -- Value of point as number. Does not do I/O.\n\
77 D -- Directory name.\n\
78 e -- Parametrized event (i.e., one that's a list) that invoked this command.\n\
79 If used more than once, the Nth `e' returns the Nth parameterized event.\n\
80 This skips events that are integers or symbols.\n\
81 f -- Existing file name.\n\
82 F -- Possibly nonexistent file name.\n\
83 k -- Key sequence (string).\n\
84 m -- Value of mark as number. Does not do I/O.\n\
85 n -- Number read using minibuffer.\n\
86 N -- Raw prefix arg, or if none, do like code `n'.\n\
87 p -- Prefix arg converted to number. Does not do I/O.\n\
88 P -- Prefix arg in raw form. Does not do I/O.\n\
89 r -- Region: point and mark as 2 numeric args, smallest first. Does no I/O.\n\
92 v -- Variable name: symbol that is user-variable-p.\n\
93 x -- Lisp expression read but not evaluated.\n\
94 X -- Lisp expression read and evaluated.\n\
95 In addition, if the string begins with `*'\n\
96 then an error is signaled if the buffer is read-only.\n\
97 This happens before reading any arguments.\n\
98 If the string begins with `@', then Emacs searches the key sequence\n\
99 which invoked the command for its first mouse click (or any other\n\
100 event which specifies a window), and selects that window before\n\
101 reading any arguments. You may use both `@' and `*'; they are\n\
102 processed in the order that they appear." */
105 DEFUN ("interactive", Finteractive
, Sinteractive
, 0, UNEVALLED
, 0,
106 0 /* See immediately above */)
113 /* Quotify EXP: if EXP is constant, return it.
114 If EXP is not constant, return (quote EXP). */
117 register Lisp_Object exp
;
119 if (!INTEGERP (exp
) && !STRINGP (exp
)
120 && !NILP (exp
) && !EQ (exp
, Qt
))
121 return Fcons (Qquote
, Fcons (exp
, Qnil
));
126 /* Modify EXP by quotifying each element (except the first). */
131 register Lisp_Object tail
;
132 register struct Lisp_Cons
*ptr
;
133 for (tail
= exp
; CONSP (tail
); tail
= ptr
->cdr
)
136 ptr
->car
= quotify_arg (ptr
->car
);
141 char *callint_argfuns
[]
142 = {"", "point", "mark", "region-beginning", "region-end"};
148 tem
= Fmarker_buffer (current_buffer
->mark
);
149 if (NILP (tem
) || (XBUFFER (tem
) != current_buffer
))
150 error ("The mark is not set now");
151 if (!NILP (Vtransient_mark_mode
) && NILP (Vmark_even_if_inactive
)
152 && NILP (current_buffer
->mark_active
))
153 Fsignal (Qmark_inactive
, Qnil
);
157 DEFUN ("call-interactively", Fcall_interactively
, Scall_interactively
, 1, 2, 0,
158 "Call FUNCTION, reading args according to its interactive calling specs.\n\
159 The function contains a specification of how to do the argument reading.\n\
160 In the case of user-defined functions, this is specified by placing a call\n\
161 to the function `interactive' at the top level of the function body.\n\
162 See `interactive'.\n\
164 Optional second arg RECORD-FLAG non-nil\n\
165 means unconditionally put this command in the command-history.\n\
166 Otherwise, this is done only if an arg is read using the minibuffer.")
168 Lisp_Object function
, record
;
170 Lisp_Object
*args
, *visargs
;
171 unsigned char **argstrings
;
177 int speccount
= specpdl_ptr
- specpdl
;
179 /* The index of the next element of this_command_keys to examine for
180 the 'e' interactive code. */
183 Lisp_Object prefix_arg
;
184 unsigned char *string
;
187 /* If varies[i] > 0, the i'th argument shouldn't just have its value
188 in this call quoted in the command history. It should be
189 recorded as a call to the function named callint_argfuns[varies[i]]. */
197 int arg_from_tty
= 0;
198 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
200 /* Save this now, since use of minibuffer will clobber it. */
201 prefix_arg
= current_perdisplay
->Vcurrent_prefix_arg
;
205 if (SYMBOLP (function
))
206 enable
= Fget (function
, Qenable_recursive_minibuffers
);
208 fun
= indirect_function (function
);
213 /* Decode the kind of function. Either handle it and return,
214 or go to `lose' if not interactive, or go to `retry'
215 to specify a different function, or set either STRING or SPECS. */
219 string
= (unsigned char *) XSUBR (fun
)->prompt
;
223 function
= wrong_type_argument (Qcommandp
, function
);
226 if ((EMACS_INT
) string
== 1)
227 /* Let SPECS (which is nil) be used as the args. */
230 else if (COMPILEDP (fun
))
232 if ((XVECTOR (fun
)->size
& PSEUDOVECTOR_SIZE_MASK
) <= COMPILED_INTERACTIVE
)
234 specs
= XVECTOR (fun
)->contents
[COMPILED_INTERACTIVE
];
236 else if (!CONSP (fun
))
238 else if (funcar
= Fcar (fun
), EQ (funcar
, Qautoload
))
240 GCPRO2 (function
, prefix_arg
);
241 do_autoload (fun
, function
);
245 else if (EQ (funcar
, Qlambda
))
247 specs
= Fassq (Qinteractive
, Fcdr (Fcdr (fun
)));
250 specs
= Fcar (Fcdr (specs
));
252 else if (EQ (funcar
, Qmocklisp
))
253 return ml_apply (fun
, Qinteractive
);
257 /* If either specs or string is set to a string, use it. */
260 /* Make a copy of string so that if a GC relocates specs,
261 `string' will still be valid. */
262 string
= (unsigned char *) alloca (XSTRING (specs
)->size
+ 1);
263 bcopy (XSTRING (specs
)->data
, string
, XSTRING (specs
)->size
+ 1);
265 else if (string
== 0)
270 /* Compute the arg values using the user's expression. */
271 specs
= Feval (specs
);
272 if (i
!= num_input_chars
|| !NILP (record
))
274 /* We should record this command on the command history. */
275 Lisp_Object values
, car
;
276 /* Make a copy of the list of values, for the command history,
277 and turn them into things we can eval. */
278 values
= quotify_args (Fcopy_sequence (specs
));
279 /* If the list of args was produced with an explicit call to `list',
280 look for elements that were computed with (region-beginning)
281 or (region-end), and put those expressions into VALUES
282 instead of the present values. */
286 Lisp_Object intail
, valtail
;
287 for (intail
= Fcdr (input
), valtail
= values
;
289 intail
= Fcdr (intail
), valtail
= Fcdr (valtail
))
295 Lisp_Object presflag
;
296 presflag
= Fmemq (Fcar (elt
), preserved_fns
);
297 if (!NILP (presflag
))
298 Fsetcar (valtail
, Fcar (intail
));
303 = Fcons (Fcons (function
, values
), Vcommand_history
);
305 return apply1 (function
, specs
);
308 /* Here if function specifies a string to control parsing the defaults */
310 /* Set next_event to point to the first event with parameters. */
311 for (next_event
= 0; next_event
< this_command_key_count
; next_event
++)
312 if (EVENT_HAS_PARAMETERS
313 (XVECTOR (this_command_keys
)->contents
[next_event
]))
316 /* Handle special starting chars `*' and `@'. Also `-'. */
322 if (!NILP (current_buffer
->read_only
))
323 Fbarf_if_buffer_read_only ();
325 /* Ignore this for semi-compatibility with Lucid. */
326 else if (*string
== '-')
328 else if (*string
== '@')
332 event
= XVECTOR (this_command_keys
)->contents
[next_event
];
333 if (EVENT_HAS_PARAMETERS (event
)
334 && (event
= XCONS (event
)->car
, CONSP (event
))
335 && (event
= XCONS (event
)->car
, CONSP (event
))
336 && (event
= XCONS (event
)->car
), WINDOWP (event
))
338 if (MINI_WINDOW_P (XWINDOW (event
))
339 && ! (minibuf_level
> 0 && EQ (event
, minibuf_window
)))
340 error ("Attempt to select inactive minibuffer window");
342 /* If the current buffer wants to clean up, let it. */
343 if (!NILP (Vmouse_leave_buffer_hook
))
344 call1 (Vrun_hooks
, Qmouse_leave_buffer_hook
);
346 Fselect_window (event
);
353 /* Count the number of arguments the interactive spec would have
354 us give to the function. */
356 for (j
= 0; *tem
; j
++)
358 /* 'r' specifications ("point and mark as 2 numeric args")
359 produce *two* arguments. */
360 if (*tem
== 'r') j
++;
361 tem
= (unsigned char *) index (tem
, '\n');
365 tem
= (unsigned char *) "";
369 args
= (Lisp_Object
*) alloca ((count
+ 1) * sizeof (Lisp_Object
));
370 visargs
= (Lisp_Object
*) alloca ((count
+ 1) * sizeof (Lisp_Object
));
371 argstrings
= (unsigned char **) alloca ((count
+ 1) * sizeof (char *));
372 varies
= (int *) alloca ((count
+ 1) * sizeof (int));
374 for (i
= 0; i
< (count
+ 1); i
++)
381 GCPRO4 (prefix_arg
, function
, *args
, *visargs
);
382 gcpro3
.nvars
= (count
+ 1);
383 gcpro4
.nvars
= (count
+ 1);
386 specbind (Qenable_recursive_minibuffers
, Qt
);
389 for (i
= 1; *tem
; i
++)
391 strncpy (prompt1
, tem
+ 1, sizeof prompt1
- 1);
392 prompt1
[sizeof prompt1
- 1] = 0;
393 tem1
= index (prompt1
, '\n');
395 /* Fill argstrings with a vector of C strings
396 corresponding to the Lisp strings in visargs. */
397 for (j
= 1; j
< i
; j
++)
399 = EQ (visargs
[j
], Qnil
)
400 ? (unsigned char *) ""
401 : XSTRING (visargs
[j
])->data
;
403 doprnt (prompt
, sizeof prompt
, prompt1
, 0, j
- 1, argstrings
+ 1);
407 case 'a': /* Symbol defined as a function */
408 visargs
[i
] = Fcompleting_read (build_string (prompt
),
409 Vobarray
, Qfboundp
, Qt
, Qnil
, Qnil
);
410 /* Passing args[i] directly stimulates compiler bug */
412 args
[i
] = Fintern (teml
, Qnil
);
415 case 'b': /* Name of existing buffer */
416 args
[i
] = Fcurrent_buffer ();
417 if (EQ (selected_window
, minibuf_window
))
418 args
[i
] = Fother_buffer (args
[i
], Qnil
);
419 args
[i
] = Fread_buffer (build_string (prompt
), args
[i
], Qt
);
422 case 'B': /* Name of buffer, possibly nonexistent */
423 args
[i
] = Fread_buffer (build_string (prompt
),
424 Fother_buffer (Fcurrent_buffer (), Qnil
),
428 case 'c': /* Character */
430 args
[i
] = Fread_char ();
431 /* Passing args[i] directly stimulates compiler bug */
433 visargs
[i
] = Fchar_to_string (teml
);
436 case 'C': /* Command: symbol with interactive function */
437 visargs
[i
] = Fcompleting_read (build_string (prompt
),
438 Vobarray
, Qcommandp
, Qt
, Qnil
, Qnil
);
439 /* Passing args[i] directly stimulates compiler bug */
441 args
[i
] = Fintern (teml
, Qnil
);
444 case 'd': /* Value of point. Does not do I/O. */
445 XSETFASTINT (args
[i
], point
);
446 /* visargs[i] = Qnil; */
450 case 'D': /* Directory name. */
451 args
[i
] = Fread_file_name (build_string (prompt
), Qnil
,
452 current_buffer
->directory
, Qlambda
, Qnil
);
455 case 'f': /* Existing file name. */
456 args
[i
] = Fread_file_name (build_string (prompt
),
457 Qnil
, Qnil
, Qlambda
, Qnil
);
460 case 'F': /* Possibly nonexistent file name. */
461 args
[i
] = Fread_file_name (build_string (prompt
),
462 Qnil
, Qnil
, Qnil
, Qnil
);
465 case 'k': /* Key sequence. */
466 args
[i
] = Fread_key_sequence (build_string (prompt
), Qnil
, Qnil
);
468 visargs
[i
] = Fkey_description (teml
);
471 case 'K': /* Key sequence to be defined. */
472 args
[i
] = Fread_key_sequence (build_string (prompt
), Qnil
, Qt
);
474 visargs
[i
] = Fkey_description (teml
);
477 case 'e': /* The invoking event. */
478 if (next_event
>= this_command_key_count
)
479 error ("%s must be bound to an event with parameters",
481 ? (char *) XSYMBOL (function
)->name
->data
483 args
[i
] = XVECTOR (this_command_keys
)->contents
[next_event
++];
486 /* Find the next parameterized event. */
487 while (next_event
< this_command_key_count
488 && ! (EVENT_HAS_PARAMETERS
489 (XVECTOR (this_command_keys
)->contents
[next_event
])))
494 case 'm': /* Value of mark. Does not do I/O. */
496 /* visargs[i] = Qnil; */
497 XSETFASTINT (args
[i
], marker_position (current_buffer
->mark
));
501 case 'N': /* Prefix arg, else number from minibuffer */
502 if (!NILP (prefix_arg
))
503 goto have_prefix_arg
;
504 case 'n': /* Read number from minibuffer. */
506 args
[i
] = Fread_minibuffer (build_string (prompt
), Qnil
);
507 while (! NUMBERP (args
[i
]));
508 visargs
[i
] = last_minibuf_string
;
511 case 'P': /* Prefix arg in raw form. Does no I/O. */
513 args
[i
] = prefix_arg
;
514 /* visargs[i] = Qnil; */
518 case 'p': /* Prefix arg converted to number. No I/O. */
519 args
[i
] = Fprefix_numeric_value (prefix_arg
);
520 /* visargs[i] = Qnil; */
524 case 'r': /* Region, point and mark as 2 args. */
526 /* visargs[i+1] = Qnil; */
527 foo
= marker_position (current_buffer
->mark
);
528 /* visargs[i] = Qnil; */
529 XSETFASTINT (args
[i
], point
< foo
? point
: foo
);
531 XSETFASTINT (args
[++i
], point
> foo
? point
: foo
);
535 case 's': /* String read via minibuffer. */
536 args
[i
] = Fread_string (build_string (prompt
), Qnil
, Qnil
);
539 case 'S': /* Any symbol. */
540 visargs
[i
] = Fread_string (build_string (prompt
), Qnil
, Qnil
);
541 /* Passing args[i] directly stimulates compiler bug */
543 args
[i
] = Fintern (teml
, Qnil
);
546 case 'v': /* Variable name: symbol that is
548 args
[i
] = Fread_variable (build_string (prompt
));
549 visargs
[i
] = last_minibuf_string
;
552 case 'x': /* Lisp expression read but not evaluated */
553 args
[i
] = Fread_minibuffer (build_string (prompt
), Qnil
);
554 visargs
[i
] = last_minibuf_string
;
557 case 'X': /* Lisp expression read and evaluated */
558 args
[i
] = Feval_minibuffer (build_string (prompt
), Qnil
);
559 visargs
[i
] = last_minibuf_string
;
563 error ("Invalid control letter \"%c\" (%03o) in interactive calling string",
570 if (NILP (visargs
[i
]) && STRINGP (args
[i
]))
571 visargs
[i
] = args
[i
];
573 tem
= (unsigned char *) index (tem
, '\n');
575 else tem
= (unsigned char *) "";
577 unbind_to (speccount
, Qnil
);
583 if (arg_from_tty
|| !NILP (record
))
585 visargs
[0] = function
;
586 for (i
= 1; i
< count
+ 1; i
++)
588 visargs
[i
] = Fcons (intern (callint_argfuns
[varies
[i
]]), Qnil
);
590 visargs
[i
] = quotify_arg (args
[i
]);
591 Vcommand_history
= Fcons (Flist (count
+ 1, visargs
),
597 specbind (Qcommand_debug_status
, Qnil
);
599 val
= Ffuncall (count
+ 1, args
);
601 return unbind_to (speccount
, val
);
605 DEFUN ("prefix-numeric-value", Fprefix_numeric_value
, Sprefix_numeric_value
,
607 "Return numeric meaning of raw prefix argument ARG.\n\
608 A raw prefix argument is what you get from `(interactive \"P\")'.\n\
609 Its numeric meaning is what you would get from `(interactive \"p\")'.")
616 XSETFASTINT (val
, 1);
617 else if (EQ (raw
, Qminus
))
619 else if (CONSP (raw
))
620 XSETINT (val
, XINT (XCONS (raw
)->car
));
621 else if (INTEGERP (raw
))
624 XSETFASTINT (val
, 1);
631 preserved_fns
= Fcons (intern ("region-beginning"),
632 Fcons (intern ("region-end"),
633 Fcons (intern ("point"),
634 Fcons (intern ("mark"), Qnil
))));
635 staticpro (&preserved_fns
);
637 Qlist
= intern ("list");
640 Qminus
= intern ("-");
643 Qplus
= intern ("+");
646 Qcall_interactively
= intern ("call-interactively");
647 staticpro (&Qcall_interactively
);
649 Qcommand_debug_status
= intern ("command-debug-status");
650 staticpro (&Qcommand_debug_status
);
652 Qenable_recursive_minibuffers
= intern ("enable-recursive-minibuffers");
653 staticpro (&Qenable_recursive_minibuffers
);
655 Qmouse_leave_buffer_hook
= intern ("mouse-leave-buffer-hook");
656 staticpro (&Qmouse_leave_buffer_hook
);
658 DEFVAR_LISP ("command-history", &Vcommand_history
,
659 "List of recent commands that read arguments from terminal.\n\
660 Each command is represented as a form to evaluate.");
661 Vcommand_history
= Qnil
;
663 DEFVAR_LISP ("command-debug-status", &Vcommand_debug_status
,
664 "Debugging status of current interactive command.\n\
665 Bound each time `call-interactively' is called;\n\
666 may be set by the debugger as a reminder for itself.");
667 Vcommand_debug_status
= Qnil
;
669 DEFVAR_LISP ("mark-even-if-inactive", &Vmark_even_if_inactive
,
670 "*Non-nil means you can use the mark even when inactive.\n\
671 This option makes a difference in Transient Mark mode.\n\
672 When the option is non-nil, deactivation of the mark\n\
673 turns off region highlighting, but commands that use the mark\n\
674 behave as if the mark were still active.");
675 Vmark_even_if_inactive
= Qnil
;
677 DEFVAR_LISP ("mouse-leave-buffer-hook", &Vmouse_leave_buffer_hook
,
678 "Hook to run when about to switch windows with a mouse command.\n\
679 Its purpose is to give temporary modes such as Isearch mode\n\
680 a way to turn themselves off when a mouse command switches windows.");
681 Vmouse_leave_buffer_hook
= Qnil
;
683 defsubr (&Sinteractive
);
684 defsubr (&Scall_interactively
);
685 defsubr (&Sprefix_numeric_value
);