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