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