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"};
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 (XTYPE (function
) == Lisp_Symbol
)
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. */
215 if (XTYPE (fun
) == Lisp_Subr
)
217 string
= (unsigned char *) XSUBR (fun
)->prompt
;
221 function
= wrong_type_argument (Qcommandp
, function
);
224 if ((int) string
== 1)
225 /* Let SPECS (which is nil) be used as the args. */
228 else if (XTYPE (fun
) == Lisp_Compiled
)
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. */
256 if (XTYPE (specs
) == Lisp_String
)
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 `@'. */
320 if (!NILP (current_buffer
->read_only
))
321 Fbarf_if_buffer_read_only ();
323 else if (*string
== '@')
327 event
= XVECTOR (this_command_keys
)->contents
[next_event
];
328 if (EVENT_HAS_PARAMETERS (event
)
329 && XTYPE (event
= XCONS (event
)->cdr
) == Lisp_Cons
330 && XTYPE (event
= XCONS (event
)->car
) == Lisp_Cons
331 && XTYPE (event
= XCONS (event
)->car
) == Lisp_Window
)
333 if (MINI_WINDOW_P (XWINDOW (event
))
334 && NILP (call1 (intern ("minibuffer-window-active-p"),
336 error ("Attempt to select inactive minibuffer window");
337 Fselect_window (event
);
344 /* Count the number of arguments the interactive spec would have
345 us give to the function. */
347 for (j
= 0; *tem
; j
++)
349 /* 'r' specifications ("point and mark as 2 numeric args")
350 produce *two* arguments. */
351 if (*tem
== 'r') j
++;
352 tem
= (unsigned char *) index (tem
, '\n');
356 tem
= (unsigned char *) "";
360 args
= (Lisp_Object
*) alloca ((count
+ 1) * sizeof (Lisp_Object
));
361 visargs
= (Lisp_Object
*) alloca ((count
+ 1) * sizeof (Lisp_Object
));
362 argstrings
= (unsigned char **) alloca ((count
+ 1) * sizeof (char *));
363 varies
= (int *) alloca ((count
+ 1) * sizeof (int));
365 for (i
= 0; i
< (count
+ 1); i
++)
372 GCPRO4 (prefix_arg
, function
, *args
, *visargs
);
373 gcpro3
.nvars
= (count
+ 1);
374 gcpro4
.nvars
= (count
+ 1);
377 specbind (Qenable_recursive_minibuffers
, Qt
);
380 for (i
= 1; *tem
; i
++)
382 strncpy (prompt1
, tem
+ 1, sizeof prompt1
- 1);
383 prompt1
[sizeof prompt1
- 1] = 0;
384 tem1
= index (prompt1
, '\n');
386 /* Fill argstrings with a vector of C strings
387 corresponding to the Lisp strings in visargs. */
388 for (j
= 1; j
< i
; j
++)
390 = EQ (visargs
[j
], Qnil
)
391 ? (unsigned char *) ""
392 : XSTRING (visargs
[j
])->data
;
394 doprnt (prompt
, sizeof prompt
, prompt1
, 0, j
- 1, argstrings
+ 1);
398 case 'a': /* Symbol defined as a function */
399 visargs
[i
] = Fcompleting_read (build_string (prompt
),
400 Vobarray
, Qfboundp
, Qt
, Qnil
, Qnil
);
401 /* Passing args[i] directly stimulates compiler bug */
403 args
[i
] = Fintern (teml
, Qnil
);
406 case 'b': /* Name of existing buffer */
407 args
[i
] = Fcurrent_buffer ();
408 if (EQ (selected_window
, minibuf_window
))
409 args
[i
] = Fother_buffer (args
[i
], Qnil
);
410 args
[i
] = Fread_buffer (build_string (prompt
), args
[i
], Qt
);
413 case 'B': /* Name of buffer, possibly nonexistent */
414 args
[i
] = Fread_buffer (build_string (prompt
),
415 Fother_buffer (Fcurrent_buffer (), Qnil
),
419 case 'c': /* Character */
421 args
[i
] = Fread_char ();
422 /* Passing args[i] directly stimulates compiler bug */
424 visargs
[i
] = Fchar_to_string (teml
);
427 case 'C': /* Command: symbol with interactive function */
428 visargs
[i
] = Fcompleting_read (build_string (prompt
),
429 Vobarray
, Qcommandp
, Qt
, Qnil
, Qnil
);
430 /* Passing args[i] directly stimulates compiler bug */
432 args
[i
] = Fintern (teml
, Qnil
);
435 case 'd': /* Value of point. Does not do I/O. */
436 XFASTINT (args
[i
]) = point
;
437 /* visargs[i] = Qnil; */
441 case 'D': /* Directory name. */
442 args
[i
] = Fread_file_name (build_string (prompt
), Qnil
,
443 current_buffer
->directory
, Qlambda
, Qnil
);
446 case 'f': /* Existing file name. */
447 args
[i
] = Fread_file_name (build_string (prompt
),
448 Qnil
, Qnil
, Qlambda
, Qnil
);
451 case 'F': /* Possibly nonexistent file name. */
452 args
[i
] = Fread_file_name (build_string (prompt
),
453 Qnil
, Qnil
, Qnil
, Qnil
);
456 case 'k': /* Key sequence (string) */
457 args
[i
] = Fread_key_sequence (build_string (prompt
), Qnil
);
459 visargs
[i
] = Fkey_description (teml
);
462 case 'e': /* The invoking event. */
463 if (next_event
>= this_command_key_count
)
464 error ("%s must be bound to an event with parameters",
465 (XTYPE (function
) == Lisp_Symbol
466 ? (char *) XSYMBOL (function
)->name
->data
468 args
[i
] = XVECTOR (this_command_keys
)->contents
[next_event
++];
471 /* Find the next parameterized event. */
472 while (next_event
< this_command_key_count
473 && ! (EVENT_HAS_PARAMETERS
474 (XVECTOR (this_command_keys
)->contents
[next_event
])))
479 case 'm': /* Value of mark. Does not do I/O. */
481 /* visargs[i] = Qnil; */
482 XFASTINT (args
[i
]) = marker_position (current_buffer
->mark
);
486 case 'N': /* Prefix arg, else number from minibuffer */
487 if (!NILP (prefix_arg
))
488 goto have_prefix_arg
;
489 case 'n': /* Read number from minibuffer. */
491 args
[i
] = Fread_minibuffer (build_string (prompt
), Qnil
);
492 while (! NUMBERP (args
[i
]));
493 visargs
[i
] = last_minibuf_string
;
496 case 'P': /* Prefix arg in raw form. Does no I/O. */
498 args
[i
] = prefix_arg
;
499 /* visargs[i] = Qnil; */
503 case 'p': /* Prefix arg converted to number. No I/O. */
504 args
[i
] = Fprefix_numeric_value (prefix_arg
);
505 /* visargs[i] = Qnil; */
509 case 'r': /* Region, point and mark as 2 args. */
511 /* visargs[i+1] = Qnil; */
512 foo
= marker_position (current_buffer
->mark
);
513 /* visargs[i] = Qnil; */
514 XFASTINT (args
[i
]) = point
< foo
? point
: foo
;
516 XFASTINT (args
[++i
]) = point
> foo
? point
: foo
;
520 case 's': /* String read via minibuffer. */
521 args
[i
] = Fread_string (build_string (prompt
), Qnil
);
524 case 'S': /* Any symbol. */
525 visargs
[i
] = Fread_string (build_string (prompt
), Qnil
);
526 /* Passing args[i] directly stimulates compiler bug */
528 args
[i
] = Fintern (teml
, Qnil
);
531 case 'v': /* Variable name: symbol that is
533 args
[i
] = Fread_variable (build_string (prompt
));
534 visargs
[i
] = last_minibuf_string
;
537 case 'x': /* Lisp expression read but not evaluated */
538 args
[i
] = Fread_minibuffer (build_string (prompt
), Qnil
);
539 visargs
[i
] = last_minibuf_string
;
542 case 'X': /* Lisp expression read and evaluated */
543 args
[i
] = Feval_minibuffer (build_string (prompt
), Qnil
);
544 visargs
[i
] = last_minibuf_string
;
548 error ("Invalid control letter \"%c\" (%03o) in interactive calling string",
555 if (NILP (visargs
[i
]) && XTYPE (args
[i
]) == Lisp_String
)
556 visargs
[i
] = args
[i
];
558 tem
= (unsigned char *) index (tem
, '\n');
560 else tem
= (unsigned char *) "";
562 unbind_to (speccount
, Qnil
);
568 if (arg_from_tty
|| !NILP (record
))
570 visargs
[0] = function
;
571 for (i
= 1; i
< count
+ 1; i
++)
573 visargs
[i
] = Fcons (intern (callint_argfuns
[varies
[i
]]), Qnil
);
575 visargs
[i
] = quotify_arg (args
[i
]);
576 Vcommand_history
= Fcons (Flist (count
+ 1, visargs
),
582 specbind (Qcommand_debug_status
, Qnil
);
584 val
= Ffuncall (count
+ 1, args
);
586 return unbind_to (speccount
, val
);
590 DEFUN ("prefix-numeric-value", Fprefix_numeric_value
, Sprefix_numeric_value
,
592 "Return numeric meaning of raw prefix argument ARG.\n\
593 A raw prefix argument is what you get from `(interactive \"P\")'.\n\
594 Its numeric meaning is what you would get from `(interactive \"p\")'.")
600 /* Tag val as an integer, so the rest of the assignments
606 else if (EQ (raw
, Qminus
))
608 else if (CONSP (raw
))
609 XSETINT (val
, XINT (XCONS (raw
)->car
));
610 else if (XTYPE (raw
) == Lisp_Int
)
620 preserved_fns
= Fcons (intern ("region-beginning"),
621 Fcons (intern ("region-end"),
622 Fcons (intern ("point"),
623 Fcons (intern ("mark"), Qnil
))));
624 staticpro (&preserved_fns
);
626 Qlist
= intern ("list");
629 Qminus
= intern ("-");
632 Qcall_interactively
= intern ("call-interactively");
633 staticpro (&Qcall_interactively
);
635 Qcommand_debug_status
= intern ("command-debug-status");
636 staticpro (&Qcommand_debug_status
);
638 Qenable_recursive_minibuffers
= intern ("enable-recursive-minibuffers");
639 staticpro (&Qenable_recursive_minibuffers
);
641 DEFVAR_LISP ("prefix-arg", &Vprefix_arg
,
642 "The value of the prefix argument for the next editing command.\n\
643 It may be a number, or the symbol `-' for just a minus sign as arg,\n\
644 or a list whose car is a number for just one or more C-U's\n\
645 or nil if no argument has been specified.\n\
647 You cannot examine this variable to find the argument for this command\n\
648 since it has been set to nil by the time you can look.\n\
649 Instead, you should use the variable `current-prefix-arg', although\n\
650 normally commands can get this prefix argument with (interactive \"P\").");
653 DEFVAR_LISP ("current-prefix-arg", &Vcurrent_prefix_arg
,
654 "The value of the prefix argument for this editing command.\n\
655 It may be a number, or the symbol `-' for just a minus sign as arg,\n\
656 or a list whose car is a number for just one or more C-U's\n\
657 or nil if no argument has been specified.\n\
658 This is what `(interactive \"P\")' returns.");
659 Vcurrent_prefix_arg
= Qnil
;
661 DEFVAR_LISP ("command-history", &Vcommand_history
,
662 "List of recent commands that read arguments from terminal.\n\
663 Each command is represented as a form to evaluate.");
664 Vcommand_history
= Qnil
;
666 DEFVAR_LISP ("command-debug-status", &Vcommand_debug_status
,
667 "Debugging status of current interactive command.\n\
668 Bound each time `call-interactively' is called;\n\
669 may be set by the debugger as a reminder for itself.");
670 Vcommand_debug_status
= Qnil
;
672 DEFVAR_LISP ("mark-even-if-inactive", &Vmark_even_if_inactive
,
673 "*Non-nil means you can use the mark even when inactive.\n\
674 This option makes a difference in Transient Mark mode.\n\
675 When the option is non-nil, deactivation of the mark\n\
676 turns off region highlighting, but commands that use the mark\n\
677 behave as if the mark were still active.");
678 Vmark_even_if_inactive
= Qnil
;
680 defsubr (&Sinteractive
);
681 defsubr (&Scall_interactively
);
682 defsubr (&Sprefix_numeric_value
);