X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/d2ddb05002375d191b3fe5cfc5978873748debe5..5dcde606e32d1794f8268ea51cd2d1746e45a311:/src/callint.c
diff --git a/src/callint.c b/src/callint.c
index 57c86f0a63..a45f8a372b 100644
--- a/src/callint.c
+++ b/src/callint.c
@@ -1,13 +1,14 @@
/* Call a Lisp function interactively.
Copyright (C) 1985, 1986, 1993, 1994, 1995, 1997, 2000, 2001, 2002,
- 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
+ Free Software Foundation, Inc.
This file is part of GNU Emacs.
-GNU Emacs is free software; you can redistribute it and/or modify
+GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 3, or (at your option)
-any later version.
+the Free Software Foundation, either version 3 of the License, or
+(at your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -15,12 +16,11 @@ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
-along with GNU Emacs; see the file COPYING. If not, write to
-the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-Boston, MA 02110-1301, USA. */
+along with GNU Emacs. If not, see . */
#include
+#include
#include "lisp.h"
#include "buffer.h"
@@ -35,6 +35,7 @@ extern char *index P_ ((const char *, int));
extern Lisp_Object Qcursor_in_echo_area;
extern Lisp_Object Qfile_directory_p;
+extern Lisp_Object Qonly;
Lisp_Object Vcurrent_prefix_arg, Qminus, Qplus;
Lisp_Object Qcall_interactively;
@@ -42,14 +43,18 @@ Lisp_Object Vcommand_history;
extern Lisp_Object Vhistory_length;
extern Lisp_Object Vthis_original_command, real_this_command;
+extern int history_delete_duplicates;
Lisp_Object Vcommand_debug_status, Qcommand_debug_status;
Lisp_Object Qenable_recursive_minibuffers;
+extern Lisp_Object Qface, Qminibuffer_prompt;
/* Non-nil means treat the mark as active
even if mark_active is 0. */
Lisp_Object Vmark_even_if_inactive;
+Lisp_Object Qhandle_shift_selection;
+
Lisp_Object Vmouse_leave_buffer_hook, Qmouse_leave_buffer_hook;
Lisp_Object Qlist, Qlet, Qletx, Qsave_excursion, Qprogn, Qif, Qwhen;
@@ -65,18 +70,19 @@ static Lisp_Object callint_message;
DEFUN ("interactive", Finteractive, Sinteractive, 0, UNEVALLED, 0,
doc: /* Specify a way of parsing arguments for interactive use of a function.
For example, write
- (defun foo (arg) "Doc string" (interactive "p") ...use arg...)
-to make ARG be the prefix argument when `foo' is called as a command.
+ (defun foo (arg buf) "Doc string" (interactive "P\\nbbuffer: ") .... )
+ to make ARG be the raw prefix argument, and set BUF to an existing buffer,
+ when `foo' is called as a command.
The "call" to `interactive' is actually a declaration rather than a function;
it tells `call-interactively' how to read arguments
to pass to the function.
When actually called, `interactive' just returns nil.
-The argument of `interactive' is usually a string containing a code letter
- followed by a prompt. (Some code letters do not use I/O to get
- the argument and do not need prompts.) To prompt for multiple arguments,
- give a code letter, its prompt, a newline, and another code letter, etc.
- Prompts are passed to format, and may use % escapes to print the
+Usually the argument of `interactive' is a string containing a code letter
+ followed optionally by a prompt. (Some code letters do not use I/O to get
+ the argument and do not use prompts.) To get several arguments, concatenate
+ the individual strings, separating them by newline characters.
+Prompts are passed to format, and may use % escapes to print the
arguments that have already been read.
If the argument is not a string, it is evaluated to get a list of
arguments to pass to the function.
@@ -114,15 +120,17 @@ x -- Lisp expression read but not evaluated.
X -- Lisp expression read and evaluated.
z -- Coding system.
Z -- Coding system, nil if no prefix arg.
-In addition, if the string begins with `*'
- then an error is signaled if the buffer is read-only.
- This happens before reading any arguments.
-If the string begins with `@', then Emacs searches the key sequence
- which invoked the command for its first mouse click (or any other
- event which specifies a window), and selects that window before
- reading any arguments. You may use both `@' and `*'; they are
- processed in the order that they appear.
-usage: (interactive ARGS) */)
+
+In addition, if the string begins with `*', an error is signaled if
+ the buffer is read-only.
+If the string begins with `@', Emacs searches the key sequence which
+ invoked the command for its first mouse click (or any other event
+ which specifies a window).
+If the string begins with `^' and `shift-select-mode' is non-nil,
+ Emacs first calls the function `handle-shift-selection'.
+You may use `@', `*', and `^' together. They are processed in the
+ order that they appear, before reading any arguments.
+usage: (interactive &optional ARGS) */)
(args)
Lisp_Object args;
{
@@ -263,7 +271,6 @@ invoke it. If KEYS is omitted or nil, the return value of
Lisp_Object function, record_flag, keys;
{
Lisp_Object *args, *visargs;
- Lisp_Object fun;
Lisp_Object specs;
Lisp_Object filter_specs;
Lisp_Object teml;
@@ -317,8 +324,6 @@ invoke it. If KEYS is omitted or nil, the return value of
else
enable = Qnil;
- fun = indirect_function (function);
-
specs = Qnil;
string = 0;
/* The idea of FILTER_SPECS is to provide away to
@@ -329,37 +334,19 @@ invoke it. If KEYS is omitted or nil, the return value of
/* If k or K discard an up-event, save it here so it can be retrieved with U */
up_event = Qnil;
- /* Decode the kind of function. Either handle it and return,
- or go to `lose' if not interactive, or set either STRING or SPECS. */
-
- if (SUBRP (fun))
- {
- string = (unsigned char *) XSUBR (fun)->prompt;
- if (!string)
- {
- lose:
- wrong_type_argument (Qcommandp, function);
- }
- }
- else if (COMPILEDP (fun))
- {
- if ((XVECTOR (fun)->size & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_INTERACTIVE)
- goto lose;
- specs = XVECTOR (fun)->contents[COMPILED_INTERACTIVE];
- }
- else
- {
- Lisp_Object form;
- GCPRO2 (function, prefix_arg);
- form = Finteractive_form (function);
- UNGCPRO;
- if (CONSP (form))
- specs = filter_specs = Fcar (XCDR (form));
- else
- goto lose;
- }
+ /* Set SPECS to the interactive form, or barf if not interactive. */
+ {
+ Lisp_Object form;
+ GCPRO2 (function, prefix_arg);
+ form = Finteractive_form (function);
+ UNGCPRO;
+ if (CONSP (form))
+ specs = filter_specs = Fcar (XCDR (form));
+ else
+ wrong_type_argument (Qcommandp, function);
+ }
- /* If either SPECS or STRING is set to a string, use it. */
+ /* If SPECS is set to a string, use it as an interactive prompt. */
if (STRINGP (specs))
{
/* Make a copy of string so that if a GC relocates specs,
@@ -368,7 +355,7 @@ invoke it. If KEYS is omitted or nil, the return value of
bcopy (SDATA (specs), string,
SBYTES (specs) + 1);
}
- else if (string == 0)
+ else
{
Lisp_Object input;
i = num_input_events;
@@ -381,12 +368,15 @@ invoke it. If KEYS is omitted or nil, the return value of
{
/* We should record this command on the command history. */
Lisp_Object values;
+ Lisp_Object this_cmd;
/* Make a copy of the list of values, for the command history,
and turn them into things we can eval. */
values = quotify_args (Fcopy_sequence (specs));
fix_command (input, values);
- Vcommand_history
- = Fcons (Fcons (function, values), Vcommand_history);
+ this_cmd = Fcons (function, values);
+ if (history_delete_duplicates)
+ Vcommand_history = Fdelete (this_cmd, Vcommand_history);
+ Vcommand_history = Fcons (this_cmd, Vcommand_history);
/* Don't keep command history around forever. */
if (INTEGERP (Vhistory_length) && XINT (Vhistory_length) > 0)
@@ -410,7 +400,7 @@ invoke it. If KEYS is omitted or nil, the return value of
/* Set next_event to point to the first event with parameters. */
for (next_event = 0; next_event < key_count; next_event++)
- if (EVENT_HAS_PARAMETERS (XVECTOR (keys)->contents[next_event]))
+ if (EVENT_HAS_PARAMETERS (AREF (keys, next_event)))
break;
/* Handle special starting chars `*' and `@'. Also `-'. */
@@ -448,7 +438,7 @@ invoke it. If KEYS is omitted or nil, the return value of
Lisp_Object event, tem;
event = (next_event < key_count
- ? XVECTOR (keys)->contents[next_event]
+ ? AREF (keys, next_event)
: Qnil);
if (EVENT_HAS_PARAMETERS (event)
&& (tem = XCDR (event), CONSP (tem))
@@ -467,6 +457,11 @@ invoke it. If KEYS is omitted or nil, the return value of
}
string++;
}
+ else if (*string == '^')
+ {
+ call0 (Qhandle_shift_selection);
+ string++;
+ }
else break;
}
@@ -546,6 +541,10 @@ invoke it. If KEYS is omitted or nil, the return value of
break;
case 'c': /* Character */
+ /* Prompt in `minibuffer-prompt' face. */
+ Fput_text_property (make_number (0),
+ make_number (SCHARS (callint_message)),
+ Qface, Qminibuffer_prompt, callint_message);
args[i] = Fread_char (callint_message, Qnil, Qnil);
message1_nolog ((char *) 0);
/* Passing args[i] directly stimulates compiler bug */
@@ -599,6 +598,10 @@ invoke it. If KEYS is omitted or nil, the return value of
{
int speccount1 = SPECPDL_INDEX ();
specbind (Qcursor_in_echo_area, Qt);
+ /* Prompt in `minibuffer-prompt' face. */
+ Fput_text_property (make_number (0),
+ make_number (SCHARS (callint_message)),
+ Qface, Qminibuffer_prompt, callint_message);
args[i] = Fread_key_sequence (callint_message,
Qnil, Qnil, Qnil, Qnil);
unbind_to (speccount1, Qnil);
@@ -627,6 +630,10 @@ invoke it. If KEYS is omitted or nil, the return value of
{
int speccount1 = SPECPDL_INDEX ();
specbind (Qcursor_in_echo_area, Qt);
+ /* Prompt in `minibuffer-prompt' face. */
+ Fput_text_property (make_number (0),
+ make_number (SCHARS (callint_message)),
+ Qface, Qminibuffer_prompt, callint_message);
args[i] = Fread_key_sequence (callint_message,
Qnil, Qt, Qnil, Qnil);
teml = args[i];
@@ -667,13 +674,13 @@ invoke it. If KEYS is omitted or nil, the return value of
(SYMBOLP (function)
? (char *) SDATA (SYMBOL_NAME (function))
: "command"));
- args[i] = XVECTOR (keys)->contents[next_event++];
+ args[i] = AREF (keys, next_event);
+ next_event++;
varies[i] = -1;
/* Find the next parameterized event. */
while (next_event < key_count
- && ! (EVENT_HAS_PARAMETERS
- (XVECTOR (keys)->contents[next_event])))
+ && !(EVENT_HAS_PARAMETERS (AREF (keys, next_event))))
next_event++;
break;
@@ -898,43 +905,45 @@ syms_of_callint ()
callint_message = Qnil;
staticpro (&callint_message);
- preserved_fns = Fcons (intern ("region-beginning"),
- Fcons (intern ("region-end"),
- Fcons (intern ("point"),
- Fcons (intern ("mark"), Qnil))));
- staticpro (&preserved_fns);
+ preserved_fns = pure_cons (intern_c_string ("region-beginning"),
+ pure_cons (intern_c_string ("region-end"),
+ pure_cons (intern_c_string ("point"),
+ pure_cons (intern_c_string ("mark"), Qnil))));
- Qlist = intern ("list");
+ Qlist = intern_c_string ("list");
staticpro (&Qlist);
- Qlet = intern ("let");
+ Qlet = intern_c_string ("let");
staticpro (&Qlet);
- Qif = intern ("if");
+ Qif = intern_c_string ("if");
staticpro (&Qif);
- Qwhen = intern ("when");
+ Qwhen = intern_c_string ("when");
staticpro (&Qwhen);
- Qletx = intern ("let*");
+ Qletx = intern_c_string ("let*");
staticpro (&Qletx);
- Qsave_excursion = intern ("save-excursion");
+ Qsave_excursion = intern_c_string ("save-excursion");
staticpro (&Qsave_excursion);
- Qprogn = intern ("progn");
+ Qprogn = intern_c_string ("progn");
staticpro (&Qprogn);
- Qminus = intern ("-");
+ Qminus = intern_c_string ("-");
staticpro (&Qminus);
- Qplus = intern ("+");
+ Qplus = intern_c_string ("+");
staticpro (&Qplus);
- Qcall_interactively = intern ("call-interactively");
+ Qhandle_shift_selection = intern_c_string ("handle-shift-selection");
+ staticpro (&Qhandle_shift_selection);
+
+ Qcall_interactively = intern_c_string ("call-interactively");
staticpro (&Qcall_interactively);
- Qcommand_debug_status = intern ("command-debug-status");
+ Qcommand_debug_status = intern_c_string ("command-debug-status");
staticpro (&Qcommand_debug_status);
- Qenable_recursive_minibuffers = intern ("enable-recursive-minibuffers");
+ Qenable_recursive_minibuffers = intern_c_string ("enable-recursive-minibuffers");
staticpro (&Qenable_recursive_minibuffers);
- Qmouse_leave_buffer_hook = intern ("mouse-leave-buffer-hook");
+ Qmouse_leave_buffer_hook = intern_c_string ("mouse-leave-buffer-hook");
staticpro (&Qmouse_leave_buffer_hook);
DEFVAR_KBOARD ("prefix-arg", Vprefix_arg,
@@ -962,7 +971,10 @@ This is what `(interactive \"P\")' returns. */);
DEFVAR_LISP ("command-history", &Vcommand_history,
doc: /* List of recent commands that read arguments from terminal.
-Each command is represented as a form to evaluate. */);
+Each command is represented as a form to evaluate.
+
+Maximum length of the history list is determined by the value
+of `history-length', which see. */);
Vcommand_history = Qnil;
DEFVAR_LISP ("command-debug-status", &Vcommand_debug_status,
@@ -977,7 +989,7 @@ This option makes a difference in Transient Mark mode.
When the option is non-nil, deactivation of the mark
turns off region highlighting, but commands that use the mark
behave as if the mark were still active. */);
- Vmark_even_if_inactive = Qnil;
+ Vmark_even_if_inactive = Qt;
DEFVAR_LISP ("mouse-leave-buffer-hook", &Vmouse_leave_buffer_hook,
doc: /* Hook to run when about to switch windows with a mouse command.