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