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