1 /* Call a Lisp function interactively.
2 Copyright (C) 1985, 1986, 1993, 1994, 1995, 1997, 2000, 2001, 2002,
3 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
4 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
32 Lisp_Object Vcurrent_prefix_arg
, Qminus
, Qplus
;
33 Lisp_Object Qcall_interactively
;
34 Lisp_Object Vcommand_history
;
36 Lisp_Object Vcommand_debug_status
, Qcommand_debug_status
;
37 Lisp_Object Qenable_recursive_minibuffers
;
39 /* Non-nil means treat the mark as active
40 even if mark_active is 0. */
41 Lisp_Object Vmark_even_if_inactive
;
43 Lisp_Object Qhandle_shift_selection
;
45 Lisp_Object Vmouse_leave_buffer_hook
, Qmouse_leave_buffer_hook
;
47 Lisp_Object Qlist
, Qlet
, Qletx
, Qsave_excursion
, Qprogn
, Qif
, Qwhen
;
48 static Lisp_Object preserved_fns
;
50 /* Marker used within call-interactively to refer to point. */
51 static Lisp_Object point_marker
;
53 /* String for the prompt text used in Fcall_interactively. */
54 static Lisp_Object callint_message
;
57 DEFUN ("interactive", Finteractive
, Sinteractive
, 0, UNEVALLED
, 0,
58 doc
: /* Specify a way of parsing arguments for interactive use of a function.
60 (defun foo (arg buf) "Doc string" (interactive "P\\nbbuffer: ") .... )
61 to make ARG be the raw prefix argument, and set BUF to an existing buffer,
62 when `foo' is called as a command.
63 The "call" to `interactive' is actually a declaration rather than a function;
64 it tells `call-interactively' how to read arguments
65 to pass to the function.
66 When actually called, `interactive' just returns nil.
68 Usually the argument of `interactive' is a string containing a code letter
69 followed optionally by a prompt. (Some code letters do not use I/O to get
70 the argument and do not use prompts.) To get several arguments, concatenate
71 the individual strings, separating them by newline characters.
72 Prompts are passed to format, and may use % escapes to print the
73 arguments that have already been read.
74 If the argument is not a string, it is evaluated to get a list of
75 arguments to pass to the function.
76 Just `(interactive)' means pass no args when calling interactively.
78 Code letters available are:
79 a -- Function name: symbol with a function definition.
80 b -- Name of existing buffer.
81 B -- Name of buffer, possibly nonexistent.
82 c -- Character (no input method is used).
83 C -- Command name: symbol with interactive function definition.
84 d -- Value of point as number. Does not do I/O.
86 e -- Parametrized event (i.e., one that's a list) that invoked this command.
87 If used more than once, the Nth `e' returns the Nth parameterized event.
88 This skips events that are integers or symbols.
89 f -- Existing file name.
90 F -- Possibly nonexistent file name.
91 G -- Possibly nonexistent file name, defaulting to just directory name.
92 i -- Ignored, i.e. always nil. Does not do I/O.
93 k -- Key sequence (downcase the last event if needed to get a definition).
94 K -- Key sequence to be redefined (do not downcase the last event).
95 m -- Value of mark as number. Does not do I/O.
96 M -- Any string. Inherits the current input method.
97 n -- Number read using minibuffer.
98 N -- Numeric prefix arg, or if none, do like code `n'.
99 p -- Prefix arg converted to number. Does not do I/O.
100 P -- Prefix arg in raw form. Does not do I/O.
101 r -- Region: point and mark as 2 numeric args, smallest first. Does no I/O.
102 s -- Any string. Does not inherit the current input method.
104 U -- Mouse up event discarded by a previous k or K argument.
105 v -- Variable name: symbol that is user-variable-p.
106 x -- Lisp expression read but not evaluated.
107 X -- Lisp expression read and evaluated.
109 Z -- Coding system, nil if no prefix arg.
111 In addition, if the string begins with `*', an error is signaled if
112 the buffer is read-only.
113 If the string begins with `@', Emacs searches the key sequence which
114 invoked the command for its first mouse click (or any other event
115 which specifies a window).
116 If the string begins with `^' and `shift-select-mode' is non-nil,
117 Emacs first calls the function `handle-shift-selection'.
118 You may use `@', `*', and `^' together. They are processed in the
119 order that they appear, before reading any arguments.
120 usage: (interactive &optional ARGS) */)
126 /* Quotify EXP: if EXP is constant, return it.
127 If EXP is not constant, return (quote EXP). */
129 quotify_arg (register Lisp_Object exp
)
131 if (!INTEGERP (exp
) && !STRINGP (exp
)
132 && !NILP (exp
) && !EQ (exp
, Qt
))
133 return Fcons (Qquote
, Fcons (exp
, Qnil
));
138 /* Modify EXP by quotifying each element (except the first). */
140 quotify_args (Lisp_Object exp
)
142 register Lisp_Object tail
;
144 for (tail
= exp
; CONSP (tail
); tail
= next
)
147 XSETCAR (tail
, quotify_arg (XCAR (tail
)));
152 static const char *callint_argfuns
[]
153 = {"", "point", "mark", "region-beginning", "region-end"};
156 check_mark (int for_region
)
159 tem
= Fmarker_buffer (current_buffer
->mark
);
160 if (NILP (tem
) || (XBUFFER (tem
) != current_buffer
))
161 error (for_region
? "The mark is not set now, so there is no region"
162 : "The mark is not set now");
163 if (!NILP (Vtransient_mark_mode
) && NILP (Vmark_even_if_inactive
)
164 && NILP (current_buffer
->mark_active
))
165 xsignal0 (Qmark_inactive
);
168 /* If the list of args INPUT was produced with an explicit call to
169 `list', look for elements that were computed with
170 (region-beginning) or (region-end), and put those expressions into
171 VALUES instead of the present values.
173 This function doesn't return a value because it modifies elements
174 of VALUES to do its job. */
177 fix_command (Lisp_Object input
, Lisp_Object values
)
184 /* Skip through certain special forms. */
185 while (EQ (car
, Qlet
) || EQ (car
, Qletx
)
186 || EQ (car
, Qsave_excursion
)
189 while (CONSP (XCDR (input
)))
190 input
= XCDR (input
);
191 input
= XCAR (input
);
198 Lisp_Object intail
, valtail
;
199 for (intail
= Fcdr (input
), valtail
= values
;
201 intail
= Fcdr (intail
), valtail
= XCDR (valtail
))
207 Lisp_Object presflag
, carelt
;
209 /* If it is (if X Y), look at Y. */
211 && EQ (Fnthcdr (make_number (3), elt
), Qnil
))
212 elt
= Fnth (make_number (2), elt
);
213 /* If it is (when ... Y), look at Y. */
214 else if (EQ (carelt
, Qwhen
))
216 while (CONSP (XCDR (elt
)))
221 /* If the function call we're looking at
222 is a special preserved one, copy the
223 whole expression for this argument. */
226 presflag
= Fmemq (Fcar (elt
), preserved_fns
);
227 if (!NILP (presflag
))
228 Fsetcar (valtail
, Fcar (intail
));
236 DEFUN ("call-interactively", Fcall_interactively
, Scall_interactively
, 1, 3, 0,
237 doc
: /* Call FUNCTION, reading args according to its interactive calling specs.
238 Return the value FUNCTION returns.
239 The function contains a specification of how to do the argument reading.
240 In the case of user-defined functions, this is specified by placing a call
241 to the function `interactive' at the top level of the function body.
244 Optional second arg RECORD-FLAG non-nil
245 means unconditionally put this command in the command-history.
246 Otherwise, this is done only if an arg is read using the minibuffer.
248 Optional third arg KEYS, if given, specifies the sequence of events to
249 supply, as a vector, if the command inquires which events were used to
250 invoke it. If KEYS is omitted or nil, the return value of
251 `this-command-keys-vector' is used. */)
252 (Lisp_Object function
, Lisp_Object record_flag
, Lisp_Object keys
)
254 Lisp_Object
*args
, *visargs
;
256 Lisp_Object filter_specs
;
258 Lisp_Object up_event
;
260 int speccount
= SPECPDL_INDEX ();
262 /* The index of the next element of this_command_keys to examine for
263 the 'e' interactive code. */
266 Lisp_Object prefix_arg
;
267 unsigned char *string
;
270 /* If varies[i] > 0, the i'th argument shouldn't just have its value
271 in this call quoted in the command history. It should be
272 recorded as a call to the function named callint_argfuns[varies[i]]. */
279 int arg_from_tty
= 0;
280 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
282 int record_then_fail
= 0;
284 Lisp_Object save_this_command
, save_last_command
;
285 Lisp_Object save_this_original_command
, save_real_this_command
;
287 save_this_command
= Vthis_command
;
288 save_this_original_command
= Vthis_original_command
;
289 save_real_this_command
= real_this_command
;
290 save_last_command
= current_kboard
->Vlast_command
;
293 keys
= this_command_keys
, key_count
= this_command_key_count
;
297 key_count
= XVECTOR (keys
)->size
;
300 /* Save this now, since use of minibuffer will clobber it. */
301 prefix_arg
= Vcurrent_prefix_arg
;
303 if (SYMBOLP (function
))
304 enable
= Fget (function
, Qenable_recursive_minibuffers
);
310 /* The idea of FILTER_SPECS is to provide away to
311 specify how to represent the arguments in command history.
312 The feature is not fully implemented. */
315 /* If k or K discard an up-event, save it here so it can be retrieved with U */
318 /* Set SPECS to the interactive form, or barf if not interactive. */
321 GCPRO2 (function
, prefix_arg
);
322 form
= Finteractive_form (function
);
325 specs
= filter_specs
= Fcar (XCDR (form
));
327 wrong_type_argument (Qcommandp
, function
);
330 /* If SPECS is set to a string, use it as an interactive prompt. */
333 /* Make a copy of string so that if a GC relocates specs,
334 `string' will still be valid. */
335 string
= (unsigned char *) alloca (SBYTES (specs
) + 1);
336 memcpy (string
, SDATA (specs
), SBYTES (specs
) + 1);
341 i
= num_input_events
;
343 /* Compute the arg values using the user's expression. */
344 GCPRO2 (input
, filter_specs
);
345 specs
= Feval (specs
);
347 if (i
!= num_input_events
|| !NILP (record_flag
))
349 /* We should record this command on the command history. */
351 Lisp_Object this_cmd
;
352 /* Make a copy of the list of values, for the command history,
353 and turn them into things we can eval. */
354 values
= quotify_args (Fcopy_sequence (specs
));
355 fix_command (input
, values
);
356 this_cmd
= Fcons (function
, values
);
357 if (history_delete_duplicates
)
358 Vcommand_history
= Fdelete (this_cmd
, Vcommand_history
);
359 Vcommand_history
= Fcons (this_cmd
, Vcommand_history
);
361 /* Don't keep command history around forever. */
362 if (INTEGERP (Vhistory_length
) && XINT (Vhistory_length
) > 0)
364 teml
= Fnthcdr (Vhistory_length
, Vcommand_history
);
366 XSETCDR (teml
, Qnil
);
370 Vthis_command
= save_this_command
;
371 Vthis_original_command
= save_this_original_command
;
372 real_this_command
= save_real_this_command
;
373 current_kboard
->Vlast_command
= save_last_command
;
375 temporarily_switch_to_single_kboard (NULL
);
376 return unbind_to (speccount
, apply1 (function
, specs
));
379 /* Here if function specifies a string to control parsing the defaults */
381 /* Set next_event to point to the first event with parameters. */
382 for (next_event
= 0; next_event
< key_count
; next_event
++)
383 if (EVENT_HAS_PARAMETERS (AREF (keys
, next_event
)))
386 /* Handle special starting chars `*' and `@'. Also `-'. */
387 /* Note that `+' is reserved for user extensions. */
391 error ("`+' is not used in `interactive' for ordinary commands");
392 else if (*string
== '*')
395 if (!NILP (current_buffer
->read_only
))
397 if (!NILP (record_flag
))
399 unsigned char *p
= string
;
402 if (! (*p
== 'r' || *p
== 'p' || *p
== 'P'
404 Fbarf_if_buffer_read_only ();
407 record_then_fail
= 1;
410 Fbarf_if_buffer_read_only ();
413 /* Ignore this for semi-compatibility with Lucid. */
414 else if (*string
== '-')
416 else if (*string
== '@')
418 Lisp_Object event
, tem
;
420 event
= (next_event
< key_count
421 ? AREF (keys
, next_event
)
423 if (EVENT_HAS_PARAMETERS (event
)
424 && (tem
= XCDR (event
), CONSP (tem
))
425 && (tem
= XCAR (tem
), CONSP (tem
))
426 && (tem
= XCAR (tem
), WINDOWP (tem
)))
428 if (MINI_WINDOW_P (XWINDOW (tem
))
429 && ! (minibuf_level
> 0 && EQ (tem
, minibuf_window
)))
430 error ("Attempt to select inactive minibuffer window");
432 /* If the current buffer wants to clean up, let it. */
433 if (!NILP (Vmouse_leave_buffer_hook
))
434 call1 (Vrun_hooks
, Qmouse_leave_buffer_hook
);
436 Fselect_window (tem
, Qnil
);
440 else if (*string
== '^')
442 call0 (Qhandle_shift_selection
);
448 /* Count the number of arguments the interactive spec would have
449 us give to the function. */
453 /* 'r' specifications ("point and mark as 2 numeric args")
454 produce *two* arguments. */
459 tem
= (unsigned char *) strchr (tem
, '\n');
467 args
= (Lisp_Object
*) alloca ((count
+ 1) * sizeof (Lisp_Object
));
468 visargs
= (Lisp_Object
*) alloca ((count
+ 1) * sizeof (Lisp_Object
));
469 varies
= (int *) alloca ((count
+ 1) * sizeof (int));
471 for (i
= 0; i
< (count
+ 1); i
++)
478 GCPRO5 (prefix_arg
, function
, *args
, *visargs
, up_event
);
479 gcpro3
.nvars
= (count
+ 1);
480 gcpro4
.nvars
= (count
+ 1);
483 specbind (Qenable_recursive_minibuffers
, Qt
);
486 for (i
= 1; *tem
; i
++)
488 strncpy (prompt1
, tem
+ 1, sizeof prompt1
- 1);
489 prompt1
[sizeof prompt1
- 1] = 0;
490 tem1
= strchr (prompt1
, '\n');
493 visargs
[0] = build_string (prompt1
);
494 if (strchr (prompt1
, '%'))
495 callint_message
= Fformat (i
, visargs
);
497 callint_message
= visargs
[0];
501 case 'a': /* Symbol defined as a function */
502 visargs
[i
] = Fcompleting_read (callint_message
,
503 Vobarray
, Qfboundp
, Qt
,
504 Qnil
, Qnil
, Qnil
, Qnil
);
505 /* Passing args[i] directly stimulates compiler bug */
507 args
[i
] = Fintern (teml
, Qnil
);
510 case 'b': /* Name of existing buffer */
511 args
[i
] = Fcurrent_buffer ();
512 if (EQ (selected_window
, minibuf_window
))
513 args
[i
] = Fother_buffer (args
[i
], Qnil
, Qnil
);
514 args
[i
] = Fread_buffer (callint_message
, args
[i
], Qt
);
517 case 'B': /* Name of buffer, possibly nonexistent */
518 args
[i
] = Fread_buffer (callint_message
,
519 Fother_buffer (Fcurrent_buffer (), Qnil
, Qnil
),
523 case 'c': /* Character */
524 /* Prompt in `minibuffer-prompt' face. */
525 Fput_text_property (make_number (0),
526 make_number (SCHARS (callint_message
)),
527 Qface
, Qminibuffer_prompt
, callint_message
);
528 args
[i
] = Fread_char (callint_message
, Qnil
, Qnil
);
529 message1_nolog ((char *) 0);
530 /* Passing args[i] directly stimulates compiler bug */
532 visargs
[i
] = Fchar_to_string (teml
);
535 case 'C': /* Command: symbol with interactive function */
536 visargs
[i
] = Fcompleting_read (callint_message
,
538 Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
539 /* Passing args[i] directly stimulates compiler bug */
541 args
[i
] = Fintern (teml
, Qnil
);
544 case 'd': /* Value of point. Does not do I/O. */
545 set_marker_both (point_marker
, Qnil
, PT
, PT_BYTE
);
546 args
[i
] = point_marker
;
547 /* visargs[i] = Qnil; */
551 case 'D': /* Directory name. */
552 args
[i
] = Fread_file_name (callint_message
, Qnil
,
553 current_buffer
->directory
, Qlambda
, Qnil
,
557 case 'f': /* Existing file name. */
558 args
[i
] = Fread_file_name (callint_message
,
559 Qnil
, Qnil
, Qlambda
, Qnil
, Qnil
);
562 case 'F': /* Possibly nonexistent file name. */
563 args
[i
] = Fread_file_name (callint_message
,
564 Qnil
, Qnil
, Qnil
, Qnil
, Qnil
);
567 case 'G': /* Possibly nonexistent file name,
568 default to directory alone. */
569 args
[i
] = Fread_file_name (callint_message
,
570 Qnil
, Qnil
, Qnil
, empty_unibyte_string
, Qnil
);
573 case 'i': /* Ignore an argument -- Does not do I/O */
577 case 'k': /* Key sequence. */
579 int speccount1
= SPECPDL_INDEX ();
580 specbind (Qcursor_in_echo_area
, Qt
);
581 /* Prompt in `minibuffer-prompt' face. */
582 Fput_text_property (make_number (0),
583 make_number (SCHARS (callint_message
)),
584 Qface
, Qminibuffer_prompt
, callint_message
);
585 args
[i
] = Fread_key_sequence (callint_message
,
586 Qnil
, Qnil
, Qnil
, Qnil
);
587 unbind_to (speccount1
, Qnil
);
589 visargs
[i
] = Fkey_description (teml
, Qnil
);
591 /* If the key sequence ends with a down-event,
592 discard the following up-event. */
593 teml
= Faref (args
[i
], make_number (XINT (Flength (args
[i
])) - 1));
600 teml
= Fget (teml
, intern ("event-symbol-elements"));
601 /* Ignore first element, which is the base key. */
602 tem2
= Fmemq (intern ("down"), Fcdr (teml
));
604 up_event
= Fread_event (Qnil
, Qnil
, Qnil
);
609 case 'K': /* Key sequence to be defined. */
611 int speccount1
= SPECPDL_INDEX ();
612 specbind (Qcursor_in_echo_area
, Qt
);
613 /* Prompt in `minibuffer-prompt' face. */
614 Fput_text_property (make_number (0),
615 make_number (SCHARS (callint_message
)),
616 Qface
, Qminibuffer_prompt
, callint_message
);
617 args
[i
] = Fread_key_sequence (callint_message
,
618 Qnil
, Qt
, Qnil
, Qnil
);
620 visargs
[i
] = Fkey_description (teml
, Qnil
);
621 unbind_to (speccount1
, Qnil
);
623 /* If the key sequence ends with a down-event,
624 discard the following up-event. */
625 teml
= Faref (args
[i
], make_number (XINT (Flength (args
[i
])) - 1));
632 teml
= Fget (teml
, intern ("event-symbol-elements"));
633 /* Ignore first element, which is the base key. */
634 tem2
= Fmemq (intern ("down"), Fcdr (teml
));
636 up_event
= Fread_event (Qnil
, Qnil
, Qnil
);
641 case 'U': /* Up event from last k or K */
642 if (!NILP (up_event
))
644 args
[i
] = Fmake_vector (make_number (1), up_event
);
647 visargs
[i
] = Fkey_description (teml
, Qnil
);
651 case 'e': /* The invoking event. */
652 if (next_event
>= key_count
)
653 error ("%s must be bound to an event with parameters",
655 ? (char *) SDATA (SYMBOL_NAME (function
))
657 args
[i
] = AREF (keys
, next_event
);
661 /* Find the next parameterized event. */
662 while (next_event
< key_count
663 && !(EVENT_HAS_PARAMETERS (AREF (keys
, next_event
))))
668 case 'm': /* Value of mark. Does not do I/O. */
670 /* visargs[i] = Qnil; */
671 args
[i
] = current_buffer
->mark
;
675 case 'M': /* String read via minibuffer with
676 inheriting the current input method. */
677 args
[i
] = Fread_string (callint_message
,
678 Qnil
, Qnil
, Qnil
, Qt
);
681 case 'N': /* Prefix arg as number, else number from minibuffer */
682 if (!NILP (prefix_arg
))
683 goto have_prefix_arg
;
684 case 'n': /* Read number from minibuffer. */
692 message ("Please enter a number.");
693 sit_for (make_number (1), 0, 0);
697 tem
= Fread_from_minibuffer (callint_message
,
698 Qnil
, Qnil
, Qnil
, Qnil
, Qnil
,
700 if (! STRINGP (tem
) || SCHARS (tem
) == 0)
703 args
[i
] = Fread (tem
);
705 while (! NUMBERP (args
[i
]));
707 visargs
[i
] = args
[i
];
710 case 'P': /* Prefix arg in raw form. Does no I/O. */
711 args
[i
] = prefix_arg
;
712 /* visargs[i] = Qnil; */
716 case 'p': /* Prefix arg converted to number. No I/O. */
718 args
[i
] = Fprefix_numeric_value (prefix_arg
);
719 /* visargs[i] = Qnil; */
723 case 'r': /* Region, point and mark as 2 args. */
725 set_marker_both (point_marker
, Qnil
, PT
, PT_BYTE
);
726 /* visargs[i+1] = Qnil; */
727 foo
= marker_position (current_buffer
->mark
);
728 /* visargs[i] = Qnil; */
729 args
[i
] = PT
< foo
? point_marker
: current_buffer
->mark
;
731 args
[++i
] = PT
> foo
? point_marker
: current_buffer
->mark
;
735 case 's': /* String read via minibuffer without
736 inheriting the current input method. */
737 args
[i
] = Fread_string (callint_message
,
738 Qnil
, Qnil
, Qnil
, Qnil
);
741 case 'S': /* Any symbol. */
742 visargs
[i
] = Fread_string (callint_message
,
743 Qnil
, Qnil
, Qnil
, Qnil
);
744 /* Passing args[i] directly stimulates compiler bug */
746 args
[i
] = Fintern (teml
, Qnil
);
749 case 'v': /* Variable name: symbol that is
751 args
[i
] = Fread_variable (callint_message
, Qnil
);
752 visargs
[i
] = last_minibuf_string
;
755 case 'x': /* Lisp expression read but not evaluated */
756 args
[i
] = Fread_minibuffer (callint_message
, Qnil
);
757 visargs
[i
] = last_minibuf_string
;
760 case 'X': /* Lisp expression read and evaluated */
761 args
[i
] = Feval_minibuffer (callint_message
, Qnil
);
762 visargs
[i
] = last_minibuf_string
;
765 case 'Z': /* Coding-system symbol, or ignore the
766 argument if no prefix */
767 if (NILP (prefix_arg
))
775 = Fread_non_nil_coding_system (callint_message
);
776 visargs
[i
] = last_minibuf_string
;
780 case 'z': /* Coding-system symbol or nil */
781 args
[i
] = Fread_coding_system (callint_message
, Qnil
);
782 visargs
[i
] = last_minibuf_string
;
785 /* We have a case for `+' so we get an error
786 if anyone tries to define one here. */
789 error ("Invalid control letter `%c' (%03o) in interactive calling string",
796 if (NILP (visargs
[i
]) && STRINGP (args
[i
]))
797 visargs
[i
] = args
[i
];
799 tem
= (unsigned char *) strchr (tem
, '\n');
801 else tem
= (unsigned char *) "";
803 unbind_to (speccount
, Qnil
);
809 if (arg_from_tty
|| !NILP (record_flag
))
811 visargs
[0] = function
;
812 for (i
= 1; i
< count
+ 1; i
++)
815 visargs
[i
] = Fcons (intern (callint_argfuns
[varies
[i
]]), Qnil
);
817 visargs
[i
] = quotify_arg (args
[i
]);
819 Vcommand_history
= Fcons (Flist (count
+ 1, visargs
),
821 /* Don't keep command history around forever. */
822 if (INTEGERP (Vhistory_length
) && XINT (Vhistory_length
) > 0)
824 teml
= Fnthcdr (Vhistory_length
, Vcommand_history
);
826 XSETCDR (teml
, Qnil
);
830 /* If we used a marker to hold point, mark, or an end of the region,
831 temporarily, convert it to an integer now. */
832 for (i
= 1; i
<= count
; i
++)
833 if (varies
[i
] >= 1 && varies
[i
] <= 4)
834 XSETINT (args
[i
], marker_position (args
[i
]));
836 if (record_then_fail
)
837 Fbarf_if_buffer_read_only ();
839 Vthis_command
= save_this_command
;
840 Vthis_original_command
= save_this_original_command
;
841 real_this_command
= save_real_this_command
;
842 current_kboard
->Vlast_command
= save_last_command
;
846 specbind (Qcommand_debug_status
, Qnil
);
848 temporarily_switch_to_single_kboard (NULL
);
849 val
= Ffuncall (count
+ 1, args
);
851 return unbind_to (speccount
, val
);
855 DEFUN ("prefix-numeric-value", Fprefix_numeric_value
, Sprefix_numeric_value
,
857 doc
: /* Return numeric meaning of raw prefix argument RAW.
858 A raw prefix argument is what you get from `(interactive "P")'.
859 Its numeric meaning is what you would get from `(interactive "p")'. */)
865 XSETFASTINT (val
, 1);
866 else if (EQ (raw
, Qminus
))
868 else if (CONSP (raw
) && INTEGERP (XCAR (raw
)))
869 XSETINT (val
, XINT (XCAR (raw
)));
870 else if (INTEGERP (raw
))
873 XSETFASTINT (val
, 1);
879 syms_of_callint (void)
881 point_marker
= Fmake_marker ();
882 staticpro (&point_marker
);
884 callint_message
= Qnil
;
885 staticpro (&callint_message
);
887 preserved_fns
= pure_cons (intern_c_string ("region-beginning"),
888 pure_cons (intern_c_string ("region-end"),
889 pure_cons (intern_c_string ("point"),
890 pure_cons (intern_c_string ("mark"), Qnil
))));
892 Qlist
= intern_c_string ("list");
894 Qlet
= intern_c_string ("let");
896 Qif
= intern_c_string ("if");
898 Qwhen
= intern_c_string ("when");
900 Qletx
= intern_c_string ("let*");
902 Qsave_excursion
= intern_c_string ("save-excursion");
903 staticpro (&Qsave_excursion
);
904 Qprogn
= intern_c_string ("progn");
907 Qminus
= intern_c_string ("-");
910 Qplus
= intern_c_string ("+");
913 Qhandle_shift_selection
= intern_c_string ("handle-shift-selection");
914 staticpro (&Qhandle_shift_selection
);
916 Qcall_interactively
= intern_c_string ("call-interactively");
917 staticpro (&Qcall_interactively
);
919 Qcommand_debug_status
= intern_c_string ("command-debug-status");
920 staticpro (&Qcommand_debug_status
);
922 Qenable_recursive_minibuffers
= intern_c_string ("enable-recursive-minibuffers");
923 staticpro (&Qenable_recursive_minibuffers
);
925 Qmouse_leave_buffer_hook
= intern_c_string ("mouse-leave-buffer-hook");
926 staticpro (&Qmouse_leave_buffer_hook
);
928 DEFVAR_KBOARD ("prefix-arg", Vprefix_arg
,
929 doc
: /* The value of the prefix argument for the next editing command.
930 It may be a number, or the symbol `-' for just a minus sign as arg,
931 or a list whose car is a number for just one or more C-u's
932 or nil if no argument has been specified.
934 You cannot examine this variable to find the argument for this command
935 since it has been set to nil by the time you can look.
936 Instead, you should use the variable `current-prefix-arg', although
937 normally commands can get this prefix argument with (interactive "P"). */);
939 DEFVAR_KBOARD ("last-prefix-arg", Vlast_prefix_arg
,
940 doc
: /* The value of the prefix argument for the previous editing command.
941 See `prefix-arg' for the meaning of the value. */);
943 DEFVAR_LISP ("current-prefix-arg", &Vcurrent_prefix_arg
,
944 doc
: /* The value of the prefix argument for this editing command.
945 It may be a number, or the symbol `-' for just a minus sign as arg,
946 or a list whose car is a number for just one or more C-u's
947 or nil if no argument has been specified.
948 This is what `(interactive \"P\")' returns. */);
949 Vcurrent_prefix_arg
= Qnil
;
951 DEFVAR_LISP ("command-history", &Vcommand_history
,
952 doc
: /* List of recent commands that read arguments from terminal.
953 Each command is represented as a form to evaluate.
955 Maximum length of the history list is determined by the value
956 of `history-length', which see. */);
957 Vcommand_history
= Qnil
;
959 DEFVAR_LISP ("command-debug-status", &Vcommand_debug_status
,
960 doc
: /* Debugging status of current interactive command.
961 Bound each time `call-interactively' is called;
962 may be set by the debugger as a reminder for itself. */);
963 Vcommand_debug_status
= Qnil
;
965 DEFVAR_LISP ("mark-even-if-inactive", &Vmark_even_if_inactive
,
966 doc
: /* *Non-nil means you can use the mark even when inactive.
967 This option makes a difference in Transient Mark mode.
968 When the option is non-nil, deactivation of the mark
969 turns off region highlighting, but commands that use the mark
970 behave as if the mark were still active. */);
971 Vmark_even_if_inactive
= Qt
;
973 DEFVAR_LISP ("mouse-leave-buffer-hook", &Vmouse_leave_buffer_hook
,
974 doc
: /* Hook to run when about to switch windows with a mouse command.
975 Its purpose is to give temporary modes such as Isearch mode
976 a way to turn themselves off when a mouse command switches windows. */);
977 Vmouse_leave_buffer_hook
= Qnil
;
979 defsubr (&Sinteractive
);
980 defsubr (&Scall_interactively
);
981 defsubr (&Sprefix_numeric_value
);
984 /* arch-tag: a3a7cad7-bcac-42ce-916e-1bd2546ebf37
985 (do not change this comment) */