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