X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/31ca4639ad1bfaa355a3f30ef92eb977bd2c6b78..99cf38598cd4ac71407b542ba0054fa0df018eb1:/src/callint.c
diff --git a/src/callint.c b/src/callint.c
index bfa981ec65..35411bf9b5 100644
--- a/src/callint.c
+++ b/src/callint.c
@@ -1,6 +1,6 @@
/* Call a Lisp function interactively.
- Copyright (C) 1985-1986, 1993-1995, 1997, 2000-2012
- Free Software Foundation, Inc.
+ Copyright (C) 1985-1986, 1993-1995, 1997, 2000-2014 Free Software
+ Foundation, Inc.
This file is part of GNU Emacs.
@@ -19,22 +19,22 @@ along with GNU Emacs. If not, see . */
#include
-#include
#include "lisp.h"
+#include "character.h"
#include "buffer.h"
#include "commands.h"
#include "keyboard.h"
#include "window.h"
#include "keymap.h"
-#include "character.h"
Lisp_Object Qminus, Qplus;
-Lisp_Object Qcall_interactively;
+static Lisp_Object Qcall_interactively;
static Lisp_Object Qcommand_debug_status;
static Lisp_Object Qenable_recursive_minibuffers;
static Lisp_Object Qhandle_shift_selection;
+static Lisp_Object Qread_number;
Lisp_Object Qmouse_leave_buffer_hook;
@@ -127,7 +127,7 @@ quotify_arg (register Lisp_Object exp)
if (CONSP (exp)
|| (SYMBOLP (exp)
&& !NILP (exp) && !EQ (exp, Qt)))
- return Fcons (Qquote, Fcons (exp, Qnil));
+ return list2 (Qquote, exp);
return exp;
}
@@ -150,7 +150,7 @@ static const char *callint_argfuns[]
= {"", "point", "mark", "region-beginning", "region-end"};
static void
-check_mark (int for_region)
+check_mark (bool for_region)
{
Lisp_Object tem;
tem = Fmarker_buffer (BVAR (current_buffer, mark));
@@ -205,7 +205,7 @@ fix_command (Lisp_Object input, Lisp_Object values)
if (CONSP (elt))
{
Lisp_Object presflag, carelt;
- carelt = Fcar (elt);
+ carelt = XCAR (elt);
/* If it is (if X Y), look at Y. */
if (EQ (carelt, Qif)
&& EQ (Fnthcdr (make_number (3), elt), Qnil))
@@ -251,6 +251,9 @@ invoke it. If KEYS is omitted or nil, the return value of
`this-command-keys-vector' is used. */)
(Lisp_Object function, Lisp_Object record_flag, Lisp_Object keys)
{
+ /* `args' will contain the array of arguments to pass to the function.
+ `visargs' will contain the same list but in a nicer form, so that if we
+ pass it to `Fformat' it will be understandable to a human. */
Lisp_Object *args, *visargs;
Lisp_Object specs;
Lisp_Object filter_specs;
@@ -273,11 +276,11 @@ invoke it. If KEYS is omitted or nil, the return value of
signed char *varies;
ptrdiff_t i, nargs;
- int foo;
- int arg_from_tty = 0;
+ ptrdiff_t mark;
+ bool arg_from_tty = 0;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
ptrdiff_t key_count;
- int record_then_fail = 0;
+ bool record_then_fail = 0;
Lisp_Object save_this_command, save_last_command;
Lisp_Object save_this_original_command, save_real_this_command;
@@ -305,7 +308,7 @@ invoke it. If KEYS is omitted or nil, the return value of
specs = Qnil;
string = 0;
- /* The idea of FILTER_SPECS is to provide away to
+ /* The idea of FILTER_SPECS is to provide a way to
specify how to represent the arguments in command history.
The feature is not fully implemented. */
filter_specs = Qnil;
@@ -328,12 +331,9 @@ invoke it. If KEYS is omitted or nil, the return value of
/* 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,
- `string' will still be valid. */
- string = (char *) alloca (SBYTES (specs) + 1);
- memcpy (string, SSDATA (specs), SBYTES (specs) + 1);
- }
+ /* Make a copy of string so that if a GC relocates specs,
+ `string' will still be valid. */
+ string = xlispstrdupa (specs);
else
{
Lisp_Object input;
@@ -343,8 +343,8 @@ invoke it. If KEYS is omitted or nil, the return value of
/* Compute the arg values using the user's expression. */
GCPRO2 (input, filter_specs);
specs = Feval (specs,
- CONSP (funval) && EQ (Qclosure, XCAR (funval))
- ? Qt : Qnil);
+ CONSP (funval) && EQ (Qclosure, XCAR (funval))
+ ? CAR_SAFE (XCDR (funval)) : Qnil);
UNGCPRO;
if (events != num_input_events || !NILP (record_flag))
{
@@ -372,7 +372,7 @@ invoke it. If KEYS is omitted or nil, the return value of
Vthis_command = save_this_command;
Vthis_original_command = save_this_original_command;
Vreal_this_command = save_real_this_command;
- KVAR (current_kboard, Vlast_command) = save_last_command;
+ kset_last_command (current_kboard, save_last_command);
temporarily_switch_to_single_kboard (NULL);
return unbind_to (speccount, apply1 (function, specs));
@@ -465,13 +465,13 @@ invoke it. If KEYS is omitted or nil, the return value of
}
if (min (MOST_POSITIVE_FIXNUM,
- min (PTRDIFF_MAX, SIZE_MAX) / sizeof (Lisp_Object))
+ min (PTRDIFF_MAX, SIZE_MAX) / word_size)
< nargs)
memory_full (SIZE_MAX);
- args = (Lisp_Object *) alloca (nargs * sizeof (Lisp_Object));
- visargs = (Lisp_Object *) alloca (nargs * sizeof (Lisp_Object));
- varies = (signed char *) alloca (nargs);
+ args = alloca (nargs * sizeof *args);
+ visargs = alloca (nargs * sizeof *visargs);
+ varies = alloca (nargs * sizeof *varies);
for (i = 0; i < nargs; i++)
{
@@ -498,47 +498,47 @@ invoke it. If KEYS is omitted or nil, the return value of
switch (*tem)
{
- case 'a': /* Symbol defined as a function */
+ case 'a': /* Symbol defined as a function. */
visargs[i] = Fcompleting_read (callint_message,
Vobarray, Qfboundp, Qt,
Qnil, Qnil, Qnil, Qnil);
- /* Passing args[i] directly stimulates compiler bug */
+ /* Passing args[i] directly stimulates compiler bug. */
teml = visargs[i];
args[i] = Fintern (teml, Qnil);
break;
- case 'b': /* Name of existing buffer */
+ case 'b': /* Name of existing buffer. */
args[i] = Fcurrent_buffer ();
if (EQ (selected_window, minibuf_window))
args[i] = Fother_buffer (args[i], Qnil, Qnil);
args[i] = Fread_buffer (callint_message, args[i], Qt);
break;
- case 'B': /* Name of buffer, possibly nonexistent */
+ case 'B': /* Name of buffer, possibly nonexistent. */
args[i] = Fread_buffer (callint_message,
Fother_buffer (Fcurrent_buffer (), Qnil, Qnil),
Qnil);
break;
- case 'c': /* Character */
+ 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 */
+ message1_nolog (0);
+ /* Passing args[i] directly stimulates compiler bug. */
teml = args[i];
/* See bug#8479. */
if (! CHARACTERP (teml)) error ("Non-character input-event");
visargs[i] = Fchar_to_string (teml);
break;
- case 'C': /* Command: symbol with interactive function */
+ case 'C': /* Command: symbol with interactive function. */
visargs[i] = Fcompleting_read (callint_message,
Vobarray, Qcommandp,
Qt, Qnil, Qnil, Qnil, Qnil);
- /* Passing args[i] directly stimulates compiler bug */
+ /* Passing args[i] directly stimulates compiler bug. */
teml = visargs[i];
args[i] = Fintern (teml, Qnil);
break;
@@ -550,33 +550,33 @@ invoke it. If KEYS is omitted or nil, the return value of
varies[i] = 1;
break;
- case 'D': /* Directory name. */
+ case 'D': /* Directory name. */
args[i] = Fread_file_name (callint_message, Qnil,
BVAR (current_buffer, directory), Qlambda, Qnil,
Qfile_directory_p);
break;
- case 'f': /* Existing file name. */
+ case 'f': /* Existing file name. */
args[i] = Fread_file_name (callint_message,
Qnil, Qnil, Qlambda, Qnil, Qnil);
break;
- case 'F': /* Possibly nonexistent file name. */
+ case 'F': /* Possibly nonexistent file name. */
args[i] = Fread_file_name (callint_message,
Qnil, Qnil, Qnil, Qnil, Qnil);
break;
case 'G': /* Possibly nonexistent file name,
- default to directory alone. */
+ default to directory alone. */
args[i] = Fread_file_name (callint_message,
Qnil, Qnil, Qnil, empty_unibyte_string, Qnil);
break;
- case 'i': /* Ignore an argument -- Does not do I/O */
+ case 'i': /* Ignore an argument -- Does not do I/O. */
varies[i] = -1;
break;
- case 'k': /* Key sequence. */
+ case 'k': /* Key sequence. */
{
ptrdiff_t speccount1 = SPECPDL_INDEX ();
specbind (Qcursor_in_echo_area, Qt);
@@ -608,7 +608,7 @@ invoke it. If KEYS is omitted or nil, the return value of
}
break;
- case 'K': /* Key sequence to be defined. */
+ case 'K': /* Key sequence to be defined. */
{
ptrdiff_t speccount1 = SPECPDL_INDEX ();
specbind (Qcursor_in_echo_area, Qt);
@@ -616,8 +616,8 @@ invoke it. If KEYS is omitted or nil, the return value of
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);
+ args[i] = Fread_key_sequence_vector (callint_message,
+ Qnil, Qt, Qnil, Qnil);
teml = args[i];
visargs[i] = Fkey_description (teml, Qnil);
unbind_to (speccount1, Qnil);
@@ -640,7 +640,7 @@ invoke it. If KEYS is omitted or nil, the return value of
}
break;
- case 'U': /* Up event from last k or K */
+ case 'U': /* Up event from last k or K. */
if (!NILP (up_event))
{
args[i] = Fmake_vector (make_number (1), up_event);
@@ -680,33 +680,14 @@ invoke it. If KEYS is omitted or nil, the return value of
Qnil, Qnil, Qnil, Qt);
break;
- case 'N': /* Prefix arg as number, else number from minibuffer */
+ case 'N': /* Prefix arg as number, else number from minibuffer. */
if (!NILP (prefix_arg))
goto have_prefix_arg;
case 'n': /* Read number from minibuffer. */
- {
- int first = 1;
- do
- {
- Lisp_Object str;
- if (! first)
- {
- message ("Please enter a number.");
- sit_for (make_number (1), 0, 0);
- }
- first = 0;
-
- str = Fread_from_minibuffer (callint_message,
- Qnil, Qnil, Qnil, Qnil, Qnil,
- Qnil);
- if (! STRINGP (str) || SCHARS (str) == 0)
- args[i] = Qnil;
- else
- args[i] = Fread (str);
- }
- while (! NUMBERP (args[i]));
- }
- visargs[i] = args[i];
+ args[i] = call1 (Qread_number, callint_message);
+ /* Passing args[i] directly stimulates compiler bug. */
+ teml = args[i];
+ visargs[i] = Fnumber_to_string (teml);
break;
case 'P': /* Prefix arg in raw form. Does no I/O. */
@@ -715,22 +696,22 @@ invoke it. If KEYS is omitted or nil, the return value of
varies[i] = -1;
break;
- case 'p': /* Prefix arg converted to number. No I/O. */
+ case 'p': /* Prefix arg converted to number. No I/O. */
have_prefix_arg:
args[i] = Fprefix_numeric_value (prefix_arg);
/* visargs[i] = Qnil; */
varies[i] = -1;
break;
- case 'r': /* Region, point and mark as 2 args. */
+ case 'r': /* Region, point and mark as 2 args. */
check_mark (1);
set_marker_both (point_marker, Qnil, PT, PT_BYTE);
/* visargs[i+1] = Qnil; */
- foo = marker_position (BVAR (current_buffer, mark));
+ mark = marker_position (BVAR (current_buffer, mark));
/* visargs[i] = Qnil; */
- args[i] = PT < foo ? point_marker : BVAR (current_buffer, mark);
+ args[i] = PT < mark ? point_marker : BVAR (current_buffer, mark);
varies[i] = 3;
- args[++i] = PT > foo ? point_marker : BVAR (current_buffer, mark);
+ args[++i] = PT > mark ? point_marker : BVAR (current_buffer, mark);
varies[i] = 4;
break;
@@ -743,29 +724,29 @@ invoke it. If KEYS is omitted or nil, the return value of
case 'S': /* Any symbol. */
visargs[i] = Fread_string (callint_message,
Qnil, Qnil, Qnil, Qnil);
- /* Passing args[i] directly stimulates compiler bug */
+ /* Passing args[i] directly stimulates compiler bug. */
teml = visargs[i];
args[i] = Fintern (teml, Qnil);
break;
case 'v': /* Variable name: symbol that is
- custom-variable-p. */
+ custom-variable-p. */
args[i] = Fread_variable (callint_message, Qnil);
visargs[i] = last_minibuf_string;
break;
- case 'x': /* Lisp expression read but not evaluated */
- args[i] = Fread_minibuffer (callint_message, Qnil);
+ case 'x': /* Lisp expression read but not evaluated. */
+ args[i] = call1 (intern ("read-minibuffer"), callint_message);
visargs[i] = last_minibuf_string;
break;
- case 'X': /* Lisp expression read and evaluated */
- args[i] = Feval_minibuffer (callint_message, Qnil);
+ case 'X': /* Lisp expression read and evaluated. */
+ args[i] = call1 (intern ("eval-minibuffer"), callint_message);
visargs[i] = last_minibuf_string;
break;
case 'Z': /* Coding-system symbol, or ignore the
- argument if no prefix */
+ argument if no prefix. */
if (NILP (prefix_arg))
{
args[i] = Qnil;
@@ -779,7 +760,7 @@ invoke it. If KEYS is omitted or nil, the return value of
}
break;
- case 'z': /* Coding-system symbol or nil */
+ case 'z': /* Coding-system symbol or nil. */
args[i] = Fread_coding_system (callint_message, Qnil);
visargs[i] = last_minibuf_string;
break;
@@ -812,11 +793,13 @@ invoke it. If KEYS is omitted or nil, the return value of
if (arg_from_tty || !NILP (record_flag))
{
+ /* We don't need `visargs' any more, so let's recycle it since we need
+ an array of just the same size. */
visargs[0] = function;
for (i = 1; i < nargs; i++)
{
if (varies[i] > 0)
- visargs[i] = Fcons (intern (callint_argfuns[varies[i]]), Qnil);
+ visargs[i] = list1 (intern (callint_argfuns[varies[i]]));
else
visargs[i] = quotify_arg (args[i]);
}
@@ -843,7 +826,7 @@ invoke it. If KEYS is omitted or nil, the return value of
Vthis_command = save_this_command;
Vthis_original_command = save_this_original_command;
Vreal_this_command = save_real_this_command;
- KVAR (current_kboard, Vlast_command) = save_last_command;
+ kset_last_command (current_kboard, save_last_command);
{
Lisp_Object val;
@@ -888,10 +871,11 @@ syms_of_callint (void)
callint_message = Qnil;
staticpro (&callint_message);
- 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))));
+ preserved_fns = listn (CONSTYPE_PURE, 4,
+ intern_c_string ("region-beginning"),
+ intern_c_string ("region-end"),
+ intern_c_string ("point"),
+ intern_c_string ("mark"));
DEFSYM (Qlist, "list");
DEFSYM (Qlet, "let");
@@ -903,6 +887,7 @@ syms_of_callint (void)
DEFSYM (Qminus, "-");
DEFSYM (Qplus, "+");
DEFSYM (Qhandle_shift_selection, "handle-shift-selection");
+ DEFSYM (Qread_number, "read-number");
DEFSYM (Qcall_interactively, "call-interactively");
DEFSYM (Qcommand_debug_status, "command-debug-status");
DEFSYM (Qenable_recursive_minibuffers, "enable-recursive-minibuffers");