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