]> code.delx.au - gnu-emacs/blob - src/callint.c
(check_mark): Use xsignal0.
[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 xsignal0 (Qmark_inactive);
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 if (SYMBOLP (function))
318 enable = Fget (function, Qenable_recursive_minibuffers);
319 else
320 enable = Qnil;
321
322 fun = indirect_function (function);
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 /* Decode the kind of function. Either handle it and return,
335 or go to `lose' if not interactive, or set either STRING or SPECS. */
336
337 if (SUBRP (fun))
338 {
339 string = (unsigned char *) XSUBR (fun)->prompt;
340 if (!string)
341 {
342 lose:
343 wrong_type_argument (Qcommandp, function);
344 }
345 }
346 else if (COMPILEDP (fun))
347 {
348 if ((XVECTOR (fun)->size & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_INTERACTIVE)
349 goto lose;
350 specs = XVECTOR (fun)->contents[COMPILED_INTERACTIVE];
351 }
352 else
353 {
354 Lisp_Object form;
355 GCPRO2 (function, prefix_arg);
356 form = Finteractive_form (function);
357 UNGCPRO;
358 if (CONSP (form))
359 specs = filter_specs = Fcar (XCDR (form));
360 else
361 goto lose;
362 }
363
364 /* If either SPECS or STRING is set to a string, use it. */
365 if (STRINGP (specs))
366 {
367 /* Make a copy of string so that if a GC relocates specs,
368 `string' will still be valid. */
369 string = (unsigned char *) alloca (SBYTES (specs) + 1);
370 bcopy (SDATA (specs), string,
371 SBYTES (specs) + 1);
372 }
373 else if (string == 0)
374 {
375 Lisp_Object input;
376 i = num_input_events;
377 input = specs;
378 /* Compute the arg values using the user's expression. */
379 GCPRO2 (input, filter_specs);
380 specs = Feval (specs);
381 UNGCPRO;
382 if (i != num_input_events || !NILP (record_flag))
383 {
384 /* We should record this command on the command history. */
385 Lisp_Object values;
386 /* Make a copy of the list of values, for the command history,
387 and turn them into things we can eval. */
388 values = quotify_args (Fcopy_sequence (specs));
389 fix_command (input, values);
390 Vcommand_history
391 = Fcons (Fcons (function, values), Vcommand_history);
392
393 /* Don't keep command history around forever. */
394 if (INTEGERP (Vhistory_length) && XINT (Vhistory_length) > 0)
395 {
396 teml = Fnthcdr (Vhistory_length, Vcommand_history);
397 if (CONSP (teml))
398 XSETCDR (teml, Qnil);
399 }
400 }
401
402 Vthis_command = save_this_command;
403 Vthis_original_command = save_this_original_command;
404 real_this_command= save_real_this_command;
405 current_kboard->Vlast_command = save_last_command;
406
407 single_kboard_state ();
408 return apply1 (function, specs);
409 }
410
411 /* Here if function specifies a string to control parsing the defaults */
412
413 /* Set next_event to point to the first event with parameters. */
414 for (next_event = 0; next_event < key_count; next_event++)
415 if (EVENT_HAS_PARAMETERS (XVECTOR (keys)->contents[next_event]))
416 break;
417
418 /* Handle special starting chars `*' and `@'. Also `-'. */
419 /* Note that `+' is reserved for user extensions. */
420 while (1)
421 {
422 if (*string == '+')
423 error ("`+' is not used in `interactive' for ordinary commands");
424 else if (*string == '*')
425 {
426 string++;
427 if (!NILP (current_buffer->read_only))
428 {
429 if (!NILP (record_flag))
430 {
431 unsigned char *p = string;
432 while (*p)
433 {
434 if (! (*p == 'r' || *p == 'p' || *p == 'P'
435 || *p == '\n'))
436 Fbarf_if_buffer_read_only ();
437 p++;
438 }
439 record_then_fail = 1;
440 }
441 else
442 Fbarf_if_buffer_read_only ();
443 }
444 }
445 /* Ignore this for semi-compatibility with Lucid. */
446 else if (*string == '-')
447 string++;
448 else if (*string == '@')
449 {
450 Lisp_Object event, tem;
451
452 event = (next_event < key_count
453 ? XVECTOR (keys)->contents[next_event]
454 : Qnil);
455 if (EVENT_HAS_PARAMETERS (event)
456 && (tem = XCDR (event), CONSP (tem))
457 && (tem = XCAR (tem), CONSP (tem))
458 && (tem = XCAR (tem), WINDOWP (tem)))
459 {
460 if (MINI_WINDOW_P (XWINDOW (tem))
461 && ! (minibuf_level > 0 && EQ (tem, minibuf_window)))
462 error ("Attempt to select inactive minibuffer window");
463
464 /* If the current buffer wants to clean up, let it. */
465 if (!NILP (Vmouse_leave_buffer_hook))
466 call1 (Vrun_hooks, Qmouse_leave_buffer_hook);
467
468 Fselect_window (tem, Qnil);
469 }
470 string++;
471 }
472 else break;
473 }
474
475 /* Count the number of arguments the interactive spec would have
476 us give to the function. */
477 tem = string;
478 for (j = 0; *tem; j++)
479 {
480 /* 'r' specifications ("point and mark as 2 numeric args")
481 produce *two* arguments. */
482 if (*tem == 'r') j++;
483 tem = (unsigned char *) index (tem, '\n');
484 if (tem)
485 tem++;
486 else
487 tem = (unsigned char *) "";
488 }
489 count = j;
490
491 args = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object));
492 visargs = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object));
493 argstrings = (unsigned char **) alloca ((count + 1) * sizeof (char *));
494 varies = (int *) alloca ((count + 1) * sizeof (int));
495
496 for (i = 0; i < (count + 1); i++)
497 {
498 args[i] = Qnil;
499 visargs[i] = Qnil;
500 varies[i] = 0;
501 }
502
503 GCPRO5 (prefix_arg, function, *args, *visargs, up_event);
504 gcpro3.nvars = (count + 1);
505 gcpro4.nvars = (count + 1);
506
507 if (!NILP (enable))
508 specbind (Qenable_recursive_minibuffers, Qt);
509
510 tem = string;
511 for (i = 1; *tem; i++)
512 {
513 strncpy (prompt1, tem + 1, sizeof prompt1 - 1);
514 prompt1[sizeof prompt1 - 1] = 0;
515 tem1 = (char *) index (prompt1, '\n');
516 if (tem1) *tem1 = 0;
517 /* Fill argstrings with a vector of C strings
518 corresponding to the Lisp strings in visargs. */
519 for (j = 1; j < i; j++)
520 argstrings[j]
521 = (EQ (visargs[j], Qnil)
522 ? (unsigned char *) ""
523 : SDATA (visargs[j]));
524
525 /* Process the format-string in prompt1, putting the output
526 into callint_message. Make callint_message bigger if necessary.
527 We don't use a buffer on the stack, because the contents
528 need to stay stable for a while. */
529 while (1)
530 {
531 int nchars = doprnt (callint_message, callint_message_size,
532 prompt1, (char *)0,
533 j - 1, (char **) argstrings + 1);
534 if (nchars < callint_message_size - 1)
535 break;
536 callint_message_size *= 2;
537 callint_message
538 = (char *) xrealloc (callint_message, callint_message_size);
539 }
540
541 switch (*tem)
542 {
543 case 'a': /* Symbol defined as a function */
544 visargs[i] = Fcompleting_read (build_string (callint_message),
545 Vobarray, Qfboundp, Qt,
546 Qnil, Qnil, Qnil, Qnil);
547 /* Passing args[i] directly stimulates compiler bug */
548 teml = visargs[i];
549 args[i] = Fintern (teml, Qnil);
550 break;
551
552 case 'b': /* Name of existing buffer */
553 args[i] = Fcurrent_buffer ();
554 if (EQ (selected_window, minibuf_window))
555 args[i] = Fother_buffer (args[i], Qnil, Qnil);
556 args[i] = Fread_buffer (build_string (callint_message), args[i], Qt);
557 break;
558
559 case 'B': /* Name of buffer, possibly nonexistent */
560 args[i] = Fread_buffer (build_string (callint_message),
561 Fother_buffer (Fcurrent_buffer (), Qnil, Qnil),
562 Qnil);
563 break;
564
565 case 'c': /* Character */
566 args[i] = Fread_char (build_string (callint_message), Qnil);
567 message1_nolog ((char *) 0);
568 /* Passing args[i] directly stimulates compiler bug */
569 teml = args[i];
570 visargs[i] = Fchar_to_string (teml);
571 break;
572
573 case 'C': /* Command: symbol with interactive function */
574 visargs[i] = Fcompleting_read (build_string (callint_message),
575 Vobarray, Qcommandp,
576 Qt, Qnil, Qnil, Qnil, Qnil);
577 /* Passing args[i] directly stimulates compiler bug */
578 teml = visargs[i];
579 args[i] = Fintern (teml, Qnil);
580 break;
581
582 case 'd': /* Value of point. Does not do I/O. */
583 set_marker_both (point_marker, Qnil, PT, PT_BYTE);
584 args[i] = point_marker;
585 /* visargs[i] = Qnil; */
586 varies[i] = 1;
587 break;
588
589 case 'D': /* Directory name. */
590 args[i] = Fread_file_name (build_string (callint_message), Qnil,
591 current_buffer->directory, Qlambda, Qnil,
592 Qfile_directory_p);
593 break;
594
595 case 'f': /* Existing file name. */
596 args[i] = Fread_file_name (build_string (callint_message),
597 Qnil, Qnil, Qlambda, Qnil, Qnil);
598 break;
599
600 case 'F': /* Possibly nonexistent file name. */
601 args[i] = Fread_file_name (build_string (callint_message),
602 Qnil, Qnil, Qnil, Qnil, Qnil);
603 break;
604
605 case 'G': /* Possibly nonexistent file name,
606 default to directory alone. */
607 args[i] = Fread_file_name (build_string (callint_message),
608 Qnil, Qnil, Qnil, build_string (""), Qnil);
609 break;
610
611 case 'i': /* Ignore an argument -- Does not do I/O */
612 varies[i] = -1;
613 break;
614
615 case 'k': /* Key sequence. */
616 {
617 int speccount1 = SPECPDL_INDEX ();
618 specbind (Qcursor_in_echo_area, Qt);
619 args[i] = Fread_key_sequence (build_string (callint_message),
620 Qnil, Qnil, Qnil, Qnil);
621 unbind_to (speccount1, Qnil);
622 teml = args[i];
623 visargs[i] = Fkey_description (teml, Qnil);
624
625 /* If the key sequence ends with a down-event,
626 discard the following up-event. */
627 teml = Faref (args[i], make_number (XINT (Flength (args[i])) - 1));
628 if (CONSP (teml))
629 teml = XCAR (teml);
630 if (SYMBOLP (teml))
631 {
632 Lisp_Object tem2;
633
634 teml = Fget (teml, intern ("event-symbol-elements"));
635 /* Ignore first element, which is the base key. */
636 tem2 = Fmemq (intern ("down"), Fcdr (teml));
637 if (! NILP (tem2))
638 up_event = Fread_event (Qnil, Qnil);
639 }
640 }
641 break;
642
643 case 'K': /* Key sequence to be defined. */
644 {
645 int speccount1 = SPECPDL_INDEX ();
646 specbind (Qcursor_in_echo_area, Qt);
647 args[i] = Fread_key_sequence (build_string (callint_message),
648 Qnil, Qt, Qnil, Qnil);
649 teml = args[i];
650 visargs[i] = Fkey_description (teml, Qnil);
651 unbind_to (speccount1, Qnil);
652
653 /* If the key sequence ends with a down-event,
654 discard the following up-event. */
655 teml = Faref (args[i], make_number (XINT (Flength (args[i])) - 1));
656 if (CONSP (teml))
657 teml = XCAR (teml);
658 if (SYMBOLP (teml))
659 {
660 Lisp_Object tem2;
661
662 teml = Fget (teml, intern ("event-symbol-elements"));
663 /* Ignore first element, which is the base key. */
664 tem2 = Fmemq (intern ("down"), Fcdr (teml));
665 if (! NILP (tem2))
666 up_event = Fread_event (Qnil, Qnil);
667 }
668 }
669 break;
670
671 case 'U': /* Up event from last k or K */
672 if (!NILP (up_event))
673 {
674 args[i] = Fmake_vector (make_number (1), up_event);
675 up_event = Qnil;
676 teml = args[i];
677 visargs[i] = Fkey_description (teml, Qnil);
678 }
679 break;
680
681 case 'e': /* The invoking event. */
682 if (next_event >= key_count)
683 error ("%s must be bound to an event with parameters",
684 (SYMBOLP (function)
685 ? (char *) SDATA (SYMBOL_NAME (function))
686 : "command"));
687 args[i] = XVECTOR (keys)->contents[next_event++];
688 varies[i] = -1;
689
690 /* Find the next parameterized event. */
691 while (next_event < key_count
692 && ! (EVENT_HAS_PARAMETERS
693 (XVECTOR (keys)->contents[next_event])))
694 next_event++;
695
696 break;
697
698 case 'm': /* Value of mark. Does not do I/O. */
699 check_mark (0);
700 /* visargs[i] = Qnil; */
701 args[i] = current_buffer->mark;
702 varies[i] = 2;
703 break;
704
705 case 'M': /* String read via minibuffer with
706 inheriting the current input method. */
707 args[i] = Fread_string (build_string (callint_message),
708 Qnil, Qnil, Qnil, Qt);
709 break;
710
711 case 'N': /* Prefix arg, else number from minibuffer */
712 if (!NILP (prefix_arg))
713 goto have_prefix_arg;
714 case 'n': /* Read number from minibuffer. */
715 {
716 int first = 1;
717 do
718 {
719 Lisp_Object tem;
720 if (! first)
721 {
722 message ("Please enter a number.");
723 sit_for (make_number (1), 0, 0);
724 }
725 first = 0;
726
727 tem = Fread_from_minibuffer (build_string (callint_message),
728 Qnil, Qnil, Qnil, Qnil, Qnil,
729 Qnil);
730 if (! STRINGP (tem) || SCHARS (tem) == 0)
731 args[i] = Qnil;
732 else
733 args[i] = Fread (tem);
734 }
735 while (! NUMBERP (args[i]));
736 }
737 visargs[i] = last_minibuf_string;
738 break;
739
740 case 'P': /* Prefix arg in raw form. Does no I/O. */
741 args[i] = prefix_arg;
742 /* visargs[i] = Qnil; */
743 varies[i] = -1;
744 break;
745
746 case 'p': /* Prefix arg converted to number. No I/O. */
747 have_prefix_arg:
748 args[i] = Fprefix_numeric_value (prefix_arg);
749 /* visargs[i] = Qnil; */
750 varies[i] = -1;
751 break;
752
753 case 'r': /* Region, point and mark as 2 args. */
754 check_mark (1);
755 set_marker_both (point_marker, Qnil, PT, PT_BYTE);
756 /* visargs[i+1] = Qnil; */
757 foo = marker_position (current_buffer->mark);
758 /* visargs[i] = Qnil; */
759 args[i] = PT < foo ? point_marker : current_buffer->mark;
760 varies[i] = 3;
761 args[++i] = PT > foo ? point_marker : current_buffer->mark;
762 varies[i] = 4;
763 break;
764
765 case 's': /* String read via minibuffer without
766 inheriting the current input method. */
767 args[i] = Fread_string (build_string (callint_message),
768 Qnil, Qnil, Qnil, Qnil);
769 break;
770
771 case 'S': /* Any symbol. */
772 visargs[i] = Fread_string (build_string (callint_message),
773 Qnil, Qnil, Qnil, Qnil);
774 /* Passing args[i] directly stimulates compiler bug */
775 teml = visargs[i];
776 args[i] = Fintern (teml, Qnil);
777 break;
778
779 case 'v': /* Variable name: symbol that is
780 user-variable-p. */
781 args[i] = Fread_variable (build_string (callint_message), Qnil);
782 visargs[i] = last_minibuf_string;
783 break;
784
785 case 'x': /* Lisp expression read but not evaluated */
786 args[i] = Fread_minibuffer (build_string (callint_message), Qnil);
787 visargs[i] = last_minibuf_string;
788 break;
789
790 case 'X': /* Lisp expression read and evaluated */
791 args[i] = Feval_minibuffer (build_string (callint_message), Qnil);
792 visargs[i] = last_minibuf_string;
793 break;
794
795 case 'Z': /* Coding-system symbol, or ignore the
796 argument if no prefix */
797 if (NILP (prefix_arg))
798 {
799 args[i] = Qnil;
800 varies[i] = -1;
801 }
802 else
803 {
804 args[i]
805 = Fread_non_nil_coding_system (build_string (callint_message));
806 visargs[i] = last_minibuf_string;
807 }
808 break;
809
810 case 'z': /* Coding-system symbol or nil */
811 args[i] = Fread_coding_system (build_string (callint_message), Qnil);
812 visargs[i] = last_minibuf_string;
813 break;
814
815 /* We have a case for `+' so we get an error
816 if anyone tries to define one here. */
817 case '+':
818 default:
819 error ("Invalid control letter `%c' (%03o) in interactive calling string",
820 *tem, *tem);
821 }
822
823 if (varies[i] == 0)
824 arg_from_tty = 1;
825
826 if (NILP (visargs[i]) && STRINGP (args[i]))
827 visargs[i] = args[i];
828
829 tem = (unsigned char *) index (tem, '\n');
830 if (tem) tem++;
831 else tem = (unsigned char *) "";
832 }
833 unbind_to (speccount, Qnil);
834
835 QUIT;
836
837 args[0] = function;
838
839 if (arg_from_tty || !NILP (record_flag))
840 {
841 visargs[0] = function;
842 for (i = 1; i < count + 1; i++)
843 {
844 if (varies[i] > 0)
845 visargs[i] = Fcons (intern (callint_argfuns[varies[i]]), Qnil);
846 else
847 visargs[i] = quotify_arg (args[i]);
848 }
849 Vcommand_history = Fcons (Flist (count + 1, visargs),
850 Vcommand_history);
851 /* Don't keep command history around forever. */
852 if (INTEGERP (Vhistory_length) && XINT (Vhistory_length) > 0)
853 {
854 teml = Fnthcdr (Vhistory_length, Vcommand_history);
855 if (CONSP (teml))
856 XSETCDR (teml, Qnil);
857 }
858 }
859
860 /* If we used a marker to hold point, mark, or an end of the region,
861 temporarily, convert it to an integer now. */
862 for (i = 1; i <= count; i++)
863 if (varies[i] >= 1 && varies[i] <= 4)
864 XSETINT (args[i], marker_position (args[i]));
865
866 if (record_then_fail)
867 Fbarf_if_buffer_read_only ();
868
869 Vthis_command = save_this_command;
870 Vthis_original_command = save_this_original_command;
871 real_this_command= save_real_this_command;
872 current_kboard->Vlast_command = save_last_command;
873
874 single_kboard_state ();
875
876 {
877 Lisp_Object val;
878 specbind (Qcommand_debug_status, Qnil);
879
880 val = Ffuncall (count + 1, args);
881 UNGCPRO;
882 return unbind_to (speccount, val);
883 }
884 }
885
886 DEFUN ("prefix-numeric-value", Fprefix_numeric_value, Sprefix_numeric_value,
887 1, 1, 0,
888 doc: /* Return numeric meaning of raw prefix argument RAW.
889 A raw prefix argument is what you get from `(interactive "P")'.
890 Its numeric meaning is what you would get from `(interactive "p")'. */)
891 (raw)
892 Lisp_Object raw;
893 {
894 Lisp_Object val;
895
896 if (NILP (raw))
897 XSETFASTINT (val, 1);
898 else if (EQ (raw, Qminus))
899 XSETINT (val, -1);
900 else if (CONSP (raw) && INTEGERP (XCAR (raw)))
901 XSETINT (val, XINT (XCAR (raw)));
902 else if (INTEGERP (raw))
903 val = raw;
904 else
905 XSETFASTINT (val, 1);
906
907 return val;
908 }
909
910 void
911 syms_of_callint ()
912 {
913 point_marker = Fmake_marker ();
914 staticpro (&point_marker);
915
916 preserved_fns = Fcons (intern ("region-beginning"),
917 Fcons (intern ("region-end"),
918 Fcons (intern ("point"),
919 Fcons (intern ("mark"), Qnil))));
920 staticpro (&preserved_fns);
921
922 Qlist = intern ("list");
923 staticpro (&Qlist);
924 Qlet = intern ("let");
925 staticpro (&Qlet);
926 Qif = intern ("if");
927 staticpro (&Qif);
928 Qwhen = intern ("when");
929 staticpro (&Qwhen);
930 Qletx = intern ("let*");
931 staticpro (&Qletx);
932 Qsave_excursion = intern ("save-excursion");
933 staticpro (&Qsave_excursion);
934 Qprogn = intern ("progn");
935 staticpro (&Qprogn);
936
937 Qminus = intern ("-");
938 staticpro (&Qminus);
939
940 Qplus = intern ("+");
941 staticpro (&Qplus);
942
943 Qcall_interactively = intern ("call-interactively");
944 staticpro (&Qcall_interactively);
945
946 Qcommand_debug_status = intern ("command-debug-status");
947 staticpro (&Qcommand_debug_status);
948
949 Qenable_recursive_minibuffers = intern ("enable-recursive-minibuffers");
950 staticpro (&Qenable_recursive_minibuffers);
951
952 Qmouse_leave_buffer_hook = intern ("mouse-leave-buffer-hook");
953 staticpro (&Qmouse_leave_buffer_hook);
954
955 callint_message_size = 100;
956 callint_message = (char *) xmalloc (callint_message_size);
957
958
959 DEFVAR_KBOARD ("prefix-arg", Vprefix_arg,
960 doc: /* The value of the prefix argument for the next editing command.
961 It may be a number, or the symbol `-' for just a minus sign as arg,
962 or a list whose car is a number for just one or more C-u's
963 or nil if no argument has been specified.
964
965 You cannot examine this variable to find the argument for this command
966 since it has been set to nil by the time you can look.
967 Instead, you should use the variable `current-prefix-arg', although
968 normally commands can get this prefix argument with (interactive "P"). */);
969
970 DEFVAR_KBOARD ("last-prefix-arg", Vlast_prefix_arg,
971 doc: /* The value of the prefix argument for the previous editing command.
972 See `prefix-arg' for the meaning of the value. */);
973
974 DEFVAR_LISP ("current-prefix-arg", &Vcurrent_prefix_arg,
975 doc: /* The value of the prefix argument for this editing command.
976 It may be a number, or the symbol `-' for just a minus sign as arg,
977 or a list whose car is a number for just one or more C-u's
978 or nil if no argument has been specified.
979 This is what `(interactive \"P\")' returns. */);
980 Vcurrent_prefix_arg = Qnil;
981
982 DEFVAR_LISP ("command-history", &Vcommand_history,
983 doc: /* List of recent commands that read arguments from terminal.
984 Each command is represented as a form to evaluate. */);
985 Vcommand_history = Qnil;
986
987 DEFVAR_LISP ("command-debug-status", &Vcommand_debug_status,
988 doc: /* Debugging status of current interactive command.
989 Bound each time `call-interactively' is called;
990 may be set by the debugger as a reminder for itself. */);
991 Vcommand_debug_status = Qnil;
992
993 DEFVAR_LISP ("mark-even-if-inactive", &Vmark_even_if_inactive,
994 doc: /* *Non-nil means you can use the mark even when inactive.
995 This option makes a difference in Transient Mark mode.
996 When the option is non-nil, deactivation of the mark
997 turns off region highlighting, but commands that use the mark
998 behave as if the mark were still active. */);
999 Vmark_even_if_inactive = Qnil;
1000
1001 DEFVAR_LISP ("mouse-leave-buffer-hook", &Vmouse_leave_buffer_hook,
1002 doc: /* Hook to run when about to switch windows with a mouse command.
1003 Its purpose is to give temporary modes such as Isearch mode
1004 a way to turn themselves off when a mouse command switches windows. */);
1005 Vmouse_leave_buffer_hook = Qnil;
1006
1007 defsubr (&Sinteractive);
1008 defsubr (&Scall_interactively);
1009 defsubr (&Sprefix_numeric_value);
1010 }
1011
1012 /* arch-tag: a3a7cad7-bcac-42ce-916e-1bd2546ebf37
1013 (do not change this comment) */