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 Lisp_Object preserved_fns
;
47 /* This comment supplies the doc string for interactive,
48 for make-docfile to see. We cannot put this in the real DEFUN
49 due to limits in the Unix cpp.
51 DEFUN ("interactive", Ffoo, Sfoo, 0, 0, 0,
52 "Specify a way of parsing arguments for interactive use of a function.\n\
54 (defun foo (arg) \"Doc string\" (interactive \"p\") ...use arg...)\n\
55 to make ARG be the prefix argument when `foo' is called as a command.\n\
56 The \"call\" to `interactive' is actually a declaration rather than a function;\n\
57 it tells `call-interactively' how to read arguments\n\
58 to pass to the function.\n\
59 When actually called, `interactive' just returns nil.\n\
61 The argument of `interactive' is usually a string containing a code letter\n\
62 followed by a prompt. (Some code letters do not use I/O to get\n\
63 the argument and do not need prompts.) To prompt for multiple arguments,\n\
64 give a code letter, its prompt, a newline, and another code letter, etc.\n\
65 Prompts are passed to format, and may use % escapes to print the\n\
66 arguments that have already been read.\n\
67 If the argument is not a string, it is evaluated to get a list of\n\
68 arguments to pass to the function.\n\
69 Just `(interactive)' means pass no args when calling interactively.\n\
70 \nCode letters available are:\n\
71 a -- Function name: symbol with a function definition.\n\
72 b -- Name of existing buffer.\n\
73 B -- Name of buffer, possibly nonexistent.\n\
75 C -- Command name: symbol with interactive function definition.\n\
76 d -- Value of point as number. Does not do I/O.\n\
77 D -- Directory name.\n\
78 e -- Parametrized event (i.e., one that's a list) that invoked this command.\n\
79 If used more than once, the Nth `e' returns the Nth parameterized event.\n\
80 This skips events that are integers or symbols.\n\
81 f -- Existing file name.\n\
82 F -- Possibly nonexistent file name.\n\
83 k -- Key sequence (downcase the last event if needed to get a definition).\n\
84 K -- Key sequence to be redefined (do not downcase the last event).\n\
85 m -- Value of mark as number. Does not do I/O.\n\
86 n -- Number read using minibuffer.\n\
87 N -- Raw prefix arg, or if none, do like code `n'.\n\
88 p -- Prefix arg converted to number. Does not do I/O.\n\
89 P -- Prefix arg in raw form. Does not do I/O.\n\
90 r -- Region: point and mark as 2 numeric args, smallest first. Does no I/O.\n\
93 v -- Variable name: symbol that is user-variable-p.\n\
94 x -- Lisp expression read but not evaluated.\n\
95 X -- Lisp expression read and evaluated.\n\
96 In addition, if the string begins with `*'\n\
97 then an error is signaled if the buffer is read-only.\n\
98 This happens before reading any arguments.\n\
99 If the string begins with `@', then Emacs searches the key sequence\n\
100 which invoked the command for its first mouse click (or any other\n\
101 event which specifies a window), and selects that window before\n\
102 reading any arguments. You may use both `@' and `*'; they are\n\
103 processed in the order that they appear." */
106 DEFUN ("interactive", Finteractive
, Sinteractive
, 0, UNEVALLED
, 0,
107 0 /* See immediately above */)
114 /* Quotify EXP: if EXP is constant, return it.
115 If EXP is not constant, return (quote EXP). */
118 register Lisp_Object exp
;
120 if (!INTEGERP (exp
) && !STRINGP (exp
)
121 && !NILP (exp
) && !EQ (exp
, Qt
))
122 return Fcons (Qquote
, Fcons (exp
, Qnil
));
127 /* Modify EXP by quotifying each element (except the first). */
132 register Lisp_Object tail
;
133 register struct Lisp_Cons
*ptr
;
134 for (tail
= exp
; CONSP (tail
); tail
= ptr
->cdr
)
137 ptr
->car
= quotify_arg (ptr
->car
);
142 char *callint_argfuns
[]
143 = {"", "point", "mark", "region-beginning", "region-end"};
149 tem
= Fmarker_buffer (current_buffer
->mark
);
150 if (NILP (tem
) || (XBUFFER (tem
) != current_buffer
))
151 error ("The mark is not set now");
152 if (!NILP (Vtransient_mark_mode
) && NILP (Vmark_even_if_inactive
)
153 && NILP (current_buffer
->mark_active
))
154 Fsignal (Qmark_inactive
, Qnil
);
158 DEFUN ("call-interactively", Fcall_interactively
, Scall_interactively
, 1, 2, 0,
159 "Call FUNCTION, reading args according to its interactive calling specs.\n\
160 The function contains a specification of how to do the argument reading.\n\
161 In the case of user-defined functions, this is specified by placing a call\n\
162 to the function `interactive' at the top level of the function body.\n\
163 See `interactive'.\n\
165 Optional second arg RECORD-FLAG non-nil\n\
166 means unconditionally put this command in the command-history.\n\
167 Otherwise, this is done only if an arg is read using the minibuffer.")
169 Lisp_Object function
, record
;
171 Lisp_Object
*args
, *visargs
;
172 unsigned char **argstrings
;
178 int speccount
= specpdl_ptr
- specpdl
;
180 /* The index of the next element of this_command_keys to examine for
181 the 'e' interactive code. */
184 Lisp_Object prefix_arg
;
185 unsigned char *string
;
188 /* If varies[i] > 0, the i'th argument shouldn't just have its value
189 in this call quoted in the command history. It should be
190 recorded as a call to the function named callint_argfuns[varies[i]]. */
198 int arg_from_tty
= 0;
199 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
201 /* Save this now, since use of minibuffer will clobber it. */
202 prefix_arg
= current_perdisplay
->Vcurrent_prefix_arg
;
206 if (SYMBOLP (function
))
207 enable
= Fget (function
, Qenable_recursive_minibuffers
);
209 fun
= indirect_function (function
);
214 /* Decode the kind of function. Either handle it and return,
215 or go to `lose' if not interactive, or go to `retry'
216 to specify a different function, or set either STRING or SPECS. */
220 string
= (unsigned char *) XSUBR (fun
)->prompt
;
224 function
= wrong_type_argument (Qcommandp
, function
);
227 if ((EMACS_INT
) string
== 1)
228 /* Let SPECS (which is nil) be used as the args. */
231 else if (COMPILEDP (fun
))
233 if ((XVECTOR (fun
)->size
& PSEUDOVECTOR_SIZE_MASK
) <= COMPILED_INTERACTIVE
)
235 specs
= XVECTOR (fun
)->contents
[COMPILED_INTERACTIVE
];
237 else if (!CONSP (fun
))
239 else if (funcar
= Fcar (fun
), EQ (funcar
, Qautoload
))
241 GCPRO2 (function
, prefix_arg
);
242 do_autoload (fun
, function
);
246 else if (EQ (funcar
, Qlambda
))
248 specs
= Fassq (Qinteractive
, Fcdr (Fcdr (fun
)));
251 specs
= Fcar (Fcdr (specs
));
253 else if (EQ (funcar
, Qmocklisp
))
254 return ml_apply (fun
, Qinteractive
);
258 /* If either specs or string is set to a string, use it. */
261 /* Make a copy of string so that if a GC relocates specs,
262 `string' will still be valid. */
263 string
= (unsigned char *) alloca (XSTRING (specs
)->size
+ 1);
264 bcopy (XSTRING (specs
)->data
, string
, XSTRING (specs
)->size
+ 1);
266 else if (string
== 0)
271 /* Compute the arg values using the user's expression. */
272 specs
= Feval (specs
);
273 if (i
!= num_input_chars
|| !NILP (record
))
275 /* We should record this command on the command history. */
276 Lisp_Object values
, car
;
277 /* Make a copy of the list of values, for the command history,
278 and turn them into things we can eval. */
279 values
= quotify_args (Fcopy_sequence (specs
));
280 /* If the list of args was produced with an explicit call to `list',
281 look for elements that were computed with (region-beginning)
282 or (region-end), and put those expressions into VALUES
283 instead of the present values. */
287 Lisp_Object intail
, valtail
;
288 for (intail
= Fcdr (input
), valtail
= values
;
290 intail
= Fcdr (intail
), valtail
= Fcdr (valtail
))
296 Lisp_Object presflag
;
297 presflag
= Fmemq (Fcar (elt
), preserved_fns
);
298 if (!NILP (presflag
))
299 Fsetcar (valtail
, Fcar (intail
));
304 = Fcons (Fcons (function
, values
), Vcommand_history
);
306 return apply1 (function
, specs
);
309 /* Here if function specifies a string to control parsing the defaults */
311 /* Set next_event to point to the first event with parameters. */
312 for (next_event
= 0; next_event
< this_command_key_count
; next_event
++)
313 if (EVENT_HAS_PARAMETERS
314 (XVECTOR (this_command_keys
)->contents
[next_event
]))
317 /* Handle special starting chars `*' and `@'. Also `-'. */
323 if (!NILP (current_buffer
->read_only
))
324 Fbarf_if_buffer_read_only ();
326 /* Ignore this for semi-compatibility with Lucid. */
327 else if (*string
== '-')
329 else if (*string
== '@')
333 event
= XVECTOR (this_command_keys
)->contents
[next_event
];
334 if (EVENT_HAS_PARAMETERS (event
)
335 && (event
= XCONS (event
)->car
, CONSP (event
))
336 && (event
= XCONS (event
)->car
, CONSP (event
))
337 && (event
= XCONS (event
)->car
), WINDOWP (event
))
339 if (MINI_WINDOW_P (XWINDOW (event
))
340 && ! (minibuf_level
> 0 && EQ (event
, minibuf_window
)))
341 error ("Attempt to select inactive minibuffer window");
343 /* If the current buffer wants to clean up, let it. */
344 if (!NILP (Vmouse_leave_buffer_hook
))
345 call1 (Vrun_hooks
, Qmouse_leave_buffer_hook
);
347 Fselect_window (event
);
354 /* Count the number of arguments the interactive spec would have
355 us give to the function. */
357 for (j
= 0; *tem
; j
++)
359 /* 'r' specifications ("point and mark as 2 numeric args")
360 produce *two* arguments. */
361 if (*tem
== 'r') j
++;
362 tem
= (unsigned char *) index (tem
, '\n');
366 tem
= (unsigned char *) "";
370 args
= (Lisp_Object
*) alloca ((count
+ 1) * sizeof (Lisp_Object
));
371 visargs
= (Lisp_Object
*) alloca ((count
+ 1) * sizeof (Lisp_Object
));
372 argstrings
= (unsigned char **) alloca ((count
+ 1) * sizeof (char *));
373 varies
= (int *) alloca ((count
+ 1) * sizeof (int));
375 for (i
= 0; i
< (count
+ 1); i
++)
382 GCPRO4 (prefix_arg
, function
, *args
, *visargs
);
383 gcpro3
.nvars
= (count
+ 1);
384 gcpro4
.nvars
= (count
+ 1);
387 specbind (Qenable_recursive_minibuffers
, Qt
);
390 for (i
= 1; *tem
; i
++)
392 strncpy (prompt1
, tem
+ 1, sizeof prompt1
- 1);
393 prompt1
[sizeof prompt1
- 1] = 0;
394 tem1
= index (prompt1
, '\n');
396 /* Fill argstrings with a vector of C strings
397 corresponding to the Lisp strings in visargs. */
398 for (j
= 1; j
< i
; j
++)
400 = EQ (visargs
[j
], Qnil
)
401 ? (unsigned char *) ""
402 : XSTRING (visargs
[j
])->data
;
404 doprnt (prompt
, sizeof prompt
, prompt1
, 0, j
- 1, argstrings
+ 1);
408 case 'a': /* Symbol defined as a function */
409 visargs
[i
] = Fcompleting_read (build_string (prompt
),
410 Vobarray
, Qfboundp
, Qt
, Qnil
, Qnil
);
411 /* Passing args[i] directly stimulates compiler bug */
413 args
[i
] = Fintern (teml
, Qnil
);
416 case 'b': /* Name of existing buffer */
417 args
[i
] = Fcurrent_buffer ();
418 if (EQ (selected_window
, minibuf_window
))
419 args
[i
] = Fother_buffer (args
[i
], Qnil
);
420 args
[i
] = Fread_buffer (build_string (prompt
), args
[i
], Qt
);
423 case 'B': /* Name of buffer, possibly nonexistent */
424 args
[i
] = Fread_buffer (build_string (prompt
),
425 Fother_buffer (Fcurrent_buffer (), Qnil
),
429 case 'c': /* Character */
431 args
[i
] = Fread_char ();
432 /* Passing args[i] directly stimulates compiler bug */
434 visargs
[i
] = Fchar_to_string (teml
);
437 case 'C': /* Command: symbol with interactive function */
438 visargs
[i
] = Fcompleting_read (build_string (prompt
),
439 Vobarray
, Qcommandp
, Qt
, Qnil
, Qnil
);
440 /* Passing args[i] directly stimulates compiler bug */
442 args
[i
] = Fintern (teml
, Qnil
);
445 case 'd': /* Value of point. Does not do I/O. */
446 XSETFASTINT (args
[i
], point
);
447 /* visargs[i] = Qnil; */
451 case 'D': /* Directory name. */
452 args
[i
] = Fread_file_name (build_string (prompt
), Qnil
,
453 current_buffer
->directory
, Qlambda
, Qnil
);
456 case 'f': /* Existing file name. */
457 args
[i
] = Fread_file_name (build_string (prompt
),
458 Qnil
, Qnil
, Qlambda
, Qnil
);
461 case 'F': /* Possibly nonexistent file name. */
462 args
[i
] = Fread_file_name (build_string (prompt
),
463 Qnil
, Qnil
, Qnil
, Qnil
);
466 case 'k': /* Key sequence. */
467 args
[i
] = Fread_key_sequence (build_string (prompt
), Qnil
, Qnil
);
469 visargs
[i
] = Fkey_description (teml
);
472 case 'K': /* Key sequence to be defined. */
473 args
[i
] = Fread_key_sequence (build_string (prompt
), Qnil
, Qt
);
475 visargs
[i
] = Fkey_description (teml
);
478 case 'e': /* The invoking event. */
479 if (next_event
>= this_command_key_count
)
480 error ("%s must be bound to an event with parameters",
482 ? (char *) XSYMBOL (function
)->name
->data
484 args
[i
] = XVECTOR (this_command_keys
)->contents
[next_event
++];
487 /* Find the next parameterized event. */
488 while (next_event
< this_command_key_count
489 && ! (EVENT_HAS_PARAMETERS
490 (XVECTOR (this_command_keys
)->contents
[next_event
])))
495 case 'm': /* Value of mark. Does not do I/O. */
497 /* visargs[i] = Qnil; */
498 XSETFASTINT (args
[i
], marker_position (current_buffer
->mark
));
502 case 'N': /* Prefix arg, else number from minibuffer */
503 if (!NILP (prefix_arg
))
504 goto have_prefix_arg
;
505 case 'n': /* Read number from minibuffer. */
507 args
[i
] = Fread_minibuffer (build_string (prompt
), Qnil
);
508 while (! NUMBERP (args
[i
]));
509 visargs
[i
] = last_minibuf_string
;
512 case 'P': /* Prefix arg in raw form. Does no I/O. */
514 args
[i
] = prefix_arg
;
515 /* visargs[i] = Qnil; */
519 case 'p': /* Prefix arg converted to number. No I/O. */
520 args
[i
] = Fprefix_numeric_value (prefix_arg
);
521 /* visargs[i] = Qnil; */
525 case 'r': /* Region, point and mark as 2 args. */
527 /* visargs[i+1] = Qnil; */
528 foo
= marker_position (current_buffer
->mark
);
529 /* visargs[i] = Qnil; */
530 XSETFASTINT (args
[i
], point
< foo
? point
: foo
);
532 XSETFASTINT (args
[++i
], point
> foo
? point
: foo
);
536 case 's': /* String read via minibuffer. */
537 args
[i
] = Fread_string (build_string (prompt
), Qnil
, Qnil
);
540 case 'S': /* Any symbol. */
541 visargs
[i
] = Fread_string (build_string (prompt
), Qnil
, Qnil
);
542 /* Passing args[i] directly stimulates compiler bug */
544 args
[i
] = Fintern (teml
, Qnil
);
547 case 'v': /* Variable name: symbol that is
549 args
[i
] = Fread_variable (build_string (prompt
));
550 visargs
[i
] = last_minibuf_string
;
553 case 'x': /* Lisp expression read but not evaluated */
554 args
[i
] = Fread_minibuffer (build_string (prompt
), Qnil
);
555 visargs
[i
] = last_minibuf_string
;
558 case 'X': /* Lisp expression read and evaluated */
559 args
[i
] = Feval_minibuffer (build_string (prompt
), Qnil
);
560 visargs
[i
] = last_minibuf_string
;
564 error ("Invalid control letter \"%c\" (%03o) in interactive calling string",
571 if (NILP (visargs
[i
]) && STRINGP (args
[i
]))
572 visargs
[i
] = args
[i
];
574 tem
= (unsigned char *) index (tem
, '\n');
576 else tem
= (unsigned char *) "";
578 unbind_to (speccount
, Qnil
);
584 if (arg_from_tty
|| !NILP (record
))
586 visargs
[0] = function
;
587 for (i
= 1; i
< count
+ 1; i
++)
589 visargs
[i
] = Fcons (intern (callint_argfuns
[varies
[i
]]), Qnil
);
591 visargs
[i
] = quotify_arg (args
[i
]);
592 Vcommand_history
= Fcons (Flist (count
+ 1, visargs
),
598 specbind (Qcommand_debug_status
, Qnil
);
600 val
= Ffuncall (count
+ 1, args
);
602 return unbind_to (speccount
, val
);
606 DEFUN ("prefix-numeric-value", Fprefix_numeric_value
, Sprefix_numeric_value
,
608 "Return numeric meaning of raw prefix argument ARG.\n\
609 A raw prefix argument is what you get from `(interactive \"P\")'.\n\
610 Its numeric meaning is what you would get from `(interactive \"p\")'.")
617 XSETFASTINT (val
, 1);
618 else if (EQ (raw
, Qminus
))
620 else if (CONSP (raw
))
621 XSETINT (val
, XINT (XCONS (raw
)->car
));
622 else if (INTEGERP (raw
))
625 XSETFASTINT (val
, 1);
632 preserved_fns
= Fcons (intern ("region-beginning"),
633 Fcons (intern ("region-end"),
634 Fcons (intern ("point"),
635 Fcons (intern ("mark"), Qnil
))));
636 staticpro (&preserved_fns
);
638 Qlist
= intern ("list");
641 Qminus
= intern ("-");
644 Qplus
= intern ("+");
647 Qcall_interactively
= intern ("call-interactively");
648 staticpro (&Qcall_interactively
);
650 Qcommand_debug_status
= intern ("command-debug-status");
651 staticpro (&Qcommand_debug_status
);
653 Qenable_recursive_minibuffers
= intern ("enable-recursive-minibuffers");
654 staticpro (&Qenable_recursive_minibuffers
);
656 Qmouse_leave_buffer_hook
= intern ("mouse-leave-buffer-hook");
657 staticpro (&Qmouse_leave_buffer_hook
);
659 DEFVAR_LISP ("command-history", &Vcommand_history
,
660 "List of recent commands that read arguments from terminal.\n\
661 Each command is represented as a form to evaluate.");
662 Vcommand_history
= Qnil
;
664 DEFVAR_LISP ("command-debug-status", &Vcommand_debug_status
,
665 "Debugging status of current interactive command.\n\
666 Bound each time `call-interactively' is called;\n\
667 may be set by the debugger as a reminder for itself.");
668 Vcommand_debug_status
= Qnil
;
670 DEFVAR_LISP ("mark-even-if-inactive", &Vmark_even_if_inactive
,
671 "*Non-nil means you can use the mark even when inactive.\n\
672 This option makes a difference in Transient Mark mode.\n\
673 When the option is non-nil, deactivation of the mark\n\
674 turns off region highlighting, but commands that use the mark\n\
675 behave as if the mark were still active.");
676 Vmark_even_if_inactive
= Qnil
;
678 DEFVAR_LISP ("mouse-leave-buffer-hook", &Vmouse_leave_buffer_hook
,
679 "Hook to run when about to switch windows with a mouse command.\n\
680 Its purpose is to give temporary modes such as Isearch mode\n\
681 a way to turn themselves off when a mouse command switches windows.");
682 Vmouse_leave_buffer_hook
= Qnil
;
684 defsubr (&Sinteractive
);
685 defsubr (&Scall_interactively
);
686 defsubr (&Sprefix_numeric_value
);