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