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