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