]> code.delx.au - gnu-emacs/blob - src/callint.c
(lisp, shortlisp): Include english.elc and tibetan.elc.
[gnu-emacs] / 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_chars;
297 input = specs;
298 /* Compute the arg values using the user's expression. */
299 specs = Feval (specs);
300 if (i != num_input_chars || !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, Qnil, Qnil);
469 /* Passing args[i] directly stimulates compiler bug */
470 teml = visargs[i];
471 args[i] = Fintern (teml, Qnil);
472 break;
473
474 case 'b': /* Name of existing buffer */
475 args[i] = Fcurrent_buffer ();
476 if (EQ (selected_window, minibuf_window))
477 args[i] = Fother_buffer (args[i], Qnil);
478 args[i] = Fread_buffer (build_string (callint_message), args[i], Qt);
479 break;
480
481 case 'B': /* Name of buffer, possibly nonexistent */
482 args[i] = Fread_buffer (build_string (callint_message),
483 Fother_buffer (Fcurrent_buffer (), Qnil),
484 Qnil);
485 break;
486
487 case 'c': /* Character */
488 /* Use message_nolog rather than message1_nolog here,
489 so that nothing bad happens if callint_message is changed
490 within Fread_char (by a timer, for example). */
491 message_nolog ("%s", callint_message);
492 args[i] = Fread_char ();
493 message1_nolog ((char *) 0);
494 /* Passing args[i] directly stimulates compiler bug */
495 teml = args[i];
496 visargs[i] = Fchar_to_string (teml);
497 break;
498
499 case 'C': /* Command: symbol with interactive function */
500 visargs[i] = Fcompleting_read (build_string (callint_message),
501 Vobarray, Qcommandp, Qt, Qnil, Qnil);
502 /* Passing args[i] directly stimulates compiler bug */
503 teml = visargs[i];
504 args[i] = Fintern (teml, Qnil);
505 break;
506
507 case 'd': /* Value of point. Does not do I/O. */
508 Fset_marker (point_marker, make_number (PT), Qnil);
509 args[i] = point_marker;
510 /* visargs[i] = Qnil; */
511 varies[i] = 1;
512 break;
513
514 case 'D': /* Directory name. */
515 args[i] = Fread_file_name (build_string (callint_message), Qnil,
516 current_buffer->directory, Qlambda, Qnil);
517 break;
518
519 case 'f': /* Existing file name. */
520 args[i] = Fread_file_name (build_string (callint_message),
521 Qnil, Qnil, Qlambda, Qnil);
522 break;
523
524 case 'F': /* Possibly nonexistent file name. */
525 args[i] = Fread_file_name (build_string (callint_message),
526 Qnil, Qnil, Qnil, Qnil);
527 break;
528
529 case 'i': /* Ignore an argument -- Does not do I/O */
530 varies[i] = -1;
531 break;
532
533 case 'k': /* Key sequence. */
534 {
535 int speccount1 = specpdl_ptr - specpdl;
536 specbind (Qcursor_in_echo_area, Qt);
537 args[i] = Fread_key_sequence (build_string (callint_message),
538 Qnil, Qnil, Qnil);
539 unbind_to (speccount1, Qnil);
540 teml = args[i];
541 visargs[i] = Fkey_description (teml);
542 }
543 break;
544
545 case 'K': /* Key sequence to be defined. */
546 {
547 int speccount1 = specpdl_ptr - specpdl;
548 specbind (Qcursor_in_echo_area, Qt);
549 args[i] = Fread_key_sequence (build_string (callint_message),
550 Qnil, Qt, Qnil);
551 teml = args[i];
552 visargs[i] = Fkey_description (teml);
553 unbind_to (speccount1, Qnil);
554 }
555 break;
556
557 case 'e': /* The invoking event. */
558 if (next_event >= key_count)
559 error ("%s must be bound to an event with parameters",
560 (SYMBOLP (function)
561 ? (char *) XSYMBOL (function)->name->data
562 : "command"));
563 args[i] = XVECTOR (keys)->contents[next_event++];
564 varies[i] = -1;
565
566 /* Find the next parameterized event. */
567 while (next_event < key_count
568 && ! (EVENT_HAS_PARAMETERS
569 (XVECTOR (keys)->contents[next_event])))
570 next_event++;
571
572 break;
573
574 case 'm': /* Value of mark. Does not do I/O. */
575 check_mark ();
576 /* visargs[i] = Qnil; */
577 args[i] = current_buffer->mark;
578 varies[i] = 2;
579 break;
580
581 case 'N': /* Prefix arg, else number from minibuffer */
582 if (!NILP (prefix_arg))
583 goto have_prefix_arg;
584 case 'n': /* Read number from minibuffer. */
585 {
586 int first = 1;
587 do
588 {
589 Lisp_Object tem;
590 if (! first)
591 {
592 message ("Please enter a number.");
593 sit_for (1, 0, 0, 0);
594 }
595 first = 0;
596
597 tem = Fread_from_minibuffer (build_string (callint_message),
598 Qnil, Qnil, Qnil, Qnil);
599 if (! STRINGP (tem) || XSTRING (tem)->size == 0)
600 args[i] = Qnil;
601 else
602 args[i] = Fread (tem);
603 }
604 while (! NUMBERP (args[i]));
605 }
606 visargs[i] = last_minibuf_string;
607 break;
608
609 case 'P': /* Prefix arg in raw form. Does no I/O. */
610 args[i] = prefix_arg;
611 /* visargs[i] = Qnil; */
612 varies[i] = -1;
613 break;
614
615 case 'p': /* Prefix arg converted to number. No I/O. */
616 have_prefix_arg:
617 args[i] = Fprefix_numeric_value (prefix_arg);
618 /* visargs[i] = Qnil; */
619 varies[i] = -1;
620 break;
621
622 case 'r': /* Region, point and mark as 2 args. */
623 check_mark ();
624 Fset_marker (point_marker, make_number (PT), Qnil);
625 /* visargs[i+1] = Qnil; */
626 foo = marker_position (current_buffer->mark);
627 /* visargs[i] = Qnil; */
628 args[i] = PT < foo ? point_marker : current_buffer->mark;
629 varies[i] = 3;
630 args[++i] = PT > foo ? point_marker : current_buffer->mark;
631 varies[i] = 4;
632 break;
633
634 case 's': /* String read via minibuffer. */
635 args[i] = Fread_string (build_string (callint_message), Qnil, Qnil);
636 break;
637
638 case 'S': /* Any symbol. */
639 visargs[i] = Fread_string (build_string (callint_message),
640 Qnil, Qnil);
641 /* Passing args[i] directly stimulates compiler bug */
642 teml = visargs[i];
643 args[i] = Fintern (teml, Qnil);
644 break;
645
646 case 'v': /* Variable name: symbol that is
647 user-variable-p. */
648 args[i] = Fread_variable (build_string (callint_message));
649 visargs[i] = last_minibuf_string;
650 break;
651
652 case 'x': /* Lisp expression read but not evaluated */
653 args[i] = Fread_minibuffer (build_string (callint_message), Qnil);
654 visargs[i] = last_minibuf_string;
655 break;
656
657 case 'X': /* Lisp expression read and evaluated */
658 args[i] = Feval_minibuffer (build_string (callint_message), Qnil);
659 visargs[i] = last_minibuf_string;
660 break;
661
662 case 'Z': /* Coding-system symbol, or ignore the
663 argument if no prefix */
664 if (NILP (prefix_arg))
665 {
666 args[i] = Qnil;
667 varies[i] = -1;
668 }
669 else
670 {
671 args[i]
672 = Fread_non_nil_coding_system (build_string (callint_message));
673 visargs[i] = last_minibuf_string;
674 }
675 break;
676
677 case 'z': /* Coding-system symbol or nil */
678 args[i] = Fread_coding_system (build_string (callint_message));
679 visargs[i] = last_minibuf_string;
680 break;
681
682 /* We have a case for `+' so we get an error
683 if anyone tries to define one here. */
684 case '+':
685 default:
686 error ("Invalid control letter `%c' (%03o) in interactive calling string",
687 *tem, *tem);
688 }
689
690 if (varies[i] == 0)
691 arg_from_tty = 1;
692
693 if (NILP (visargs[i]) && STRINGP (args[i]))
694 visargs[i] = args[i];
695
696 tem = (unsigned char *) index (tem, '\n');
697 if (tem) tem++;
698 else tem = (unsigned char *) "";
699 }
700 unbind_to (speccount, Qnil);
701
702 QUIT;
703
704 args[0] = function;
705
706 if (arg_from_tty || !NILP (record_flag))
707 {
708 visargs[0] = function;
709 for (i = 1; i < count + 1; i++)
710 {
711 if (varies[i] > 0)
712 visargs[i] = Fcons (intern (callint_argfuns[varies[i]]), Qnil);
713 else
714 visargs[i] = quotify_arg (args[i]);
715 }
716 Vcommand_history = Fcons (Flist (count + 1, visargs),
717 Vcommand_history);
718 }
719
720 /* If we used a marker to hold point, mark, or an end of the region,
721 temporarily, convert it to an integer now. */
722 for (i = 1; i <= count; i++)
723 if (varies[i] >= 1 && varies[i] <= 4)
724 XSETINT (args[i], marker_position (args[i]));
725
726 single_kboard_state ();
727
728 {
729 Lisp_Object val;
730 specbind (Qcommand_debug_status, Qnil);
731
732 val = Ffuncall (count + 1, args);
733 UNGCPRO;
734 return unbind_to (speccount, val);
735 }
736 }
737
738 DEFUN ("prefix-numeric-value", Fprefix_numeric_value, Sprefix_numeric_value,
739 1, 1, 0,
740 "Return numeric meaning of raw prefix argument RAW.\n\
741 A raw prefix argument is what you get from `(interactive \"P\")'.\n\
742 Its numeric meaning is what you would get from `(interactive \"p\")'.")
743 (raw)
744 Lisp_Object raw;
745 {
746 Lisp_Object val;
747
748 if (NILP (raw))
749 XSETFASTINT (val, 1);
750 else if (EQ (raw, Qminus))
751 XSETINT (val, -1);
752 else if (CONSP (raw) && INTEGERP (XCONS (raw)->car))
753 XSETINT (val, XINT (XCONS (raw)->car));
754 else if (INTEGERP (raw))
755 val = raw;
756 else
757 XSETFASTINT (val, 1);
758
759 return val;
760 }
761
762 syms_of_callint ()
763 {
764 point_marker = Fmake_marker ();
765 staticpro (&point_marker);
766
767 preserved_fns = Fcons (intern ("region-beginning"),
768 Fcons (intern ("region-end"),
769 Fcons (intern ("point"),
770 Fcons (intern ("mark"), Qnil))));
771 staticpro (&preserved_fns);
772
773 Qlist = intern ("list");
774 staticpro (&Qlist);
775 Qlet = intern ("let");
776 staticpro (&Qlet);
777 Qletx = intern ("let*");
778 staticpro (&Qletx);
779 Qsave_excursion = intern ("save-excursion");
780 staticpro (&Qsave_excursion);
781
782 Qminus = intern ("-");
783 staticpro (&Qminus);
784
785 Qplus = intern ("+");
786 staticpro (&Qplus);
787
788 Qcall_interactively = intern ("call-interactively");
789 staticpro (&Qcall_interactively);
790
791 Qcommand_debug_status = intern ("command-debug-status");
792 staticpro (&Qcommand_debug_status);
793
794 Qenable_recursive_minibuffers = intern ("enable-recursive-minibuffers");
795 staticpro (&Qenable_recursive_minibuffers);
796
797 Qmouse_leave_buffer_hook = intern ("mouse-leave-buffer-hook");
798 staticpro (&Qmouse_leave_buffer_hook);
799
800 callint_message_size = 100;
801 callint_message = (char *) xmalloc (callint_message_size);
802
803
804 DEFVAR_KBOARD ("prefix-arg", Vprefix_arg,
805 "The value of the prefix argument for the next editing command.\n\
806 It may be a number, or the symbol `-' for just a minus sign as arg,\n\
807 or a list whose car is a number for just one or more C-U's\n\
808 or nil if no argument has been specified.\n\
809 \n\
810 You cannot examine this variable to find the argument for this command\n\
811 since it has been set to nil by the time you can look.\n\
812 Instead, you should use the variable `current-prefix-arg', although\n\
813 normally commands can get this prefix argument with (interactive \"P\").");
814
815 DEFVAR_LISP ("current-prefix-arg", &Vcurrent_prefix_arg,
816 "The value of the prefix argument for this editing command.\n\
817 It may be a number, or the symbol `-' for just a minus sign as arg,\n\
818 or a list whose car is a number for just one or more C-U's\n\
819 or nil if no argument has been specified.\n\
820 This is what `(interactive \"P\")' returns.");
821 Vcurrent_prefix_arg = Qnil;
822
823 DEFVAR_LISP ("command-history", &Vcommand_history,
824 "List of recent commands that read arguments from terminal.\n\
825 Each command is represented as a form to evaluate.");
826 Vcommand_history = Qnil;
827
828 DEFVAR_LISP ("command-debug-status", &Vcommand_debug_status,
829 "Debugging status of current interactive command.\n\
830 Bound each time `call-interactively' is called;\n\
831 may be set by the debugger as a reminder for itself.");
832 Vcommand_debug_status = Qnil;
833
834 DEFVAR_LISP ("mark-even-if-inactive", &Vmark_even_if_inactive,
835 "*Non-nil means you can use the mark even when inactive.\n\
836 This option makes a difference in Transient Mark mode.\n\
837 When the option is non-nil, deactivation of the mark\n\
838 turns off region highlighting, but commands that use the mark\n\
839 behave as if the mark were still active.");
840 Vmark_even_if_inactive = Qnil;
841
842 DEFVAR_LISP ("mouse-leave-buffer-hook", &Vmouse_leave_buffer_hook,
843 "Hook to run when about to switch windows with a mouse command.\n\
844 Its purpose is to give temporary modes such as Isearch mode\n\
845 a way to turn themselves off when a mouse command switches windows.");
846 Vmouse_leave_buffer_hook = Qnil;
847
848 defsubr (&Sinteractive);
849 defsubr (&Scall_interactively);
850 defsubr (&Sprefix_numeric_value);
851 }