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