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