1 /* Call a Lisp function interactively.
2 Copyright (C) 1985, 1986, 1993 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
;
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
;
43 Lisp_Object preserved_fns
;
45 /* This comment supplies the doc string for interactive,
46 for make-docfile to see. We cannot put this in the real DEFUN
47 due to limits in the Unix cpp.
49 DEFUN ("interactive", Ffoo, Sfoo, 0, 0, 0,
50 "Specify a way of parsing arguments for interactive use of a function.\n\
52 (defun foo (arg) \"Doc string\" (interactive \"p\") ...use arg...)\n\
53 to make ARG be the prefix argument when `foo' is called as a command.\n\
54 The \"call\" to `interactive' is actually a declaration rather than a function;\n\
55 it tells `call-interactively' how to read arguments\n\
56 to pass to the function.\n\
57 When actually called, `interactive' just returns nil.\n\
59 The argument of `interactive' is usually a string containing a code letter\n\
60 followed by a prompt. (Some code letters do not use I/O to get\n\
61 the argument and do not need prompts.) To prompt for multiple arguments,\n\
62 give a code letter, its prompt, a newline, and another code letter, etc.\n\
63 Prompts are passed to format, and may use % escapes to print the\n\
64 arguments that have already been read.\n\
65 If the argument is not a string, it is evaluated to get a list of\n\
66 arguments to pass to the function.\n\
67 Just `(interactive)' means pass no args when calling interactively.\n\
68 \nCode letters available are:\n\
69 a -- Function name: symbol with a function definition.\n\
70 b -- Name of existing buffer.\n\
71 B -- Name of buffer, possibly nonexistent.\n\
73 C -- Command name: symbol with interactive function definition.\n\
74 d -- Value of point as number. Does not do I/O.\n\
75 D -- Directory name.\n\
76 e -- Parametrized event (i.e., one that's a list) that invoked this command.\n\
77 If used more than once, the Nth `e' returns the Nth parameterized event.\n\
78 This skips events that are integers or symbols.\n\
79 f -- Existing file name.\n\
80 F -- Possibly nonexistent file name.\n\
81 k -- Key sequence (string).\n\
82 m -- Value of mark as number. Does not do I/O.\n\
83 n -- Number read using minibuffer.\n\
84 N -- Prefix arg converted to number, or if none, do like code `n'.\n\
85 p -- Prefix arg converted to number. Does not do I/O.\n\
86 P -- Prefix arg in raw form. Does not do I/O.\n\
87 r -- Region: point and mark as 2 numeric args, smallest first. Does no I/O.\n\
90 v -- Variable name: symbol that is user-variable-p.\n\
91 x -- Lisp expression read but not evaluated.\n\
92 X -- Lisp expression read and evaluated.\n\
93 In addition, if the string begins with `*'\n\
94 then an error is signaled if the buffer is read-only.\n\
95 This happens before reading any arguments.\n\
96 If the string begins with `@', then Emacs searches the key sequence\n\
97 which invoked the command for its first mouse click (or any other\n\
98 event which specifies a window), and selects that window before\n\
99 reading any arguments. You may use both `@' and `*'; they are\n\
100 processed in the order that they appear." */
103 DEFUN ("interactive", Finteractive
, Sinteractive
, 0, UNEVALLED
, 0,
104 0 /* See immediately above */)
111 /* Quotify EXP: if EXP is constant, return it.
112 If EXP is not constant, return (quote EXP). */
115 register Lisp_Object exp
;
117 if (XTYPE (exp
) != Lisp_Int
&& XTYPE (exp
) != Lisp_String
118 && !NILP (exp
) && !EQ (exp
, Qt
))
119 return Fcons (Qquote
, Fcons (exp
, Qnil
));
124 /* Modify EXP by quotifying each element (except the first). */
129 register Lisp_Object tail
;
130 register struct Lisp_Cons
*ptr
;
131 for (tail
= exp
; CONSP (tail
); tail
= ptr
->cdr
)
134 ptr
->car
= quotify_arg (ptr
->car
);
139 char *callint_argfuns
[]
140 = {"", "point", "mark", "region-beginning", "region-end"};
145 Lisp_Object tem
= Fmarker_buffer (current_buffer
->mark
);
146 if (NILP (tem
) || (XBUFFER (tem
) != current_buffer
))
147 error ("The mark is not set now");
148 if (!NILP (Vtransient_mark_mode
) && NILP (Vmark_even_if_inactive
)
149 && NILP (current_buffer
->mark_active
))
150 Fsignal (Qmark_inactive
, Qnil
);
154 DEFUN ("call-interactively", Fcall_interactively
, Scall_interactively
, 1, 2, 0,
155 "Call FUNCTION, reading args according to its interactive calling specs.\n\
156 The function contains a specification of how to do the argument reading.\n\
157 In the case of user-defined functions, this is specified by placing a call\n\
158 to the function `interactive' at the top level of the function body.\n\
159 See `interactive'.\n\
161 Optional second arg RECORD-FLAG non-nil\n\
162 means unconditionally put this command in the command-history.\n\
163 Otherwise, this is done only if an arg is read using the minibuffer.")
165 Lisp_Object function
, record
;
167 Lisp_Object
*args
, *visargs
;
168 unsigned char **argstrings
;
174 int speccount
= specpdl_ptr
- specpdl
;
176 /* The index of the next element of this_command_keys to examine for
177 the 'e' interactive code. */
180 Lisp_Object prefix_arg
;
181 unsigned char *string
;
184 /* If varies[i] > 0, the i'th argument shouldn't just have its value
185 in this call quoted in the command history. It should be
186 recorded as a call to the function named callint_argfuns[varies[i]]. */
194 int arg_from_tty
= 0;
195 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
197 /* Save this now, since use of minibuffer will clobber it. */
198 prefix_arg
= Vcurrent_prefix_arg
;
202 if (XTYPE (function
) == Lisp_Symbol
)
203 enable
= Fget (function
, Qenable_recursive_minibuffers
);
205 fun
= indirect_function (function
);
210 /* Decode the kind of function. Either handle it and return,
211 or go to `lose' if not interactive, or go to `retry'
212 to specify a different function, or set either STRING or SPECS. */
214 if (XTYPE (fun
) == Lisp_Subr
)
216 string
= (unsigned char *) XSUBR (fun
)->prompt
;
220 function
= wrong_type_argument (Qcommandp
, function
);
223 if ((int) string
== 1)
224 /* Let SPECS (which is nil) be used as the args. */
227 else if (XTYPE (fun
) == Lisp_Compiled
)
229 if (XVECTOR (fun
)->size
<= COMPILED_INTERACTIVE
)
231 specs
= XVECTOR (fun
)->contents
[COMPILED_INTERACTIVE
];
233 else if (!CONSP (fun
))
235 else if (funcar
= Fcar (fun
), EQ (funcar
, Qautoload
))
237 GCPRO2 (function
, prefix_arg
);
238 do_autoload (fun
, function
);
242 else if (EQ (funcar
, Qlambda
))
244 specs
= Fassq (Qinteractive
, Fcdr (Fcdr (fun
)));
247 specs
= Fcar (Fcdr (specs
));
249 else if (EQ (funcar
, Qmocklisp
))
250 return ml_apply (fun
, Qinteractive
);
254 /* If either specs or string is set to a string, use it. */
255 if (XTYPE (specs
) == Lisp_String
)
257 /* Make a copy of string so that if a GC relocates specs,
258 `string' will still be valid. */
259 string
= (unsigned char *) alloca (XSTRING (specs
)->size
+ 1);
260 bcopy (XSTRING (specs
)->data
, string
, XSTRING (specs
)->size
+ 1);
262 else if (string
== 0)
267 /* Compute the arg values using the user's expression. */
268 specs
= Feval (specs
);
269 if (i
!= num_input_chars
|| !NILP (record
))
271 /* We should record this command on the command history. */
272 Lisp_Object values
, car
;
273 /* Make a copy of the list of values, for the command history,
274 and turn them into things we can eval. */
275 values
= quotify_args (Fcopy_sequence (specs
));
276 /* If the list of args was produced with an explicit call to `list',
277 look for elements that were computed with (region-beginning)
278 or (region-end), and put those expressions into VALUES
279 instead of the present values. */
283 Lisp_Object intail
, valtail
;
284 for (intail
= Fcdr (input
), valtail
= values
;
286 intail
= Fcdr (intail
), valtail
= Fcdr (valtail
))
292 Lisp_Object presflag
;
293 presflag
= Fmemq (Fcar (elt
), preserved_fns
);
294 if (!NILP (presflag
))
295 Fsetcar (valtail
, Fcar (intail
));
300 = Fcons (Fcons (function
, values
), Vcommand_history
);
302 return apply1 (function
, specs
);
305 /* Here if function specifies a string to control parsing the defaults */
307 /* Set next_event to point to the first event with parameters. */
308 for (next_event
= 0; next_event
< this_command_key_count
; next_event
++)
309 if (EVENT_HAS_PARAMETERS
310 (XVECTOR (this_command_keys
)->contents
[next_event
]))
313 /* Handle special starting chars `*' and `@'. */
319 if (!NILP (current_buffer
->read_only
))
320 Fbarf_if_buffer_read_only ();
322 else if (*string
== '@')
325 XVECTOR (this_command_keys
)->contents
[next_event
];
327 if (EVENT_HAS_PARAMETERS (event
)
328 && XTYPE (event
= XCONS (event
)->cdr
) == Lisp_Cons
329 && XTYPE (event
= XCONS (event
)->car
) == Lisp_Cons
330 && XTYPE (event
= XCONS (event
)->car
) == Lisp_Window
)
332 if (MINI_WINDOW_P (XWINDOW (event
))
333 && NILP (call1 (intern ("minibuffer-window-active-p"),
335 error ("Attempt to select inactive minibuffer window");
336 Fselect_window (event
);
343 /* Count the number of arguments the interactive spec would have
344 us give to the function. */
346 for (j
= 0; *tem
; j
++)
348 /* 'r' specifications ("point and mark as 2 numeric args")
349 produce *two* arguments. */
350 if (*tem
== 'r') j
++;
351 tem
= (unsigned char *) index (tem
, '\n');
355 tem
= (unsigned char *) "";
359 args
= (Lisp_Object
*) alloca ((count
+ 1) * sizeof (Lisp_Object
));
360 visargs
= (Lisp_Object
*) alloca ((count
+ 1) * sizeof (Lisp_Object
));
361 argstrings
= (unsigned char **) alloca ((count
+ 1) * sizeof (char *));
362 varies
= (int *) alloca ((count
+ 1) * sizeof (int));
364 for (i
= 0; i
< (count
+ 1); i
++)
371 GCPRO4 (prefix_arg
, function
, *args
, *visargs
);
372 gcpro3
.nvars
= (count
+ 1);
373 gcpro4
.nvars
= (count
+ 1);
376 specbind (Qenable_recursive_minibuffers
, Qt
);
379 for (i
= 1; *tem
; i
++)
381 strncpy (prompt1
, tem
+ 1, sizeof prompt1
- 1);
382 prompt1
[sizeof prompt1
- 1] = 0;
383 tem1
= index (prompt1
, '\n');
385 /* Fill argstrings with a vector of C strings
386 corresponding to the Lisp strings in visargs. */
387 for (j
= 1; j
< i
; j
++)
389 = EQ (visargs
[j
], Qnil
)
390 ? (unsigned char *) ""
391 : XSTRING (visargs
[j
])->data
;
393 doprnt (prompt
, sizeof prompt
, prompt1
, 0, j
- 1, argstrings
+ 1);
397 case 'a': /* Symbol defined as a function */
398 visargs
[i
] = Fcompleting_read (build_string (prompt
),
399 Vobarray
, Qfboundp
, Qt
, Qnil
, Qnil
);
400 /* Passing args[i] directly stimulates compiler bug */
402 args
[i
] = Fintern (teml
, Qnil
);
405 case 'b': /* Name of existing buffer */
406 args
[i
] = Fcurrent_buffer ();
407 if (EQ (selected_window
, minibuf_window
))
408 args
[i
] = Fother_buffer (args
[i
], Qnil
);
409 args
[i
] = Fread_buffer (build_string (prompt
), args
[i
], Qt
);
412 case 'B': /* Name of buffer, possibly nonexistent */
413 args
[i
] = Fread_buffer (build_string (prompt
),
414 Fother_buffer (Fcurrent_buffer (), Qnil
),
418 case 'c': /* Character */
420 args
[i
] = Fread_char ();
421 /* Passing args[i] directly stimulates compiler bug */
423 visargs
[i
] = Fchar_to_string (teml
);
426 case 'C': /* Command: symbol with interactive function */
427 visargs
[i
] = Fcompleting_read (build_string (prompt
),
428 Vobarray
, Qcommandp
, Qt
, Qnil
, Qnil
);
429 /* Passing args[i] directly stimulates compiler bug */
431 args
[i
] = Fintern (teml
, Qnil
);
434 case 'd': /* Value of point. Does not do I/O. */
435 XFASTINT (args
[i
]) = point
;
436 /* visargs[i] = Qnil; */
440 case 'D': /* Directory name. */
441 args
[i
] = Fread_file_name (build_string (prompt
), Qnil
,
442 current_buffer
->directory
, Qlambda
, Qnil
);
445 case 'f': /* Existing file name. */
446 args
[i
] = Fread_file_name (build_string (prompt
),
447 Qnil
, Qnil
, Qlambda
, Qnil
);
450 case 'F': /* Possibly nonexistent file name. */
451 args
[i
] = Fread_file_name (build_string (prompt
),
452 Qnil
, Qnil
, Qnil
, Qnil
);
455 case 'k': /* Key sequence (string) */
456 args
[i
] = Fread_key_sequence (build_string (prompt
), Qnil
);
458 visargs
[i
] = Fkey_description (teml
);
461 case 'e': /* The invoking event. */
462 if (next_event
>= this_command_key_count
)
463 error ("%s must be bound to an event with parameters",
464 (XTYPE (function
) == Lisp_Symbol
465 ? (char *) XSYMBOL (function
)->name
->data
467 args
[i
] = XVECTOR (this_command_keys
)->contents
[next_event
++];
470 /* Find the next parameterized event. */
471 while (next_event
< this_command_key_count
472 && ! (EVENT_HAS_PARAMETERS
473 (XVECTOR (this_command_keys
)->contents
[next_event
])))
478 case 'm': /* Value of mark. Does not do I/O. */
480 /* visargs[i] = Qnil; */
481 XFASTINT (args
[i
]) = marker_position (current_buffer
->mark
);
485 case 'N': /* Prefix arg, else number from minibuffer */
486 if (!NILP (prefix_arg
))
487 goto have_prefix_arg
;
488 case 'n': /* Read number from minibuffer. */
490 args
[i
] = Fread_minibuffer (build_string (prompt
), Qnil
);
491 while (! NUMBERP (args
[i
]));
492 visargs
[i
] = last_minibuf_string
;
495 case 'P': /* Prefix arg in raw form. Does no I/O. */
497 args
[i
] = prefix_arg
;
498 /* visargs[i] = Qnil; */
502 case 'p': /* Prefix arg converted to number. No I/O. */
503 args
[i
] = Fprefix_numeric_value (prefix_arg
);
504 /* visargs[i] = Qnil; */
508 case 'r': /* Region, point and mark as 2 args. */
510 /* visargs[i+1] = Qnil; */
511 foo
= marker_position (current_buffer
->mark
);
512 /* visargs[i] = Qnil; */
513 XFASTINT (args
[i
]) = point
< foo
? point
: foo
;
515 XFASTINT (args
[++i
]) = point
> foo
? point
: foo
;
519 case 's': /* String read via minibuffer. */
520 args
[i
] = Fread_string (build_string (prompt
), Qnil
);
523 case 'S': /* Any symbol. */
524 visargs
[i
] = Fread_string (build_string (prompt
), Qnil
);
525 /* Passing args[i] directly stimulates compiler bug */
527 args
[i
] = Fintern (teml
, Qnil
);
530 case 'v': /* Variable name: symbol that is
532 args
[i
] = Fread_variable (build_string (prompt
));
533 visargs
[i
] = last_minibuf_string
;
536 case 'x': /* Lisp expression read but not evaluated */
537 args
[i
] = Fread_minibuffer (build_string (prompt
), Qnil
);
538 visargs
[i
] = last_minibuf_string
;
541 case 'X': /* Lisp expression read and evaluated */
542 args
[i
] = Feval_minibuffer (build_string (prompt
), Qnil
);
543 visargs
[i
] = last_minibuf_string
;
547 error ("Invalid control letter \"%c\" (%03o) in interactive calling string",
554 if (NILP (visargs
[i
]) && XTYPE (args
[i
]) == Lisp_String
)
555 visargs
[i
] = args
[i
];
557 tem
= (unsigned char *) index (tem
, '\n');
559 else tem
= (unsigned char *) "";
561 unbind_to (speccount
, Qnil
);
567 if (arg_from_tty
|| !NILP (record
))
569 visargs
[0] = function
;
570 for (i
= 1; i
< count
+ 1; i
++)
572 visargs
[i
] = Fcons (intern (callint_argfuns
[varies
[i
]]), Qnil
);
574 visargs
[i
] = quotify_arg (args
[i
]);
575 Vcommand_history
= Fcons (Flist (count
+ 1, visargs
),
581 specbind (Qcommand_debug_status
, Qnil
);
583 val
= Ffuncall (count
+ 1, args
);
585 return unbind_to (speccount
, val
);
589 DEFUN ("prefix-numeric-value", Fprefix_numeric_value
, Sprefix_numeric_value
,
591 "Return numeric meaning of raw prefix argument ARG.\n\
592 A raw prefix argument is what you get from `(interactive \"P\")'.\n\
593 Its numeric meaning is what you would get from `(interactive \"p\")'.")
599 /* Tag val as an integer, so the rest of the assignments
605 else if (EQ (raw
, Qminus
))
607 else if (CONSP (raw
))
608 XSETINT (val
, XINT (XCONS (raw
)->car
));
609 else if (XTYPE (raw
) == Lisp_Int
)
619 preserved_fns
= Fcons (intern ("region-beginning"),
620 Fcons (intern ("region-end"),
621 Fcons (intern ("point"),
622 Fcons (intern ("mark"), Qnil
))));
623 staticpro (&preserved_fns
);
625 Qlist
= intern ("list");
628 Qminus
= intern ("-");
631 Qcall_interactively
= intern ("call-interactively");
632 staticpro (&Qcall_interactively
);
634 Qcommand_debug_status
= intern ("command-debug-status");
635 staticpro (&Qcommand_debug_status
);
637 Qenable_recursive_minibuffers
= intern ("enable-recursive-minibuffers");
638 staticpro (&Qenable_recursive_minibuffers
);
640 DEFVAR_LISP ("prefix-arg", &Vprefix_arg
,
641 "The value of the prefix argument for the next editing command.\n\
642 It may be a number, or the symbol `-' for just a minus sign as arg,\n\
643 or a list whose car is a number for just one or more C-U's\n\
644 or nil if no argument has been specified.\n\
646 You cannot examine this variable to find the argument for this command\n\
647 since it has been set to nil by the time you can look.\n\
648 Instead, you should use the variable `current-prefix-arg', although\n\
649 normally commands can get this prefix argument with (interactive \"P\").");
652 DEFVAR_LISP ("current-prefix-arg", &Vcurrent_prefix_arg
,
653 "The value of the prefix argument for this editing command.\n\
654 It may be a number, or the symbol `-' for just a minus sign as arg,\n\
655 or a list whose car is a number for just one or more C-U's\n\
656 or nil if no argument has been specified.\n\
657 This is what `(interactive \"P\")' returns.");
658 Vcurrent_prefix_arg
= Qnil
;
660 DEFVAR_LISP ("command-history", &Vcommand_history
,
661 "List of recent commands that read arguments from terminal.\n\
662 Each command is represented as a form to evaluate.");
663 Vcommand_history
= Qnil
;
665 DEFVAR_LISP ("command-debug-status", &Vcommand_debug_status
,
666 "Debugging status of current interactive command.\n\
667 Bound each time `call-interactively' is called;\n\
668 may be set by the debugger as a reminder for itself.");
669 Vcommand_debug_status
= Qnil
;
671 DEFVAR_LISP ("mark-even-if-inactive", &Vmark_even_if_inactive
,
672 "*Non-nil means you can use the mark even when inactive.\n\
673 This option makes a difference in Transient Mark mode.\n\
674 When the option is non-nil, deactivation of the mark\n\
675 turns off region highlighting, but commands that use the mark\n\
676 behave as if the mark were still active.");
677 Vmark_even_if_inactive
= Qnil
;
679 defsubr (&Sinteractive
);
680 defsubr (&Scall_interactively
);
681 defsubr (&Sprefix_numeric_value
);