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