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