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