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