1 /* Call a Lisp function interactively.
2 Copyright (C) 1985, 1986, 1992 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 1, 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
;
39 Lisp_Object preserved_fns
;
41 /* This comment supplies the doc string for interactive,
42 for make-docfile to see. We cannot put this in the real DEFUN
43 due to limits in the Unix cpp.
45 DEFUN ("interactive", Ffoo, Sfoo, 0, 0, 0,
46 "Specify a way of parsing arguments for interactive use of a function.\n\
48 (defun foo (arg) \"Doc string\" (interactive \"p\") ...use arg...)\n\
49 to make ARG be the prefix argument when `foo' is called as a command.\n\
50 The \"call\" to `interactive' is actually a declaration rather than a function;\n\
51 it tells `call-interactively' how to read arguments\n\
52 to pass to the function.\n\
53 When actually called, `interactive' just returns nil.\n\
55 The argument of `interactive' is usually a string containing a code letter\n\
56 followed by a prompt. (Some code letters do not use I/O to get\n\
57 the argument and do not need prompts.) To prompt for multiple arguments,\n\
58 give a code letter, its prompt, a newline, and another code letter, etc.\n\
59 Prompts are passed to format, and may use % escapes to print the\n\
60 arguments that have already been read.\n\
61 If the argument is not a string, it is evaluated to get a list of\n\
62 arguments to pass to the function.\n\
63 Just `(interactive)' means pass no args when calling interactively.\n\
64 \nCode letters available are:\n\
65 a -- Function name: symbol with a function definition.\n\
66 b -- Name of existing buffer.\n\
67 B -- Name of buffer, possibly nonexistent.\n\
69 C -- Command name: symbol with interactive function definition.\n\
70 d -- Value of point as number. Does not do I/O.\n\
71 D -- Directory name.\n\
72 e -- Event that invoked this command (value of `last-nonmenu-event').\n\
73 This skips events without parameters.\n\
74 If used more than once, the Nth 'e' returns the Nth parameterized event.\n\
75 f -- Existing file name.\n\
76 F -- Possibly nonexistent file name.\n\
77 k -- Key sequence (string).\n\
78 m -- Value of mark as number. Does not do I/O.\n\
79 n -- Number read using minibuffer.\n\
80 N -- Prefix arg converted to number, or if none, do like code `n'.\n\
81 p -- Prefix arg converted to number. Does not do I/O.\n\
82 P -- Prefix arg in raw form. Does not do I/O.\n\
83 r -- Region: point and mark as 2 numeric args, smallest first. Does no I/O.\n\
86 v -- Variable name: symbol that is user-variable-p.\n\
87 x -- Lisp expression read but not evaluated.\n\
88 X -- Lisp expression read and evaluated.\n\
89 In addition, if the string begins with `*'\n\
90 then an error is signaled if the buffer is read-only.\n\
91 This happens before reading any arguments.\n\
92 If the string begins with `@', then the window the mouse is over is selected\n\
93 before anything else is done. You may use both `@' and `*';\n\
94 they are processed in the order that they appear."
98 DEFUN ("interactive", Finteractive
, Sinteractive
, 0, UNEVALLED
, 0,
99 0 /* See immediately above */)
106 /* Quotify EXP: if EXP is constant, return it.
107 If EXP is not constant, return (quote EXP). */
110 register Lisp_Object exp
;
112 if (XTYPE (exp
) != Lisp_Int
&& XTYPE (exp
) != Lisp_String
113 && !NILP (exp
) && !EQ (exp
, Qt
))
114 return Fcons (Qquote
, Fcons (exp
, Qnil
));
119 /* Modify EXP by quotifying each element (except the first). */
124 register Lisp_Object tail
;
125 register struct Lisp_Cons
*ptr
;
126 for (tail
= exp
; CONSP (tail
); tail
= ptr
->cdr
)
129 ptr
->car
= quotify_arg (ptr
->car
);
134 char *callint_argfuns
[]
135 = {"", "point", "mark", "region-beginning", "region-end"};
140 Lisp_Object tem
= Fmarker_buffer (current_buffer
->mark
);
141 if (NILP (tem
) || (XBUFFER (tem
) != current_buffer
))
142 error ("The mark is not set now");
146 DEFUN ("call-interactively", Fcall_interactively
, Scall_interactively
, 1, 2, 0,
147 "Call FUNCTION, reading args according to its interactive calling specs.\n\
148 The function contains a specification of how to do the argument reading.\n\
149 In the case of user-defined functions, this is specified by placing a call\n\
150 to the function `interactive' at the top level of the function body.\n\
151 See `interactive'.\n\
153 Optional second arg RECORD-FLAG non-nil\n\
154 means unconditionally put this command in the command-history.\n\
155 Otherwise, this is done only if an arg is read using the minibuffer.")
157 Lisp_Object function
, record
;
159 Lisp_Object
*args
, *visargs
;
160 unsigned char **argstrings
;
166 int speccount
= specpdl_ptr
- specpdl
;
168 /* The index of the next element of this_command_keys to examine for
169 the 'e' interactive code. */
172 Lisp_Object prefix_arg
;
173 unsigned char *string
;
176 /* If varies[i] > 0, the i'th argument shouldn't just have its value
177 in this call quoted in the command history. It should be
178 recorded as a call to the function named callint_argfuns[varies[i]]. */
186 int arg_from_tty
= 0;
187 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
189 /* Save this now, since use of minibuffer will clobber it. */
190 prefix_arg
= Vcurrent_prefix_arg
;
194 if (XTYPE (function
) == Lisp_Symbol
)
195 enable
= Fget (function
, Qenable_recursive_minibuffers
);
197 fun
= indirect_function (function
);
202 /* Decode the kind of function. Either handle it and return,
203 or go to `lose' if not interactive, or go to `retry'
204 to specify a different function, or set either STRING or SPECS. */
206 if (XTYPE (fun
) == Lisp_Subr
)
208 string
= (unsigned char *) XSUBR (fun
)->prompt
;
212 function
= wrong_type_argument (Qcommandp
, function
, 0);
215 if ((int) string
== 1)
216 /* Let SPECS (which is nil) be used as the args. */
219 else if (XTYPE (fun
) == Lisp_Compiled
)
221 if (XVECTOR (fun
)->size
<= COMPILED_INTERACTIVE
)
223 specs
= XVECTOR (fun
)->contents
[COMPILED_INTERACTIVE
];
225 else if (!CONSP (fun
))
227 else if (funcar
= Fcar (fun
), EQ (funcar
, Qautoload
))
229 GCPRO2 (function
, prefix_arg
);
230 do_autoload (fun
, function
);
234 else if (EQ (funcar
, Qlambda
))
236 specs
= Fassq (Qinteractive
, Fcdr (Fcdr (fun
)));
239 specs
= Fcar (Fcdr (specs
));
241 else if (EQ (funcar
, Qmocklisp
))
242 return ml_apply (fun
, Qinteractive
);
246 /* If either specs or string is set to a string, use it. */
247 if (XTYPE (specs
) == Lisp_String
)
249 /* Make a copy of string so that if a GC relocates specs,
250 `string' will still be valid. */
251 string
= (unsigned char *) alloca (XSTRING (specs
)->size
+ 1);
252 bcopy (XSTRING (specs
)->data
, string
, XSTRING (specs
)->size
+ 1);
254 else if (string
== 0)
259 /* Compute the arg values using the user's expression. */
260 specs
= Feval (specs
);
261 if (i
!= num_input_chars
|| !NILP (record
))
263 /* We should record this command on the command history. */
264 Lisp_Object values
, car
;
265 /* Make a copy of the list of values, for the command history,
266 and turn them into things we can eval. */
267 values
= quotify_args (Fcopy_sequence (specs
));
268 /* If the list of args was produced with an explicit call to `list',
269 look for elements that were computed with (region-beginning)
270 or (region-end), and put those expressions into VALUES
271 instead of the present values. */
275 Lisp_Object intail
, valtail
;
276 for (intail
= Fcdr (input
), valtail
= values
;
278 intail
= Fcdr (intail
), valtail
= Fcdr (valtail
))
284 Lisp_Object presflag
;
285 presflag
= Fmemq (Fcar (elt
), preserved_fns
);
286 if (!NILP (presflag
))
287 Fsetcar (valtail
, Fcar (intail
));
292 = Fcons (Fcons (function
, values
), Vcommand_history
);
294 return apply1 (function
, specs
);
297 /* Here if function specifies a string to control parsing the defaults */
299 /* Handle special starting chars `*' and `@'. */
305 if (!NILP (current_buffer
->read_only
))
306 Fbarf_if_buffer_read_only ();
308 else if (*string
== '@')
311 if (!NILP (Vmouse_window
))
312 Fselect_window (Vmouse_window
);
317 /* Count the number of arguments the interactive spec would have
318 us give to the function. */
320 for (j
= 0; *tem
; j
++)
322 /* 'r' specifications ("point and mark as 2 numeric args")
323 produce *two* arguments. */
324 if (*tem
== 'r') j
++;
325 tem
= (unsigned char *) index (tem
, '\n');
329 tem
= (unsigned char *) "";
333 args
= (Lisp_Object
*) alloca ((count
+ 1) * sizeof (Lisp_Object
));
334 visargs
= (Lisp_Object
*) alloca ((count
+ 1) * sizeof (Lisp_Object
));
335 argstrings
= (unsigned char **) alloca ((count
+ 1) * sizeof (char *));
336 varies
= (int *) alloca ((count
+ 1) * sizeof (int));
338 for (i
= 0; i
< (count
+ 1); i
++)
345 GCPRO4 (prefix_arg
, function
, *args
, *visargs
);
346 gcpro3
.nvars
= (count
+ 1);
347 gcpro4
.nvars
= (count
+ 1);
350 specbind (Qenable_recursive_minibuffers
, Qt
);
353 for (i
= 1; *tem
; i
++)
355 strncpy (prompt1
, tem
+ 1, sizeof prompt1
- 1);
356 prompt1
[sizeof prompt1
- 1] = 0;
357 tem1
= index (prompt1
, '\n');
359 /* Fill argstrings with a vector of C strings
360 corresponding to the Lisp strings in visargs. */
361 for (j
= 1; j
< i
; j
++)
363 = EQ (visargs
[j
], Qnil
)
364 ? (unsigned char *) ""
365 : XSTRING (visargs
[j
])->data
;
367 doprnt (prompt
, sizeof prompt
, prompt1
, 0, j
- 1, argstrings
+ 1);
371 case 'a': /* Symbol defined as a function */
372 visargs
[i
] = Fcompleting_read (build_string (prompt
),
373 Vobarray
, Qfboundp
, Qt
, Qnil
, Qnil
);
374 /* Passing args[i] directly stimulates compiler bug */
376 args
[i
] = Fintern (teml
, Qnil
);
379 case 'b': /* Name of existing buffer */
380 args
[i
] = Fcurrent_buffer ();
381 if (EQ (selected_window
, minibuf_window
))
382 args
[i
] = Fother_buffer (args
[i
], Qnil
);
383 args
[i
] = Fread_buffer (build_string (prompt
), args
[i
], Qt
);
386 case 'B': /* Name of buffer, possibly nonexistent */
387 args
[i
] = Fread_buffer (build_string (prompt
),
388 Fother_buffer (Fcurrent_buffer (), Qnil
),
392 case 'c': /* Character */
394 args
[i
] = Fread_char ();
395 /* Passing args[i] directly stimulates compiler bug */
397 visargs
[i
] = Fchar_to_string (teml
);
400 case 'C': /* Command: symbol with interactive function */
401 visargs
[i
] = Fcompleting_read (build_string (prompt
),
402 Vobarray
, Qcommandp
, Qt
, Qnil
, Qnil
);
403 /* Passing args[i] directly stimulates compiler bug */
405 args
[i
] = Fintern (teml
, Qnil
);
408 case 'd': /* Value of point. Does not do I/O. */
409 XFASTINT (args
[i
]) = point
;
410 /* visargs[i] = Qnil; */
414 case 'D': /* Directory name. */
415 args
[i
] = Fread_file_name (build_string (prompt
), Qnil
,
416 current_buffer
->directory
, Qlambda
, Qnil
);
419 case 'f': /* Existing file name. */
420 args
[i
] = Fread_file_name (build_string (prompt
),
421 Qnil
, Qnil
, Qlambda
, Qnil
);
424 case 'F': /* Possibly nonexistent file name. */
425 args
[i
] = Fread_file_name (build_string (prompt
),
426 Qnil
, Qnil
, Qnil
, Qnil
);
429 case 'k': /* Key sequence (string) */
430 args
[i
] = Fread_key_sequence (build_string (prompt
), Qnil
);
432 visargs
[i
] = Fkey_description (teml
);
435 case 'e': /* The invoking event. */
436 /* Find the next parameterized event. */
437 while (next_event
< this_command_key_count
438 && ! (EVENT_HAS_PARAMETERS
439 (XVECTOR (this_command_keys
)->contents
[next_event
])))
441 if (next_event
>= this_command_key_count
)
442 error ("%s must be bound to an event with parameters",
443 (XTYPE (function
) == Lisp_Symbol
444 ? (char *) XSYMBOL (function
)->name
->data
446 args
[i
] = XVECTOR (this_command_keys
)->contents
[next_event
++];
450 case 'm': /* Value of mark. Does not do I/O. */
452 /* visargs[i] = Qnil; */
453 XFASTINT (args
[i
]) = marker_position (current_buffer
->mark
);
457 case 'N': /* Prefix arg, else number from minibuffer */
458 if (!NILP (prefix_arg
))
459 goto have_prefix_arg
;
460 case 'n': /* Read number from minibuffer. */
462 args
[i
] = Fread_minibuffer (build_string (prompt
), Qnil
);
463 while (! NUMBERP (args
[i
]));
464 visargs
[i
] = last_minibuf_string
;
467 case 'P': /* Prefix arg in raw form. Does no I/O. */
469 args
[i
] = prefix_arg
;
470 /* visargs[i] = Qnil; */
474 case 'p': /* Prefix arg converted to number. No I/O. */
475 args
[i
] = Fprefix_numeric_value (prefix_arg
);
476 /* visargs[i] = Qnil; */
480 case 'r': /* Region, point and mark as 2 args. */
482 /* visargs[i+1] = Qnil; */
483 foo
= marker_position (current_buffer
->mark
);
484 /* visargs[i] = Qnil; */
485 XFASTINT (args
[i
]) = point
< foo
? point
: foo
;
487 XFASTINT (args
[++i
]) = point
> foo
? point
: foo
;
491 case 's': /* String read via minibuffer. */
492 args
[i
] = Fread_string (build_string (prompt
), Qnil
);
495 case 'S': /* Any symbol. */
496 visargs
[i
] = Fread_string (build_string (prompt
), Qnil
);
497 /* Passing args[i] directly stimulates compiler bug */
499 args
[i
] = Fintern (teml
, Qnil
);
502 case 'v': /* Variable name: symbol that is
504 args
[i
] = Fread_variable (build_string (prompt
));
505 visargs
[i
] = last_minibuf_string
;
508 case 'x': /* Lisp expression read but not evaluated */
509 args
[i
] = Fread_minibuffer (build_string (prompt
), Qnil
);
510 visargs
[i
] = last_minibuf_string
;
513 case 'X': /* Lisp expression read and evaluated */
514 args
[i
] = Feval_minibuffer (build_string (prompt
), Qnil
);
515 visargs
[i
] = last_minibuf_string
;
519 error ("Invalid control letter \"%c\" (%03o) in interactive calling string",
526 if (NILP (visargs
[i
]) && XTYPE (args
[i
]) == Lisp_String
)
527 visargs
[i
] = args
[i
];
529 tem
= (unsigned char *) index (tem
, '\n');
531 else tem
= (unsigned char *) "";
533 unbind_to (speccount
, Qnil
);
539 if (arg_from_tty
|| !NILP (record
))
541 visargs
[0] = function
;
542 for (i
= 1; i
< count
+ 1; i
++)
544 visargs
[i
] = Fcons (intern (callint_argfuns
[varies
[i
]]), Qnil
);
546 visargs
[i
] = quotify_arg (args
[i
]);
547 Vcommand_history
= Fcons (Flist (count
+ 1, visargs
),
553 specbind (Qcommand_debug_status
, Qnil
);
555 val
= Ffuncall (count
+ 1, args
);
557 return unbind_to (speccount
, val
);
561 DEFUN ("prefix-numeric-value", Fprefix_numeric_value
, Sprefix_numeric_value
,
563 "Return numeric meaning of raw prefix argument ARG.\n\
564 A raw prefix argument is what you get from `(interactive \"P\")'.\n\
565 Its numeric meaning is what you would get from `(interactive \"p\")'.")
571 /* Tag val as an integer, so the rest of the assignments
577 else if (EQ (raw
, Qminus
))
579 else if (CONSP (raw
))
580 XSETINT (val
, XINT (XCONS (raw
)->car
));
581 else if (XTYPE (raw
) == Lisp_Int
)
591 preserved_fns
= Fcons (intern ("region-beginning"),
592 Fcons (intern ("region-end"),
593 Fcons (intern ("point"),
594 Fcons (intern ("mark"), Qnil
))));
595 staticpro (&preserved_fns
);
597 Qlist
= intern ("list");
600 Qminus
= intern ("-");
603 Qcall_interactively
= intern ("call-interactively");
604 staticpro (&Qcall_interactively
);
606 Qcommand_debug_status
= intern ("command-debug-status");
607 staticpro (&Qcommand_debug_status
);
609 Qenable_recursive_minibuffers
= intern ("enable-recursive-minibuffers");
610 staticpro (&Qenable_recursive_minibuffers
);
612 DEFVAR_LISP ("prefix-arg", &Vprefix_arg
,
613 "The value of the prefix argument for the next editing command.\n\
614 It may be a number, or the symbol `-' for just a minus sign as arg,\n\
615 or a list whose car is a number for just one or more C-U's\n\
616 or nil if no argument has been specified.\n\
618 You cannot examine this variable to find the argument for this command\n\
619 since it has been set to nil by the time you can look.\n\
620 Instead, you should use the variable `current-prefix-arg', although\n\
621 normally commands can get this prefix argument with (interactive \"P\").");
624 DEFVAR_LISP ("current-prefix-arg", &Vcurrent_prefix_arg
,
625 "The value of the prefix argument for this editing command.\n\
626 It may be a number, or the symbol `-' for just a minus sign as arg,\n\
627 or a list whose car is a number for just one or more C-U's\n\
628 or nil if no argument has been specified.\n\
629 This is what `(interactive \"P\")' returns.");
630 Vcurrent_prefix_arg
= Qnil
;
632 DEFVAR_LISP ("command-history", &Vcommand_history
,
633 "List of recent commands that read arguments from terminal.\n\
634 Each command is represented as a form to evaluate.");
635 Vcommand_history
= Qnil
;
637 DEFVAR_LISP ("command-debug-status", &Vcommand_debug_status
,
638 "Debugging status of current interactive command.\n\
639 Bound each time `call-interactively' is called;\n\
640 may be set by the debugger as a reminder for itself.");
641 Vcommand_debug_status
= Qnil
;
643 defsubr (&Sinteractive
);
644 defsubr (&Scall_interactively
);
645 defsubr (&Sprefix_numeric_value
);