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