]> code.delx.au - gnu-emacs/blob - src/callint.c
Merge from trunk.
[gnu-emacs] / src / callint.c
1 /* Call a Lisp function interactively.
2 Copyright (C) 1985-1986, 1993-1995, 1997, 2000-2011
3 Free Software 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 #include <setjmp.h>
23
24 #include "lisp.h"
25 #include "buffer.h"
26 #include "commands.h"
27 #include "keyboard.h"
28 #include "window.h"
29 #include "keymap.h"
30 #include "character.h"
31
32 Lisp_Object Qminus, Qplus;
33 Lisp_Object Qcall_interactively;
34 static Lisp_Object Qcommand_debug_status;
35 static Lisp_Object Qenable_recursive_minibuffers;
36
37 static Lisp_Object Qhandle_shift_selection;
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 user-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 Fcons (Qquote, Fcons (exp, Qnil));
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 (int 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 = Fcar (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 Lisp_Object *args, *visargs;
255 Lisp_Object specs;
256 Lisp_Object filter_specs;
257 Lisp_Object teml;
258 Lisp_Object up_event;
259 Lisp_Object enable;
260 ptrdiff_t speccount = SPECPDL_INDEX ();
261
262 /* The index of the next element of this_command_keys to examine for
263 the 'e' interactive code. */
264 ptrdiff_t next_event;
265
266 Lisp_Object prefix_arg;
267 char *string;
268 const char *tem;
269
270 /* If varies[i] > 0, the i'th argument shouldn't just have its value
271 in this call quoted in the command history. It should be
272 recorded as a call to the function named callint_argfuns[varies[i]]. */
273 signed char *varies;
274
275 ptrdiff_t i, nargs;
276 int foo;
277 char prompt1[100];
278 char *tem1;
279 int arg_from_tty = 0;
280 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
281 ptrdiff_t key_count;
282 int record_then_fail = 0;
283
284 Lisp_Object save_this_command, save_last_command;
285 Lisp_Object save_this_original_command, save_real_this_command;
286
287 save_this_command = Vthis_command;
288 save_this_original_command = Vthis_original_command;
289 save_real_this_command = real_this_command;
290 save_last_command = KVAR (current_kboard, Vlast_command);
291
292 if (NILP (keys))
293 keys = this_command_keys, key_count = this_command_key_count;
294 else
295 {
296 CHECK_VECTOR (keys);
297 key_count = ASIZE (keys);
298 }
299
300 /* Save this now, since use of minibuffer will clobber it. */
301 prefix_arg = Vcurrent_prefix_arg;
302
303 if (SYMBOLP (function))
304 enable = Fget (function, Qenable_recursive_minibuffers);
305 else
306 enable = Qnil;
307
308 specs = Qnil;
309 string = 0;
310 /* The idea of FILTER_SPECS is to provide away to
311 specify how to represent the arguments in command history.
312 The feature is not fully implemented. */
313 filter_specs = Qnil;
314
315 /* If k or K discard an up-event, save it here so it can be retrieved with U */
316 up_event = Qnil;
317
318 /* Set SPECS to the interactive form, or barf if not interactive. */
319 {
320 Lisp_Object form;
321 GCPRO2 (function, prefix_arg);
322 form = Finteractive_form (function);
323 UNGCPRO;
324 if (CONSP (form))
325 specs = filter_specs = Fcar (XCDR (form));
326 else
327 wrong_type_argument (Qcommandp, function);
328 }
329
330 /* If SPECS is set to a string, use it as an interactive prompt. */
331 if (STRINGP (specs))
332 {
333 /* Make a copy of string so that if a GC relocates specs,
334 `string' will still be valid. */
335 string = (char *) alloca (SBYTES (specs) + 1);
336 memcpy (string, SSDATA (specs), SBYTES (specs) + 1);
337 }
338 else
339 {
340 Lisp_Object input;
341 Lisp_Object funval = Findirect_function (function, Qt);
342 uintmax_t events = num_input_events;
343 input = specs;
344 /* Compute the arg values using the user's expression. */
345 GCPRO2 (input, filter_specs);
346 specs = Feval (specs,
347 CONSP (funval) && EQ (Qclosure, XCAR (funval))
348 ? Qt : Qnil);
349 UNGCPRO;
350 if (events != num_input_events || !NILP (record_flag))
351 {
352 /* We should record this command on the command history. */
353 Lisp_Object values;
354 Lisp_Object this_cmd;
355 /* Make a copy of the list of values, for the command history,
356 and turn them into things we can eval. */
357 values = quotify_args (Fcopy_sequence (specs));
358 fix_command (input, values);
359 this_cmd = Fcons (function, values);
360 if (history_delete_duplicates)
361 Vcommand_history = Fdelete (this_cmd, Vcommand_history);
362 Vcommand_history = Fcons (this_cmd, Vcommand_history);
363
364 /* Don't keep command history around forever. */
365 if (INTEGERP (Vhistory_length) && XINT (Vhistory_length) > 0)
366 {
367 teml = Fnthcdr (Vhistory_length, Vcommand_history);
368 if (CONSP (teml))
369 XSETCDR (teml, Qnil);
370 }
371 }
372
373 Vthis_command = save_this_command;
374 Vthis_original_command = save_this_original_command;
375 real_this_command= save_real_this_command;
376 KVAR (current_kboard, Vlast_command) = save_last_command;
377
378 temporarily_switch_to_single_kboard (NULL);
379 return unbind_to (speccount, apply1 (function, specs));
380 }
381
382 /* Here if function specifies a string to control parsing the defaults */
383
384 /* Set next_event to point to the first event with parameters. */
385 for (next_event = 0; next_event < key_count; next_event++)
386 if (EVENT_HAS_PARAMETERS (AREF (keys, next_event)))
387 break;
388
389 /* Handle special starting chars `*' and `@'. Also `-'. */
390 /* Note that `+' is reserved for user extensions. */
391 while (1)
392 {
393 if (*string == '+')
394 error ("`+' is not used in `interactive' for ordinary commands");
395 else if (*string == '*')
396 {
397 string++;
398 if (!NILP (BVAR (current_buffer, read_only)))
399 {
400 if (!NILP (record_flag))
401 {
402 char *p = string;
403 while (*p)
404 {
405 if (! (*p == 'r' || *p == 'p' || *p == 'P'
406 || *p == '\n'))
407 Fbarf_if_buffer_read_only ();
408 p++;
409 }
410 record_then_fail = 1;
411 }
412 else
413 Fbarf_if_buffer_read_only ();
414 }
415 }
416 /* Ignore this for semi-compatibility with Lucid. */
417 else if (*string == '-')
418 string++;
419 else if (*string == '@')
420 {
421 Lisp_Object event, w;
422
423 event = (next_event < key_count
424 ? AREF (keys, next_event)
425 : Qnil);
426 if (EVENT_HAS_PARAMETERS (event)
427 && (w = XCDR (event), CONSP (w))
428 && (w = XCAR (w), CONSP (w))
429 && (w = XCAR (w), WINDOWP (w)))
430 {
431 if (MINI_WINDOW_P (XWINDOW (w))
432 && ! (minibuf_level > 0 && EQ (w, minibuf_window)))
433 error ("Attempt to select inactive minibuffer window");
434
435 /* If the current buffer wants to clean up, let it. */
436 Frun_hooks (1, &Qmouse_leave_buffer_hook);
437
438 Fselect_window (w, Qnil);
439 }
440 string++;
441 }
442 else if (*string == '^')
443 {
444 call0 (Qhandle_shift_selection);
445 string++;
446 }
447 else break;
448 }
449
450 /* Count the number of arguments, which is one plus the number of arguments
451 the interactive spec would have us give to the function. */
452 tem = string;
453 for (nargs = 1; *tem; )
454 {
455 /* 'r' specifications ("point and mark as 2 numeric args")
456 produce *two* arguments. */
457 if (*tem == 'r')
458 nargs += 2;
459 else
460 nargs++;
461 tem = strchr (tem, '\n');
462 if (tem)
463 ++tem;
464 else
465 break;
466 }
467
468 if (min (MOST_POSITIVE_FIXNUM,
469 min (PTRDIFF_MAX, SIZE_MAX) / sizeof (Lisp_Object))
470 < nargs)
471 memory_full (SIZE_MAX);
472
473 args = (Lisp_Object *) alloca (nargs * sizeof (Lisp_Object));
474 visargs = (Lisp_Object *) alloca (nargs * sizeof (Lisp_Object));
475 varies = (signed char *) alloca (nargs);
476
477 for (i = 0; i < nargs; i++)
478 {
479 args[i] = Qnil;
480 visargs[i] = Qnil;
481 varies[i] = 0;
482 }
483
484 GCPRO5 (prefix_arg, function, *args, *visargs, up_event);
485 gcpro3.nvars = nargs;
486 gcpro4.nvars = nargs;
487
488 if (!NILP (enable))
489 specbind (Qenable_recursive_minibuffers, Qt);
490
491 tem = string;
492 for (i = 1; *tem; i++)
493 {
494 strncpy (prompt1, tem + 1, sizeof prompt1 - 1);
495 prompt1[sizeof prompt1 - 1] = 0;
496 tem1 = strchr (prompt1, '\n');
497 if (tem1) *tem1 = 0;
498
499 visargs[0] = build_string (prompt1);
500 if (strchr (prompt1, '%'))
501 callint_message = Fformat (i, visargs);
502 else
503 callint_message = visargs[0];
504
505 switch (*tem)
506 {
507 case 'a': /* Symbol defined as a function */
508 visargs[i] = Fcompleting_read (callint_message,
509 Vobarray, Qfboundp, Qt,
510 Qnil, Qnil, Qnil, Qnil);
511 /* Passing args[i] directly stimulates compiler bug */
512 teml = visargs[i];
513 args[i] = Fintern (teml, Qnil);
514 break;
515
516 case 'b': /* Name of existing buffer */
517 args[i] = Fcurrent_buffer ();
518 if (EQ (selected_window, minibuf_window))
519 args[i] = Fother_buffer (args[i], Qnil, Qnil);
520 args[i] = Fread_buffer (callint_message, args[i], Qt);
521 break;
522
523 case 'B': /* Name of buffer, possibly nonexistent */
524 args[i] = Fread_buffer (callint_message,
525 Fother_buffer (Fcurrent_buffer (), Qnil, Qnil),
526 Qnil);
527 break;
528
529 case 'c': /* Character */
530 /* Prompt in `minibuffer-prompt' face. */
531 Fput_text_property (make_number (0),
532 make_number (SCHARS (callint_message)),
533 Qface, Qminibuffer_prompt, callint_message);
534 args[i] = Fread_char (callint_message, Qnil, Qnil);
535 message1_nolog ((char *) 0);
536 /* Passing args[i] directly stimulates compiler bug */
537 teml = args[i];
538 /* See bug#8479. */
539 if (! CHARACTERP (teml)) error ("Non-character input-event");
540 visargs[i] = Fchar_to_string (teml);
541 break;
542
543 case 'C': /* Command: symbol with interactive function */
544 visargs[i] = Fcompleting_read (callint_message,
545 Vobarray, Qcommandp,
546 Qt, Qnil, Qnil, Qnil, Qnil);
547 /* Passing args[i] directly stimulates compiler bug */
548 teml = visargs[i];
549 args[i] = Fintern (teml, Qnil);
550 break;
551
552 case 'd': /* Value of point. Does not do I/O. */
553 set_marker_both (point_marker, Qnil, PT, PT_BYTE);
554 args[i] = point_marker;
555 /* visargs[i] = Qnil; */
556 varies[i] = 1;
557 break;
558
559 case 'D': /* Directory name. */
560 args[i] = Fread_file_name (callint_message, Qnil,
561 BVAR (current_buffer, directory), Qlambda, Qnil,
562 Qfile_directory_p);
563 break;
564
565 case 'f': /* Existing file name. */
566 args[i] = Fread_file_name (callint_message,
567 Qnil, Qnil, Qlambda, Qnil, Qnil);
568 break;
569
570 case 'F': /* Possibly nonexistent file name. */
571 args[i] = Fread_file_name (callint_message,
572 Qnil, Qnil, Qnil, Qnil, Qnil);
573 break;
574
575 case 'G': /* Possibly nonexistent file name,
576 default to directory alone. */
577 args[i] = Fread_file_name (callint_message,
578 Qnil, Qnil, Qnil, empty_unibyte_string, Qnil);
579 break;
580
581 case 'i': /* Ignore an argument -- Does not do I/O */
582 varies[i] = -1;
583 break;
584
585 case 'k': /* Key sequence. */
586 {
587 ptrdiff_t speccount1 = SPECPDL_INDEX ();
588 specbind (Qcursor_in_echo_area, Qt);
589 /* Prompt in `minibuffer-prompt' face. */
590 Fput_text_property (make_number (0),
591 make_number (SCHARS (callint_message)),
592 Qface, Qminibuffer_prompt, callint_message);
593 args[i] = Fread_key_sequence (callint_message,
594 Qnil, Qnil, Qnil, Qnil);
595 unbind_to (speccount1, Qnil);
596 teml = args[i];
597 visargs[i] = Fkey_description (teml, Qnil);
598
599 /* If the key sequence ends with a down-event,
600 discard the following up-event. */
601 teml = Faref (args[i], make_number (XINT (Flength (args[i])) - 1));
602 if (CONSP (teml))
603 teml = XCAR (teml);
604 if (SYMBOLP (teml))
605 {
606 Lisp_Object tem2;
607
608 teml = Fget (teml, intern ("event-symbol-elements"));
609 /* Ignore first element, which is the base key. */
610 tem2 = Fmemq (intern ("down"), Fcdr (teml));
611 if (! NILP (tem2))
612 up_event = Fread_event (Qnil, Qnil, Qnil);
613 }
614 }
615 break;
616
617 case 'K': /* Key sequence to be defined. */
618 {
619 ptrdiff_t speccount1 = SPECPDL_INDEX ();
620 specbind (Qcursor_in_echo_area, Qt);
621 /* Prompt in `minibuffer-prompt' face. */
622 Fput_text_property (make_number (0),
623 make_number (SCHARS (callint_message)),
624 Qface, Qminibuffer_prompt, callint_message);
625 args[i] = Fread_key_sequence (callint_message,
626 Qnil, Qt, Qnil, Qnil);
627 teml = args[i];
628 visargs[i] = Fkey_description (teml, Qnil);
629 unbind_to (speccount1, Qnil);
630
631 /* If the key sequence ends with a down-event,
632 discard the following up-event. */
633 teml = Faref (args[i], make_number (XINT (Flength (args[i])) - 1));
634 if (CONSP (teml))
635 teml = XCAR (teml);
636 if (SYMBOLP (teml))
637 {
638 Lisp_Object tem2;
639
640 teml = Fget (teml, intern ("event-symbol-elements"));
641 /* Ignore first element, which is the base key. */
642 tem2 = Fmemq (intern ("down"), Fcdr (teml));
643 if (! NILP (tem2))
644 up_event = Fread_event (Qnil, Qnil, Qnil);
645 }
646 }
647 break;
648
649 case 'U': /* Up event from last k or K */
650 if (!NILP (up_event))
651 {
652 args[i] = Fmake_vector (make_number (1), up_event);
653 up_event = Qnil;
654 teml = args[i];
655 visargs[i] = Fkey_description (teml, Qnil);
656 }
657 break;
658
659 case 'e': /* The invoking event. */
660 if (next_event >= key_count)
661 error ("%s must be bound to an event with parameters",
662 (SYMBOLP (function)
663 ? SSDATA (SYMBOL_NAME (function))
664 : "command"));
665 args[i] = AREF (keys, next_event);
666 next_event++;
667 varies[i] = -1;
668
669 /* Find the next parameterized event. */
670 while (next_event < key_count
671 && !(EVENT_HAS_PARAMETERS (AREF (keys, next_event))))
672 next_event++;
673
674 break;
675
676 case 'm': /* Value of mark. Does not do I/O. */
677 check_mark (0);
678 /* visargs[i] = Qnil; */
679 args[i] = BVAR (current_buffer, mark);
680 varies[i] = 2;
681 break;
682
683 case 'M': /* String read via minibuffer with
684 inheriting the current input method. */
685 args[i] = Fread_string (callint_message,
686 Qnil, Qnil, Qnil, Qt);
687 break;
688
689 case 'N': /* Prefix arg as number, else number from minibuffer */
690 if (!NILP (prefix_arg))
691 goto have_prefix_arg;
692 case 'n': /* Read number from minibuffer. */
693 {
694 int first = 1;
695 do
696 {
697 Lisp_Object str;
698 if (! first)
699 {
700 message ("Please enter a number.");
701 sit_for (make_number (1), 0, 0);
702 }
703 first = 0;
704
705 str = Fread_from_minibuffer (callint_message,
706 Qnil, Qnil, Qnil, Qnil, Qnil,
707 Qnil);
708 if (! STRINGP (str) || SCHARS (str) == 0)
709 args[i] = Qnil;
710 else
711 args[i] = Fread (str);
712 }
713 while (! NUMBERP (args[i]));
714 }
715 visargs[i] = args[i];
716 break;
717
718 case 'P': /* Prefix arg in raw form. Does no I/O. */
719 args[i] = prefix_arg;
720 /* visargs[i] = Qnil; */
721 varies[i] = -1;
722 break;
723
724 case 'p': /* Prefix arg converted to number. No I/O. */
725 have_prefix_arg:
726 args[i] = Fprefix_numeric_value (prefix_arg);
727 /* visargs[i] = Qnil; */
728 varies[i] = -1;
729 break;
730
731 case 'r': /* Region, point and mark as 2 args. */
732 check_mark (1);
733 set_marker_both (point_marker, Qnil, PT, PT_BYTE);
734 /* visargs[i+1] = Qnil; */
735 foo = marker_position (BVAR (current_buffer, mark));
736 /* visargs[i] = Qnil; */
737 args[i] = PT < foo ? point_marker : BVAR (current_buffer, mark);
738 varies[i] = 3;
739 args[++i] = PT > foo ? point_marker : BVAR (current_buffer, mark);
740 varies[i] = 4;
741 break;
742
743 case 's': /* String read via minibuffer without
744 inheriting the current input method. */
745 args[i] = Fread_string (callint_message,
746 Qnil, Qnil, Qnil, Qnil);
747 break;
748
749 case 'S': /* Any symbol. */
750 visargs[i] = Fread_string (callint_message,
751 Qnil, Qnil, Qnil, Qnil);
752 /* Passing args[i] directly stimulates compiler bug */
753 teml = visargs[i];
754 args[i] = Fintern (teml, Qnil);
755 break;
756
757 case 'v': /* Variable name: symbol that is
758 user-variable-p. */
759 args[i] = Fread_variable (callint_message, Qnil);
760 visargs[i] = last_minibuf_string;
761 break;
762
763 case 'x': /* Lisp expression read but not evaluated */
764 args[i] = Fread_minibuffer (callint_message, Qnil);
765 visargs[i] = last_minibuf_string;
766 break;
767
768 case 'X': /* Lisp expression read and evaluated */
769 args[i] = Feval_minibuffer (callint_message, Qnil);
770 visargs[i] = last_minibuf_string;
771 break;
772
773 case 'Z': /* Coding-system symbol, or ignore the
774 argument if no prefix */
775 if (NILP (prefix_arg))
776 {
777 args[i] = Qnil;
778 varies[i] = -1;
779 }
780 else
781 {
782 args[i]
783 = Fread_non_nil_coding_system (callint_message);
784 visargs[i] = last_minibuf_string;
785 }
786 break;
787
788 case 'z': /* Coding-system symbol or nil */
789 args[i] = Fread_coding_system (callint_message, Qnil);
790 visargs[i] = last_minibuf_string;
791 break;
792
793 /* We have a case for `+' so we get an error
794 if anyone tries to define one here. */
795 case '+':
796 default:
797 error ("Invalid control letter `%c' (#o%03o, #x%04x) in interactive calling string",
798 STRING_CHAR ((unsigned char *) tem),
799 (unsigned) STRING_CHAR ((unsigned char *) tem),
800 (unsigned) STRING_CHAR ((unsigned char *) tem));
801 }
802
803 if (varies[i] == 0)
804 arg_from_tty = 1;
805
806 if (NILP (visargs[i]) && STRINGP (args[i]))
807 visargs[i] = args[i];
808
809 tem = strchr (tem, '\n');
810 if (tem) tem++;
811 else tem = "";
812 }
813 unbind_to (speccount, Qnil);
814
815 QUIT;
816
817 args[0] = function;
818
819 if (arg_from_tty || !NILP (record_flag))
820 {
821 visargs[0] = function;
822 for (i = 1; i < nargs; i++)
823 {
824 if (varies[i] > 0)
825 visargs[i] = Fcons (intern (callint_argfuns[varies[i]]), Qnil);
826 else
827 visargs[i] = quotify_arg (args[i]);
828 }
829 Vcommand_history = Fcons (Flist (nargs, visargs),
830 Vcommand_history);
831 /* Don't keep command history around forever. */
832 if (INTEGERP (Vhistory_length) && XINT (Vhistory_length) > 0)
833 {
834 teml = Fnthcdr (Vhistory_length, Vcommand_history);
835 if (CONSP (teml))
836 XSETCDR (teml, Qnil);
837 }
838 }
839
840 /* If we used a marker to hold point, mark, or an end of the region,
841 temporarily, convert it to an integer now. */
842 for (i = 1; i < nargs; i++)
843 if (varies[i] >= 1 && varies[i] <= 4)
844 XSETINT (args[i], marker_position (args[i]));
845
846 if (record_then_fail)
847 Fbarf_if_buffer_read_only ();
848
849 Vthis_command = save_this_command;
850 Vthis_original_command = save_this_original_command;
851 real_this_command= save_real_this_command;
852 KVAR (current_kboard, Vlast_command) = save_last_command;
853
854 {
855 Lisp_Object val;
856 specbind (Qcommand_debug_status, Qnil);
857
858 temporarily_switch_to_single_kboard (NULL);
859 val = Ffuncall (nargs, args);
860 UNGCPRO;
861 return unbind_to (speccount, val);
862 }
863 }
864
865 DEFUN ("prefix-numeric-value", Fprefix_numeric_value, Sprefix_numeric_value,
866 1, 1, 0,
867 doc: /* Return numeric meaning of raw prefix argument RAW.
868 A raw prefix argument is what you get from `(interactive "P")'.
869 Its numeric meaning is what you would get from `(interactive "p")'. */)
870 (Lisp_Object raw)
871 {
872 Lisp_Object val;
873
874 if (NILP (raw))
875 XSETFASTINT (val, 1);
876 else if (EQ (raw, Qminus))
877 XSETINT (val, -1);
878 else if (CONSP (raw) && INTEGERP (XCAR (raw)))
879 XSETINT (val, XINT (XCAR (raw)));
880 else if (INTEGERP (raw))
881 val = raw;
882 else
883 XSETFASTINT (val, 1);
884
885 return val;
886 }
887
888 void
889 syms_of_callint (void)
890 {
891 point_marker = Fmake_marker ();
892 staticpro (&point_marker);
893
894 callint_message = Qnil;
895 staticpro (&callint_message);
896
897 preserved_fns = pure_cons (intern_c_string ("region-beginning"),
898 pure_cons (intern_c_string ("region-end"),
899 pure_cons (intern_c_string ("point"),
900 pure_cons (intern_c_string ("mark"), Qnil))));
901
902 DEFSYM (Qlist, "list");
903 DEFSYM (Qlet, "let");
904 DEFSYM (Qif, "if");
905 DEFSYM (Qwhen, "when");
906 DEFSYM (Qletx, "let*");
907 DEFSYM (Qsave_excursion, "save-excursion");
908 DEFSYM (Qprogn, "progn");
909 DEFSYM (Qminus, "-");
910 DEFSYM (Qplus, "+");
911 DEFSYM (Qhandle_shift_selection, "handle-shift-selection");
912 DEFSYM (Qcall_interactively, "call-interactively");
913 DEFSYM (Qcommand_debug_status, "command-debug-status");
914 DEFSYM (Qenable_recursive_minibuffers, "enable-recursive-minibuffers");
915 DEFSYM (Qmouse_leave_buffer_hook, "mouse-leave-buffer-hook");
916
917 DEFVAR_KBOARD ("prefix-arg", Vprefix_arg,
918 doc: /* The value of the prefix argument for the next editing command.
919 It may be a number, or the symbol `-' for just a minus sign as arg,
920 or a list whose car is a number for just one or more C-u's
921 or nil if no argument has been specified.
922
923 You cannot examine this variable to find the argument for this command
924 since it has been set to nil by the time you can look.
925 Instead, you should use the variable `current-prefix-arg', although
926 normally commands can get this prefix argument with (interactive "P"). */);
927
928 DEFVAR_KBOARD ("last-prefix-arg", Vlast_prefix_arg,
929 doc: /* The value of the prefix argument for the previous editing command.
930 See `prefix-arg' for the meaning of the value. */);
931
932 DEFVAR_LISP ("current-prefix-arg", Vcurrent_prefix_arg,
933 doc: /* The value of the prefix argument for this editing command.
934 It may be a number, or the symbol `-' for just a minus sign as arg,
935 or a list whose car is a number for just one or more C-u's
936 or nil if no argument has been specified.
937 This is what `(interactive \"P\")' returns. */);
938 Vcurrent_prefix_arg = Qnil;
939
940 DEFVAR_LISP ("command-history", Vcommand_history,
941 doc: /* List of recent commands that read arguments from terminal.
942 Each command is represented as a form to evaluate.
943
944 Maximum length of the history list is determined by the value
945 of `history-length', which see. */);
946 Vcommand_history = Qnil;
947
948 DEFVAR_LISP ("command-debug-status", Vcommand_debug_status,
949 doc: /* Debugging status of current interactive command.
950 Bound each time `call-interactively' is called;
951 may be set by the debugger as a reminder for itself. */);
952 Vcommand_debug_status = Qnil;
953
954 DEFVAR_LISP ("mark-even-if-inactive", Vmark_even_if_inactive,
955 doc: /* *Non-nil means you can use the mark even when inactive.
956 This option makes a difference in Transient Mark mode.
957 When the option is non-nil, deactivation of the mark
958 turns off region highlighting, but commands that use the mark
959 behave as if the mark were still active. */);
960 Vmark_even_if_inactive = Qt;
961
962 DEFVAR_LISP ("mouse-leave-buffer-hook", Vmouse_leave_buffer_hook,
963 doc: /* Hook to run when about to switch windows with a mouse command.
964 Its purpose is to give temporary modes such as Isearch mode
965 a way to turn themselves off when a mouse command switches windows. */);
966 Vmouse_leave_buffer_hook = Qnil;
967
968 defsubr (&Sinteractive);
969 defsubr (&Scall_interactively);
970 defsubr (&Sprefix_numeric_value);
971 }