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 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
= current_perdisplay
->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
))
257 return ml_apply (fun
, Qinteractive
);
261 /* If either specs or string is set to a string, use it. */
264 /* Make a copy of string so that if a GC relocates specs,
265 `string' will still be valid. */
266 string
= (unsigned char *) alloca (XSTRING (specs
)->size
+ 1);
267 bcopy (XSTRING (specs
)->data
, string
, XSTRING (specs
)->size
+ 1);
269 else if (string
== 0)
274 /* Compute the arg values using the user's expression. */
275 specs
= Feval (specs
);
276 if (i
!= num_input_chars
|| !NILP (record
))
278 /* We should record this command on the command history. */
279 Lisp_Object values
, car
;
280 /* Make a copy of the list of values, for the command history,
281 and turn them into things we can eval. */
282 values
= quotify_args (Fcopy_sequence (specs
));
283 /* If the list of args was produced with an explicit call to `list',
284 look for elements that were computed with (region-beginning)
285 or (region-end), and put those expressions into VALUES
286 instead of the present values. */
290 Lisp_Object intail
, valtail
;
291 for (intail
= Fcdr (input
), valtail
= values
;
293 intail
= Fcdr (intail
), valtail
= Fcdr (valtail
))
299 Lisp_Object presflag
;
300 presflag
= Fmemq (Fcar (elt
), preserved_fns
);
301 if (!NILP (presflag
))
302 Fsetcar (valtail
, Fcar (intail
));
307 = Fcons (Fcons (function
, values
), Vcommand_history
);
309 return apply1 (function
, specs
);
312 /* Here if function specifies a string to control parsing the defaults */
314 /* Set next_event to point to the first event with parameters. */
315 for (next_event
= 0; next_event
< this_command_key_count
; next_event
++)
316 if (EVENT_HAS_PARAMETERS
317 (XVECTOR (this_command_keys
)->contents
[next_event
]))
320 /* Handle special starting chars `*' and `@'. Also `-'. */
326 if (!NILP (current_buffer
->read_only
))
327 Fbarf_if_buffer_read_only ();
329 /* Ignore this for semi-compatibility with Lucid. */
330 else if (*string
== '-')
332 else if (*string
== '@')
336 event
= XVECTOR (this_command_keys
)->contents
[next_event
];
337 if (EVENT_HAS_PARAMETERS (event
)
338 && (event
= XCONS (event
)->car
, CONSP (event
))
339 && (event
= XCONS (event
)->car
, CONSP (event
))
340 && (event
= XCONS (event
)->car
), WINDOWP (event
))
342 if (MINI_WINDOW_P (XWINDOW (event
))
343 && ! (minibuf_level
> 0 && EQ (event
, minibuf_window
)))
344 error ("Attempt to select inactive minibuffer window");
346 /* If the current buffer wants to clean up, let it. */
347 if (!NILP (Vmouse_leave_buffer_hook
))
348 call1 (Vrun_hooks
, Qmouse_leave_buffer_hook
);
350 Fselect_window (event
);
357 /* Count the number of arguments the interactive spec would have
358 us give to the function. */
360 for (j
= 0; *tem
; j
++)
362 /* 'r' specifications ("point and mark as 2 numeric args")
363 produce *two* arguments. */
364 if (*tem
== 'r') j
++;
365 tem
= (unsigned char *) index (tem
, '\n');
369 tem
= (unsigned char *) "";
373 args
= (Lisp_Object
*) alloca ((count
+ 1) * sizeof (Lisp_Object
));
374 visargs
= (Lisp_Object
*) alloca ((count
+ 1) * sizeof (Lisp_Object
));
375 argstrings
= (unsigned char **) alloca ((count
+ 1) * sizeof (char *));
376 varies
= (int *) alloca ((count
+ 1) * sizeof (int));
378 for (i
= 0; i
< (count
+ 1); i
++)
385 GCPRO4 (prefix_arg
, function
, *args
, *visargs
);
386 gcpro3
.nvars
= (count
+ 1);
387 gcpro4
.nvars
= (count
+ 1);
390 specbind (Qenable_recursive_minibuffers
, Qt
);
393 for (i
= 1; *tem
; i
++)
395 strncpy (prompt1
, tem
+ 1, sizeof prompt1
- 1);
396 prompt1
[sizeof prompt1
- 1] = 0;
397 tem1
= index (prompt1
, '\n');
399 /* Fill argstrings with a vector of C strings
400 corresponding to the Lisp strings in visargs. */
401 for (j
= 1; j
< i
; j
++)
403 = EQ (visargs
[j
], Qnil
)
404 ? (unsigned char *) ""
405 : XSTRING (visargs
[j
])->data
;
407 doprnt (prompt
, sizeof prompt
, prompt1
, 0, j
- 1, argstrings
+ 1);
411 case 'a': /* Symbol defined as a function */
412 visargs
[i
] = Fcompleting_read (build_string (prompt
),
413 Vobarray
, Qfboundp
, Qt
, Qnil
, Qnil
);
414 /* Passing args[i] directly stimulates compiler bug */
416 args
[i
] = Fintern (teml
, Qnil
);
419 case 'b': /* Name of existing buffer */
420 args
[i
] = Fcurrent_buffer ();
421 if (EQ (selected_window
, minibuf_window
))
422 args
[i
] = Fother_buffer (args
[i
], Qnil
);
423 args
[i
] = Fread_buffer (build_string (prompt
), args
[i
], Qt
);
426 case 'B': /* Name of buffer, possibly nonexistent */
427 args
[i
] = Fread_buffer (build_string (prompt
),
428 Fother_buffer (Fcurrent_buffer (), Qnil
),
432 case 'c': /* Character */
434 args
[i
] = Fread_char ();
435 /* Passing args[i] directly stimulates compiler bug */
437 visargs
[i
] = Fchar_to_string (teml
);
440 case 'C': /* Command: symbol with interactive function */
441 visargs
[i
] = Fcompleting_read (build_string (prompt
),
442 Vobarray
, Qcommandp
, Qt
, Qnil
, Qnil
);
443 /* Passing args[i] directly stimulates compiler bug */
445 args
[i
] = Fintern (teml
, Qnil
);
448 case 'd': /* Value of point. Does not do I/O. */
449 Fset_marker (point_marker
, make_number (PT
), Qnil
);
450 args
[i
] = point_marker
;
451 /* visargs[i] = Qnil; */
455 case 'D': /* Directory name. */
456 args
[i
] = Fread_file_name (build_string (prompt
), Qnil
,
457 current_buffer
->directory
, Qlambda
, Qnil
);
460 case 'f': /* Existing file name. */
461 args
[i
] = Fread_file_name (build_string (prompt
),
462 Qnil
, Qnil
, Qlambda
, Qnil
);
465 case 'F': /* Possibly nonexistent file name. */
466 args
[i
] = Fread_file_name (build_string (prompt
),
467 Qnil
, Qnil
, Qnil
, Qnil
);
470 case 'k': /* Key sequence. */
471 args
[i
] = Fread_key_sequence (build_string (prompt
), Qnil
, Qnil
);
473 visargs
[i
] = Fkey_description (teml
);
476 case 'K': /* Key sequence to be defined. */
477 args
[i
] = Fread_key_sequence (build_string (prompt
), Qnil
, Qt
);
479 visargs
[i
] = Fkey_description (teml
);
482 case 'e': /* The invoking event. */
483 if (next_event
>= this_command_key_count
)
484 error ("%s must be bound to an event with parameters",
486 ? (char *) XSYMBOL (function
)->name
->data
488 args
[i
] = XVECTOR (this_command_keys
)->contents
[next_event
++];
491 /* Find the next parameterized event. */
492 while (next_event
< this_command_key_count
493 && ! (EVENT_HAS_PARAMETERS
494 (XVECTOR (this_command_keys
)->contents
[next_event
])))
499 case 'm': /* Value of mark. Does not do I/O. */
501 /* visargs[i] = Qnil; */
502 args
[i
] = current_buffer
->mark
;
506 case 'N': /* Prefix arg, else number from minibuffer */
507 if (!NILP (prefix_arg
))
508 goto have_prefix_arg
;
509 case 'n': /* Read number from minibuffer. */
511 args
[i
] = Fread_minibuffer (build_string (prompt
), Qnil
);
512 while (! NUMBERP (args
[i
]));
513 visargs
[i
] = last_minibuf_string
;
516 case 'P': /* Prefix arg in raw form. Does no I/O. */
518 args
[i
] = prefix_arg
;
519 /* visargs[i] = Qnil; */
523 case 'p': /* Prefix arg converted to number. No I/O. */
524 args
[i
] = Fprefix_numeric_value (prefix_arg
);
525 /* visargs[i] = Qnil; */
529 case 'r': /* Region, point and mark as 2 args. */
531 Fset_marker (point_marker
, make_number (PT
), Qnil
);
532 /* visargs[i+1] = Qnil; */
533 foo
= marker_position (current_buffer
->mark
);
534 /* visargs[i] = Qnil; */
535 args
[i
] = point
< foo
? point_marker
: current_buffer
->mark
;
537 args
[++i
] = point
> foo
? point_marker
: current_buffer
->mark
;
541 case 's': /* String read via minibuffer. */
542 args
[i
] = Fread_string (build_string (prompt
), Qnil
, Qnil
);
545 case 'S': /* Any symbol. */
546 visargs
[i
] = Fread_string (build_string (prompt
), Qnil
, Qnil
);
547 /* Passing args[i] directly stimulates compiler bug */
549 args
[i
] = Fintern (teml
, Qnil
);
552 case 'v': /* Variable name: symbol that is
554 args
[i
] = Fread_variable (build_string (prompt
));
555 visargs
[i
] = last_minibuf_string
;
558 case 'x': /* Lisp expression read but not evaluated */
559 args
[i
] = Fread_minibuffer (build_string (prompt
), Qnil
);
560 visargs
[i
] = last_minibuf_string
;
563 case 'X': /* Lisp expression read and evaluated */
564 args
[i
] = Feval_minibuffer (build_string (prompt
), Qnil
);
565 visargs
[i
] = last_minibuf_string
;
569 error ("Invalid control letter \"%c\" (%03o) in interactive calling string",
576 if (NILP (visargs
[i
]) && STRINGP (args
[i
]))
577 visargs
[i
] = args
[i
];
579 tem
= (unsigned char *) index (tem
, '\n');
581 else tem
= (unsigned char *) "";
583 unbind_to (speccount
, Qnil
);
589 if (arg_from_tty
|| !NILP (record
))
591 visargs
[0] = function
;
592 for (i
= 1; i
< count
+ 1; i
++)
595 visargs
[i
] = Fcons (intern (callint_argfuns
[varies
[i
]]), Qnil
);
597 visargs
[i
] = quotify_arg (args
[i
]);
599 Vcommand_history
= Fcons (Flist (count
+ 1, visargs
),
603 /* If we used a marker to hold point, mark, or an end of the region,
604 temporarily, convert it to an integer now. */
605 for (i
= 0; i
++; i
< count
)
606 if (varies
[i
] >= 1 && varies
[i
] <= 4)
607 XSETINT (args
[i
], marker_position (args
[i
]));
611 specbind (Qcommand_debug_status
, Qnil
);
613 val
= Ffuncall (count
+ 1, args
);
615 return unbind_to (speccount
, val
);
619 DEFUN ("prefix-numeric-value", Fprefix_numeric_value
, Sprefix_numeric_value
,
621 "Return numeric meaning of raw prefix argument ARG.\n\
622 A raw prefix argument is what you get from `(interactive \"P\")'.\n\
623 Its numeric meaning is what you would get from `(interactive \"p\")'.")
630 XSETFASTINT (val
, 1);
631 else if (EQ (raw
, Qminus
))
633 else if (CONSP (raw
))
634 XSETINT (val
, XINT (XCONS (raw
)->car
));
635 else if (INTEGERP (raw
))
638 XSETFASTINT (val
, 1);
645 point_marker
= Fmake_marker ();
646 staticpro (&point_marker
);
648 preserved_fns
= Fcons (intern ("region-beginning"),
649 Fcons (intern ("region-end"),
650 Fcons (intern ("point"),
651 Fcons (intern ("mark"), Qnil
))));
652 staticpro (&preserved_fns
);
654 Qlist
= intern ("list");
657 Qminus
= intern ("-");
660 Qplus
= intern ("+");
663 Qcall_interactively
= intern ("call-interactively");
664 staticpro (&Qcall_interactively
);
666 Qcommand_debug_status
= intern ("command-debug-status");
667 staticpro (&Qcommand_debug_status
);
669 Qenable_recursive_minibuffers
= intern ("enable-recursive-minibuffers");
670 staticpro (&Qenable_recursive_minibuffers
);
672 Qmouse_leave_buffer_hook
= intern ("mouse-leave-buffer-hook");
673 staticpro (&Qmouse_leave_buffer_hook
);
675 DEFVAR_LISP ("command-history", &Vcommand_history
,
676 "List of recent commands that read arguments from terminal.\n\
677 Each command is represented as a form to evaluate.");
678 Vcommand_history
= Qnil
;
680 DEFVAR_LISP ("command-debug-status", &Vcommand_debug_status
,
681 "Debugging status of current interactive command.\n\
682 Bound each time `call-interactively' is called;\n\
683 may be set by the debugger as a reminder for itself.");
684 Vcommand_debug_status
= Qnil
;
686 DEFVAR_LISP ("mark-even-if-inactive", &Vmark_even_if_inactive
,
687 "*Non-nil means you can use the mark even when inactive.\n\
688 This option makes a difference in Transient Mark mode.\n\
689 When the option is non-nil, deactivation of the mark\n\
690 turns off region highlighting, but commands that use the mark\n\
691 behave as if the mark were still active.");
692 Vmark_even_if_inactive
= Qnil
;
694 DEFVAR_LISP ("mouse-leave-buffer-hook", &Vmouse_leave_buffer_hook
,
695 "Hook to run when about to switch windows with a mouse command.\n\
696 Its purpose is to give temporary modes such as Isearch mode\n\
697 a way to turn themselves off when a mouse command switches windows.");
698 Vmouse_leave_buffer_hook
= Qnil
;
700 defsubr (&Sinteractive
);
701 defsubr (&Scall_interactively
);
702 defsubr (&Sprefix_numeric_value
);