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 unbind_to (speccount1, Qnil);
542 visargs[i] = Fkey_description (args[i], Qnil);
543
544 /* If the key sequence ends with a down-event,
545 discard the following up-event. */
546 Lisp_Object teml
547 = Faref (args[i], make_fixnum (XFIXNUM (Flength (args[i])) - 1));
548 if (CONSP (teml))
549 teml = XCAR (teml);
550 if (SYMBOLP (teml))
551 {
552 teml = Fget (teml, Qevent_symbol_elements);
553 /* Ignore first element, which is the base key. */
554 Lisp_Object tem2 = Fmemq (Qdown, Fcdr (teml));
555 if (! NILP (tem2))
556 up_event = Fread_event (Qnil, Qnil, Qnil);
557 }
558 }
559 break;
560
561 case 'K': /* Key sequence to be defined. */
562 {
563 specpdl_ref speccount1 = SPECPDL_INDEX ();
564 specbind (Qcursor_in_echo_area, Qt);
565 /* Prompt in `minibuffer-prompt' face. */
566 Fput_text_property (make_fixnum (0),
567 make_fixnum (SCHARS (callint_message)),
568 Qface, Qminibuffer_prompt, callint_message);
569 args[i] = Fread_key_sequence_vector (callint_message,
570 Qnil, Qt, Qnil, Qnil);
571 visargs[i] = Fkey_description (args[i], Qnil);
572 unbind_to (speccount1, Qnil);
573
574 /* If the key sequence ends with a down-event,
575 discard the following up-event. */
576 Lisp_Object teml
577 = Faref (args[i], make_fixnum (ASIZE (args[i]) - 1));
578 if (CONSP (teml))
579 teml = XCAR (teml);
580 if (SYMBOLP (teml))
581 {
582 teml = Fget (teml, Qevent_symbol_elements);
583 /* Ignore first element, which is the base key. */
584 Lisp_Object tem2 = Fmemq (Qdown, Fcdr (teml));
585 if (! NILP (tem2))
586 up_event = Fread_event (Qnil, Qnil, Qnil);
587 }
588 }
589 break;
590
591 case 'U': /* Up event from last k or K. */
592 if (!NILP (up_event))
593 {
594 args[i] = make_vector (1, up_event);
595 up_event = Qnil;
596 visargs[i] = Fkey_description (args[i], Qnil);
597 }
598 break;
599
600 case 'e': /* The invoking event. */
601 if (next_event >= key_count)
602 error ("%s must be bound to an event with parameters",
603 (SYMBOLP (function)
604 ? SSDATA (SYMBOL_NAME (function))
605 : "command"));
606 args[i] = AREF (keys, next_event);
607 varies[i] = -1;
608
609 /* `inhibit_mouse_event_check' allows non-parameterized events. */
610 if (inhibit_mouse_event_check)
611 next_event++;
612 else
613 /* Find the next parameterized event. */
614 do
615 next_event++;
616 while (next_event < key_count
617 && ! EVENT_HAS_PARAMETERS (AREF (keys, next_event)));
618
619 break;
620
621 case 'm': /* Value of mark. Does not do I/O. */
622 check_mark (false);
623 /* visargs[i] = Qnil; */
624 args[i] = BVAR (current_buffer, mark);
625 varies[i] = 2;
626 break;
627
628 case 'M': /* String read via minibuffer with
629 inheriting the current input method. */
630 args[i] = Fread_string (callint_message,
631 Qnil, Qnil, Qnil, Qt);
632 break;
633
634 case 'N': /* Prefix arg as number, else number from minibuffer. */
635 if (!NILP (prefix_arg))
636 goto have_prefix_arg;
637 FALLTHROUGH;
638 case 'n': /* Read number from minibuffer. */
639 args[i] = call1 (Qread_number, callint_message);
640 visargs[i] = Fnumber_to_string (args[i]);
641 break;
642
643 case 'P': /* Prefix arg in raw form. Does no I/O. */
644 args[i] = prefix_arg;
645 /* visargs[i] = Qnil; */
646 varies[i] = -1;
647 break;
648
649 case 'p': /* Prefix arg converted to number. No I/O. */
650 have_prefix_arg:
651 args[i] = Fprefix_numeric_value (prefix_arg);
652 /* visargs[i] = Qnil; */
653 varies[i] = -1;
654 break;
655
656 case 'r': /* Region, point and mark as 2 args. */
657 {
658 check_mark (true);
659 set_marker_both (point_marker, Qnil, PT, PT_BYTE);
660 ptrdiff_t mark = marker_position (BVAR (current_buffer, mark));
661 /* visargs[i] = visargs[i + 1] = Qnil; */
662 args[i] = PT < mark ? point_marker : BVAR (current_buffer, mark);
663 varies[i] = 3;
664 args[++i] = PT > mark ? point_marker : BVAR (current_buffer, mark);
665 varies[i] = 4;
666 }
667 break;
668
669 case 's': /* String read via minibuffer without
670 inheriting the current input method. */
671 args[i] = Fread_string (callint_message,
672 Qnil, Qnil, Qnil, Qnil);
673 break;
674
675 case 'S': /* Any symbol. */
676 visargs[i] = Fread_string (callint_message,
677 Qnil, Qnil, Qnil, Qnil);
678 args[i] = Fintern (visargs[i], Qnil);
679 break;
680
681 case 'v': /* Variable name: symbol that is
682 custom-variable-p. */
683 args[i] = Fread_variable (callint_message, Qnil);
684 visargs[i] = last_minibuf_string;
685 break;
686
687 case 'x': /* Lisp expression read but not evaluated. */
688 args[i] = call1 (intern ("read-minibuffer"), callint_message);
689 visargs[i] = last_minibuf_string;
690 break;
691
692 case 'X': /* Lisp expression read and evaluated. */
693 args[i] = call1 (intern ("eval-minibuffer"), callint_message);
694 visargs[i] = last_minibuf_string;
695 break;
696
697 case 'Z': /* Coding-system symbol, or ignore the
698 argument if no prefix. */
699 if (NILP (prefix_arg))
700 {
701 /* args[i] = Qnil; */
702 varies[i] = -1;
703 }
704 else
705 {
706 args[i]
707 = Fread_non_nil_coding_system (callint_message);
708 visargs[i] = last_minibuf_string;
709 }
710 break;
711
712 case 'z': /* Coding-system symbol or nil. */
713 args[i] = Fread_coding_system (callint_message, Qnil);
714 visargs[i] = last_minibuf_string;
715 break;
716
717 /* We have a case for `+' so we get an error
718 if anyone tries to define one here. */
719 case '+':
720 default:
721 {
722 /* How many bytes are left unprocessed in the specs string?
723 (Note that this excludes the trailing null byte.) */
724 ptrdiff_t bytes_left = string_len - (tem - string);
725 unsigned letter;
726
727 /* If we have enough bytes left to treat the sequence as a
728 character, show that character's codepoint; otherwise
729 show only its first byte. */
730 if (bytes_left >= BYTES_BY_CHAR_HEAD (*((unsigned char *) tem)))
731 letter = STRING_CHAR ((unsigned char *) tem);
732 else
733 letter = *((unsigned char *) tem);
734
735 error (("Invalid control letter `%c' (#o%03o, #x%04x)"
736 " in interactive calling string"),
737 (int) letter, letter, letter);
738 }
739 }
740
741 if (varies[i] == 0)
742 arg_from_tty = true;
743
744 if (NILP (visargs[i]) && STRINGP (args[i]))
745 visargs[i] = args[i];
746
747 tem = memchr (tem, '\n', string_len - (tem - string));
748 if (tem) tem++;
749 else tem = string_end;
750 }
751 unbind_to (speccount, Qnil);
752
753 maybe_quit ();
754
755 args[0] = Qfuncall_interactively;
756 args[1] = function;
757
758 if (arg_from_tty || !NILP (record_flag))
759 {
760 /* We don't need `visargs' any more, so let's recycle it since we need
761 an array of just the same size. */
762 visargs[1] = function;
763 for (ptrdiff_t i = 2; i < nargs; i++)
764 visargs[i] = (varies[i] > 0
765 ? list1 (intern (callint_argfuns[varies[i]]))
766 : quotify_arg (args[i]));
767 call4 (intern ("add-to-history"), intern ("command-history"),
768 Flist (nargs - 1, visargs + 1), Qnil, Qt);
769 }
770
771 /* If we used a marker to hold point, mark, or an end of the region,
772 temporarily, convert it to an integer now. */
773 for (ptrdiff_t i = 2; i < nargs; i++)
774 if (varies[i] >= 1 && varies[i] <= 4)
775 XSETINT (args[i], marker_position (args[i]));
776
777 if (record_then_fail)
778 Fbarf_if_buffer_read_only (Qnil);
779
780 Vthis_command = save_this_command;
781 Vthis_original_command = save_this_original_command;
782 Vreal_this_command = save_real_this_command;
783 kset_last_command (current_kboard, save_last_command);
784
785 specbind (Qcommand_debug_status, Qnil);
786
787 Lisp_Object val = Ffuncall (nargs, args);
788 return SAFE_FREE_UNBIND_TO (speccount, val);
789 }
790
791 DEFUN ("prefix-numeric-value", Fprefix_numeric_value, Sprefix_numeric_value,
792 1, 1, 0,
793 doc: /* Return numeric meaning of raw prefix argument RAW.
794 A raw prefix argument is what you get from `(interactive "P")'.
795 Its numeric meaning is what you would get from `(interactive "p")'. */)
796 (Lisp_Object raw)
797 {
798 Lisp_Object val;
799
800 if (NILP (raw))
801 XSETFASTINT (val, 1);
802 else if (EQ (raw, Qminus))
803 XSETINT (val, -1);
804 else if (CONSP (raw) && FIXNUMP (XCAR (raw)))
805 val = XCAR (raw);
806 else if (FIXNUMP (raw))
807 val = raw;
808 else
809 XSETFASTINT (val, 1);
810
811 return val;
812 }
813
814 void
815 syms_of_callint (void)
816 {
817 point_marker = Fmake_marker ();
818 staticpro (&point_marker);
819
820 callint_message = Qnil;
821 staticpro (&callint_message);
822
823 preserved_fns = pure_list (intern_c_string ("region-beginning"),
824 intern_c_string ("region-end"),
825 intern_c_string ("point"),
826 intern_c_string ("mark"));
827 staticpro (&preserved_fns);
828
829 DEFSYM (Qlist, "list");
830 DEFSYM (Qlet, "let");
831 DEFSYM (Qif, "if");
832 DEFSYM (Qwhen, "when");
833 DEFSYM (Qletx, "let*");
834 DEFSYM (Qsave_excursion, "save-excursion");
835 DEFSYM (Qprogn, "progn");
836 DEFSYM (Qminus, "-");
837 DEFSYM (Qplus, "+");
838 DEFSYM (Qhandle_shift_selection, "handle-shift-selection");
839 DEFSYM (Qread_number, "read-number");
840 DEFSYM (Qfuncall_interactively, "funcall-interactively");
841 DEFSYM (Qcommand_debug_status, "command-debug-status");
842 DEFSYM (Qenable_recursive_minibuffers, "enable-recursive-minibuffers");
843 DEFSYM (Qmouse_leave_buffer_hook, "mouse-leave-buffer-hook");
844
845 DEFVAR_KBOARD ("prefix-arg", Vprefix_arg,
846 doc: /* The value of the prefix argument for the next editing command.
847 It may be a number, or the symbol `-' for just a minus sign as arg,
848 or a list whose car is a number for just one or more C-u's
849 or nil if no argument has been specified.
850
851 You cannot examine this variable to find the argument for this command
852 since it has been set to nil by the time you can look.
853 Instead, you should use the variable `current-prefix-arg', although
854 normally commands can get this prefix argument with (interactive "P"). */);
855
856 DEFVAR_KBOARD ("last-prefix-arg", Vlast_prefix_arg,
857 doc: /* The value of the prefix argument for the previous editing command.
858 See `prefix-arg' for the meaning of the value. */);
859
860 DEFVAR_LISP ("current-prefix-arg", Vcurrent_prefix_arg,
861 doc: /* The value of the prefix argument for this editing command.
862 It may be a number, or the symbol `-' for just a minus sign as arg,
863 or a list whose car is a number for just one or more C-u's
864 or nil if no argument has been specified.
865 This is what `(interactive \"P\")' returns. */);
866 Vcurrent_prefix_arg = Qnil;
867
868 DEFVAR_LISP ("command-history", Vcommand_history,
869 doc: /* List of recent commands that read arguments from terminal.
870 Each command is represented as a form to evaluate.
871
872 Maximum length of the history list is determined by the value
873 of `history-length', which see. */);
874 Vcommand_history = Qnil;
875
876 DEFVAR_LISP ("command-debug-status", Vcommand_debug_status,
877 doc: /* Debugging status of current interactive command.
878 Bound each time `call-interactively' is called;
879 may be set by the debugger as a reminder for itself. */);
880 Vcommand_debug_status = Qnil;
881
882 DEFVAR_LISP ("mark-even-if-inactive", Vmark_even_if_inactive,
883 doc: /* Non-nil means you can use the mark even when inactive.
884 This option makes a difference in Transient Mark mode.
885 When the option is non-nil, deactivation of the mark
886 turns off region highlighting, but commands that use the mark
887 behave as if the mark were still active. */);
888 Vmark_even_if_inactive = Qt;
889
890 DEFVAR_LISP ("mouse-leave-buffer-hook", Vmouse_leave_buffer_hook,
891 doc: /* Hook run when the user mouse-clicks in a window.
892 It can be run both before and after switching windows, or even when
893 not actually switching windows.
894
895 Its purpose is to give temporary modes such as Isearch mode
896 a way to turn themselves off when a mouse command switches windows. */);
897 Vmouse_leave_buffer_hook = Qnil;
898
899 DEFVAR_BOOL ("inhibit-mouse-event-check", inhibit_mouse_event_check,
900 doc: /* Whether the interactive spec "e" requires a mouse gesture event.
901 If non-nil, `(interactive "e")' doesn't signal an error when the command
902 was invoked by an input event that is not a mouse gesture: a click, a drag,
903 etc. To create the event data when the input was some other event,
904 use `event-start', `event-end', and `event-click-count'. */);
905 inhibit_mouse_event_check = false;
906
907 defsubr (&Sinteractive);
908 defsubr (&Scall_interactively);
909 defsubr (&Sfuncall_interactively);
910 defsubr (&Sprefix_numeric_value);
911
912 DEFSYM (Qinteractive_args, "interactive-args");
913 }