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 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
;
42 Lisp_Object Vmouse_leave_buffer_hook
, Qmouse_leave_buffer_hook
;
45 static Lisp_Object preserved_fns
;
47 /* Marker used within call-interactively to refer to point. */
48 static Lisp_Object point_marker
;
50 /* Buffer for the prompt text used in Fcall_interactively. */
51 static char *callint_message
;
53 /* Allocated length of that buffer. */
54 static int callint_message_size
;
56 /* This comment supplies the doc string for interactive,
57 for make-docfile to see. We cannot put this in the real DEFUN
58 due to limits in the Unix cpp.
60 DEFUN ("interactive", Ffoo, Sfoo, 0, 0, 0,
61 "Specify a way of parsing arguments for interactive use of a function.\n\
63 (defun foo (arg) \"Doc string\" (interactive \"p\") ...use arg...)\n\
64 to make ARG be the prefix argument when `foo' is called as a command.\n\
65 The \"call\" to `interactive' is actually a declaration rather than a function;\n\
66 it tells `call-interactively' how to read arguments\n\
67 to pass to the function.\n\
68 When actually called, `interactive' just returns nil.\n\
70 The argument of `interactive' is usually a string containing a code letter\n\
71 followed by a prompt. (Some code letters do not use I/O to get\n\
72 the argument and do not need prompts.) To prompt for multiple arguments,\n\
73 give a code letter, its prompt, a newline, and another code letter, etc.\n\
74 Prompts are passed to format, and may use % escapes to print the\n\
75 arguments that have already been read.\n\
76 If the argument is not a string, it is evaluated to get a list of\n\
77 arguments to pass to the function.\n\
78 Just `(interactive)' means pass no args when calling interactively.\n\
79 \nCode letters available are:\n\
80 a -- Function name: symbol with a function definition.\n\
81 b -- Name of existing buffer.\n\
82 B -- Name of buffer, possibly nonexistent.\n\
84 C -- Command name: symbol with interactive function definition.\n\
85 d -- Value of point as number. Does not do I/O.\n\
86 D -- Directory name.\n\
87 e -- Parametrized event (i.e., one that's a list) that invoked this command.\n\
88 If used more than once, the Nth `e' returns the Nth parameterized event.\n\
89 This skips events that are integers or symbols.\n\
90 f -- Existing file name.\n\
91 F -- Possibly nonexistent file name.\n\
92 k -- Key sequence (downcase the last event if needed to get a definition).\n\
93 K -- Key sequence to be redefined (do not downcase the last event).\n\
94 m -- Value of mark as number. Does not do I/O.\n\
95 n -- Number read using minibuffer.\n\
96 N -- Raw prefix arg, or if none, do like code `n'.\n\
97 p -- Prefix arg converted to number. Does not do I/O.\n\
98 P -- Prefix arg in raw form. Does not do I/O.\n\
99 r -- Region: point and mark as 2 numeric args, smallest first. Does no I/O.\n\
102 v -- Variable name: symbol that is user-variable-p.\n\
103 x -- Lisp expression read but not evaluated.\n\
104 X -- Lisp expression read and evaluated.\n\
105 In addition, if the string begins with `*'\n\
106 then an error is signaled if the buffer is read-only.\n\
107 This happens before reading any arguments.\n\
108 If the string begins with `@', then Emacs searches the key sequence\n\
109 which invoked the command for its first mouse click (or any other\n\
110 event which specifies a window), and selects that window before\n\
111 reading any arguments. You may use both `@' and `*'; they are\n\
112 processed in the order that they appear." */
115 DEFUN ("interactive", Finteractive
, Sinteractive
, 0, UNEVALLED
, 0,
116 0 /* See immediately above */)
123 /* Quotify EXP: if EXP is constant, return it.
124 If EXP is not constant, return (quote EXP). */
127 register Lisp_Object exp
;
129 if (!INTEGERP (exp
) && !STRINGP (exp
)
130 && !NILP (exp
) && !EQ (exp
, Qt
))
131 return Fcons (Qquote
, Fcons (exp
, Qnil
));
136 /* Modify EXP by quotifying each element (except the first). */
141 register Lisp_Object tail
;
142 register struct Lisp_Cons
*ptr
;
143 for (tail
= exp
; CONSP (tail
); tail
= ptr
->cdr
)
146 ptr
->car
= quotify_arg (ptr
->car
);
151 char *callint_argfuns
[]
152 = {"", "point", "mark", "region-beginning", "region-end"};
158 tem
= Fmarker_buffer (current_buffer
->mark
);
159 if (NILP (tem
) || (XBUFFER (tem
) != current_buffer
))
160 error ("The mark is not set now");
161 if (!NILP (Vtransient_mark_mode
) && NILP (Vmark_even_if_inactive
)
162 && NILP (current_buffer
->mark_active
))
163 Fsignal (Qmark_inactive
, Qnil
);
167 DEFUN ("call-interactively", Fcall_interactively
, Scall_interactively
, 1, 3, 0,
168 "Call FUNCTION, reading args according to its interactive calling specs.\n\
169 Return the value FUNCTION returns.\n\
170 The function contains a specification of how to do the argument reading.\n\
171 In the case of user-defined functions, this is specified by placing a call\n\
172 to the function `interactive' at the top level of the function body.\n\
173 See `interactive'.\n\
175 Optional second arg RECORD-FLAG non-nil\n\
176 means unconditionally put this command in the command-history.\n\
177 Otherwise, this is done only if an arg is read using the minibuffer.")
178 (function
, record
, keys
)
179 Lisp_Object function
, record
, keys
;
181 Lisp_Object
*args
, *visargs
;
182 unsigned char **argstrings
;
188 int speccount
= specpdl_ptr
- specpdl
;
190 /* The index of the next element of this_command_keys to examine for
191 the 'e' interactive code. */
194 Lisp_Object prefix_arg
;
195 unsigned char *string
;
198 /* If varies[i] > 0, the i'th argument shouldn't just have its value
199 in this call quoted in the command history. It should be
200 recorded as a call to the function named callint_argfuns[varies[i]]. */
207 int arg_from_tty
= 0;
208 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
212 keys
= this_command_keys
, key_count
= this_command_key_count
;
215 CHECK_VECTOR (keys
, 3);
216 key_count
= XVECTOR (keys
)->size
;
219 /* Save this now, since use of minibuffer will clobber it. */
220 prefix_arg
= Vcurrent_prefix_arg
;
224 if (SYMBOLP (function
))
225 enable
= Fget (function
, Qenable_recursive_minibuffers
);
227 fun
= indirect_function (function
);
232 /* Decode the kind of function. Either handle it and return,
233 or go to `lose' if not interactive, or go to `retry'
234 to specify a different function, or set either STRING or SPECS. */
238 string
= (unsigned char *) XSUBR (fun
)->prompt
;
242 function
= wrong_type_argument (Qcommandp
, function
);
245 if ((EMACS_INT
) string
== 1)
246 /* Let SPECS (which is nil) be used as the args. */
249 else if (COMPILEDP (fun
))
251 if ((XVECTOR (fun
)->size
& PSEUDOVECTOR_SIZE_MASK
) <= COMPILED_INTERACTIVE
)
253 specs
= XVECTOR (fun
)->contents
[COMPILED_INTERACTIVE
];
255 else if (!CONSP (fun
))
257 else if (funcar
= Fcar (fun
), EQ (funcar
, Qautoload
))
259 GCPRO2 (function
, prefix_arg
);
260 do_autoload (fun
, function
);
264 else if (EQ (funcar
, Qlambda
))
266 specs
= Fassq (Qinteractive
, Fcdr (Fcdr (fun
)));
269 specs
= Fcar (Fcdr (specs
));
271 else if (EQ (funcar
, Qmocklisp
))
273 single_kboard_state ();
274 return ml_apply (fun
, Qinteractive
);
279 /* If either specs or string is set to a string, use it. */
282 /* Make a copy of string so that if a GC relocates specs,
283 `string' will still be valid. */
284 string
= (unsigned char *) alloca (XSTRING (specs
)->size
+ 1);
285 bcopy (XSTRING (specs
)->data
, string
, XSTRING (specs
)->size
+ 1);
287 else if (string
== 0)
292 /* Compute the arg values using the user's expression. */
293 specs
= Feval (specs
);
294 if (i
!= num_input_chars
|| !NILP (record
))
296 /* We should record this command on the command history. */
297 Lisp_Object values
, car
;
298 /* Make a copy of the list of values, for the command history,
299 and turn them into things we can eval. */
300 values
= quotify_args (Fcopy_sequence (specs
));
301 /* If the list of args was produced with an explicit call to `list',
302 look for elements that were computed with (region-beginning)
303 or (region-end), and put those expressions into VALUES
304 instead of the present values. */
308 Lisp_Object intail
, valtail
;
309 for (intail
= Fcdr (input
), valtail
= values
;
311 intail
= Fcdr (intail
), valtail
= Fcdr (valtail
))
317 Lisp_Object presflag
;
318 presflag
= Fmemq (Fcar (elt
), preserved_fns
);
319 if (!NILP (presflag
))
320 Fsetcar (valtail
, Fcar (intail
));
325 = Fcons (Fcons (function
, values
), Vcommand_history
);
327 single_kboard_state ();
328 return apply1 (function
, specs
);
331 /* Here if function specifies a string to control parsing the defaults */
333 /* Set next_event to point to the first event with parameters. */
334 for (next_event
= 0; next_event
< key_count
; next_event
++)
335 if (EVENT_HAS_PARAMETERS (XVECTOR (keys
)->contents
[next_event
]))
338 /* Handle special starting chars `*' and `@'. Also `-'. */
339 /* Note that `+' is reserved for user extensions. */
343 error ("`+' is not used in `interactive' for ordinary commands");
344 else if (*string
== '*')
347 if (!NILP (current_buffer
->read_only
))
348 Fbarf_if_buffer_read_only ();
350 /* Ignore this for semi-compatibility with Lucid. */
351 else if (*string
== '-')
353 else if (*string
== '@')
357 event
= XVECTOR (keys
)->contents
[next_event
];
358 if (EVENT_HAS_PARAMETERS (event
)
359 && (event
= XCONS (event
)->cdr
, CONSP (event
))
360 && (event
= XCONS (event
)->car
, CONSP (event
))
361 && (event
= XCONS (event
)->car
, WINDOWP (event
)))
363 if (MINI_WINDOW_P (XWINDOW (event
))
364 && ! (minibuf_level
> 0 && EQ (event
, minibuf_window
)))
365 error ("Attempt to select inactive minibuffer window");
367 /* If the current buffer wants to clean up, let it. */
368 if (!NILP (Vmouse_leave_buffer_hook
))
369 call1 (Vrun_hooks
, Qmouse_leave_buffer_hook
);
371 Fselect_window (event
);
378 /* Count the number of arguments the interactive spec would have
379 us give to the function. */
381 for (j
= 0; *tem
; j
++)
383 /* 'r' specifications ("point and mark as 2 numeric args")
384 produce *two* arguments. */
385 if (*tem
== 'r') j
++;
386 tem
= (unsigned char *) index (tem
, '\n');
390 tem
= (unsigned char *) "";
394 args
= (Lisp_Object
*) alloca ((count
+ 1) * sizeof (Lisp_Object
));
395 visargs
= (Lisp_Object
*) alloca ((count
+ 1) * sizeof (Lisp_Object
));
396 argstrings
= (unsigned char **) alloca ((count
+ 1) * sizeof (char *));
397 varies
= (int *) alloca ((count
+ 1) * sizeof (int));
399 for (i
= 0; i
< (count
+ 1); i
++)
406 GCPRO4 (prefix_arg
, function
, *args
, *visargs
);
407 gcpro3
.nvars
= (count
+ 1);
408 gcpro4
.nvars
= (count
+ 1);
411 specbind (Qenable_recursive_minibuffers
, Qt
);
414 for (i
= 1; *tem
; i
++)
416 strncpy (prompt1
, tem
+ 1, sizeof prompt1
- 1);
417 prompt1
[sizeof prompt1
- 1] = 0;
418 tem1
= index (prompt1
, '\n');
420 /* Fill argstrings with a vector of C strings
421 corresponding to the Lisp strings in visargs. */
422 for (j
= 1; j
< i
; j
++)
424 = EQ (visargs
[j
], Qnil
)
425 ? (unsigned char *) ""
426 : XSTRING (visargs
[j
])->data
;
428 /* Process the format-string in prompt1, putting the output
429 into callint_message. Make callint_message bigger if necessary.
430 We don't use a buffer on the stack, because the contents
431 need to stay stable for a while. */
434 int nchars
= doprnt (callint_message
, callint_message_size
,
436 j
- 1, argstrings
+ 1);
437 if (nchars
< callint_message_size
)
439 callint_message_size
*= 2;
441 = (char *) xrealloc (callint_message
, callint_message_size
);
446 case 'a': /* Symbol defined as a function */
447 visargs
[i
] = Fcompleting_read (build_string (callint_message
),
448 Vobarray
, Qfboundp
, Qt
, Qnil
, Qnil
);
449 /* Passing args[i] directly stimulates compiler bug */
451 args
[i
] = Fintern (teml
, Qnil
);
454 case 'b': /* Name of existing buffer */
455 args
[i
] = Fcurrent_buffer ();
456 if (EQ (selected_window
, minibuf_window
))
457 args
[i
] = Fother_buffer (args
[i
], Qnil
);
458 args
[i
] = Fread_buffer (build_string (callint_message
), args
[i
], Qt
);
461 case 'B': /* Name of buffer, possibly nonexistent */
462 args
[i
] = Fread_buffer (build_string (callint_message
),
463 Fother_buffer (Fcurrent_buffer (), Qnil
),
467 case 'c': /* Character */
468 message1 (callint_message
);
469 args
[i
] = Fread_char ();
470 /* Passing args[i] directly stimulates compiler bug */
472 visargs
[i
] = Fchar_to_string (teml
);
475 case 'C': /* Command: symbol with interactive function */
476 visargs
[i
] = Fcompleting_read (build_string (callint_message
),
477 Vobarray
, Qcommandp
, Qt
, Qnil
, Qnil
);
478 /* Passing args[i] directly stimulates compiler bug */
480 args
[i
] = Fintern (teml
, Qnil
);
483 case 'd': /* Value of point. Does not do I/O. */
484 Fset_marker (point_marker
, make_number (PT
), Qnil
);
485 args
[i
] = point_marker
;
486 /* visargs[i] = Qnil; */
490 case 'D': /* Directory name. */
491 args
[i
] = Fread_file_name (build_string (callint_message
), Qnil
,
492 current_buffer
->directory
, Qlambda
, Qnil
);
495 case 'f': /* Existing file name. */
496 args
[i
] = Fread_file_name (build_string (callint_message
),
497 Qnil
, Qnil
, Qlambda
, Qnil
);
500 case 'F': /* Possibly nonexistent file name. */
501 args
[i
] = Fread_file_name (build_string (callint_message
),
502 Qnil
, Qnil
, Qnil
, Qnil
);
505 case 'k': /* Key sequence. */
506 args
[i
] = Fread_key_sequence (build_string (callint_message
),
509 visargs
[i
] = Fkey_description (teml
);
512 case 'K': /* Key sequence to be defined. */
513 args
[i
] = Fread_key_sequence (build_string (callint_message
),
516 visargs
[i
] = Fkey_description (teml
);
519 case 'e': /* The invoking event. */
520 if (next_event
>= key_count
)
521 error ("%s must be bound to an event with parameters",
523 ? (char *) XSYMBOL (function
)->name
->data
525 args
[i
] = XVECTOR (keys
)->contents
[next_event
++];
528 /* Find the next parameterized event. */
529 while (next_event
< key_count
530 && ! (EVENT_HAS_PARAMETERS
531 (XVECTOR (keys
)->contents
[next_event
])))
536 case 'm': /* Value of mark. Does not do I/O. */
538 /* visargs[i] = Qnil; */
539 args
[i
] = current_buffer
->mark
;
543 case 'N': /* Prefix arg, else number from minibuffer */
544 if (!NILP (prefix_arg
))
545 goto have_prefix_arg
;
546 case 'n': /* Read number from minibuffer. */
548 args
[i
] = Fread_minibuffer (build_string (callint_message
), Qnil
);
549 while (! NUMBERP (args
[i
]));
550 visargs
[i
] = last_minibuf_string
;
553 case 'P': /* Prefix arg in raw form. Does no I/O. */
555 args
[i
] = prefix_arg
;
556 /* visargs[i] = Qnil; */
560 case 'p': /* Prefix arg converted to number. No I/O. */
561 args
[i
] = Fprefix_numeric_value (prefix_arg
);
562 /* visargs[i] = Qnil; */
566 case 'r': /* Region, point and mark as 2 args. */
568 Fset_marker (point_marker
, make_number (PT
), Qnil
);
569 /* visargs[i+1] = Qnil; */
570 foo
= marker_position (current_buffer
->mark
);
571 /* visargs[i] = Qnil; */
572 args
[i
] = point
< foo
? point_marker
: current_buffer
->mark
;
574 args
[++i
] = point
> foo
? point_marker
: current_buffer
->mark
;
578 case 's': /* String read via minibuffer. */
579 args
[i
] = Fread_string (build_string (callint_message
), Qnil
, Qnil
);
582 case 'S': /* Any symbol. */
583 visargs
[i
] = Fread_string (build_string (callint_message
),
585 /* Passing args[i] directly stimulates compiler bug */
587 args
[i
] = Fintern (teml
, Qnil
);
590 case 'v': /* Variable name: symbol that is
592 args
[i
] = Fread_variable (build_string (callint_message
));
593 visargs
[i
] = last_minibuf_string
;
596 case 'x': /* Lisp expression read but not evaluated */
597 args
[i
] = Fread_minibuffer (build_string (callint_message
), Qnil
);
598 visargs
[i
] = last_minibuf_string
;
601 case 'X': /* Lisp expression read and evaluated */
602 args
[i
] = Feval_minibuffer (build_string (callint_message
), Qnil
);
603 visargs
[i
] = last_minibuf_string
;
606 /* We have a case for `+' so we get an error
607 if anyone tries to define one here. */
610 error ("Invalid control letter `%c' (%03o) in interactive calling string",
617 if (NILP (visargs
[i
]) && STRINGP (args
[i
]))
618 visargs
[i
] = args
[i
];
620 tem
= (unsigned char *) index (tem
, '\n');
622 else tem
= (unsigned char *) "";
624 unbind_to (speccount
, Qnil
);
630 if (arg_from_tty
|| !NILP (record
))
632 visargs
[0] = function
;
633 for (i
= 1; i
< count
+ 1; i
++)
636 visargs
[i
] = Fcons (intern (callint_argfuns
[varies
[i
]]), Qnil
);
638 visargs
[i
] = quotify_arg (args
[i
]);
640 Vcommand_history
= Fcons (Flist (count
+ 1, visargs
),
644 /* If we used a marker to hold point, mark, or an end of the region,
645 temporarily, convert it to an integer now. */
646 for (i
= 1; i
<= count
; i
++)
647 if (varies
[i
] >= 1 && varies
[i
] <= 4)
648 XSETINT (args
[i
], marker_position (args
[i
]));
650 single_kboard_state ();
654 specbind (Qcommand_debug_status
, Qnil
);
656 val
= Ffuncall (count
+ 1, args
);
658 return unbind_to (speccount
, val
);
662 DEFUN ("prefix-numeric-value", Fprefix_numeric_value
, Sprefix_numeric_value
,
664 "Return numeric meaning of raw prefix argument ARG.\n\
665 A raw prefix argument is what you get from `(interactive \"P\")'.\n\
666 Its numeric meaning is what you would get from `(interactive \"p\")'.")
673 XSETFASTINT (val
, 1);
674 else if (EQ (raw
, Qminus
))
676 else if (CONSP (raw
) && INTEGERP (XCONS (raw
)->car
))
677 XSETINT (val
, XINT (XCONS (raw
)->car
));
678 else if (INTEGERP (raw
))
681 XSETFASTINT (val
, 1);
688 point_marker
= Fmake_marker ();
689 staticpro (&point_marker
);
691 preserved_fns
= Fcons (intern ("region-beginning"),
692 Fcons (intern ("region-end"),
693 Fcons (intern ("point"),
694 Fcons (intern ("mark"), Qnil
))));
695 staticpro (&preserved_fns
);
697 Qlist
= intern ("list");
700 Qminus
= intern ("-");
703 Qplus
= intern ("+");
706 Qcall_interactively
= intern ("call-interactively");
707 staticpro (&Qcall_interactively
);
709 Qcommand_debug_status
= intern ("command-debug-status");
710 staticpro (&Qcommand_debug_status
);
712 Qenable_recursive_minibuffers
= intern ("enable-recursive-minibuffers");
713 staticpro (&Qenable_recursive_minibuffers
);
715 Qmouse_leave_buffer_hook
= intern ("mouse-leave-buffer-hook");
716 staticpro (&Qmouse_leave_buffer_hook
);
718 callint_message_size
= 100;
719 callint_message
= (char *) xmalloc (callint_message_size
);
722 DEFVAR_KBOARD ("prefix-arg", Vprefix_arg
,
723 "The value of the prefix argument for the next editing command.\n\
724 It may be a number, or the symbol `-' for just a minus sign as arg,\n\
725 or a list whose car is a number for just one or more C-U's\n\
726 or nil if no argument has been specified.\n\
728 You cannot examine this variable to find the argument for this command\n\
729 since it has been set to nil by the time you can look.\n\
730 Instead, you should use the variable `current-prefix-arg', although\n\
731 normally commands can get this prefix argument with (interactive \"P\").");
733 DEFVAR_LISP ("current-prefix-arg", &Vcurrent_prefix_arg
,
734 "The value of the prefix argument for this editing command.\n\
735 It may be a number, or the symbol `-' for just a minus sign as arg,\n\
736 or a list whose car is a number for just one or more C-U's\n\
737 or nil if no argument has been specified.\n\
738 This is what `(interactive \"P\")' returns.");
739 Vcurrent_prefix_arg
= Qnil
;
741 DEFVAR_LISP ("command-history", &Vcommand_history
,
742 "List of recent commands that read arguments from terminal.\n\
743 Each command is represented as a form to evaluate.");
744 Vcommand_history
= Qnil
;
746 DEFVAR_LISP ("command-debug-status", &Vcommand_debug_status
,
747 "Debugging status of current interactive command.\n\
748 Bound each time `call-interactively' is called;\n\
749 may be set by the debugger as a reminder for itself.");
750 Vcommand_debug_status
= Qnil
;
752 DEFVAR_LISP ("mark-even-if-inactive", &Vmark_even_if_inactive
,
753 "*Non-nil means you can use the mark even when inactive.\n\
754 This option makes a difference in Transient Mark mode.\n\
755 When the option is non-nil, deactivation of the mark\n\
756 turns off region highlighting, but commands that use the mark\n\
757 behave as if the mark were still active.");
758 Vmark_even_if_inactive
= Qnil
;
760 DEFVAR_LISP ("mouse-leave-buffer-hook", &Vmouse_leave_buffer_hook
,
761 "Hook to run when about to switch windows with a mouse command.\n\
762 Its purpose is to give temporary modes such as Isearch mode\n\
763 a way to turn themselves off when a mouse command switches windows.");
764 Vmouse_leave_buffer_hook
= Qnil
;
766 defsubr (&Sinteractive
);
767 defsubr (&Scall_interactively
);
768 defsubr (&Sprefix_numeric_value
);