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 static Lisp_Object preserved_fns
;
47 /* Marker used within call-interactively to refer to point. */
48 static Lisp_Object point_marker
;
50 /* This comment supplies the doc string for interactive,
51 for make-docfile to see. We cannot put this in the real DEFUN
52 due to limits in the Unix cpp.
54 DEFUN ("interactive", Ffoo, Sfoo, 0, 0, 0,
55 "Specify a way of parsing arguments for interactive use of a function.\n\
57 (defun foo (arg) \"Doc string\" (interactive \"p\") ...use arg...)\n\
58 to make ARG be the prefix argument when `foo' is called as a command.\n\
59 The \"call\" to `interactive' is actually a declaration rather than a function;\n\
60 it tells `call-interactively' how to read arguments\n\
61 to pass to the function.\n\
62 When actually called, `interactive' just returns nil.\n\
64 The argument of `interactive' is usually a string containing a code letter\n\
65 followed by a prompt. (Some code letters do not use I/O to get\n\
66 the argument and do not need prompts.) To prompt for multiple arguments,\n\
67 give a code letter, its prompt, a newline, and another code letter, etc.\n\
68 Prompts are passed to format, and may use % escapes to print the\n\
69 arguments that have already been read.\n\
70 If the argument is not a string, it is evaluated to get a list of\n\
71 arguments to pass to the function.\n\
72 Just `(interactive)' means pass no args when calling interactively.\n\
73 \nCode letters available are:\n\
74 a -- Function name: symbol with a function definition.\n\
75 b -- Name of existing buffer.\n\
76 B -- Name of buffer, possibly nonexistent.\n\
78 C -- Command name: symbol with interactive function definition.\n\
79 d -- Value of point as number. Does not do I/O.\n\
80 D -- Directory name.\n\
81 e -- Parametrized event (i.e., one that's a list) that invoked this command.\n\
82 If used more than once, the Nth `e' returns the Nth parameterized event.\n\
83 This skips events that are integers or symbols.\n\
84 f -- Existing file name.\n\
85 F -- Possibly nonexistent file name.\n\
86 k -- Key sequence (downcase the last event if needed to get a definition).\n\
87 K -- Key sequence to be redefined (do not downcase the last event).\n\
88 m -- Value of mark as number. Does not do I/O.\n\
89 n -- Number read using minibuffer.\n\
90 N -- Raw prefix arg, or if none, do like code `n'.\n\
91 p -- Prefix arg converted to number. Does not do I/O.\n\
92 P -- Prefix arg in raw form. Does not do I/O.\n\
93 r -- Region: point and mark as 2 numeric args, smallest first. Does no I/O.\n\
96 v -- Variable name: symbol that is user-variable-p.\n\
97 x -- Lisp expression read but not evaluated.\n\
98 X -- Lisp expression read and evaluated.\n\
99 In addition, if the string begins with `*'\n\
100 then an error is signaled if the buffer is read-only.\n\
101 This happens before reading any arguments.\n\
102 If the string begins with `@', then Emacs searches the key sequence\n\
103 which invoked the command for its first mouse click (or any other\n\
104 event which specifies a window), and selects that window before\n\
105 reading any arguments. You may use both `@' and `*'; they are\n\
106 processed in the order that they appear." */
109 DEFUN ("interactive", Finteractive
, Sinteractive
, 0, UNEVALLED
, 0,
110 0 /* See immediately above */)
117 /* Quotify EXP: if EXP is constant, return it.
118 If EXP is not constant, return (quote EXP). */
121 register Lisp_Object exp
;
123 if (!INTEGERP (exp
) && !STRINGP (exp
)
124 && !NILP (exp
) && !EQ (exp
, Qt
))
125 return Fcons (Qquote
, Fcons (exp
, Qnil
));
130 /* Modify EXP by quotifying each element (except the first). */
135 register Lisp_Object tail
;
136 register struct Lisp_Cons
*ptr
;
137 for (tail
= exp
; CONSP (tail
); tail
= ptr
->cdr
)
140 ptr
->car
= quotify_arg (ptr
->car
);
145 char *callint_argfuns
[]
146 = {"", "point", "mark", "region-beginning", "region-end"};
152 tem
= Fmarker_buffer (current_buffer
->mark
);
153 if (NILP (tem
) || (XBUFFER (tem
) != current_buffer
))
154 error ("The mark is not set now");
155 if (!NILP (Vtransient_mark_mode
) && NILP (Vmark_even_if_inactive
)
156 && NILP (current_buffer
->mark_active
))
157 Fsignal (Qmark_inactive
, Qnil
);
161 DEFUN ("call-interactively", Fcall_interactively
, Scall_interactively
, 1, 2, 0,
162 "Call FUNCTION, reading args according to its interactive calling specs.\n\
163 The function contains a specification of how to do the argument reading.\n\
164 In the case of user-defined functions, this is specified by placing a call\n\
165 to the function `interactive' at the top level of the function body.\n\
166 See `interactive'.\n\
168 Optional second arg RECORD-FLAG non-nil\n\
169 means unconditionally put this command in the command-history.\n\
170 Otherwise, this is done only if an arg is read using the minibuffer.")
172 Lisp_Object function
, record
;
174 Lisp_Object
*args
, *visargs
;
175 unsigned char **argstrings
;
181 int speccount
= specpdl_ptr
- specpdl
;
183 /* The index of the next element of this_command_keys to examine for
184 the 'e' interactive code. */
187 Lisp_Object prefix_arg
;
188 unsigned char *string
;
191 /* If varies[i] > 0, the i'th argument shouldn't just have its value
192 in this call quoted in the command history. It should be
193 recorded as a call to the function named callint_argfuns[varies[i]]. */
201 int arg_from_tty
= 0;
202 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
204 /* Save this now, since use of minibuffer will clobber it. */
205 prefix_arg
= Vcurrent_prefix_arg
;
209 if (SYMBOLP (function
))
210 enable
= Fget (function
, Qenable_recursive_minibuffers
);
212 fun
= indirect_function (function
);
217 /* Decode the kind of function. Either handle it and return,
218 or go to `lose' if not interactive, or go to `retry'
219 to specify a different function, or set either STRING or SPECS. */
223 string
= (unsigned char *) XSUBR (fun
)->prompt
;
227 function
= wrong_type_argument (Qcommandp
, function
);
230 if ((EMACS_INT
) string
== 1)
231 /* Let SPECS (which is nil) be used as the args. */
234 else if (COMPILEDP (fun
))
236 if ((XVECTOR (fun
)->size
& PSEUDOVECTOR_SIZE_MASK
) <= COMPILED_INTERACTIVE
)
238 specs
= XVECTOR (fun
)->contents
[COMPILED_INTERACTIVE
];
240 else if (!CONSP (fun
))
242 else if (funcar
= Fcar (fun
), EQ (funcar
, Qautoload
))
244 GCPRO2 (function
, prefix_arg
);
245 do_autoload (fun
, function
);
249 else if (EQ (funcar
, Qlambda
))
251 specs
= Fassq (Qinteractive
, Fcdr (Fcdr (fun
)));
254 specs
= Fcar (Fcdr (specs
));
256 else if (EQ (funcar
, Qmocklisp
))
258 #ifdef MULTI_PERDISPLAY
261 return ml_apply (fun
, Qinteractive
);
266 /* If either specs or string is set to a string, use it. */
269 /* Make a copy of string so that if a GC relocates specs,
270 `string' will still be valid. */
271 string
= (unsigned char *) alloca (XSTRING (specs
)->size
+ 1);
272 bcopy (XSTRING (specs
)->data
, string
, XSTRING (specs
)->size
+ 1);
274 else if (string
== 0)
279 /* Compute the arg values using the user's expression. */
280 specs
= Feval (specs
);
281 if (i
!= num_input_chars
|| !NILP (record
))
283 /* We should record this command on the command history. */
284 Lisp_Object values
, car
;
285 /* Make a copy of the list of values, for the command history,
286 and turn them into things we can eval. */
287 values
= quotify_args (Fcopy_sequence (specs
));
288 /* If the list of args was produced with an explicit call to `list',
289 look for elements that were computed with (region-beginning)
290 or (region-end), and put those expressions into VALUES
291 instead of the present values. */
295 Lisp_Object intail
, valtail
;
296 for (intail
= Fcdr (input
), valtail
= values
;
298 intail
= Fcdr (intail
), valtail
= Fcdr (valtail
))
304 Lisp_Object presflag
;
305 presflag
= Fmemq (Fcar (elt
), preserved_fns
);
306 if (!NILP (presflag
))
307 Fsetcar (valtail
, Fcar (intail
));
312 = Fcons (Fcons (function
, values
), Vcommand_history
);
314 #ifdef MULTI_PERDISPLAY
317 return apply1 (function
, specs
);
320 /* Here if function specifies a string to control parsing the defaults */
322 /* Set next_event to point to the first event with parameters. */
323 for (next_event
= 0; next_event
< this_command_key_count
; next_event
++)
324 if (EVENT_HAS_PARAMETERS
325 (XVECTOR (this_command_keys
)->contents
[next_event
]))
328 /* Handle special starting chars `*' and `@'. Also `-'. */
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
)->car
, 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
, 0, j
- 1, argstrings
+ 1);
419 case 'a': /* Symbol defined as a function */
420 visargs
[i
] = Fcompleting_read (build_string (prompt
),
421 Vobarray
, Qfboundp
, Qt
, Qnil
, Qnil
);
422 /* Passing args[i] directly stimulates compiler bug */
424 args
[i
] = Fintern (teml
, Qnil
);
427 case 'b': /* Name of existing buffer */
428 args
[i
] = Fcurrent_buffer ();
429 if (EQ (selected_window
, minibuf_window
))
430 args
[i
] = Fother_buffer (args
[i
], Qnil
);
431 args
[i
] = Fread_buffer (build_string (prompt
), args
[i
], Qt
);
434 case 'B': /* Name of buffer, possibly nonexistent */
435 args
[i
] = Fread_buffer (build_string (prompt
),
436 Fother_buffer (Fcurrent_buffer (), Qnil
),
440 case 'c': /* Character */
442 args
[i
] = Fread_char ();
443 /* Passing args[i] directly stimulates compiler bug */
445 visargs
[i
] = Fchar_to_string (teml
);
448 case 'C': /* Command: symbol with interactive function */
449 visargs
[i
] = Fcompleting_read (build_string (prompt
),
450 Vobarray
, Qcommandp
, Qt
, Qnil
, Qnil
);
451 /* Passing args[i] directly stimulates compiler bug */
453 args
[i
] = Fintern (teml
, Qnil
);
456 case 'd': /* Value of point. Does not do I/O. */
457 Fset_marker (point_marker
, make_number (PT
), Qnil
);
458 args
[i
] = point_marker
;
459 /* visargs[i] = Qnil; */
463 case 'D': /* Directory name. */
464 args
[i
] = Fread_file_name (build_string (prompt
), Qnil
,
465 current_buffer
->directory
, Qlambda
, Qnil
);
468 case 'f': /* Existing file name. */
469 args
[i
] = Fread_file_name (build_string (prompt
),
470 Qnil
, Qnil
, Qlambda
, Qnil
);
473 case 'F': /* Possibly nonexistent file name. */
474 args
[i
] = Fread_file_name (build_string (prompt
),
475 Qnil
, Qnil
, Qnil
, Qnil
);
478 case 'k': /* Key sequence. */
479 args
[i
] = Fread_key_sequence (build_string (prompt
), Qnil
, Qnil
, Qnil
);
481 visargs
[i
] = Fkey_description (teml
);
484 case 'K': /* Key sequence to be defined. */
485 args
[i
] = Fread_key_sequence (build_string (prompt
), Qnil
, Qt
, Qnil
);
487 visargs
[i
] = Fkey_description (teml
);
490 case 'e': /* The invoking event. */
491 if (next_event
>= this_command_key_count
)
492 error ("%s must be bound to an event with parameters",
494 ? (char *) XSYMBOL (function
)->name
->data
496 args
[i
] = XVECTOR (this_command_keys
)->contents
[next_event
++];
499 /* Find the next parameterized event. */
500 while (next_event
< this_command_key_count
501 && ! (EVENT_HAS_PARAMETERS
502 (XVECTOR (this_command_keys
)->contents
[next_event
])))
507 case 'm': /* Value of mark. Does not do I/O. */
509 /* visargs[i] = Qnil; */
510 args
[i
] = current_buffer
->mark
;
514 case 'N': /* Prefix arg, else number from minibuffer */
515 if (!NILP (prefix_arg
))
516 goto have_prefix_arg
;
517 case 'n': /* Read number from minibuffer. */
519 args
[i
] = Fread_minibuffer (build_string (prompt
), Qnil
);
520 while (! NUMBERP (args
[i
]));
521 visargs
[i
] = last_minibuf_string
;
524 case 'P': /* Prefix arg in raw form. Does no I/O. */
526 args
[i
] = prefix_arg
;
527 /* visargs[i] = Qnil; */
531 case 'p': /* Prefix arg converted to number. No I/O. */
532 args
[i
] = Fprefix_numeric_value (prefix_arg
);
533 /* visargs[i] = Qnil; */
537 case 'r': /* Region, point and mark as 2 args. */
539 Fset_marker (point_marker
, make_number (PT
), Qnil
);
540 /* visargs[i+1] = Qnil; */
541 foo
= marker_position (current_buffer
->mark
);
542 /* visargs[i] = Qnil; */
543 args
[i
] = point
< foo
? point_marker
: current_buffer
->mark
;
545 args
[++i
] = point
> foo
? point_marker
: current_buffer
->mark
;
549 case 's': /* String read via minibuffer. */
550 args
[i
] = Fread_string (build_string (prompt
), Qnil
, Qnil
);
553 case 'S': /* Any symbol. */
554 visargs
[i
] = Fread_string (build_string (prompt
), Qnil
, Qnil
);
555 /* Passing args[i] directly stimulates compiler bug */
557 args
[i
] = Fintern (teml
, Qnil
);
560 case 'v': /* Variable name: symbol that is
562 args
[i
] = Fread_variable (build_string (prompt
));
563 visargs
[i
] = last_minibuf_string
;
566 case 'x': /* Lisp expression read but not evaluated */
567 args
[i
] = Fread_minibuffer (build_string (prompt
), Qnil
);
568 visargs
[i
] = last_minibuf_string
;
571 case 'X': /* Lisp expression read and evaluated */
572 args
[i
] = Feval_minibuffer (build_string (prompt
), Qnil
);
573 visargs
[i
] = last_minibuf_string
;
577 error ("Invalid control letter \"%c\" (%03o) in interactive calling string",
584 if (NILP (visargs
[i
]) && STRINGP (args
[i
]))
585 visargs
[i
] = args
[i
];
587 tem
= (unsigned char *) index (tem
, '\n');
589 else tem
= (unsigned char *) "";
591 unbind_to (speccount
, Qnil
);
597 if (arg_from_tty
|| !NILP (record
))
599 visargs
[0] = function
;
600 for (i
= 1; i
< count
+ 1; i
++)
603 visargs
[i
] = Fcons (intern (callint_argfuns
[varies
[i
]]), Qnil
);
605 visargs
[i
] = quotify_arg (args
[i
]);
607 Vcommand_history
= Fcons (Flist (count
+ 1, visargs
),
611 /* If we used a marker to hold point, mark, or an end of the region,
612 temporarily, convert it to an integer now. */
613 for (i
= 1; i
<= count
; i
++)
614 if (varies
[i
] >= 1 && varies
[i
] <= 4)
615 XSETINT (args
[i
], marker_position (args
[i
]));
617 #ifdef MULTI_PERDISPLAY
623 specbind (Qcommand_debug_status
, Qnil
);
625 val
= Ffuncall (count
+ 1, args
);
627 return unbind_to (speccount
, val
);
631 DEFUN ("prefix-numeric-value", Fprefix_numeric_value
, Sprefix_numeric_value
,
633 "Return numeric meaning of raw prefix argument ARG.\n\
634 A raw prefix argument is what you get from `(interactive \"P\")'.\n\
635 Its numeric meaning is what you would get from `(interactive \"p\")'.")
642 XSETFASTINT (val
, 1);
643 else if (EQ (raw
, Qminus
))
645 else if (CONSP (raw
))
646 XSETINT (val
, XINT (XCONS (raw
)->car
));
647 else if (INTEGERP (raw
))
650 XSETFASTINT (val
, 1);
657 point_marker
= Fmake_marker ();
658 staticpro (&point_marker
);
660 preserved_fns
= Fcons (intern ("region-beginning"),
661 Fcons (intern ("region-end"),
662 Fcons (intern ("point"),
663 Fcons (intern ("mark"), Qnil
))));
664 staticpro (&preserved_fns
);
666 Qlist
= intern ("list");
669 Qminus
= intern ("-");
672 Qplus
= intern ("+");
675 Qcall_interactively
= intern ("call-interactively");
676 staticpro (&Qcall_interactively
);
678 Qcommand_debug_status
= intern ("command-debug-status");
679 staticpro (&Qcommand_debug_status
);
681 Qenable_recursive_minibuffers
= intern ("enable-recursive-minibuffers");
682 staticpro (&Qenable_recursive_minibuffers
);
684 Qmouse_leave_buffer_hook
= intern ("mouse-leave-buffer-hook");
685 staticpro (&Qmouse_leave_buffer_hook
);
687 DEFVAR_LISP ("prefix-arg", &Vprefix_arg
,
688 "The value of the prefix argument for the next editing command.\n\
689 It may be a number, or the symbol `-' for just a minus sign as arg,\n\
690 or a list whose car is a number for just one or more C-U's\n\
691 or nil if no argument has been specified.\n\
693 You cannot examine this variable to find the argument for this command\n\
694 since it has been set to nil by the time you can look.\n\
695 Instead, you should use the variable `current-prefix-arg', although\n\
696 normally commands can get this prefix argument with (interactive \"P\").");
699 DEFVAR_LISP ("current-prefix-arg", &Vcurrent_prefix_arg
,
700 "The value of the prefix argument for this editing command.\n\
701 It may be a number, or the symbol `-' for just a minus sign as arg,\n\
702 or a list whose car is a number for just one or more C-U's\n\
703 or nil if no argument has been specified.\n\
704 This is what `(interactive \"P\")' returns.");
705 Vcurrent_prefix_arg
= Qnil
;
707 DEFVAR_LISP ("command-history", &Vcommand_history
,
708 "List of recent commands that read arguments from terminal.\n\
709 Each command is represented as a form to evaluate.");
710 Vcommand_history
= Qnil
;
712 DEFVAR_LISP ("command-debug-status", &Vcommand_debug_status
,
713 "Debugging status of current interactive command.\n\
714 Bound each time `call-interactively' is called;\n\
715 may be set by the debugger as a reminder for itself.");
716 Vcommand_debug_status
= Qnil
;
718 DEFVAR_LISP ("mark-even-if-inactive", &Vmark_even_if_inactive
,
719 "*Non-nil means you can use the mark even when inactive.\n\
720 This option makes a difference in Transient Mark mode.\n\
721 When the option is non-nil, deactivation of the mark\n\
722 turns off region highlighting, but commands that use the mark\n\
723 behave as if the mark were still active.");
724 Vmark_even_if_inactive
= Qnil
;
726 DEFVAR_LISP ("mouse-leave-buffer-hook", &Vmouse_leave_buffer_hook
,
727 "Hook to run when about to switch windows with a mouse command.\n\
728 Its purpose is to give temporary modes such as Isearch mode\n\
729 a way to turn themselves off when a mouse command switches windows.");
730 Vmouse_leave_buffer_hook
= Qnil
;
732 defsubr (&Sinteractive
);
733 defsubr (&Scall_interactively
);
734 defsubr (&Sprefix_numeric_value
);