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