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 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 static Lisp_Object preserved_fns
;
47 /* Marker used within call-interactively to refer to point. */
48 static Lisp_Object point_marker
;
51 /* This comment supplies the doc string for interactive,
52 for make-docfile to see. We cannot put this in the real DEFUN
53 due to limits in the Unix cpp.
55 DEFUN ("interactive", Ffoo, Sfoo, 0, 0, 0,
56 "Specify a way of parsing arguments for interactive use of a function.\n\
58 (defun foo (arg) \"Doc string\" (interactive \"p\") ...use arg...)\n\
59 to make ARG be the prefix argument when `foo' is called as a command.\n\
60 The \"call\" to `interactive' is actually a declaration rather than a function;\n\
61 it tells `call-interactively' how to read arguments\n\
62 to pass to the function.\n\
63 When actually called, `interactive' just returns nil.\n\
65 The argument of `interactive' is usually a string containing a code letter\n\
66 followed by a prompt. (Some code letters do not use I/O to get\n\
67 the argument and do not need prompts.) To prompt for multiple arguments,\n\
68 give a code letter, its prompt, a newline, and another code letter, etc.\n\
69 Prompts are passed to format, and may use % escapes to print the\n\
70 arguments that have already been read.\n\
71 If the argument is not a string, it is evaluated to get a list of\n\
72 arguments to pass to the function.\n\
73 Just `(interactive)' means pass no args when calling interactively.\n\
74 \nCode letters available are:\n\
75 a -- Function name: symbol with a function definition.\n\
76 b -- Name of existing buffer.\n\
77 B -- Name of buffer, possibly nonexistent.\n\
79 C -- Command name: symbol with interactive function definition.\n\
80 d -- Value of point as number. Does not do I/O.\n\
81 D -- Directory name.\n\
82 e -- Parametrized event (i.e., one that's a list) that invoked this command.\n\
83 If used more than once, the Nth `e' returns the Nth parameterized event.\n\
84 This skips events that are integers or symbols.\n\
85 f -- Existing file name.\n\
86 F -- Possibly nonexistent file name.\n\
87 k -- Key sequence (downcase the last event if needed to get a definition).\n\
88 K -- Key sequence to be redefined (do not downcase the last event).\n\
89 m -- Value of mark as number. Does not do I/O.\n\
90 n -- Number read using minibuffer.\n\
91 N -- Raw prefix arg, or if none, do like code `n'.\n\
92 p -- Prefix arg converted to number. Does not do I/O.\n\
93 P -- Prefix arg in raw form. Does not do I/O.\n\
94 r -- Region: point and mark as 2 numeric args, smallest first. Does no I/O.\n\
97 v -- Variable name: symbol that is user-variable-p.\n\
98 x -- Lisp expression read but not evaluated.\n\
99 X -- Lisp expression read and evaluated.\n\
100 In addition, if the string begins with `*'\n\
101 then an error is signaled if the buffer is read-only.\n\
102 This happens before reading any arguments.\n\
103 If the string begins with `@', then Emacs searches the key sequence\n\
104 which invoked the command for its first mouse click (or any other\n\
105 event which specifies a window), and selects that window before\n\
106 reading any arguments. You may use both `@' and `*'; they are\n\
107 processed in the order that they appear." */
110 DEFUN ("interactive", Finteractive
, Sinteractive
, 0, UNEVALLED
, 0,
111 0 /* See immediately above */)
118 /* Quotify EXP: if EXP is constant, return it.
119 If EXP is not constant, return (quote EXP). */
122 register Lisp_Object exp
;
124 if (!INTEGERP (exp
) && !STRINGP (exp
)
125 && !NILP (exp
) && !EQ (exp
, Qt
))
126 return Fcons (Qquote
, Fcons (exp
, Qnil
));
131 /* Modify EXP by quotifying each element (except the first). */
136 register Lisp_Object tail
;
137 register struct Lisp_Cons
*ptr
;
138 for (tail
= exp
; CONSP (tail
); tail
= ptr
->cdr
)
141 ptr
->car
= quotify_arg (ptr
->car
);
146 char *callint_argfuns
[]
147 = {"", "point", "mark", "region-beginning", "region-end"};
153 tem
= Fmarker_buffer (current_buffer
->mark
);
154 if (NILP (tem
) || (XBUFFER (tem
) != current_buffer
))
155 error ("The mark is not set now");
156 if (!NILP (Vtransient_mark_mode
) && NILP (Vmark_even_if_inactive
)
157 && NILP (current_buffer
->mark_active
))
158 Fsignal (Qmark_inactive
, Qnil
);
162 DEFUN ("call-interactively", Fcall_interactively
, Scall_interactively
, 1, 2, 0,
163 "Call FUNCTION, reading args according to its interactive calling specs.\n\
164 The function contains a specification of how to do the argument reading.\n\
165 In the case of user-defined functions, this is specified by placing a call\n\
166 to the function `interactive' at the top level of the function body.\n\
167 See `interactive'.\n\
169 Optional second arg RECORD-FLAG non-nil\n\
170 means unconditionally put this command in the command-history.\n\
171 Otherwise, this is done only if an arg is read using the minibuffer.")
173 Lisp_Object function
, record
;
175 Lisp_Object
*args
, *visargs
;
176 unsigned char **argstrings
;
182 int speccount
= specpdl_ptr
- specpdl
;
184 /* The index of the next element of this_command_keys to examine for
185 the 'e' interactive code. */
188 Lisp_Object prefix_arg
;
189 unsigned char *string
;
192 /* If varies[i] > 0, the i'th argument shouldn't just have its value
193 in this call quoted in the command history. It should be
194 recorded as a call to the function named callint_argfuns[varies[i]]. */
202 int arg_from_tty
= 0;
203 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
205 /* Save this now, since use of minibuffer will clobber it. */
206 prefix_arg
= Vcurrent_prefix_arg
;
210 if (SYMBOLP (function
))
211 enable
= Fget (function
, Qenable_recursive_minibuffers
);
213 fun
= indirect_function (function
);
218 /* Decode the kind of function. Either handle it and return,
219 or go to `lose' if not interactive, or go to `retry'
220 to specify a different function, or set either STRING or SPECS. */
224 string
= (unsigned char *) XSUBR (fun
)->prompt
;
228 function
= wrong_type_argument (Qcommandp
, function
);
231 if ((EMACS_INT
) string
== 1)
232 /* Let SPECS (which is nil) be used as the args. */
235 else if (COMPILEDP (fun
))
237 if ((XVECTOR (fun
)->size
& PSEUDOVECTOR_SIZE_MASK
) <= COMPILED_INTERACTIVE
)
239 specs
= XVECTOR (fun
)->contents
[COMPILED_INTERACTIVE
];
241 else if (!CONSP (fun
))
243 else if (funcar
= Fcar (fun
), EQ (funcar
, Qautoload
))
245 GCPRO2 (function
, prefix_arg
);
246 do_autoload (fun
, function
);
250 else if (EQ (funcar
, Qlambda
))
252 specs
= Fassq (Qinteractive
, Fcdr (Fcdr (fun
)));
255 specs
= Fcar (Fcdr (specs
));
257 else if (EQ (funcar
, Qmocklisp
))
259 single_kboard_state ();
260 return ml_apply (fun
, Qinteractive
);
265 /* If either specs or string is set to a string, use it. */
268 /* Make a copy of string so that if a GC relocates specs,
269 `string' will still be valid. */
270 string
= (unsigned char *) alloca (XSTRING (specs
)->size
+ 1);
271 bcopy (XSTRING (specs
)->data
, string
, XSTRING (specs
)->size
+ 1);
273 else if (string
== 0)
278 /* Compute the arg values using the user's expression. */
279 specs
= Feval (specs
);
280 if (i
!= num_input_chars
|| !NILP (record
))
282 /* We should record this command on the command history. */
283 Lisp_Object values
, car
;
284 /* Make a copy of the list of values, for the command history,
285 and turn them into things we can eval. */
286 values
= quotify_args (Fcopy_sequence (specs
));
287 /* If the list of args was produced with an explicit call to `list',
288 look for elements that were computed with (region-beginning)
289 or (region-end), and put those expressions into VALUES
290 instead of the present values. */
294 Lisp_Object intail
, valtail
;
295 for (intail
= Fcdr (input
), valtail
= values
;
297 intail
= Fcdr (intail
), valtail
= Fcdr (valtail
))
303 Lisp_Object presflag
;
304 presflag
= Fmemq (Fcar (elt
), preserved_fns
);
305 if (!NILP (presflag
))
306 Fsetcar (valtail
, Fcar (intail
));
311 = Fcons (Fcons (function
, values
), Vcommand_history
);
313 single_kboard_state ();
314 return apply1 (function
, specs
);
317 /* Here if function specifies a string to control parsing the defaults */
319 /* Set next_event to point to the first event with parameters. */
320 for (next_event
= 0; next_event
< this_command_key_count
; next_event
++)
321 if (EVENT_HAS_PARAMETERS
322 (XVECTOR (this_command_keys
)->contents
[next_event
]))
325 /* Handle special starting chars `*' and `@'. Also `-'. */
326 /* Note that `+' is reserved for user extensions. */
330 error ("`+' is not used in `interactive' for ordinary commands");
331 else if (*string
== '*')
334 if (!NILP (current_buffer
->read_only
))
335 Fbarf_if_buffer_read_only ();
337 /* Ignore this for semi-compatibility with Lucid. */
338 else if (*string
== '-')
340 else if (*string
== '@')
344 event
= XVECTOR (this_command_keys
)->contents
[next_event
];
345 if (EVENT_HAS_PARAMETERS (event
)
346 && (event
= XCONS (event
)->cdr
, CONSP (event
))
347 && (event
= XCONS (event
)->car
, CONSP (event
))
348 && (event
= XCONS (event
)->car
, WINDOWP (event
)))
350 if (MINI_WINDOW_P (XWINDOW (event
))
351 && ! (minibuf_level
> 0 && EQ (event
, minibuf_window
)))
352 error ("Attempt to select inactive minibuffer window");
354 /* If the current buffer wants to clean up, let it. */
355 if (!NILP (Vmouse_leave_buffer_hook
))
356 call1 (Vrun_hooks
, Qmouse_leave_buffer_hook
);
358 Fselect_window (event
);
365 /* Count the number of arguments the interactive spec would have
366 us give to the function. */
368 for (j
= 0; *tem
; j
++)
370 /* 'r' specifications ("point and mark as 2 numeric args")
371 produce *two* arguments. */
372 if (*tem
== 'r') j
++;
373 tem
= (unsigned char *) index (tem
, '\n');
377 tem
= (unsigned char *) "";
381 args
= (Lisp_Object
*) alloca ((count
+ 1) * sizeof (Lisp_Object
));
382 visargs
= (Lisp_Object
*) alloca ((count
+ 1) * sizeof (Lisp_Object
));
383 argstrings
= (unsigned char **) alloca ((count
+ 1) * sizeof (char *));
384 varies
= (int *) alloca ((count
+ 1) * sizeof (int));
386 for (i
= 0; i
< (count
+ 1); i
++)
393 GCPRO4 (prefix_arg
, function
, *args
, *visargs
);
394 gcpro3
.nvars
= (count
+ 1);
395 gcpro4
.nvars
= (count
+ 1);
398 specbind (Qenable_recursive_minibuffers
, Qt
);
401 for (i
= 1; *tem
; i
++)
403 strncpy (prompt1
, tem
+ 1, sizeof prompt1
- 1);
404 prompt1
[sizeof prompt1
- 1] = 0;
405 tem1
= index (prompt1
, '\n');
407 /* Fill argstrings with a vector of C strings
408 corresponding to the Lisp strings in visargs. */
409 for (j
= 1; j
< i
; j
++)
411 = EQ (visargs
[j
], Qnil
)
412 ? (unsigned char *) ""
413 : XSTRING (visargs
[j
])->data
;
415 doprnt (prompt
, sizeof prompt
, prompt1
, (char *)0,
416 j
- 1, argstrings
+ 1);
420 case 'a': /* Symbol defined as a function */
421 visargs
[i
] = Fcompleting_read (build_string (prompt
),
422 Vobarray
, Qfboundp
, Qt
, Qnil
, Qnil
);
423 /* Passing args[i] directly stimulates compiler bug */
425 args
[i
] = Fintern (teml
, Qnil
);
428 case 'b': /* Name of existing buffer */
429 args
[i
] = Fcurrent_buffer ();
430 if (EQ (selected_window
, minibuf_window
))
431 args
[i
] = Fother_buffer (args
[i
], Qnil
);
432 args
[i
] = Fread_buffer (build_string (prompt
), args
[i
], Qt
);
435 case 'B': /* Name of buffer, possibly nonexistent */
436 args
[i
] = Fread_buffer (build_string (prompt
),
437 Fother_buffer (Fcurrent_buffer (), Qnil
),
441 case 'c': /* Character */
443 args
[i
] = Fread_char ();
444 /* Passing args[i] directly stimulates compiler bug */
446 visargs
[i
] = Fchar_to_string (teml
);
449 case 'C': /* Command: symbol with interactive function */
450 visargs
[i
] = Fcompleting_read (build_string (prompt
),
451 Vobarray
, Qcommandp
, Qt
, Qnil
, Qnil
);
452 /* Passing args[i] directly stimulates compiler bug */
454 args
[i
] = Fintern (teml
, Qnil
);
457 case 'd': /* Value of point. Does not do I/O. */
458 Fset_marker (point_marker
, make_number (PT
), Qnil
);
459 args
[i
] = point_marker
;
460 /* visargs[i] = Qnil; */
464 case 'D': /* Directory name. */
465 args
[i
] = Fread_file_name (build_string (prompt
), Qnil
,
466 current_buffer
->directory
, Qlambda
, Qnil
);
469 case 'f': /* Existing file name. */
470 args
[i
] = Fread_file_name (build_string (prompt
),
471 Qnil
, Qnil
, Qlambda
, Qnil
);
474 case 'F': /* Possibly nonexistent file name. */
475 args
[i
] = Fread_file_name (build_string (prompt
),
476 Qnil
, Qnil
, Qnil
, Qnil
);
479 case 'k': /* Key sequence. */
480 args
[i
] = Fread_key_sequence (build_string (prompt
), Qnil
, Qnil
, Qnil
);
482 visargs
[i
] = Fkey_description (teml
);
485 case 'K': /* Key sequence to be defined. */
486 args
[i
] = Fread_key_sequence (build_string (prompt
), Qnil
, Qt
, Qnil
);
488 visargs
[i
] = Fkey_description (teml
);
491 case 'e': /* The invoking event. */
492 if (next_event
>= this_command_key_count
)
493 error ("%s must be bound to an event with parameters",
495 ? (char *) XSYMBOL (function
)->name
->data
497 args
[i
] = XVECTOR (this_command_keys
)->contents
[next_event
++];
500 /* Find the next parameterized event. */
501 while (next_event
< this_command_key_count
502 && ! (EVENT_HAS_PARAMETERS
503 (XVECTOR (this_command_keys
)->contents
[next_event
])))
508 case 'm': /* Value of mark. Does not do I/O. */
510 /* visargs[i] = Qnil; */
511 args
[i
] = current_buffer
->mark
;
515 case 'N': /* Prefix arg, else number from minibuffer */
516 if (!NILP (prefix_arg
))
517 goto have_prefix_arg
;
518 case 'n': /* Read number from minibuffer. */
520 args
[i
] = Fread_minibuffer (build_string (prompt
), Qnil
);
521 while (! NUMBERP (args
[i
]));
522 visargs
[i
] = last_minibuf_string
;
525 case 'P': /* Prefix arg in raw form. Does no I/O. */
527 args
[i
] = prefix_arg
;
528 /* visargs[i] = Qnil; */
532 case 'p': /* Prefix arg converted to number. No I/O. */
533 args
[i
] = Fprefix_numeric_value (prefix_arg
);
534 /* visargs[i] = Qnil; */
538 case 'r': /* Region, point and mark as 2 args. */
540 Fset_marker (point_marker
, make_number (PT
), Qnil
);
541 /* visargs[i+1] = Qnil; */
542 foo
= marker_position (current_buffer
->mark
);
543 /* visargs[i] = Qnil; */
544 args
[i
] = point
< foo
? point_marker
: current_buffer
->mark
;
546 args
[++i
] = point
> foo
? point_marker
: current_buffer
->mark
;
550 case 's': /* String read via minibuffer. */
551 args
[i
] = Fread_string (build_string (prompt
), Qnil
, Qnil
);
554 case 'S': /* Any symbol. */
555 visargs
[i
] = Fread_string (build_string (prompt
), Qnil
, Qnil
);
556 /* Passing args[i] directly stimulates compiler bug */
558 args
[i
] = Fintern (teml
, Qnil
);
561 case 'v': /* Variable name: symbol that is
563 args
[i
] = Fread_variable (build_string (prompt
));
564 visargs
[i
] = last_minibuf_string
;
567 case 'x': /* Lisp expression read but not evaluated */
568 args
[i
] = Fread_minibuffer (build_string (prompt
), Qnil
);
569 visargs
[i
] = last_minibuf_string
;
572 case 'X': /* Lisp expression read and evaluated */
573 args
[i
] = Feval_minibuffer (build_string (prompt
), Qnil
);
574 visargs
[i
] = last_minibuf_string
;
577 /* We have a case for `+' so we get an error
578 if anyone tries to define one here. */
581 error ("Invalid control letter `%c' (%03o) in interactive calling string",
588 if (NILP (visargs
[i
]) && STRINGP (args
[i
]))
589 visargs
[i
] = args
[i
];
591 tem
= (unsigned char *) index (tem
, '\n');
593 else tem
= (unsigned char *) "";
595 unbind_to (speccount
, Qnil
);
601 if (arg_from_tty
|| !NILP (record
))
603 visargs
[0] = function
;
604 for (i
= 1; i
< count
+ 1; i
++)
607 visargs
[i
] = Fcons (intern (callint_argfuns
[varies
[i
]]), Qnil
);
609 visargs
[i
] = quotify_arg (args
[i
]);
611 Vcommand_history
= Fcons (Flist (count
+ 1, visargs
),
615 /* If we used a marker to hold point, mark, or an end of the region,
616 temporarily, convert it to an integer now. */
617 for (i
= 1; i
<= count
; i
++)
618 if (varies
[i
] >= 1 && varies
[i
] <= 4)
619 XSETINT (args
[i
], marker_position (args
[i
]));
621 single_kboard_state ();
625 specbind (Qcommand_debug_status
, Qnil
);
627 val
= Ffuncall (count
+ 1, args
);
629 return unbind_to (speccount
, val
);
633 DEFUN ("prefix-numeric-value", Fprefix_numeric_value
, Sprefix_numeric_value
,
635 "Return numeric meaning of raw prefix argument ARG.\n\
636 A raw prefix argument is what you get from `(interactive \"P\")'.\n\
637 Its numeric meaning is what you would get from `(interactive \"p\")'.")
644 XSETFASTINT (val
, 1);
645 else if (EQ (raw
, Qminus
))
647 else if (CONSP (raw
) && INTEGERP (XCONS (raw
)->car
))
648 XSETINT (val
, XINT (XCONS (raw
)->car
));
649 else if (INTEGERP (raw
))
652 XSETFASTINT (val
, 1);
659 point_marker
= Fmake_marker ();
660 staticpro (&point_marker
);
662 preserved_fns
= Fcons (intern ("region-beginning"),
663 Fcons (intern ("region-end"),
664 Fcons (intern ("point"),
665 Fcons (intern ("mark"), Qnil
))));
666 staticpro (&preserved_fns
);
668 Qlist
= intern ("list");
671 Qminus
= intern ("-");
674 Qplus
= intern ("+");
677 Qcall_interactively
= intern ("call-interactively");
678 staticpro (&Qcall_interactively
);
680 Qcommand_debug_status
= intern ("command-debug-status");
681 staticpro (&Qcommand_debug_status
);
683 Qenable_recursive_minibuffers
= intern ("enable-recursive-minibuffers");
684 staticpro (&Qenable_recursive_minibuffers
);
686 Qmouse_leave_buffer_hook
= intern ("mouse-leave-buffer-hook");
687 staticpro (&Qmouse_leave_buffer_hook
);
689 DEFVAR_KBOARD ("prefix-arg", Vprefix_arg
,
690 "The value of the prefix argument for the next editing command.\n\
691 It may be a number, or the symbol `-' for just a minus sign as arg,\n\
692 or a list whose car is a number for just one or more C-U's\n\
693 or nil if no argument has been specified.\n\
695 You cannot examine this variable to find the argument for this command\n\
696 since it has been set to nil by the time you can look.\n\
697 Instead, you should use the variable `current-prefix-arg', although\n\
698 normally commands can get this prefix argument with (interactive \"P\").");
700 DEFVAR_LISP ("current-prefix-arg", &Vcurrent_prefix_arg
,
701 "The value of the prefix argument for this editing command.\n\
702 It may be a number, or the symbol `-' for just a minus sign as arg,\n\
703 or a list whose car is a number for just one or more C-U's\n\
704 or nil if no argument has been specified.\n\
705 This is what `(interactive \"P\")' returns.");
706 Vcurrent_prefix_arg
= Qnil
;
708 DEFVAR_LISP ("command-history", &Vcommand_history
,
709 "List of recent commands that read arguments from terminal.\n\
710 Each command is represented as a form to evaluate.");
711 Vcommand_history
= Qnil
;
713 DEFVAR_LISP ("command-debug-status", &Vcommand_debug_status
,
714 "Debugging status of current interactive command.\n\
715 Bound each time `call-interactively' is called;\n\
716 may be set by the debugger as a reminder for itself.");
717 Vcommand_debug_status
= Qnil
;
719 DEFVAR_LISP ("mark-even-if-inactive", &Vmark_even_if_inactive
,
720 "*Non-nil means you can use the mark even when inactive.\n\
721 This option makes a difference in Transient Mark mode.\n\
722 When the option is non-nil, deactivation of the mark\n\
723 turns off region highlighting, but commands that use the mark\n\
724 behave as if the mark were still active.");
725 Vmark_even_if_inactive
= Qnil
;
727 DEFVAR_LISP ("mouse-leave-buffer-hook", &Vmouse_leave_buffer_hook
,
728 "Hook to run when about to switch windows with a mouse command.\n\
729 Its purpose is to give temporary modes such as Isearch mode\n\
730 a way to turn themselves off when a mouse command switches windows.");
731 Vmouse_leave_buffer_hook
= Qnil
;
733 defsubr (&Sinteractive
);
734 defsubr (&Scall_interactively
);
735 defsubr (&Sprefix_numeric_value
);