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