Merge from trunk.
[bpt/emacs.git] / src / callint.c
index a0efc4b..5cf9949 100644 (file)
@@ -27,17 +27,19 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 #include "keyboard.h"
 #include "window.h"
 #include "keymap.h"
+#include "character.h"
 
 Lisp_Object Qminus, Qplus;
 Lisp_Object Qcall_interactively;
-Lisp_Object Qcommand_debug_status;
-Lisp_Object Qenable_recursive_minibuffers;
+static Lisp_Object Qcommand_debug_status;
+static Lisp_Object Qenable_recursive_minibuffers;
 
-Lisp_Object Qhandle_shift_selection;
+static Lisp_Object Qhandle_shift_selection;
 
 Lisp_Object Qmouse_leave_buffer_hook;
 
-Lisp_Object Qlist, Qlet, Qletx, Qsave_excursion, Qprogn, Qif, Qwhen;
+static Lisp_Object Qlist, Qlet, Qletx, Qsave_excursion, Qprogn, Qif;
+Lisp_Object Qwhen;
 static Lisp_Object preserved_fns;
 
 /* Marker used within call-interactively to refer to point.  */
@@ -103,9 +105,10 @@ Z -- Coding system, nil if no prefix arg.
 
 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 `@' appears at the beginning of the string, and if the key sequence
+ used to invoke the command includes any mouse events, then the window
+ associated with the first of those events is selected before the
+ command is run.
 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
@@ -118,7 +121,7 @@ usage: (interactive &optional ARGS)  */)
 
 /* Quotify EXP: if EXP is constant, return it.
    If EXP is not constant, return (quote EXP).  */
-Lisp_Object
+static Lisp_Object
 quotify_arg (register Lisp_Object exp)
 {
   if (CONSP (exp)
@@ -130,7 +133,7 @@ quotify_arg (register Lisp_Object exp)
 }
 
 /* Modify EXP by quotifying each element (except the first).  */
-Lisp_Object
+static Lisp_Object
 quotify_args (Lisp_Object exp)
 {
   register Lisp_Object tail;
@@ -171,8 +174,8 @@ static void
 fix_command (Lisp_Object input, Lisp_Object values)
 {
   /* FIXME: Instead of this ugly hack, we should provide a way for an
-     interactive spec to return an expression that will re-build the args
-     without user intervention.  */
+     interactive spec to return an expression/function that will re-build the
+     args without user intervention.  */
   if (CONSP (input))
     {
       Lisp_Object car;
@@ -231,7 +234,7 @@ fix_command (Lisp_Object input, Lisp_Object values)
 }
 
 DEFUN ("call-interactively", Fcall_interactively, Scall_interactively, 1, 3, 0,
-       doc: /* Call FUNCTION, reading args according to its interactive calling specs.
+       doc: /* Call FUNCTION, providing args according to its interactive calling specs.
 Return the value FUNCTION returns.
 The function contains a specification of how to do the argument reading.
 In the case of user-defined functions, this is specified by placing a call
@@ -262,15 +265,15 @@ invoke it.  If KEYS is omitted or nil, the return value of
 
   Lisp_Object prefix_arg;
   char *string;
-  char *tem;
+  const char *tem;
 
   /* If varies[i] > 0, the i'th argument shouldn't just have its value
      in this call quoted in the command history.  It should be
      recorded as a call to the function named callint_argfuns[varies[i]].  */
-  int *varies;
+  signed char *varies;
 
-  register int i, j;
-  int count, foo;
+  ptrdiff_t i, nargs;
+  int foo;
   char prompt1[100];
   char *tem1;
   int arg_from_tty = 0;
@@ -291,7 +294,7 @@ invoke it.  If KEYS is omitted or nil, the return value of
   else
     {
       CHECK_VECTOR (keys);
-      key_count = XVECTOR (keys)->size;
+      key_count = ASIZE (keys);
     }
 
   /* Save this now, since use of minibuffer will clobber it. */
@@ -336,7 +339,7 @@ invoke it.  If KEYS is omitted or nil, the return value of
     {
       Lisp_Object input;
       Lisp_Object funval = Findirect_function (function, Qt);
-      i = num_input_events;
+      uintmax_t events = num_input_events;
       input = specs;
       /* Compute the arg values using the user's expression.  */
       GCPRO2 (input, filter_specs);
@@ -344,7 +347,7 @@ invoke it.  If KEYS is omitted or nil, the return value of
                     CONSP (funval) && EQ (Qclosure, XCAR (funval))
                     ? Qt : Qnil);
       UNGCPRO;
-      if (i != num_input_events || !NILP (record_flag))
+      if (events != num_input_events || !NILP (record_flag))
        {
          /* We should record this command on the command history.  */
          Lisp_Object values;
@@ -415,25 +418,24 @@ invoke it.  If KEYS is omitted or nil, the return value of
        string++;
       else if (*string == '@')
        {
-         Lisp_Object event, tem;
+         Lisp_Object event, w;
 
          event = (next_event < key_count
                   ? AREF (keys, next_event)
                   : Qnil);
          if (EVENT_HAS_PARAMETERS (event)
-             && (tem = XCDR (event), CONSP (tem))
-             && (tem = XCAR (tem), CONSP (tem))
-             && (tem = XCAR (tem), WINDOWP (tem)))
+             && (w = XCDR (event), CONSP (w))
+             && (w = XCAR (w), CONSP (w))
+             && (w = XCAR (w), WINDOWP (w)))
            {
-             if (MINI_WINDOW_P (XWINDOW (tem))
-                 && ! (minibuf_level > 0 && EQ (tem, minibuf_window)))
+             if (MINI_WINDOW_P (XWINDOW (w))
+                 && ! (minibuf_level > 0 && EQ (w, minibuf_window)))
                error ("Attempt to select inactive minibuffer window");
 
              /* If the current buffer wants to clean up, let it.  */
-             if (!NILP (Vmouse_leave_buffer_hook))
-               call1 (Vrun_hooks, Qmouse_leave_buffer_hook);
+              Frun_hooks (1, &Qmouse_leave_buffer_hook);
 
-             Fselect_window (tem, Qnil);
+             Fselect_window (w, Qnil);
            }
          string++;
        }
@@ -445,30 +447,34 @@ invoke it.  If KEYS is omitted or nil, the return value of
       else break;
     }
 
-  /* Count the number of arguments the interactive spec would have
-     us give to the function.  */
+  /* Count the number of arguments, which is one plus the number of arguments
+     the interactive spec would have us give to the function.  */
   tem = string;
-  for (j = 0; *tem;)
+  for (nargs = 1; *tem; )
     {
       /* 'r' specifications ("point and mark as 2 numeric args")
         produce *two* arguments.  */
       if (*tem == 'r')
-       j += 2;
+       nargs += 2;
       else
-       j++;
+       nargs++;
       tem = strchr (tem, '\n');
       if (tem)
        ++tem;
       else
        break;
     }
-  count = j;
 
-  args = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object));
-  visargs = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object));
-  varies = (int *) alloca ((count + 1) * sizeof (int));
+  if (min (MOST_POSITIVE_FIXNUM,
+          min (PTRDIFF_MAX, SIZE_MAX) / sizeof (Lisp_Object))
+      < nargs)
+    memory_full (SIZE_MAX);
 
-  for (i = 0; i < (count + 1); i++)
+  args = (Lisp_Object *) alloca (nargs * sizeof (Lisp_Object));
+  visargs = (Lisp_Object *) alloca (nargs * sizeof (Lisp_Object));
+  varies = (signed char *) alloca (nargs);
+
+  for (i = 0; i < nargs; i++)
     {
       args[i] = Qnil;
       visargs[i] = Qnil;
@@ -476,8 +482,8 @@ invoke it.  If KEYS is omitted or nil, the return value of
     }
 
   GCPRO5 (prefix_arg, function, *args, *visargs, up_event);
-  gcpro3.nvars = (count + 1);
-  gcpro4.nvars = (count + 1);
+  gcpro3.nvars = nargs;
+  gcpro4.nvars = nargs;
 
   if (!NILP (enable))
     specbind (Qenable_recursive_minibuffers, Qt);
@@ -686,7 +692,7 @@ invoke it.  If KEYS is omitted or nil, the return value of
            int first = 1;
            do
              {
-               Lisp_Object tem;
+               Lisp_Object str;
                if (! first)
                  {
                    message ("Please enter a number.");
@@ -694,13 +700,13 @@ invoke it.  If KEYS is omitted or nil, the return value of
                  }
                first = 0;
 
-               tem = Fread_from_minibuffer (callint_message,
+               str = Fread_from_minibuffer (callint_message,
                                             Qnil, Qnil, Qnil, Qnil, Qnil,
                                             Qnil);
-               if (! STRINGP (tem) || SCHARS (tem) == 0)
+               if (! STRINGP (str) || SCHARS (str) == 0)
                  args[i] = Qnil;
                else
-                 args[i] = Fread (tem);
+                 args[i] = Fread (str);
              }
            while (! NUMBERP (args[i]));
          }
@@ -786,8 +792,10 @@ invoke it.  If KEYS is omitted or nil, the return value of
             if anyone tries to define one here.  */
        case '+':
        default:
-         error ("Invalid control letter `%c' (%03o) in interactive calling string",
-                *tem, (unsigned char) *tem);
+         error ("Invalid control letter `%c' (#o%03o, #x%04x) in interactive calling string",
+                STRING_CHAR ((unsigned char *) tem),
+                (unsigned) STRING_CHAR ((unsigned char *) tem),
+                (unsigned) STRING_CHAR ((unsigned char *) tem));
        }
 
       if (varies[i] == 0)
@@ -809,14 +817,14 @@ invoke it.  If KEYS is omitted or nil, the return value of
   if (arg_from_tty || !NILP (record_flag))
     {
       visargs[0] = function;
-      for (i = 1; i < count + 1; i++)
+      for (i = 1; i < nargs; i++)
        {
          if (varies[i] > 0)
            visargs[i] = Fcons (intern (callint_argfuns[varies[i]]), Qnil);
          else
            visargs[i] = quotify_arg (args[i]);
        }
-      Vcommand_history = Fcons (Flist (count + 1, visargs),
+      Vcommand_history = Fcons (Flist (nargs, visargs),
                                Vcommand_history);
       /* Don't keep command history around forever.  */
       if (INTEGERP (Vhistory_length) && XINT (Vhistory_length) > 0)
@@ -829,7 +837,7 @@ invoke it.  If KEYS is omitted or nil, the return value of
 
   /* If we used a marker to hold point, mark, or an end of the region,
      temporarily, convert it to an integer now.  */
-  for (i = 1; i <= count; i++)
+  for (i = 1; i < nargs; i++)
     if (varies[i] >= 1 && varies[i] <= 4)
       XSETINT (args[i], marker_position (args[i]));
 
@@ -846,7 +854,7 @@ invoke it.  If KEYS is omitted or nil, the return value of
     specbind (Qcommand_debug_status, Qnil);
 
     temporarily_switch_to_single_kboard (NULL);
-    val = Ffuncall (count + 1, args);
+    val = Ffuncall (nargs, args);
     UNGCPRO;
     return unbind_to (speccount, val);
   }
@@ -889,41 +897,20 @@ syms_of_callint (void)
                                pure_cons (intern_c_string ("point"),
                                       pure_cons (intern_c_string ("mark"), Qnil))));
 
-  Qlist = intern_c_string ("list");
-  staticpro (&Qlist);
-  Qlet = intern_c_string ("let");
-  staticpro (&Qlet);
-  Qif = intern_c_string ("if");
-  staticpro (&Qif);
-  Qwhen = intern_c_string ("when");
-  staticpro (&Qwhen);
-  Qletx = intern_c_string ("let*");
-  staticpro (&Qletx);
-  Qsave_excursion = intern_c_string ("save-excursion");
-  staticpro (&Qsave_excursion);
-  Qprogn = intern_c_string ("progn");
-  staticpro (&Qprogn);
-
-  Qminus = intern_c_string ("-");
-  staticpro (&Qminus);
-
-  Qplus = intern_c_string ("+");
-  staticpro (&Qplus);
-
-  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_c_string ("command-debug-status");
-  staticpro (&Qcommand_debug_status);
-
-  Qenable_recursive_minibuffers = intern_c_string ("enable-recursive-minibuffers");
-  staticpro (&Qenable_recursive_minibuffers);
-
-  Qmouse_leave_buffer_hook = intern_c_string ("mouse-leave-buffer-hook");
-  staticpro (&Qmouse_leave_buffer_hook);
+  DEFSYM (Qlist, "list");
+  DEFSYM (Qlet, "let");
+  DEFSYM (Qif, "if");
+  DEFSYM (Qwhen, "when");
+  DEFSYM (Qletx, "let*");
+  DEFSYM (Qsave_excursion, "save-excursion");
+  DEFSYM (Qprogn, "progn");
+  DEFSYM (Qminus, "-");
+  DEFSYM (Qplus, "+");
+  DEFSYM (Qhandle_shift_selection, "handle-shift-selection");
+  DEFSYM (Qcall_interactively, "call-interactively");
+  DEFSYM (Qcommand_debug_status, "command-debug-status");
+  DEFSYM (Qenable_recursive_minibuffers, "enable-recursive-minibuffers");
+  DEFSYM (Qmouse_leave_buffer_hook, "mouse-leave-buffer-hook");
 
   DEFVAR_KBOARD ("prefix-arg", Vprefix_arg,
                 doc: /* The value of the prefix argument for the next editing command.