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 Vprefix_arg
, Vcurrent_prefix_arg
, 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
= 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
);
539 case 'S': /* Any symbol. */
540 visargs
[i
] = Fread_string (build_string (prompt
), 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 ("prefix-arg", &Vprefix_arg
,
659 "The value of the prefix argument for the next editing command.\n\
660 It may be a number, or the symbol `-' for just a minus sign as arg,\n\
661 or a list whose car is a number for just one or more C-U's\n\
662 or nil if no argument has been specified.\n\
664 You cannot examine this variable to find the argument for this command\n\
665 since it has been set to nil by the time you can look.\n\
666 Instead, you should use the variable `current-prefix-arg', although\n\
667 normally commands can get this prefix argument with (interactive \"P\").");
670 DEFVAR_LISP ("current-prefix-arg", &Vcurrent_prefix_arg
,
671 "The value of the prefix argument for this editing command.\n\
672 It may be a number, or the symbol `-' for just a minus sign as arg,\n\
673 or a list whose car is a number for just one or more C-U's\n\
674 or nil if no argument has been specified.\n\
675 This is what `(interactive \"P\")' returns.");
676 Vcurrent_prefix_arg
= Qnil
;
678 DEFVAR_LISP ("command-history", &Vcommand_history
,
679 "List of recent commands that read arguments from terminal.\n\
680 Each command is represented as a form to evaluate.");
681 Vcommand_history
= Qnil
;
683 DEFVAR_LISP ("command-debug-status", &Vcommand_debug_status
,
684 "Debugging status of current interactive command.\n\
685 Bound each time `call-interactively' is called;\n\
686 may be set by the debugger as a reminder for itself.");
687 Vcommand_debug_status
= Qnil
;
689 DEFVAR_LISP ("mark-even-if-inactive", &Vmark_even_if_inactive
,
690 "*Non-nil means you can use the mark even when inactive.\n\
691 This option makes a difference in Transient Mark mode.\n\
692 When the option is non-nil, deactivation of the mark\n\
693 turns off region highlighting, but commands that use the mark\n\
694 behave as if the mark were still active.");
695 Vmark_even_if_inactive
= Qnil
;
697 DEFVAR_LISP ("mouse-leave-buffer-hook", &Vmouse_leave_buffer_hook
,
698 "Hook to run when about to switch windows with a mouse command.\n\
699 Its purpose is to give temporary modes such as Isearch mode\n\
700 a way to turn themselves off when a mouse command switches windows.");
701 Vmouse_leave_buffer_hook
= Qnil
;
703 defsubr (&Sinteractive
);
704 defsubr (&Scall_interactively
);
705 defsubr (&Sprefix_numeric_value
);