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, 2, 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.")
179 Lisp_Object function
, record
;
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
;
210 /* Save this now, since use of minibuffer will clobber it. */
211 prefix_arg
= Vcurrent_prefix_arg
;
215 if (SYMBOLP (function
))
216 enable
= Fget (function
, Qenable_recursive_minibuffers
);
218 fun
= indirect_function (function
);
223 /* Decode the kind of function. Either handle it and return,
224 or go to `lose' if not interactive, or go to `retry'
225 to specify a different function, or set either STRING or SPECS. */
229 string
= (unsigned char *) XSUBR (fun
)->prompt
;
233 function
= wrong_type_argument (Qcommandp
, function
);
236 if ((EMACS_INT
) string
== 1)
237 /* Let SPECS (which is nil) be used as the args. */
240 else if (COMPILEDP (fun
))
242 if ((XVECTOR (fun
)->size
& PSEUDOVECTOR_SIZE_MASK
) <= COMPILED_INTERACTIVE
)
244 specs
= XVECTOR (fun
)->contents
[COMPILED_INTERACTIVE
];
246 else if (!CONSP (fun
))
248 else if (funcar
= Fcar (fun
), EQ (funcar
, Qautoload
))
250 GCPRO2 (function
, prefix_arg
);
251 do_autoload (fun
, function
);
255 else if (EQ (funcar
, Qlambda
))
257 specs
= Fassq (Qinteractive
, Fcdr (Fcdr (fun
)));
260 specs
= Fcar (Fcdr (specs
));
262 else if (EQ (funcar
, Qmocklisp
))
264 single_kboard_state ();
265 return ml_apply (fun
, Qinteractive
);
270 /* If either specs or string is set to a string, use it. */
273 /* Make a copy of string so that if a GC relocates specs,
274 `string' will still be valid. */
275 string
= (unsigned char *) alloca (XSTRING (specs
)->size
+ 1);
276 bcopy (XSTRING (specs
)->data
, string
, XSTRING (specs
)->size
+ 1);
278 else if (string
== 0)
283 /* Compute the arg values using the user's expression. */
284 specs
= Feval (specs
);
285 if (i
!= num_input_chars
|| !NILP (record
))
287 /* We should record this command on the command history. */
288 Lisp_Object values
, car
;
289 /* Make a copy of the list of values, for the command history,
290 and turn them into things we can eval. */
291 values
= quotify_args (Fcopy_sequence (specs
));
292 /* If the list of args was produced with an explicit call to `list',
293 look for elements that were computed with (region-beginning)
294 or (region-end), and put those expressions into VALUES
295 instead of the present values. */
299 Lisp_Object intail
, valtail
;
300 for (intail
= Fcdr (input
), valtail
= values
;
302 intail
= Fcdr (intail
), valtail
= Fcdr (valtail
))
308 Lisp_Object presflag
;
309 presflag
= Fmemq (Fcar (elt
), preserved_fns
);
310 if (!NILP (presflag
))
311 Fsetcar (valtail
, Fcar (intail
));
316 = Fcons (Fcons (function
, values
), Vcommand_history
);
318 single_kboard_state ();
319 return apply1 (function
, specs
);
322 /* Here if function specifies a string to control parsing the defaults */
324 /* Set next_event to point to the first event with parameters. */
325 for (next_event
= 0; next_event
< this_command_key_count
; next_event
++)
326 if (EVENT_HAS_PARAMETERS
327 (XVECTOR (this_command_keys
)->contents
[next_event
]))
330 /* Handle special starting chars `*' and `@'. Also `-'. */
331 /* Note that `+' is reserved for user extensions. */
335 error ("`+' is not used in `interactive' for ordinary commands");
336 else if (*string
== '*')
339 if (!NILP (current_buffer
->read_only
))
340 Fbarf_if_buffer_read_only ();
342 /* Ignore this for semi-compatibility with Lucid. */
343 else if (*string
== '-')
345 else if (*string
== '@')
349 event
= XVECTOR (this_command_keys
)->contents
[next_event
];
350 if (EVENT_HAS_PARAMETERS (event
)
351 && (event
= XCONS (event
)->cdr
, CONSP (event
))
352 && (event
= XCONS (event
)->car
, CONSP (event
))
353 && (event
= XCONS (event
)->car
, WINDOWP (event
)))
355 if (MINI_WINDOW_P (XWINDOW (event
))
356 && ! (minibuf_level
> 0 && EQ (event
, minibuf_window
)))
357 error ("Attempt to select inactive minibuffer window");
359 /* If the current buffer wants to clean up, let it. */
360 if (!NILP (Vmouse_leave_buffer_hook
))
361 call1 (Vrun_hooks
, Qmouse_leave_buffer_hook
);
363 Fselect_window (event
);
370 /* Count the number of arguments the interactive spec would have
371 us give to the function. */
373 for (j
= 0; *tem
; j
++)
375 /* 'r' specifications ("point and mark as 2 numeric args")
376 produce *two* arguments. */
377 if (*tem
== 'r') j
++;
378 tem
= (unsigned char *) index (tem
, '\n');
382 tem
= (unsigned char *) "";
386 args
= (Lisp_Object
*) alloca ((count
+ 1) * sizeof (Lisp_Object
));
387 visargs
= (Lisp_Object
*) alloca ((count
+ 1) * sizeof (Lisp_Object
));
388 argstrings
= (unsigned char **) alloca ((count
+ 1) * sizeof (char *));
389 varies
= (int *) alloca ((count
+ 1) * sizeof (int));
391 for (i
= 0; i
< (count
+ 1); i
++)
398 GCPRO4 (prefix_arg
, function
, *args
, *visargs
);
399 gcpro3
.nvars
= (count
+ 1);
400 gcpro4
.nvars
= (count
+ 1);
403 specbind (Qenable_recursive_minibuffers
, Qt
);
406 for (i
= 1; *tem
; i
++)
408 strncpy (prompt1
, tem
+ 1, sizeof prompt1
- 1);
409 prompt1
[sizeof prompt1
- 1] = 0;
410 tem1
= index (prompt1
, '\n');
412 /* Fill argstrings with a vector of C strings
413 corresponding to the Lisp strings in visargs. */
414 for (j
= 1; j
< i
; j
++)
416 = EQ (visargs
[j
], Qnil
)
417 ? (unsigned char *) ""
418 : XSTRING (visargs
[j
])->data
;
420 /* Process the format-string in prompt1, putting the output
421 into callint_message. Make callint_message bigger if necessary.
422 We don't use a buffer on the stack, because the contents
423 need to stay stable for a while. */
426 int nchars
= doprnt (callint_message
, callint_message_size
,
428 j
- 1, argstrings
+ 1);
429 if (nchars
< callint_message_size
)
431 callint_message_size
*= 2;
433 = (char *) xrealloc (callint_message
, callint_message_size
);
438 case 'a': /* Symbol defined as a function */
439 visargs
[i
] = Fcompleting_read (build_string (callint_message
),
440 Vobarray
, Qfboundp
, Qt
, Qnil
, Qnil
);
441 /* Passing args[i] directly stimulates compiler bug */
443 args
[i
] = Fintern (teml
, Qnil
);
446 case 'b': /* Name of existing buffer */
447 args
[i
] = Fcurrent_buffer ();
448 if (EQ (selected_window
, minibuf_window
))
449 args
[i
] = Fother_buffer (args
[i
], Qnil
);
450 args
[i
] = Fread_buffer (build_string (callint_message
), args
[i
], Qt
);
453 case 'B': /* Name of buffer, possibly nonexistent */
454 args
[i
] = Fread_buffer (build_string (callint_message
),
455 Fother_buffer (Fcurrent_buffer (), Qnil
),
459 case 'c': /* Character */
460 message1 (callint_message
);
461 args
[i
] = Fread_char ();
462 /* Passing args[i] directly stimulates compiler bug */
464 visargs
[i
] = Fchar_to_string (teml
);
467 case 'C': /* Command: symbol with interactive function */
468 visargs
[i
] = Fcompleting_read (build_string (callint_message
),
469 Vobarray
, Qcommandp
, Qt
, Qnil
, Qnil
);
470 /* Passing args[i] directly stimulates compiler bug */
472 args
[i
] = Fintern (teml
, Qnil
);
475 case 'd': /* Value of point. Does not do I/O. */
476 Fset_marker (point_marker
, make_number (PT
), Qnil
);
477 args
[i
] = point_marker
;
478 /* visargs[i] = Qnil; */
482 case 'D': /* Directory name. */
483 args
[i
] = Fread_file_name (build_string (callint_message
), Qnil
,
484 current_buffer
->directory
, Qlambda
, Qnil
);
487 case 'f': /* Existing file name. */
488 args
[i
] = Fread_file_name (build_string (callint_message
),
489 Qnil
, Qnil
, Qlambda
, Qnil
);
492 case 'F': /* Possibly nonexistent file name. */
493 args
[i
] = Fread_file_name (build_string (callint_message
),
494 Qnil
, Qnil
, Qnil
, Qnil
);
497 case 'k': /* Key sequence. */
498 args
[i
] = Fread_key_sequence (build_string (callint_message
),
501 visargs
[i
] = Fkey_description (teml
);
504 case 'K': /* Key sequence to be defined. */
505 args
[i
] = Fread_key_sequence (build_string (callint_message
),
508 visargs
[i
] = Fkey_description (teml
);
511 case 'e': /* The invoking event. */
512 if (next_event
>= this_command_key_count
)
513 error ("%s must be bound to an event with parameters",
515 ? (char *) XSYMBOL (function
)->name
->data
517 args
[i
] = XVECTOR (this_command_keys
)->contents
[next_event
++];
520 /* Find the next parameterized event. */
521 while (next_event
< this_command_key_count
522 && ! (EVENT_HAS_PARAMETERS
523 (XVECTOR (this_command_keys
)->contents
[next_event
])))
528 case 'm': /* Value of mark. Does not do I/O. */
530 /* visargs[i] = Qnil; */
531 args
[i
] = current_buffer
->mark
;
535 case 'N': /* Prefix arg, else number from minibuffer */
536 if (!NILP (prefix_arg
))
537 goto have_prefix_arg
;
538 case 'n': /* Read number from minibuffer. */
540 args
[i
] = Fread_minibuffer (build_string (callint_message
), Qnil
);
541 while (! NUMBERP (args
[i
]));
542 visargs
[i
] = last_minibuf_string
;
545 case 'P': /* Prefix arg in raw form. Does no I/O. */
547 args
[i
] = prefix_arg
;
548 /* visargs[i] = Qnil; */
552 case 'p': /* Prefix arg converted to number. No I/O. */
553 args
[i
] = Fprefix_numeric_value (prefix_arg
);
554 /* visargs[i] = Qnil; */
558 case 'r': /* Region, point and mark as 2 args. */
560 Fset_marker (point_marker
, make_number (PT
), Qnil
);
561 /* visargs[i+1] = Qnil; */
562 foo
= marker_position (current_buffer
->mark
);
563 /* visargs[i] = Qnil; */
564 args
[i
] = point
< foo
? point_marker
: current_buffer
->mark
;
566 args
[++i
] = point
> foo
? point_marker
: current_buffer
->mark
;
570 case 's': /* String read via minibuffer. */
571 args
[i
] = Fread_string (build_string (callint_message
), Qnil
, Qnil
);
574 case 'S': /* Any symbol. */
575 visargs
[i
] = Fread_string (build_string (callint_message
),
577 /* Passing args[i] directly stimulates compiler bug */
579 args
[i
] = Fintern (teml
, Qnil
);
582 case 'v': /* Variable name: symbol that is
584 args
[i
] = Fread_variable (build_string (callint_message
));
585 visargs
[i
] = last_minibuf_string
;
588 case 'x': /* Lisp expression read but not evaluated */
589 args
[i
] = Fread_minibuffer (build_string (callint_message
), Qnil
);
590 visargs
[i
] = last_minibuf_string
;
593 case 'X': /* Lisp expression read and evaluated */
594 args
[i
] = Feval_minibuffer (build_string (callint_message
), Qnil
);
595 visargs
[i
] = last_minibuf_string
;
598 /* We have a case for `+' so we get an error
599 if anyone tries to define one here. */
602 error ("Invalid control letter `%c' (%03o) in interactive calling string",
609 if (NILP (visargs
[i
]) && STRINGP (args
[i
]))
610 visargs
[i
] = args
[i
];
612 tem
= (unsigned char *) index (tem
, '\n');
614 else tem
= (unsigned char *) "";
616 unbind_to (speccount
, Qnil
);
622 if (arg_from_tty
|| !NILP (record
))
624 visargs
[0] = function
;
625 for (i
= 1; i
< count
+ 1; i
++)
628 visargs
[i
] = Fcons (intern (callint_argfuns
[varies
[i
]]), Qnil
);
630 visargs
[i
] = quotify_arg (args
[i
]);
632 Vcommand_history
= Fcons (Flist (count
+ 1, visargs
),
636 /* If we used a marker to hold point, mark, or an end of the region,
637 temporarily, convert it to an integer now. */
638 for (i
= 1; i
<= count
; i
++)
639 if (varies
[i
] >= 1 && varies
[i
] <= 4)
640 XSETINT (args
[i
], marker_position (args
[i
]));
642 single_kboard_state ();
646 specbind (Qcommand_debug_status
, Qnil
);
648 val
= Ffuncall (count
+ 1, args
);
650 return unbind_to (speccount
, val
);
654 DEFUN ("prefix-numeric-value", Fprefix_numeric_value
, Sprefix_numeric_value
,
656 "Return numeric meaning of raw prefix argument ARG.\n\
657 A raw prefix argument is what you get from `(interactive \"P\")'.\n\
658 Its numeric meaning is what you would get from `(interactive \"p\")'.")
665 XSETFASTINT (val
, 1);
666 else if (EQ (raw
, Qminus
))
668 else if (CONSP (raw
) && INTEGERP (XCONS (raw
)->car
))
669 XSETINT (val
, XINT (XCONS (raw
)->car
));
670 else if (INTEGERP (raw
))
673 XSETFASTINT (val
, 1);
680 point_marker
= Fmake_marker ();
681 staticpro (&point_marker
);
683 preserved_fns
= Fcons (intern ("region-beginning"),
684 Fcons (intern ("region-end"),
685 Fcons (intern ("point"),
686 Fcons (intern ("mark"), Qnil
))));
687 staticpro (&preserved_fns
);
689 Qlist
= intern ("list");
692 Qminus
= intern ("-");
695 Qplus
= intern ("+");
698 Qcall_interactively
= intern ("call-interactively");
699 staticpro (&Qcall_interactively
);
701 Qcommand_debug_status
= intern ("command-debug-status");
702 staticpro (&Qcommand_debug_status
);
704 Qenable_recursive_minibuffers
= intern ("enable-recursive-minibuffers");
705 staticpro (&Qenable_recursive_minibuffers
);
707 Qmouse_leave_buffer_hook
= intern ("mouse-leave-buffer-hook");
708 staticpro (&Qmouse_leave_buffer_hook
);
710 callint_message_size
= 100;
711 callint_message
= (char *) xmalloc (callint_message_size
);
714 DEFVAR_KBOARD ("prefix-arg", Vprefix_arg
,
715 "The value of the prefix argument for the next editing command.\n\
716 It may be a number, or the symbol `-' for just a minus sign as arg,\n\
717 or a list whose car is a number for just one or more C-U's\n\
718 or nil if no argument has been specified.\n\
720 You cannot examine this variable to find the argument for this command\n\
721 since it has been set to nil by the time you can look.\n\
722 Instead, you should use the variable `current-prefix-arg', although\n\
723 normally commands can get this prefix argument with (interactive \"P\").");
725 DEFVAR_LISP ("current-prefix-arg", &Vcurrent_prefix_arg
,
726 "The value of the prefix argument for this editing command.\n\
727 It may be a number, or the symbol `-' for just a minus sign as arg,\n\
728 or a list whose car is a number for just one or more C-U's\n\
729 or nil if no argument has been specified.\n\
730 This is what `(interactive \"P\")' returns.");
731 Vcurrent_prefix_arg
= Qnil
;
733 DEFVAR_LISP ("command-history", &Vcommand_history
,
734 "List of recent commands that read arguments from terminal.\n\
735 Each command is represented as a form to evaluate.");
736 Vcommand_history
= Qnil
;
738 DEFVAR_LISP ("command-debug-status", &Vcommand_debug_status
,
739 "Debugging status of current interactive command.\n\
740 Bound each time `call-interactively' is called;\n\
741 may be set by the debugger as a reminder for itself.");
742 Vcommand_debug_status
= Qnil
;
744 DEFVAR_LISP ("mark-even-if-inactive", &Vmark_even_if_inactive
,
745 "*Non-nil means you can use the mark even when inactive.\n\
746 This option makes a difference in Transient Mark mode.\n\
747 When the option is non-nil, deactivation of the mark\n\
748 turns off region highlighting, but commands that use the mark\n\
749 behave as if the mark were still active.");
750 Vmark_even_if_inactive
= Qnil
;
752 DEFVAR_LISP ("mouse-leave-buffer-hook", &Vmouse_leave_buffer_hook
,
753 "Hook to run when about to switch windows with a mouse command.\n\
754 Its purpose is to give temporary modes such as Isearch mode\n\
755 a way to turn themselves off when a mouse command switches windows.");
756 Vmouse_leave_buffer_hook
= Qnil
;
758 defsubr (&Sinteractive
);
759 defsubr (&Scall_interactively
);
760 defsubr (&Sprefix_numeric_value
);