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