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