1 /* Call a Lisp function interactively.
2 Copyright (C) 1985, 1986, 1993, 1994 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
;
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 -- Raw prefix arg, 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 (!INTEGERP (exp
) && !STRINGP (exp
)
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"};
146 tem
= Fmarker_buffer (current_buffer
->mark
);
147 if (NILP (tem
) || (XBUFFER (tem
) != current_buffer
))
148 error ("The mark is not set now");
149 if (!NILP (Vtransient_mark_mode
) && NILP (Vmark_even_if_inactive
)
150 && NILP (current_buffer
->mark_active
))
151 Fsignal (Qmark_inactive
, Qnil
);
155 DEFUN ("call-interactively", Fcall_interactively
, Scall_interactively
, 1, 2, 0,
156 "Call FUNCTION, reading args according to its interactive calling specs.\n\
157 The function contains a specification of how to do the argument reading.\n\
158 In the case of user-defined functions, this is specified by placing a call\n\
159 to the function `interactive' at the top level of the function body.\n\
160 See `interactive'.\n\
162 Optional second arg RECORD-FLAG non-nil\n\
163 means unconditionally put this command in the command-history.\n\
164 Otherwise, this is done only if an arg is read using the minibuffer.")
166 Lisp_Object function
, record
;
168 Lisp_Object
*args
, *visargs
;
169 unsigned char **argstrings
;
175 int speccount
= specpdl_ptr
- specpdl
;
177 /* The index of the next element of this_command_keys to examine for
178 the 'e' interactive code. */
181 Lisp_Object prefix_arg
;
182 unsigned char *string
;
185 /* If varies[i] > 0, the i'th argument shouldn't just have its value
186 in this call quoted in the command history. It should be
187 recorded as a call to the function named callint_argfuns[varies[i]]. */
195 int arg_from_tty
= 0;
196 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
198 /* Save this now, since use of minibuffer will clobber it. */
199 prefix_arg
= Vcurrent_prefix_arg
;
203 if (SYMBOLP (function
))
204 enable
= Fget (function
, Qenable_recursive_minibuffers
);
206 fun
= indirect_function (function
);
211 /* Decode the kind of function. Either handle it and return,
212 or go to `lose' if not interactive, or go to `retry'
213 to specify a different function, or set either STRING or SPECS. */
217 string
= (unsigned char *) XSUBR (fun
)->prompt
;
221 function
= wrong_type_argument (Qcommandp
, function
);
224 if ((EMACS_INT
) string
== 1)
225 /* Let SPECS (which is nil) be used as the args. */
228 else if (COMPILEDP (fun
))
230 if (XVECTOR (fun
)->size
<= COMPILED_INTERACTIVE
)
232 specs
= XVECTOR (fun
)->contents
[COMPILED_INTERACTIVE
];
234 else if (!CONSP (fun
))
236 else if (funcar
= Fcar (fun
), EQ (funcar
, Qautoload
))
238 GCPRO2 (function
, prefix_arg
);
239 do_autoload (fun
, function
);
243 else if (EQ (funcar
, Qlambda
))
245 specs
= Fassq (Qinteractive
, Fcdr (Fcdr (fun
)));
248 specs
= Fcar (Fcdr (specs
));
250 else if (EQ (funcar
, Qmocklisp
))
251 return ml_apply (fun
, Qinteractive
);
255 /* If either specs or string is set to a string, use it. */
258 /* Make a copy of string so that if a GC relocates specs,
259 `string' will still be valid. */
260 string
= (unsigned char *) alloca (XSTRING (specs
)->size
+ 1);
261 bcopy (XSTRING (specs
)->data
, string
, XSTRING (specs
)->size
+ 1);
263 else if (string
== 0)
268 /* Compute the arg values using the user's expression. */
269 specs
= Feval (specs
);
270 if (i
!= num_input_chars
|| !NILP (record
))
272 /* We should record this command on the command history. */
273 Lisp_Object values
, car
;
274 /* Make a copy of the list of values, for the command history,
275 and turn them into things we can eval. */
276 values
= quotify_args (Fcopy_sequence (specs
));
277 /* If the list of args was produced with an explicit call to `list',
278 look for elements that were computed with (region-beginning)
279 or (region-end), and put those expressions into VALUES
280 instead of the present values. */
284 Lisp_Object intail
, valtail
;
285 for (intail
= Fcdr (input
), valtail
= values
;
287 intail
= Fcdr (intail
), valtail
= Fcdr (valtail
))
293 Lisp_Object presflag
;
294 presflag
= Fmemq (Fcar (elt
), preserved_fns
);
295 if (!NILP (presflag
))
296 Fsetcar (valtail
, Fcar (intail
));
301 = Fcons (Fcons (function
, values
), Vcommand_history
);
303 return apply1 (function
, specs
);
306 /* Here if function specifies a string to control parsing the defaults */
308 /* Set next_event to point to the first event with parameters. */
309 for (next_event
= 0; next_event
< this_command_key_count
; next_event
++)
310 if (EVENT_HAS_PARAMETERS
311 (XVECTOR (this_command_keys
)->contents
[next_event
]))
314 /* Handle special starting chars `*' and `@'. Also `-'. */
320 if (!NILP (current_buffer
->read_only
))
321 Fbarf_if_buffer_read_only ();
323 /* Ignore this for semi-compatibility with Lucid. */
324 else if (*string
== '-')
326 else if (*string
== '@')
330 event
= XVECTOR (this_command_keys
)->contents
[next_event
];
331 if (EVENT_HAS_PARAMETERS (event
)
332 && (event
= XCONS (event
)->car
, CONSP (event
))
333 && (event
= XCONS (event
)->car
, CONSP (event
))
334 && (event
= XCONS (event
)->car
), WINDOWP (event
))
336 if (MINI_WINDOW_P (XWINDOW (event
))
337 && ! (minibuf_level
> 0 && EQ (event
, minibuf_window
)))
338 error ("Attempt to select inactive minibuffer window");
339 Fselect_window (event
);
346 /* Count the number of arguments the interactive spec would have
347 us give to the function. */
349 for (j
= 0; *tem
; j
++)
351 /* 'r' specifications ("point and mark as 2 numeric args")
352 produce *two* arguments. */
353 if (*tem
== 'r') j
++;
354 tem
= (unsigned char *) index (tem
, '\n');
358 tem
= (unsigned char *) "";
362 args
= (Lisp_Object
*) alloca ((count
+ 1) * sizeof (Lisp_Object
));
363 visargs
= (Lisp_Object
*) alloca ((count
+ 1) * sizeof (Lisp_Object
));
364 argstrings
= (unsigned char **) alloca ((count
+ 1) * sizeof (char *));
365 varies
= (int *) alloca ((count
+ 1) * sizeof (int));
367 for (i
= 0; i
< (count
+ 1); i
++)
374 GCPRO4 (prefix_arg
, function
, *args
, *visargs
);
375 gcpro3
.nvars
= (count
+ 1);
376 gcpro4
.nvars
= (count
+ 1);
379 specbind (Qenable_recursive_minibuffers
, Qt
);
382 for (i
= 1; *tem
; i
++)
384 strncpy (prompt1
, tem
+ 1, sizeof prompt1
- 1);
385 prompt1
[sizeof prompt1
- 1] = 0;
386 tem1
= index (prompt1
, '\n');
388 /* Fill argstrings with a vector of C strings
389 corresponding to the Lisp strings in visargs. */
390 for (j
= 1; j
< i
; j
++)
392 = EQ (visargs
[j
], Qnil
)
393 ? (unsigned char *) ""
394 : XSTRING (visargs
[j
])->data
;
396 doprnt (prompt
, sizeof prompt
, prompt1
, 0, j
- 1, argstrings
+ 1);
400 case 'a': /* Symbol defined as a function */
401 visargs
[i
] = Fcompleting_read (build_string (prompt
),
402 Vobarray
, Qfboundp
, Qt
, Qnil
, Qnil
);
403 /* Passing args[i] directly stimulates compiler bug */
405 args
[i
] = Fintern (teml
, Qnil
);
408 case 'b': /* Name of existing buffer */
409 args
[i
] = Fcurrent_buffer ();
410 if (EQ (selected_window
, minibuf_window
))
411 args
[i
] = Fother_buffer (args
[i
], Qnil
);
412 args
[i
] = Fread_buffer (build_string (prompt
), args
[i
], Qt
);
415 case 'B': /* Name of buffer, possibly nonexistent */
416 args
[i
] = Fread_buffer (build_string (prompt
),
417 Fother_buffer (Fcurrent_buffer (), Qnil
),
421 case 'c': /* Character */
423 args
[i
] = Fread_char ();
424 /* Passing args[i] directly stimulates compiler bug */
426 visargs
[i
] = Fchar_to_string (teml
);
429 case 'C': /* Command: symbol with interactive function */
430 visargs
[i
] = Fcompleting_read (build_string (prompt
),
431 Vobarray
, Qcommandp
, Qt
, Qnil
, Qnil
);
432 /* Passing args[i] directly stimulates compiler bug */
434 args
[i
] = Fintern (teml
, Qnil
);
437 case 'd': /* Value of point. Does not do I/O. */
438 XSETFASTINT (args
[i
], point
);
439 /* visargs[i] = Qnil; */
443 case 'D': /* Directory name. */
444 args
[i
] = Fread_file_name (build_string (prompt
), Qnil
,
445 current_buffer
->directory
, Qlambda
, Qnil
);
448 case 'f': /* Existing file name. */
449 args
[i
] = Fread_file_name (build_string (prompt
),
450 Qnil
, Qnil
, Qlambda
, Qnil
);
453 case 'F': /* Possibly nonexistent file name. */
454 args
[i
] = Fread_file_name (build_string (prompt
),
455 Qnil
, Qnil
, Qnil
, Qnil
);
458 case 'k': /* Key sequence (string) */
459 args
[i
] = Fread_key_sequence (build_string (prompt
), Qnil
);
461 visargs
[i
] = Fkey_description (teml
);
464 case 'e': /* The invoking event. */
465 if (next_event
>= this_command_key_count
)
466 error ("%s must be bound to an event with parameters",
468 ? (char *) XSYMBOL (function
)->name
->data
470 args
[i
] = XVECTOR (this_command_keys
)->contents
[next_event
++];
473 /* Find the next parameterized event. */
474 while (next_event
< this_command_key_count
475 && ! (EVENT_HAS_PARAMETERS
476 (XVECTOR (this_command_keys
)->contents
[next_event
])))
481 case 'm': /* Value of mark. Does not do I/O. */
483 /* visargs[i] = Qnil; */
484 XSETFASTINT (args
[i
], marker_position (current_buffer
->mark
));
488 case 'N': /* Prefix arg, else number from minibuffer */
489 if (!NILP (prefix_arg
))
490 goto have_prefix_arg
;
491 case 'n': /* Read number from minibuffer. */
493 args
[i
] = Fread_minibuffer (build_string (prompt
), Qnil
);
494 while (! NUMBERP (args
[i
]));
495 visargs
[i
] = last_minibuf_string
;
498 case 'P': /* Prefix arg in raw form. Does no I/O. */
500 args
[i
] = prefix_arg
;
501 /* visargs[i] = Qnil; */
505 case 'p': /* Prefix arg converted to number. No I/O. */
506 args
[i
] = Fprefix_numeric_value (prefix_arg
);
507 /* visargs[i] = Qnil; */
511 case 'r': /* Region, point and mark as 2 args. */
513 /* visargs[i+1] = Qnil; */
514 foo
= marker_position (current_buffer
->mark
);
515 /* visargs[i] = Qnil; */
516 XSETFASTINT (args
[i
], point
< foo
? point
: foo
);
518 XSETFASTINT (args
[++i
], point
> foo
? point
: foo
);
522 case 's': /* String read via minibuffer. */
523 args
[i
] = Fread_string (build_string (prompt
), Qnil
);
526 case 'S': /* Any symbol. */
527 visargs
[i
] = Fread_string (build_string (prompt
), Qnil
);
528 /* Passing args[i] directly stimulates compiler bug */
530 args
[i
] = Fintern (teml
, Qnil
);
533 case 'v': /* Variable name: symbol that is
535 args
[i
] = Fread_variable (build_string (prompt
));
536 visargs
[i
] = last_minibuf_string
;
539 case 'x': /* Lisp expression read but not evaluated */
540 args
[i
] = Fread_minibuffer (build_string (prompt
), Qnil
);
541 visargs
[i
] = last_minibuf_string
;
544 case 'X': /* Lisp expression read and evaluated */
545 args
[i
] = Feval_minibuffer (build_string (prompt
), Qnil
);
546 visargs
[i
] = last_minibuf_string
;
550 error ("Invalid control letter \"%c\" (%03o) in interactive calling string",
557 if (NILP (visargs
[i
]) && STRINGP (args
[i
]))
558 visargs
[i
] = args
[i
];
560 tem
= (unsigned char *) index (tem
, '\n');
562 else tem
= (unsigned char *) "";
564 unbind_to (speccount
, Qnil
);
570 if (arg_from_tty
|| !NILP (record
))
572 visargs
[0] = function
;
573 for (i
= 1; i
< count
+ 1; i
++)
575 visargs
[i
] = Fcons (intern (callint_argfuns
[varies
[i
]]), Qnil
);
577 visargs
[i
] = quotify_arg (args
[i
]);
578 Vcommand_history
= Fcons (Flist (count
+ 1, visargs
),
584 specbind (Qcommand_debug_status
, Qnil
);
586 val
= Ffuncall (count
+ 1, args
);
588 return unbind_to (speccount
, val
);
592 DEFUN ("prefix-numeric-value", Fprefix_numeric_value
, Sprefix_numeric_value
,
594 "Return numeric meaning of raw prefix argument ARG.\n\
595 A raw prefix argument is what you get from `(interactive \"P\")'.\n\
596 Its numeric meaning is what you would get from `(interactive \"p\")'.")
603 XSETFASTINT (val
, 1);
604 else if (EQ (raw
, Qminus
))
606 else if (CONSP (raw
))
607 XSETINT (val
, XINT (XCONS (raw
)->car
));
608 else if (INTEGERP (raw
))
611 XSETFASTINT (val
, 1);
618 preserved_fns
= Fcons (intern ("region-beginning"),
619 Fcons (intern ("region-end"),
620 Fcons (intern ("point"),
621 Fcons (intern ("mark"), Qnil
))));
622 staticpro (&preserved_fns
);
624 Qlist
= intern ("list");
627 Qminus
= intern ("-");
630 Qplus
= intern ("+");
633 Qcall_interactively
= intern ("call-interactively");
634 staticpro (&Qcall_interactively
);
636 Qcommand_debug_status
= intern ("command-debug-status");
637 staticpro (&Qcommand_debug_status
);
639 Qenable_recursive_minibuffers
= intern ("enable-recursive-minibuffers");
640 staticpro (&Qenable_recursive_minibuffers
);
642 DEFVAR_LISP ("prefix-arg", &Vprefix_arg
,
643 "The value of the prefix argument for the next editing command.\n\
644 It may be a number, or the symbol `-' for just a minus sign as arg,\n\
645 or a list whose car is a number for just one or more C-U's\n\
646 or nil if no argument has been specified.\n\
648 You cannot examine this variable to find the argument for this command\n\
649 since it has been set to nil by the time you can look.\n\
650 Instead, you should use the variable `current-prefix-arg', although\n\
651 normally commands can get this prefix argument with (interactive \"P\").");
654 DEFVAR_LISP ("current-prefix-arg", &Vcurrent_prefix_arg
,
655 "The value of the prefix argument for this editing command.\n\
656 It may be a number, or the symbol `-' for just a minus sign as arg,\n\
657 or a list whose car is a number for just one or more C-U's\n\
658 or nil if no argument has been specified.\n\
659 This is what `(interactive \"P\")' returns.");
660 Vcurrent_prefix_arg
= Qnil
;
662 DEFVAR_LISP ("command-history", &Vcommand_history
,
663 "List of recent commands that read arguments from terminal.\n\
664 Each command is represented as a form to evaluate.");
665 Vcommand_history
= Qnil
;
667 DEFVAR_LISP ("command-debug-status", &Vcommand_debug_status
,
668 "Debugging status of current interactive command.\n\
669 Bound each time `call-interactively' is called;\n\
670 may be set by the debugger as a reminder for itself.");
671 Vcommand_debug_status
= Qnil
;
673 DEFVAR_LISP ("mark-even-if-inactive", &Vmark_even_if_inactive
,
674 "*Non-nil means you can use the mark even when inactive.\n\
675 This option makes a difference in Transient Mark mode.\n\
676 When the option is non-nil, deactivation of the mark\n\
677 turns off region highlighting, but commands that use the mark\n\
678 behave as if the mark were still active.");
679 Vmark_even_if_inactive
= Qnil
;
681 defsubr (&Sinteractive
);
682 defsubr (&Scall_interactively
);
683 defsubr (&Sprefix_numeric_value
);