1 /* Call a Lisp function interactively.
2 Copyright (C) 1985-1986, 1993-1995, 1997, 2000-2023 Free Software
3 Foundation, Inc.
4
5 This file is part of GNU Emacs.
6
7 GNU Emacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or (at
10 your option) any later version.
11
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
19
20
21 #include <config.h>
22
23 #include "lisp.h"
24 #include "character.h"
25 #include "buffer.h"
26 #include "keyboard.h"
27 #include "window.h"
28
29 static Lisp_Object preserved_fns;
30
31 /* Marker used within call-interactively to refer to point. */
32 static Lisp_Object point_marker;
33
34 /* String for the prompt text used in Fcall_interactively. */
35 static Lisp_Object callint_message;
36
37 DEFUN ("interactive", Finteractive, Sinteractive, 0, UNEVALLED, 0,
38 doc: /* Specify a way of parsing arguments for interactive use of a function.
39 For example, write
40 (defun foo (arg buf) "Doc string" (interactive "P\\nbbuffer: ") .... )
41 to make ARG be the raw prefix argument, and set BUF to an existing buffer,
42 when `foo' is called as a command.
43
44 The "call" to `interactive' is actually a declaration rather than a
45 function; it tells `call-interactively' how to read arguments to pass
46 to the function. When actually called, `interactive' just returns
47 nil.
48
49 Usually the argument of `interactive' is a string containing a code
50 letter followed optionally by a prompt. (Some code letters do not
51 use I/O to get the argument and do not use prompts.) To pass several
52 arguments to the command, concatenate the individual strings,
53 separating them by newline characters.
54
55 Prompts are passed to `format', and may use %s escapes to print the
56 arguments that have already been read.
57
58 If the argument is not a string, it is evaluated to get a list of
59 arguments to pass to the command.
60
61 Just `(interactive)' means pass no arguments to the command when
62 calling interactively.
63
64 Code letters available are:
65 a -- Function name: symbol with a function definition.
66 b -- Name of existing buffer.
67 B -- Name of buffer, possibly nonexistent.
68 c -- Character (no input method is used).
69 C -- Command name: symbol with interactive function definition.
70 d -- Value of point as number. Does not do I/O.
71 D -- Directory name.
72 e -- Parameterized event (i.e., one that's a list) that invoked this command.
73 If used more than once, the Nth `e' returns the Nth parameterized event.
74 This skips events that are integers or symbols.
75 f -- Existing file name.
76 F -- Possibly nonexistent file name.
77 G -- Possibly nonexistent file name, defaulting to just directory name.
78 i -- Ignored, i.e. always nil. Does not do I/O.
79 k -- Key sequence (downcase the last event if needed to get a definition).
80 K -- Key sequence to be redefined (do not downcase the last event).
81 m -- Value of mark as number. Does not do I/O.
82 M -- Any string. Inherits the current input method.
83 n -- Number read using minibuffer.
84 N -- Numeric prefix arg, or if none, do like code `n'.
85 p -- Prefix arg converted to number. Does not do I/O.
86 P -- Prefix arg in raw form. Does not do I/O.
87 r -- Region: point and mark as 2 numeric args, smallest first. Does no I/O.
88 s -- Any string. Does not inherit the current input method.
89 S -- Any symbol.
90 U -- Mouse up event discarded by a previous k or K argument.
91 v -- Variable name: symbol that is `custom-variable-p'.
92 x -- Lisp expression read but not evaluated.
93 X -- Lisp expression read and evaluated.
94 z -- Coding system.
95 Z -- Coding system, nil if no prefix arg.
96
97 In addition, if the string begins with `*', an error is signaled if
98 the buffer is read-only.
99 If `@' appears at the beginning of the string, and if the key sequence
100 used to invoke the command includes any mouse events, then the window
101 associated with the first of those events is selected before the
102 command is run.
103 If the string begins with `^' and `shift-select-mode' is non-nil,
104 Emacs first calls the function `handle-shift-selection'.
105 You may use `@', `*', and `^' together. They are processed in the
106 order that they appear, before reading any arguments.
107
108 If MODES is present, it should be one or more mode names (symbols)
109 for which this command is applicable. This is so that `M-x TAB'
110 will be able to exclude this command from the list of completion
111 candidates if the current buffer's mode doesn't match the list.
112 Which commands are excluded from the list of completion
113 candidates based on this information is controlled by the value
114 of `read-extended-command-predicate', which see.
115
116 usage: (interactive &optional ARG-DESCRIPTOR &rest MODES) */
117 attributes: const)
118 (Lisp_Object args)
119 {
120 return Qnil;
121 }
122
123 /* Quotify EXP: if EXP is constant, return it.
124 If EXP is not constant, return (quote EXP). */
125 static Lisp_Object
126 quotify_arg (register Lisp_Object exp)
127 {
128 if (CONSP (exp)
129 || (SYMBOLP (exp)
130 && !NILP (exp) && !EQ (exp, Qt)))
131 return list2 (Qquote, exp);
132
133 return exp;
134 }
135
136 /* Modify EXP by quotifying each element (except the first). */
137 static Lisp_Object
138 quotify_args (Lisp_Object exp)
139 {
140 register Lisp_Object tail;
141 Lisp_Object next;
142 for (tail = exp; CONSP (tail); tail = next)
143 {
144 next = XCDR (tail);
145 XSETCAR (tail, quotify_arg (XCAR (tail)));
146 }
147 return exp;
148 }
149
150 static const char *callint_argfuns[]
151 = {"", "point", "mark", "region-beginning", "region-end"};
152
153 static void
154 check_mark (bool for_region)
155 {
156 Lisp_Object tem;
157 tem = Fmarker_buffer (BVAR (current_buffer, mark));
158 if (NILP (tem) || (XBUFFER (tem) != current_buffer))
159 error (for_region ? "The mark is not set now, so there is no region"
160 : "The mark is not set now");
161 if (!NILP (Vtransient_mark_mode) && NILP (Vmark_even_if_inactive)
162 && NILP (BVAR (current_buffer, mark_active)))
163 xsignal0 (Qmark_inactive);
164 }
165
166 /* If FUNCTION has an `interactive-args' spec, replace relevant
167 elements in VALUES with those forms instead.
168
169 This function doesn't return a value because it modifies elements
170 of VALUES to do its job. */
171
172 static void
173 fix_command (Lisp_Object function, Lisp_Object values)
174 {
175 /* Quick exit if there's no values to alter. */
176 if (!CONSP (values) || !SYMBOLP (function))
177 return;
178
179 Lisp_Object reps = Fget (function, Qinteractive_args);
180
181 if (CONSP (reps))
182 {
183 int i = 0;
184 Lisp_Object vals = values;
185
186 while (!NILP (vals))
187 {
188 Lisp_Object rep = Fassq (make_fixnum (i), reps);
189 if (!NILP (rep))
190 Fsetcar (vals, XCDR (rep));
191 vals = XCDR (vals);
192 ++i;
193 }
194 }
195
196 /* If the list contains a bunch of trailing nil values, and they are
197 optional, remove them from the list. This makes navigating the
198 history less confusing, since it doesn't contain a lot of
199 parameters that aren't used. */
200 Lisp_Object arity = Ffunc_arity (function);
201 /* We don't want to do this simplification if we have an &rest
202 function, because (cl-defun foo (a &optional (b 'zot)) ..)
203 etc. */
204 if (FIXNUMP (XCAR (arity)) && FIXNUMP (XCDR (arity)))
205 {
206 Lisp_Object final = Qnil;
207 ptrdiff_t final_i = 0, i = 0;
208 for (Lisp_Object tail = values;
209 CONSP (tail);
210 tail = XCDR (tail), ++i)
211 {
212 if (!NILP (XCAR (tail)))
213 {
214 final = tail;
215 final_i = i;
216 }
217 }
218
219 /* Chop the trailing optional values. */
220 if (final_i > 0 && final_i >= XFIXNUM (XCAR (arity)) - 1)
221 XSETCDR (final, Qnil);
222 }
223 }
224
225 /* Helper function to call `read-file-name' from C. */
226
227 static Lisp_Object
228 read_file_name (Lisp_Object default_filename, Lisp_Object mustmatch,
229 Lisp_Object initial, Lisp_Object predicate)
230 {
231 return CALLN (Ffuncall, intern ("read-file-name"),
232 callint_message, Qnil, default_filename,
233 mustmatch, initial, predicate);
234 }
235
236 /* BEWARE: Calling this directly from C would defeat the purpose! */
237 DEFUN ("funcall-interactively", Ffuncall_interactively, Sfuncall_interactively,
238 1, MANY, 0, doc: /* Like `funcall' but marks the call as interactive.
239 I.e. arrange that within the called function `called-interactively-p' will
240 return non-nil.
241 usage: (funcall-interactively FUNCTION &rest ARGUMENTS) */)
242 (ptrdiff_t nargs, Lisp_Object *args)
243 {
244 specpdl_ref speccount = SPECPDL_INDEX ();
245 temporarily_switch_to_single_kboard (NULL);
246
247 /* Nothing special to do here, all the work is inside
248 `called-interactively-p'. Which will look for us as a marker in the
249 backtrace. */
250 return unbind_to (speccount, Ffuncall (nargs, args));
251 }
252
253 DEFUN ("call-interactively", Fcall_interactively, Scall_interactively, 1, 3, 0,
254 doc: /* Call FUNCTION, providing args according to its interactive calling specs.
255 Return the value FUNCTION returns.
256 The function contains a specification of how to do the argument reading.
257 In the case of user-defined functions, this is specified by placing a call
258 to the function `interactive' at the top level of the function body.
259 See `interactive'.
260
261 Optional second arg RECORD-FLAG non-nil
262 means unconditionally put this command in the variable `command-history'.
263 Otherwise, this is done only if an arg is read using the minibuffer.
264
265 Optional third arg KEYS, if given, specifies the sequence of events to
266 supply, as a vector, if FUNCTION inquires which events were used to
267 invoke it (via an `interactive' spec that contains, for instance, an
268 \"e\" code letter). If KEYS is omitted or nil, the return value of
269 `this-command-keys-vector' is used. */)
270 (Lisp_Object function, Lisp_Object record_flag, Lisp_Object keys)
271 {
272 specpdl_ref speccount = SPECPDL_INDEX ();
273
274 bool arg_from_tty = false;
275 ptrdiff_t key_count;
276 bool record_then_fail = false;
277
278 Lisp_Object save_this_command = Vthis_command;
279 Lisp_Object save_this_original_command = Vthis_original_command;
280 Lisp_Object save_real_this_command = Vreal_this_command;
281 Lisp_Object save_last_command = KVAR (current_kboard, Vlast_command);
282
283 /* Bound recursively so that code can check the current command from
284 code running from minibuffer hooks (and the like), without being
285 overwritten by subsequent minibuffer calls. */
286 specbind (Qcurrent_minibuffer_command, Vthis_command);
287
288 if (NILP (keys))
289 keys = this_command_keys, key_count = this_command_key_count;
290 else
291 {
292 CHECK_VECTOR (keys);
293 key_count = ASIZE (keys);
294 }
295
296 /* Save this now, since use of minibuffer will clobber it. */
297 Lisp_Object prefix_arg = Vcurrent_prefix_arg;
298
299 Lisp_Object enable = (SYMBOLP (function)
300 ? Fget (function, Qenable_recursive_minibuffers)
301 : Qnil);
302
303 /* If k or K discard an up-event, save it here so it can be retrieved with
304 U. */
305 Lisp_Object up_event = Qnil;
306
307 /* Set SPECS to the interactive form, or barf if not interactive. */
308 Lisp_Object form = call1 (Qinteractive_form, function);
309 if (! CONSP (form))
310 wrong_type_argument (Qcommandp, function);
311 Lisp_Object specs = Fcar (XCDR (form));
312
313 /* At this point the value of SPECS could help provide a way to
314 specify how to represent the arguments in command history.
315 The feature is not fully implemented. */
316
317 /* If SPECS is not a string, invent one. */
318 if (! STRINGP (specs))
319 {
320 Lisp_Object funval = Findirect_function (function, Qt);
321 uintmax_t events = num_input_events;
322 /* Compute the arg values using the user's expression. */
323 specs = Feval (specs,
324 CONSP (funval) && EQ (Qclosure, XCAR (funval))
325 ? CAR_SAFE (XCDR (funval)) : Qnil);
326 if (events != num_input_events || !NILP (record_flag))
327 {
328 /* We should record this command on the command history.
329 Make a copy of the list of values, for the command history,
330 and turn them into things we can eval. */
331 Lisp_Object values = quotify_args (Fcopy_sequence (specs));
332 fix_command (function, values);
333 call4 (intern ("add-to-history"), intern ("command-history"),
334 Fcons (function, values), Qnil, Qt);
335 }
336
337 Vthis_command = save_this_command;
338 Vthis_original_command = save_this_original_command;
339 Vreal_this_command = save_real_this_command;
340 kset_last_command (current_kboard, save_last_command);
341
342 return unbind_to (speccount, CALLN (Fapply, Qfuncall_interactively,
343 function, specs));
344 }
345
346 /* SPECS is set to a string; use it as an interactive prompt.
347 Copy it so that STRING will be valid even if a GC relocates SPECS. */
348 USE_SAFE_ALLOCA;
349 ptrdiff_t string_len = SBYTES (specs);
350 char *string = SAFE_ALLOCA (string_len + 1);
351 memcpy (string, SDATA (specs), string_len + 1);
352 char *string_end = string + string_len;
353
354 /* The index of the next element of this_command_keys to examine for
355 the 'e' interactive code. Initialize it to point to the first
356 event with parameters. When `inhibit_mouse_event_check' is non-nil,
357 the command can accept an event without parameters,
358 so don't search for the event with parameters in this case. */
359 ptrdiff_t next_event = 0;
360 if (!inhibit_mouse_event_check)
361 for (; next_event < key_count; next_event++)
362 if (EVENT_HAS_PARAMETERS (AREF (keys, next_event)))
363 break;
364
365 /* Handle special starting chars `*' and `@'. Also `-'. */
366 /* Note that `+' is reserved for user extensions. */
367 for (;; string++)
368 {
369 if (*string == '+')
370 error ("`+' is not used in `interactive' for ordinary commands");
371 else if (*string == '*')
372 {
373 if (!NILP (BVAR (current_buffer, read_only)))
374 {
375 if (!NILP (record_flag))
376 {
377 for (char *p = string + 1; p < string_end; p++)
378 if (! (*p == 'r' || *p == 'p' || *p == 'P' || *p == '\n'))
379 Fbarf_if_buffer_read_only (Qnil);
380 record_then_fail = true;
381 }
382 else
383 Fbarf_if_buffer_read_only (Qnil);
384 }
385 }
386 /* Ignore this for semi-compatibility with Lucid. */
387 else if (*string == '-')
388 ;
389 else if (*string == '@')
390 {
391 Lisp_Object w, event = (next_event < key_count
392 ? AREF (keys, next_event)
393 : Qnil);
394 if (EVENT_HAS_PARAMETERS (event)
395 && (w = XCDR (event), CONSP (w))
396 && (w = XCAR (w), CONSP (w))
397 && (w = XCAR (w), WINDOWP (w)))
398 {
399 if (MINI_WINDOW_P (XWINDOW (w))
400 && ! (minibuf_level > 0 && BASE_EQ (w, minibuf_window)))
401 error ("Attempt to select inactive minibuffer window");
402
403 /* If the current buffer wants to clean up, let it. */
404 run_hook (Qmouse_leave_buffer_hook);
405
406 Fselect_window (w, Qnil);
407 }
408 }
409 else if (*string == '^')
410 call0 (Qhandle_shift_selection);
411 else break;
412 }
413
414 /* Count the number of arguments, which is two (the function itself and
415 `funcall-interactively') plus the number of arguments the interactive spec
416 would have us give to the function. */
417 ptrdiff_t nargs = 2;
418 for (char const *tem = string; tem < string_end; tem++)
419 {
420 /* 'r' specifications ("point and mark as 2 numeric args")
421 produce *two* arguments. */
422 nargs += 1 + (*tem == 'r');
423 tem = memchr (tem, '\n', string_len - (tem - string));
424 if (!tem)
425 break;
426 }
427
428 if (MOST_POSITIVE_FIXNUM < min (PTRDIFF_MAX, SIZE_MAX) / word_size
429 && MOST_POSITIVE_FIXNUM < nargs)
430 memory_full (SIZE_MAX);
431
432 /* ARGS will contain the array of arguments to pass to the function.
433 VISARGS will contain the same list but in a nicer form, so that if we
434 pass it to Fformat_message it will be understandable to a human.
435 Allocate them all at one go. This wastes a bit of memory, but
436 it's OK to trade space for speed. */
437 Lisp_Object *args;
438 SAFE_NALLOCA (args, 3, nargs);
439 Lisp_Object *visargs = args + nargs;
440 /* If varies[I] > 0, the Ith argument shouldn't just have its value
441 in this call quoted in the command history. It should be
442 recorded as a call to the function named callint_argfuns[varies[I]]. */
443 signed char *varies = (signed char *) (visargs + nargs);
444
445 memclear (args, nargs * (2 * word_size + 1));
446
447 if (!NILP (enable))
448 specbind (Qenable_recursive_minibuffers, Qt);
449
450 char const *tem = string;
451 for (ptrdiff_t i = 2; tem < string_end; i++)
452 {
453 char *pnl = memchr (tem + 1, '\n', string_len - (tem + 1 - string));
454 ptrdiff_t sz = pnl ? pnl - (tem + 1) : string_end - (tem + 1);
455
456 visargs[1] = make_string (tem + 1, sz);
457 callint_message = Fformat_message (i - 1, visargs + 1);
458
459 switch (*tem)
460 {
461 case 'a': /* Symbol defined as a function. */
462 visargs[i] = Fcompleting_read (callint_message,
463 Vobarray, Qfboundp, Qt,
464 Qnil, Qnil, Qnil, Qnil);
465 args[i] = Fintern (visargs[i], Qnil);
466 break;
467
468 case 'b': /* Name of existing buffer. */
469 args[i] = Fcurrent_buffer ();
470 if (BASE_EQ (selected_window, minibuf_window))
471 args[i] = Fother_buffer (args[i], Qnil, Qnil);
472 args[i] = Fread_buffer (callint_message, args[i], Qt, Qnil);
473 break;
474
475 case 'B': /* Name of buffer, possibly nonexistent. */
476 args[i] = Fread_buffer (callint_message,
477 Fother_buffer (Fcurrent_buffer (),
478 Qnil, Qnil),
479 Qnil, Qnil);
480 break;
481
482 case 'c': /* Character. */
483 /* Prompt in `minibuffer-prompt' face. */
484 Fput_text_property (make_fixnum (0),
485 make_fixnum (SCHARS (callint_message)),
486 Qface, Qminibuffer_prompt, callint_message);
487 args[i] = Fread_char (callint_message, Qnil, Qnil);
488 message1_nolog (0);
489 /* See bug#8479. */
490 if (! CHARACTERP (args[i]))
491 error ("Non-character input-event");
492 visargs[i] = Fchar_to_string (args[i]);
493 break;
494
495 case 'C': /* Command: symbol with interactive function. */
496 visargs[i] = Fcompleting_read (callint_message,
497 Vobarray, Qcommandp,
498 Qt, Qnil, Qnil, Qnil, Qnil);
499 args[i] = Fintern (visargs[i], Qnil);
500 break;
501
502 case 'd': /* Value of point. Does not do I/O. */
503 set_marker_both (point_marker, Qnil, PT, PT_BYTE);
504 args[i] = point_marker;
505 /* visargs[i] = Qnil; */
506 varies[i] = 1;
507 break;
508
509 case 'D': /* Directory name. */
510 args[i] = read_file_name (BVAR (current_buffer, directory), Qlambda,
511 Qnil, Qfile_directory_p);
512 break;
513
514 case 'f': /* Existing file name. */
515 args[i] = read_file_name (Qnil, Qlambda, Qnil, Qnil);
516 break;
517
518 case 'F': /* Possibly nonexistent file name. */
519 args[i] = read_file_name (Qnil, Qnil, Qnil, Qnil);
520 break;
521
522 case 'G': /* Possibly nonexistent file name,
523 default to directory alone. */
524 args[i] = read_file_name (Qnil, Qnil, empty_unibyte_string, Qnil);
525 break;
526
527 case 'i': /* Ignore an argument -- Does not do I/O. */
528 varies[i] = -1;
529 break;
530
531 case 'k': /* Key sequence. */
532 {
533 specpdl_ref speccount1 = SPECPDL_INDEX ();
534 specbind (Qcursor_in_echo_area, Qt);
535 /* Prompt in `minibuffer-prompt' face. */
536 Fput_text_property (make_fixnum (0),
537 make_fixnum (SCHARS (callint_message)),
538 Qface, Qminibuffer_prompt, callint_message);
539 args[i] = Fread_key_sequence (callint_message,
540 Qnil, Qnil, Qnil, Qnil,
541 Qnil);
542 unbind_to (speccount1, Qnil);
543 visargs[i] = Fkey_description (args[i], Qnil);
544
545 /* If the key sequence ends with a down-event,
546 discard the following up-event. */
547 Lisp_Object teml
548 = Faref (args[i], make_fixnum (XFIXNUM (Flength (args[i])) - 1));
549 if (CONSP (teml))
550 teml = XCAR (teml);
551 if (SYMBOLP (teml))
552 {
553 teml = Fget (teml, Qevent_symbol_elements);
554 /* Ignore first element, which is the base key. */
555 Lisp_Object tem2 = Fmemq (Qdown, Fcdr (teml));
556 if (! NILP (tem2))
557 up_event = Fread_event (Qnil, Qnil, Qnil);
558 }
559 }
560 break;
561
562 case 'K': /* Key sequence to be defined. */
563 {
564 specpdl_ref speccount1 = SPECPDL_INDEX ();
565 specbind (Qcursor_in_echo_area, Qt);
566 /* Prompt in `minibuffer-prompt' face. */
567 Fput_text_property (make_fixnum (0),
568 make_fixnum (SCHARS (callint_message)),
569 Qface, Qminibuffer_prompt, callint_message);
570 args[i] = Fread_key_sequence_vector (callint_message,
571 Qnil, Qt, Qnil, Qnil,
572 Qnil);
573 visargs[i] = Fkey_description (args[i], Qnil);
574 unbind_to (speccount1, Qnil);
575
576 /* If the key sequence ends with a down-event,
577 discard the following up-event. */
578 Lisp_Object teml
579 = Faref (args[i], make_fixnum (ASIZE (args[i]) - 1));
580 if (CONSP (teml))
581 teml = XCAR (teml);
582 if (SYMBOLP (teml))
583 {
584 teml = Fget (teml, Qevent_symbol_elements);
585 /* Ignore first element, which is the base key. */
586 Lisp_Object tem2 = Fmemq (Qdown, Fcdr (teml));
587 if (! NILP (tem2))
588 up_event = Fread_event (Qnil, Qnil, Qnil);
589 }
590 }
591 break;
592
593 case 'U': /* Up event from last k or K. */
594 if (!NILP (up_event))
595 {
596 args[i] = make_vector (1, up_event);
597 up_event = Qnil;
598 visargs[i] = Fkey_description (args[i], Qnil);
599 }
600 break;
601
602 case 'e': /* The invoking event. */
603 if (next_event >= key_count)
604 error ("%s must be bound to an event with parameters",
605 (SYMBOLP (function)
606 ? SSDATA (SYMBOL_NAME (function))
607 : "command"));
608 args[i] = AREF (keys, next_event);
609 varies[i] = -1;
610
611 /* `inhibit_mouse_event_check' allows non-parameterized events. */
612 if (inhibit_mouse_event_check)
613 next_event++;
614 else
615 /* Find the next parameterized event. */
616 do
617 next_event++;
618 while (next_event < key_count
619 && ! EVENT_HAS_PARAMETERS (AREF (keys, next_event)));
620
621 break;
622
623 case 'm': /* Value of mark. Does not do I/O. */
624 check_mark (false);
625 /* visargs[i] = Qnil; */
626 args[i] = BVAR (current_buffer, mark);
627 varies[i] = 2;
628 break;
629
630 case 'M': /* String read via minibuffer with
631 inheriting the current input method. */
632 args[i] = Fread_string (callint_message,
633 Qnil, Qnil, Qnil, Qt);
634 break;
635
636 case 'N': /* Prefix arg as number, else number from minibuffer. */
637 if (!NILP (prefix_arg))
638 goto have_prefix_arg;
639 FALLTHROUGH;
640 case 'n': /* Read number from minibuffer. */
641 args[i] = call1 (Qread_number, callint_message);
642 visargs[i] = Fnumber_to_string (args[i]);
643 break;
644
645 case 'P': /* Prefix arg in raw form. Does no I/O. */
646 args[i] = prefix_arg;
647 /* visargs[i] = Qnil; */
648 varies[i] = -1;
649 break;
650
651 case 'p': /* Prefix arg converted to number. No I/O. */
652 have_prefix_arg:
653 args[i] = Fprefix_numeric_value (prefix_arg);
654 /* visargs[i] = Qnil; */
655 varies[i] = -1;
656 break;
657
658 case 'r': /* Region, point and mark as 2 args. */
659 {
660 check_mark (true);
661 set_marker_both (point_marker, Qnil, PT, PT_BYTE);
662 ptrdiff_t mark = marker_position (BVAR (current_buffer, mark));
663 /* visargs[i] = visargs[i + 1] = Qnil; */
664 args[i] = PT < mark ? point_marker : BVAR (current_buffer, mark);
665 varies[i] = 3;
666 args[++i] = PT > mark ? point_marker : BVAR (current_buffer, mark);
667 varies[i] = 4;
668 }
669 break;
670
671 case 's': /* String read via minibuffer without
672 inheriting the current input method. */
673 args[i] = Fread_string (callint_message,
674 Qnil, Qnil, Qnil, Qnil);
675 break;
676
677 case 'S': /* Any symbol. */
678 visargs[i] = Fread_string (callint_message,
679 Qnil, Qnil, Qnil, Qnil);
680 args[i] = Fintern (visargs[i], Qnil);
681 break;
682
683 case 'v': /* Variable name: symbol that is
684 custom-variable-p. */
685 args[i] = Fread_variable (callint_message, Qnil);
686 visargs[i] = last_minibuf_string;
687 break;
688
689 case 'x': /* Lisp expression read but not evaluated. */
690 args[i] = call1 (intern ("read-minibuffer"), callint_message);
691 visargs[i] = last_minibuf_string;
692 break;
693
694 case 'X': /* Lisp expression read and evaluated. */
695 args[i] = call1 (intern ("eval-minibuffer"), callint_message);
696 visargs[i] = last_minibuf_string;
697 break;
698
699 case 'Z': /* Coding-system symbol, or ignore the
700 argument if no prefix. */
701 if (NILP (prefix_arg))
702 {
703 /* args[i] = Qnil; */
704 varies[i] = -1;
705 }
706 else
707 {
708 args[i]
709 = Fread_non_nil_coding_system (callint_message);
710 visargs[i] = last_minibuf_string;
711 }
712 break;
713
714 case 'z': /* Coding-system symbol or nil. */
715 args[i] = Fread_coding_system (callint_message, Qnil);
716 visargs[i] = last_minibuf_string;
717 break;
718
719 /* We have a case for `+' so we get an error
720 if anyone tries to define one here. */
721 case '+':
722 default:
723 {
724 /* How many bytes are left unprocessed in the specs string?
725 (Note that this excludes the trailing null byte.) */
726 ptrdiff_t bytes_left = string_len - (tem - string);
727 unsigned letter;
728
729 /* If we have enough bytes left to treat the sequence as a
730 character, show that character's codepoint; otherwise
731 show only its first byte. */
732 if (bytes_left >= BYTES_BY_CHAR_HEAD (*((unsigned char *) tem)))
733 letter = STRING_CHAR ((unsigned char *) tem);
734 else
735 letter = *((unsigned char *) tem);
736
737 error (("Invalid control letter `%c' (#o%03o, #x%04x)"
738 " in interactive calling string"),
739 (int) letter, letter, letter);
740 }
741 }
742
743 if (varies[i] == 0)
744 arg_from_tty = true;
745
746 if (NILP (visargs[i]) && STRINGP (args[i]))
747 visargs[i] = args[i];
748
749 tem = memchr (tem, '\n', string_len - (tem - string));
750 if (tem) tem++;
751 else tem = string_end;
752 }
753 unbind_to (speccount, Qnil);
754
755 maybe_quit ();
756
757 args[0] = Qfuncall_interactively;
758 args[1] = function;
759
760 if (arg_from_tty || !NILP (record_flag))
761 {
762 /* We don't need `visargs' any more, so let's recycle it since we need
763 an array of just the same size. */
764 visargs[1] = function;
765 for (ptrdiff_t i = 2; i < nargs; i++)
766 visargs[i] = (varies[i] > 0
767 ? list1 (intern (callint_argfuns[varies[i]]))
768 : quotify_arg (args[i]));
769 call4 (intern ("add-to-history"), intern ("command-history"),
770 Flist (nargs - 1, visargs + 1), Qnil, Qt);
771 }
772
773 /* If we used a marker to hold point, mark, or an end of the region,
774 temporarily, convert it to an integer now. */
775 for (ptrdiff_t i = 2; i < nargs; i++)
776 if (varies[i] >= 1 && varies[i] <= 4)
777 XSETINT (args[i], marker_position (args[i]));
778
779 if (record_then_fail)
780 Fbarf_if_buffer_read_only (Qnil);
781
782 Vthis_command = save_this_command;
783 Vthis_original_command = save_this_original_command;
784 Vreal_this_command = save_real_this_command;
785 kset_last_command (current_kboard, save_last_command);
786
787 specbind (Qcommand_debug_status, Qnil);
788
789 Lisp_Object val = Ffuncall (nargs, args);
790 return SAFE_FREE_UNBIND_TO (speccount, val);
791 }
792
793 DEFUN ("prefix-numeric-value", Fprefix_numeric_value, Sprefix_numeric_value,
794 1, 1, 0,
795 doc: /* Return numeric meaning of raw prefix argument RAW.
796 A raw prefix argument is what you get from `(interactive "P")'.
797 Its numeric meaning is what you would get from `(interactive "p")'. */)
798 (Lisp_Object raw)
799 {
800 Lisp_Object val;
801
802 if (NILP (raw))
803 XSETFASTINT (val, 1);
804 else if (EQ (raw, Qminus))
805 XSETINT (val, -1);
806 else if (CONSP (raw) && FIXNUMP (XCAR (raw)))
807 val = XCAR (raw);
808 else if (FIXNUMP (raw))
809 val = raw;
810 else
811 XSETFASTINT (val, 1);
812
813 return val;
814 }
815
816 void
817 syms_of_callint (void)
818 {
819 point_marker = Fmake_marker ();
820 staticpro (&point_marker);
821
822 callint_message = Qnil;
823 staticpro (&callint_message);
824
825 preserved_fns = pure_list (intern_c_string ("region-beginning"),
826 intern_c_string ("region-end"),
827 intern_c_string ("point"),
828 intern_c_string ("mark"));
829 staticpro (&preserved_fns);
830
831 DEFSYM (Qlist, "list");
832 DEFSYM (Qlet, "let");
833 DEFSYM (Qif, "if");
834 DEFSYM (Qwhen, "when");
835 DEFSYM (Qletx, "let*");
836 DEFSYM (Qsave_excursion, "save-excursion");
837 DEFSYM (Qprogn, "progn");
838 DEFSYM (Qminus, "-");
839 DEFSYM (Qplus, "+");
840 DEFSYM (Qhandle_shift_selection, "handle-shift-selection");
841 DEFSYM (Qread_number, "read-number");
842 DEFSYM (Qfuncall_interactively, "funcall-interactively");
843 DEFSYM (Qcommand_debug_status, "command-debug-status");
844 DEFSYM (Qenable_recursive_minibuffers, "enable-recursive-minibuffers");
845 DEFSYM (Qmouse_leave_buffer_hook, "mouse-leave-buffer-hook");
846
847 DEFVAR_KBOARD ("prefix-arg", Vprefix_arg,
848 doc: /* The value of the prefix argument for the next editing command.
849 It may be a number, or the symbol `-' for just a minus sign as arg,
850 or a list whose car is a number for just one or more C-u's
851 or nil if no argument has been specified.
852
853 You cannot examine this variable to find the argument for this command
854 since it has been set to nil by the time you can look.
855 Instead, you should use the variable `current-prefix-arg', although
856 normally commands can get this prefix argument with (interactive "P"). */);
857
858 DEFVAR_KBOARD ("last-prefix-arg", Vlast_prefix_arg,
859 doc: /* The value of the prefix argument for the previous editing command.
860 See `prefix-arg' for the meaning of the value. */);
861
862 DEFVAR_LISP ("current-prefix-arg", Vcurrent_prefix_arg,
863 doc: /* The value of the prefix argument for this editing command.
864 It may be a number, or the symbol `-' for just a minus sign as arg,
865 or a list whose car is a number for just one or more C-u's
866 or nil if no argument has been specified.
867 This is what `(interactive \"P\")' returns. */);
868 Vcurrent_prefix_arg = Qnil;
869
870 DEFVAR_LISP ("command-history", Vcommand_history,
871 doc: /* List of recent commands that read arguments from terminal.
872 Each command is represented as a form to evaluate.
873
874 Maximum length of the history list is determined by the value
875 of `history-length', which see. */);
876 Vcommand_history = Qnil;
877
878 DEFVAR_LISP ("command-debug-status", Vcommand_debug_status,
879 doc: /* Debugging status of current interactive command.
880 Bound each time `call-interactively' is called;
881 may be set by the debugger as a reminder for itself. */);
882 Vcommand_debug_status = Qnil;
883
884 DEFVAR_LISP ("mark-even-if-inactive", Vmark_even_if_inactive,
885 doc: /* Non-nil means you can use the mark even when inactive.
886 This option makes a difference in Transient Mark mode.
887 When the option is non-nil, deactivation of the mark
888 turns off region highlighting, but commands that use the mark
889 behave as if the mark were still active. */);
890 Vmark_even_if_inactive = Qt;
891
892 DEFVAR_LISP ("mouse-leave-buffer-hook", Vmouse_leave_buffer_hook,
893 doc: /* Hook run when the user mouse-clicks in a window.
894 It can be run both before and after switching windows, or even when
895 not actually switching windows.
896
897 Its purpose is to give temporary modes such as Isearch mode
898 a way to turn themselves off when a mouse command switches windows. */);
899 Vmouse_leave_buffer_hook = Qnil;
900
901 DEFVAR_BOOL ("inhibit-mouse-event-check", inhibit_mouse_event_check,
902 doc: /* Whether the interactive spec "e" requires a mouse gesture event.
903 If non-nil, `(interactive "e")' doesn't signal an error when the command
904 was invoked by an input event that is not a mouse gesture: a click, a drag,
905 etc. To create the event data when the input was some other event,
906 use `event-start', `event-end', and `event-click-count'. */);
907 inhibit_mouse_event_check = false;
908
909 defsubr (&Sinteractive);
910 defsubr (&Scall_interactively);
911 defsubr (&Sfuncall_interactively);
912 defsubr (&Sprefix_numeric_value);
913
914 DEFSYM (Qinteractive_args, "interactive-args");
915 }