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