(status_notify): Use byte and char pointers.
[bpt/emacs.git] / src / callint.c
... / ...
CommitLineData
1/* Call a Lisp function interactively.
2 Copyright (C) 1985, 1986, 1993, 1994, 1995 Free Software Foundation, Inc.
3
4This file is part of GNU Emacs.
5
6GNU Emacs is free software; you can redistribute it and/or modify
7it under the terms of the GNU General Public License as published by
8the Free Software Foundation; either version 2, or (at your option)
9any later version.
10
11GNU Emacs is distributed in the hope that it will be useful,
12but WITHOUT ANY WARRANTY; without even the implied warranty of
13MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14GNU General Public License for more details.
15
16You should have received a copy of the GNU General Public License
17along with GNU Emacs; see the file COPYING. If not, write to
18the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19Boston, 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
30extern char *index ();
31
32extern Lisp_Object Qcursor_in_echo_area;
33
34Lisp_Object Vcurrent_prefix_arg, Qminus, Qplus;
35Lisp_Object Qcall_interactively;
36Lisp_Object Vcommand_history;
37
38Lisp_Object Vcommand_debug_status, Qcommand_debug_status;
39Lisp_Object Qenable_recursive_minibuffers;
40
41/* Non-nil means treat the mark as active
42 even if mark_active is 0. */
43Lisp_Object Vmark_even_if_inactive;
44
45Lisp_Object Vmouse_leave_buffer_hook, Qmouse_leave_buffer_hook;
46
47Lisp_Object Qlist, Qlet, Qletx, Qsave_excursion;
48static Lisp_Object preserved_fns;
49
50/* Marker used within call-interactively to refer to point. */
51static Lisp_Object point_marker;
52
53/* Buffer for the prompt text used in Fcall_interactively. */
54static char *callint_message;
55
56/* Allocated length of that buffer. */
57static 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
63DEFUN ("interactive", Ffoo, Sfoo, 0, 0, 0,
64 "Specify a way of parsing arguments for interactive use of a function.\n\
65For example, write\n\
66 (defun foo (arg) \"Doc string\" (interactive \"p\") ...use arg...)\n\
67to make ARG be the prefix argument when `foo' is called as a command.\n\
68The \"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\
71When actually called, `interactive' just returns nil.\n\
72\n\
73The 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\
79If the argument is not a string, it is evaluated to get a list of\n\
80 arguments to pass to the function.\n\
81Just `(interactive)' means pass no args when calling interactively.\n\
82\nCode letters available are:\n\
83a -- Function name: symbol with a function definition.\n\
84b -- Name of existing buffer.\n\
85B -- Name of buffer, possibly nonexistent.\n\
86c -- Character.\n\
87C -- Command name: symbol with interactive function definition.\n\
88d -- Value of point as number. Does not do I/O.\n\
89D -- Directory name.\n\
90e -- 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\
93f -- Existing file name.\n\
94F -- Possibly nonexistent file name.\n\
95i -- Ignored, i.e. always nil. Does not do I/O.\n\
96k -- Key sequence (downcase the last event if needed to get a definition).\n\
97K -- Key sequence to be redefined (do not downcase the last event).\n\
98m -- Value of mark as number. Does not do I/O.\n\
99M -- Any string. Inherits the current input method.\n\
100n -- Number read using minibuffer.\n\
101N -- Raw prefix arg, or if none, do like code `n'.\n\
102p -- Prefix arg converted to number. Does not do I/O.\n\
103P -- Prefix arg in raw form. Does not do I/O.\n\
104r -- Region: point and mark as 2 numeric args, smallest first. Does no I/O.\n\
105s -- Any string. Does not inherit the current input method.\n\
106S -- Any symbol.\n\
107v -- Variable name: symbol that is user-variable-p.\n\
108x -- Lisp expression read but not evaluated.\n\
109X -- Lisp expression read and evaluated.\n\
110z -- Coding system.\n\
111Z -- Coding system, nil if no prefix arg.\n\
112In 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\
115If 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 */
122DEFUN ("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). */
132Lisp_Object
133quotify_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). */
144Lisp_Object
145quotify_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
158char *callint_argfuns[]
159 = {"", "point", "mark", "region-beginning", "region-end"};
160
161static void
162check_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
174DEFUN ("call-interactively", Fcall_interactively, Scall_interactively, 1, 3, 0,
175 "Call FUNCTION, reading args according to its interactive calling specs.\n\
176Return the value FUNCTION returns.\n\
177The function contains a specification of how to do the argument reading.\n\
178In the case of user-defined functions, this is specified by placing a call\n\
179to the function `interactive' at the top level of the function body.\n\
180See `interactive'.\n\
181\n\
182Optional second arg RECORD-FLAG non-nil\n\
183means unconditionally put this command in the command-history.\n\
184Otherwise, 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 (XSTRING (specs)->size + 1);
292 bcopy (XSTRING (specs)->data, string, XSTRING (specs)->size + 1);
293 }
294 else if (string == 0)
295 {
296 Lisp_Object input;
297 i = num_input_events;
298 input = specs;
299 /* Compute the arg values using the user's expression. */
300 specs = Feval (specs);
301 if (i != num_input_events || !NILP (record_flag))
302 {
303 /* We should record this command on the command history. */
304 Lisp_Object values, car;
305 /* Make a copy of the list of values, for the command history,
306 and turn them into things we can eval. */
307 values = quotify_args (Fcopy_sequence (specs));
308 /* If the list of args was produced with an explicit call to `list',
309 look for elements that were computed with (region-beginning)
310 or (region-end), and put those expressions into VALUES
311 instead of the present values. */
312 if (CONSP (input))
313 {
314 car = XCONS (input)->car;
315 /* Skip through certain special forms. */
316 while (EQ (car, Qlet) || EQ (car, Qletx)
317 || EQ (car, Qsave_excursion))
318 {
319 while (CONSP (XCONS (input)->cdr))
320 input = XCONS (input)->cdr;
321 input = XCONS (input)->car;
322 if (!CONSP (input))
323 break;
324 car = XCONS (input)->car;
325 }
326 if (EQ (car, Qlist))
327 {
328 Lisp_Object intail, valtail;
329 for (intail = Fcdr (input), valtail = values;
330 CONSP (valtail);
331 intail = Fcdr (intail), valtail = Fcdr (valtail))
332 {
333 Lisp_Object elt;
334 elt = Fcar (intail);
335 if (CONSP (elt))
336 {
337 Lisp_Object presflag;
338 presflag = Fmemq (Fcar (elt), preserved_fns);
339 if (!NILP (presflag))
340 Fsetcar (valtail, Fcar (intail));
341 }
342 }
343 }
344 }
345 Vcommand_history
346 = Fcons (Fcons (function, values), Vcommand_history);
347 }
348 single_kboard_state ();
349 return apply1 (function, specs);
350 }
351
352 /* Here if function specifies a string to control parsing the defaults */
353
354 /* Set next_event to point to the first event with parameters. */
355 for (next_event = 0; next_event < key_count; next_event++)
356 if (EVENT_HAS_PARAMETERS (XVECTOR (keys)->contents[next_event]))
357 break;
358
359 /* Handle special starting chars `*' and `@'. Also `-'. */
360 /* Note that `+' is reserved for user extensions. */
361 while (1)
362 {
363 if (*string == '+')
364 error ("`+' is not used in `interactive' for ordinary commands");
365 else if (*string == '*')
366 {
367 string++;
368 if (!NILP (current_buffer->read_only))
369 Fbarf_if_buffer_read_only ();
370 }
371 /* Ignore this for semi-compatibility with Lucid. */
372 else if (*string == '-')
373 string++;
374 else if (*string == '@')
375 {
376 Lisp_Object event;
377
378 event = XVECTOR (keys)->contents[next_event];
379 if (EVENT_HAS_PARAMETERS (event)
380 && (event = XCONS (event)->cdr, CONSP (event))
381 && (event = XCONS (event)->car, CONSP (event))
382 && (event = XCONS (event)->car, WINDOWP (event)))
383 {
384 if (MINI_WINDOW_P (XWINDOW (event))
385 && ! (minibuf_level > 0 && EQ (event, minibuf_window)))
386 error ("Attempt to select inactive minibuffer window");
387
388 /* If the current buffer wants to clean up, let it. */
389 if (!NILP (Vmouse_leave_buffer_hook))
390 call1 (Vrun_hooks, Qmouse_leave_buffer_hook);
391
392 Fselect_window (event);
393 }
394 string++;
395 }
396 else break;
397 }
398
399 /* Count the number of arguments the interactive spec would have
400 us give to the function. */
401 tem = string;
402 for (j = 0; *tem; j++)
403 {
404 /* 'r' specifications ("point and mark as 2 numeric args")
405 produce *two* arguments. */
406 if (*tem == 'r') j++;
407 tem = (unsigned char *) index (tem, '\n');
408 if (tem)
409 tem++;
410 else
411 tem = (unsigned char *) "";
412 }
413 count = j;
414
415 args = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object));
416 visargs = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object));
417 argstrings = (unsigned char **) alloca ((count + 1) * sizeof (char *));
418 varies = (int *) alloca ((count + 1) * sizeof (int));
419
420 for (i = 0; i < (count + 1); i++)
421 {
422 args[i] = Qnil;
423 visargs[i] = Qnil;
424 varies[i] = 0;
425 }
426
427 GCPRO4 (prefix_arg, function, *args, *visargs);
428 gcpro3.nvars = (count + 1);
429 gcpro4.nvars = (count + 1);
430
431 if (!NILP (enable))
432 specbind (Qenable_recursive_minibuffers, Qt);
433
434 tem = string;
435 for (i = 1; *tem; i++)
436 {
437 strncpy (prompt1, tem + 1, sizeof prompt1 - 1);
438 prompt1[sizeof prompt1 - 1] = 0;
439 tem1 = index (prompt1, '\n');
440 if (tem1) *tem1 = 0;
441 /* Fill argstrings with a vector of C strings
442 corresponding to the Lisp strings in visargs. */
443 for (j = 1; j < i; j++)
444 argstrings[j]
445 = EQ (visargs[j], Qnil)
446 ? (unsigned char *) ""
447 : XSTRING (visargs[j])->data;
448
449 /* Process the format-string in prompt1, putting the output
450 into callint_message. Make callint_message bigger if necessary.
451 We don't use a buffer on the stack, because the contents
452 need to stay stable for a while. */
453 while (1)
454 {
455 int nchars = doprnt (callint_message, callint_message_size,
456 prompt1, (char *)0,
457 j - 1, argstrings + 1);
458 if (nchars < callint_message_size)
459 break;
460 callint_message_size *= 2;
461 callint_message
462 = (char *) xrealloc (callint_message, callint_message_size);
463 }
464
465 switch (*tem)
466 {
467 case 'a': /* Symbol defined as a function */
468 visargs[i] = Fcompleting_read (build_string (callint_message),
469 Vobarray, Qfboundp, Qt,
470 Qnil, Qnil, Qnil, Qnil);
471 /* Passing args[i] directly stimulates compiler bug */
472 teml = visargs[i];
473 args[i] = Fintern (teml, Qnil);
474 break;
475
476 case 'b': /* Name of existing buffer */
477 args[i] = Fcurrent_buffer ();
478 if (EQ (selected_window, minibuf_window))
479 args[i] = Fother_buffer (args[i], Qnil);
480 args[i] = Fread_buffer (build_string (callint_message), args[i], Qt);
481 break;
482
483 case 'B': /* Name of buffer, possibly nonexistent */
484 args[i] = Fread_buffer (build_string (callint_message),
485 Fother_buffer (Fcurrent_buffer (), Qnil),
486 Qnil);
487 break;
488
489 case 'c': /* Character */
490 /* Use message_nolog rather than message1_nolog here,
491 so that nothing bad happens if callint_message is changed
492 within Fread_char (by a timer, for example). */
493 message_nolog ("%s", callint_message);
494 args[i] = Fread_char ();
495 message1_nolog ((char *) 0);
496 /* Passing args[i] directly stimulates compiler bug */
497 teml = args[i];
498 visargs[i] = Fchar_to_string (teml);
499 break;
500
501 case 'C': /* Command: symbol with interactive function */
502 visargs[i] = Fcompleting_read (build_string (callint_message),
503 Vobarray, Qcommandp,
504 Qt, Qnil, Qnil, Qnil, Qnil);
505 /* Passing args[i] directly stimulates compiler bug */
506 teml = visargs[i];
507 args[i] = Fintern (teml, Qnil);
508 break;
509
510 case 'd': /* Value of point. Does not do I/O. */
511 Fset_marker (point_marker, make_number (PT), Qnil);
512 args[i] = point_marker;
513 /* visargs[i] = Qnil; */
514 varies[i] = 1;
515 break;
516
517 case 'D': /* Directory name. */
518 args[i] = Fread_file_name (build_string (callint_message), Qnil,
519 current_buffer->directory, Qlambda, Qnil);
520 break;
521
522 case 'f': /* Existing file name. */
523 args[i] = Fread_file_name (build_string (callint_message),
524 Qnil, Qnil, Qlambda, Qnil);
525 break;
526
527 case 'F': /* Possibly nonexistent file name. */
528 args[i] = Fread_file_name (build_string (callint_message),
529 Qnil, Qnil, Qnil, Qnil);
530 break;
531
532 case 'i': /* Ignore an argument -- Does not do I/O */
533 varies[i] = -1;
534 break;
535
536 case 'k': /* Key sequence. */
537 {
538 int speccount1 = specpdl_ptr - specpdl;
539 specbind (Qcursor_in_echo_area, Qt);
540 args[i] = Fread_key_sequence (build_string (callint_message),
541 Qnil, Qnil, Qnil);
542 unbind_to (speccount1, Qnil);
543 teml = args[i];
544 visargs[i] = Fkey_description (teml);
545 }
546 break;
547
548 case 'K': /* Key sequence to be defined. */
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, Qt, Qnil);
554 teml = args[i];
555 visargs[i] = Fkey_description (teml);
556 unbind_to (speccount1, Qnil);
557 }
558 break;
559
560 case 'e': /* The invoking event. */
561 if (next_event >= key_count)
562 error ("%s must be bound to an event with parameters",
563 (SYMBOLP (function)
564 ? (char *) XSYMBOL (function)->name->data
565 : "command"));
566 args[i] = XVECTOR (keys)->contents[next_event++];
567 varies[i] = -1;
568
569 /* Find the next parameterized event. */
570 while (next_event < key_count
571 && ! (EVENT_HAS_PARAMETERS
572 (XVECTOR (keys)->contents[next_event])))
573 next_event++;
574
575 break;
576
577 case 'm': /* Value of mark. Does not do I/O. */
578 check_mark ();
579 /* visargs[i] = Qnil; */
580 args[i] = current_buffer->mark;
581 varies[i] = 2;
582 break;
583
584 case 'M': /* String read via minibuffer with
585 inheriting the current input method. */
586 args[i] = Fread_string (build_string (callint_message),
587 Qnil, Qnil, Qnil, Qt);
588 break;
589
590 case 'N': /* Prefix arg, else number from minibuffer */
591 if (!NILP (prefix_arg))
592 goto have_prefix_arg;
593 case 'n': /* Read number from minibuffer. */
594 {
595 int first = 1;
596 do
597 {
598 Lisp_Object tem;
599 if (! first)
600 {
601 message ("Please enter a number.");
602 sit_for (1, 0, 0, 0, 0);
603 }
604 first = 0;
605
606 tem = Fread_from_minibuffer (build_string (callint_message),
607 Qnil, Qnil, Qnil, Qnil, Qnil,
608 Qnil);
609 if (! STRINGP (tem) || XSTRING (tem)->size == 0)
610 args[i] = Qnil;
611 else
612 args[i] = Fread (tem);
613 }
614 while (! NUMBERP (args[i]));
615 }
616 visargs[i] = last_minibuf_string;
617 break;
618
619 case 'P': /* Prefix arg in raw form. Does no I/O. */
620 args[i] = prefix_arg;
621 /* visargs[i] = Qnil; */
622 varies[i] = -1;
623 break;
624
625 case 'p': /* Prefix arg converted to number. No I/O. */
626 have_prefix_arg:
627 args[i] = Fprefix_numeric_value (prefix_arg);
628 /* visargs[i] = Qnil; */
629 varies[i] = -1;
630 break;
631
632 case 'r': /* Region, point and mark as 2 args. */
633 check_mark ();
634 Fset_marker (point_marker, make_number (PT), Qnil);
635 /* visargs[i+1] = Qnil; */
636 foo = marker_position (current_buffer->mark);
637 /* visargs[i] = Qnil; */
638 args[i] = PT < foo ? point_marker : current_buffer->mark;
639 varies[i] = 3;
640 args[++i] = PT > foo ? point_marker : current_buffer->mark;
641 varies[i] = 4;
642 break;
643
644 case 's': /* String read via minibuffer without
645 inheriting the current input method. */
646 args[i] = Fread_string (build_string (callint_message),
647 Qnil, Qnil, Qnil, Qnil);
648 break;
649
650 case 'S': /* Any symbol. */
651 visargs[i] = Fread_string (build_string (callint_message),
652 Qnil, Qnil, Qnil, Qnil);
653 /* Passing args[i] directly stimulates compiler bug */
654 teml = visargs[i];
655 args[i] = Fintern (teml, Qnil);
656 break;
657
658 case 'v': /* Variable name: symbol that is
659 user-variable-p. */
660 args[i] = Fread_variable (build_string (callint_message), Qnil);
661 visargs[i] = last_minibuf_string;
662 break;
663
664 case 'x': /* Lisp expression read but not evaluated */
665 args[i] = Fread_minibuffer (build_string (callint_message), Qnil);
666 visargs[i] = last_minibuf_string;
667 break;
668
669 case 'X': /* Lisp expression read and evaluated */
670 args[i] = Feval_minibuffer (build_string (callint_message), Qnil);
671 visargs[i] = last_minibuf_string;
672 break;
673
674 case 'Z': /* Coding-system symbol, or ignore the
675 argument if no prefix */
676 if (NILP (prefix_arg))
677 {
678 args[i] = Qnil;
679 varies[i] = -1;
680 }
681 else
682 {
683 args[i]
684 = Fread_non_nil_coding_system (build_string (callint_message));
685 visargs[i] = last_minibuf_string;
686 }
687 break;
688
689 case 'z': /* Coding-system symbol or nil */
690 args[i] = Fread_coding_system (build_string (callint_message), Qnil);
691 visargs[i] = last_minibuf_string;
692 break;
693
694 /* We have a case for `+' so we get an error
695 if anyone tries to define one here. */
696 case '+':
697 default:
698 error ("Invalid control letter `%c' (%03o) in interactive calling string",
699 *tem, *tem);
700 }
701
702 if (varies[i] == 0)
703 arg_from_tty = 1;
704
705 if (NILP (visargs[i]) && STRINGP (args[i]))
706 visargs[i] = args[i];
707
708 tem = (unsigned char *) index (tem, '\n');
709 if (tem) tem++;
710 else tem = (unsigned char *) "";
711 }
712 unbind_to (speccount, Qnil);
713
714 QUIT;
715
716 args[0] = function;
717
718 if (arg_from_tty || !NILP (record_flag))
719 {
720 visargs[0] = function;
721 for (i = 1; i < count + 1; i++)
722 {
723 if (varies[i] > 0)
724 visargs[i] = Fcons (intern (callint_argfuns[varies[i]]), Qnil);
725 else
726 visargs[i] = quotify_arg (args[i]);
727 }
728 Vcommand_history = Fcons (Flist (count + 1, visargs),
729 Vcommand_history);
730 }
731
732 /* If we used a marker to hold point, mark, or an end of the region,
733 temporarily, convert it to an integer now. */
734 for (i = 1; i <= count; i++)
735 if (varies[i] >= 1 && varies[i] <= 4)
736 XSETINT (args[i], marker_position (args[i]));
737
738 single_kboard_state ();
739
740 {
741 Lisp_Object val;
742 specbind (Qcommand_debug_status, Qnil);
743
744 val = Ffuncall (count + 1, args);
745 UNGCPRO;
746 return unbind_to (speccount, val);
747 }
748}
749
750DEFUN ("prefix-numeric-value", Fprefix_numeric_value, Sprefix_numeric_value,
751 1, 1, 0,
752 "Return numeric meaning of raw prefix argument RAW.\n\
753A raw prefix argument is what you get from `(interactive \"P\")'.\n\
754Its numeric meaning is what you would get from `(interactive \"p\")'.")
755 (raw)
756 Lisp_Object raw;
757{
758 Lisp_Object val;
759
760 if (NILP (raw))
761 XSETFASTINT (val, 1);
762 else if (EQ (raw, Qminus))
763 XSETINT (val, -1);
764 else if (CONSP (raw) && INTEGERP (XCONS (raw)->car))
765 XSETINT (val, XINT (XCONS (raw)->car));
766 else if (INTEGERP (raw))
767 val = raw;
768 else
769 XSETFASTINT (val, 1);
770
771 return val;
772}
773
774syms_of_callint ()
775{
776 point_marker = Fmake_marker ();
777 staticpro (&point_marker);
778
779 preserved_fns = Fcons (intern ("region-beginning"),
780 Fcons (intern ("region-end"),
781 Fcons (intern ("point"),
782 Fcons (intern ("mark"), Qnil))));
783 staticpro (&preserved_fns);
784
785 Qlist = intern ("list");
786 staticpro (&Qlist);
787 Qlet = intern ("let");
788 staticpro (&Qlet);
789 Qletx = intern ("let*");
790 staticpro (&Qletx);
791 Qsave_excursion = intern ("save-excursion");
792 staticpro (&Qsave_excursion);
793
794 Qminus = intern ("-");
795 staticpro (&Qminus);
796
797 Qplus = intern ("+");
798 staticpro (&Qplus);
799
800 Qcall_interactively = intern ("call-interactively");
801 staticpro (&Qcall_interactively);
802
803 Qcommand_debug_status = intern ("command-debug-status");
804 staticpro (&Qcommand_debug_status);
805
806 Qenable_recursive_minibuffers = intern ("enable-recursive-minibuffers");
807 staticpro (&Qenable_recursive_minibuffers);
808
809 Qmouse_leave_buffer_hook = intern ("mouse-leave-buffer-hook");
810 staticpro (&Qmouse_leave_buffer_hook);
811
812 callint_message_size = 100;
813 callint_message = (char *) xmalloc (callint_message_size);
814
815
816 DEFVAR_KBOARD ("prefix-arg", Vprefix_arg,
817 "The value of the prefix argument for the next editing command.\n\
818It may be a number, or the symbol `-' for just a minus sign as arg,\n\
819or a list whose car is a number for just one or more C-U's\n\
820or nil if no argument has been specified.\n\
821\n\
822You cannot examine this variable to find the argument for this command\n\
823since it has been set to nil by the time you can look.\n\
824Instead, you should use the variable `current-prefix-arg', although\n\
825normally commands can get this prefix argument with (interactive \"P\").");
826
827 DEFVAR_LISP ("current-prefix-arg", &Vcurrent_prefix_arg,
828 "The value of the prefix argument for this editing command.\n\
829It may be a number, or the symbol `-' for just a minus sign as arg,\n\
830or a list whose car is a number for just one or more C-U's\n\
831or nil if no argument has been specified.\n\
832This is what `(interactive \"P\")' returns.");
833 Vcurrent_prefix_arg = Qnil;
834
835 DEFVAR_LISP ("command-history", &Vcommand_history,
836 "List of recent commands that read arguments from terminal.\n\
837Each command is represented as a form to evaluate.");
838 Vcommand_history = Qnil;
839
840 DEFVAR_LISP ("command-debug-status", &Vcommand_debug_status,
841 "Debugging status of current interactive command.\n\
842Bound each time `call-interactively' is called;\n\
843may be set by the debugger as a reminder for itself.");
844 Vcommand_debug_status = Qnil;
845
846 DEFVAR_LISP ("mark-even-if-inactive", &Vmark_even_if_inactive,
847 "*Non-nil means you can use the mark even when inactive.\n\
848This option makes a difference in Transient Mark mode.\n\
849When the option is non-nil, deactivation of the mark\n\
850turns off region highlighting, but commands that use the mark\n\
851behave as if the mark were still active.");
852 Vmark_even_if_inactive = Qnil;
853
854 DEFVAR_LISP ("mouse-leave-buffer-hook", &Vmouse_leave_buffer_hook,
855 "Hook to run when about to switch windows with a mouse command.\n\
856Its purpose is to give temporary modes such as Isearch mode\n\
857a way to turn themselves off when a mouse command switches windows.");
858 Vmouse_leave_buffer_hook = Qnil;
859
860 defsubr (&Sinteractive);
861 defsubr (&Scall_interactively);
862 defsubr (&Sprefix_numeric_value);
863}