* dispextern.h (struct face.stipple):
[bpt/emacs.git] / src / callint.c
index 1546594..dc5e6a4 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.  */
@@ -118,18 +120,19 @@ 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 (!INTEGERP (exp) && !STRINGP (exp)
-      && !NILP (exp) && !EQ (exp, Qt))
+  if (CONSP (exp)
+      || (SYMBOLP (exp)
+         && !NILP (exp) && !EQ (exp, Qt)))
     return Fcons (Qquote, Fcons (exp, Qnil));
 
   return exp;
 }
 
 /* Modify EXP by quotifying each element (except the first).  */
-Lisp_Object
+static Lisp_Object
 quotify_args (Lisp_Object exp)
 {
   register Lisp_Object tail;
@@ -149,12 +152,12 @@ static void
 check_mark (int for_region)
 {
   Lisp_Object tem;
-  tem = Fmarker_buffer (B_ (current_buffer, mark));
+  tem = Fmarker_buffer (BVAR (current_buffer, mark));
   if (NILP (tem) || (XBUFFER (tem) != current_buffer))
     error (for_region ? "The mark is not set now, so there is no region"
           : "The mark is not set now");
   if (!NILP (Vtransient_mark_mode) && NILP (Vmark_even_if_inactive)
-      && NILP (B_ (current_buffer, mark_active)))
+      && NILP (BVAR (current_buffer, mark_active)))
     xsignal0 (Qmark_inactive);
 }
 
@@ -169,6 +172,9 @@ check_mark (int for_region)
 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/function that will re-build the
+     args without user intervention.  */
   if (CONSP (input))
     {
       Lisp_Object car;
@@ -258,15 +264,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;
@@ -280,14 +286,14 @@ invoke it.  If KEYS is omitted or nil, the return value of
   save_this_command = Vthis_command;
   save_this_original_command = Vthis_original_command;
   save_real_this_command = real_this_command;
-  save_last_command = current_kboard->Vlast_command;
+  save_last_command = KVAR (current_kboard, Vlast_command);
 
   if (NILP (keys))
     keys = this_command_keys, key_count = this_command_key_count;
   else
     {
       CHECK_VECTOR (keys);
-      key_count = XVECTOR (keys)->size;
+      key_count = ASIZE (keys);
     }
 
   /* Save this now, since use of minibuffer will clobber it. */
@@ -331,13 +337,16 @@ invoke it.  If KEYS is omitted or nil, the return value of
   else
     {
       Lisp_Object input;
-      i = num_input_events;
+      Lisp_Object funval = Findirect_function (function, Qt);
+      size_t events = num_input_events;
       input = specs;
       /* Compute the arg values using the user's expression.  */
       GCPRO2 (input, filter_specs);
-      specs = Feval (specs);
+      specs = Feval (specs,
+                    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;
@@ -363,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;
       real_this_command= save_real_this_command;
-      current_kboard->Vlast_command = save_last_command;
+      KVAR (current_kboard, Vlast_command) = save_last_command;
 
       temporarily_switch_to_single_kboard (NULL);
       return unbind_to (speccount, apply1 (function, specs));
@@ -385,7 +394,7 @@ invoke it.  If KEYS is omitted or nil, the return value of
       else if (*string == '*')
        {
          string++;
-         if (!NILP (B_ (current_buffer, read_only)))
+         if (!NILP (BVAR (current_buffer, read_only)))
            {
              if (!NILP (record_flag))
                {
@@ -408,25 +417,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++;
        }
@@ -438,30 +446,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;
@@ -469,8 +481,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);
@@ -543,7 +555,7 @@ invoke it.  If KEYS is omitted or nil, the return value of
 
        case 'D':               /* Directory name. */
          args[i] = Fread_file_name (callint_message, Qnil,
-                                    B_ (current_buffer, directory), Qlambda, Qnil,
+                                    BVAR (current_buffer, directory), Qlambda, Qnil,
                                     Qfile_directory_p);
          break;
 
@@ -661,7 +673,7 @@ invoke it.  If KEYS is omitted or nil, the return value of
        case 'm':               /* Value of mark.  Does not do I/O.  */
          check_mark (0);
          /* visargs[i] = Qnil; */
-         args[i] = B_ (current_buffer, mark);
+         args[i] = BVAR (current_buffer, mark);
          varies[i] = 2;
          break;
 
@@ -679,7 +691,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.");
@@ -687,13 +699,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]));
          }
@@ -717,11 +729,11 @@ invoke it.  If KEYS is omitted or nil, the return value of
          check_mark (1);
          set_marker_both (point_marker, Qnil, PT, PT_BYTE);
          /* visargs[i+1] = Qnil; */
-         foo = marker_position (B_ (current_buffer, mark));
+         foo = marker_position (BVAR (current_buffer, mark));
          /* visargs[i] = Qnil; */
-         args[i] = PT < foo ? point_marker : B_ (current_buffer, mark);
+         args[i] = PT < foo ? point_marker : BVAR (current_buffer, mark);
          varies[i] = 3;
-         args[++i] = PT > foo ? point_marker : B_ (current_buffer, mark);
+         args[++i] = PT > foo ? point_marker : BVAR (current_buffer, mark);
          varies[i] = 4;
          break;
 
@@ -779,8 +791,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)
@@ -802,14 +816,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)
@@ -822,7 +836,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]));
 
@@ -832,14 +846,14 @@ invoke it.  If KEYS is omitted or nil, the return value of
   Vthis_command = save_this_command;
   Vthis_original_command = save_this_original_command;
   real_this_command= save_real_this_command;
-  current_kboard->Vlast_command = save_last_command;
+  KVAR (current_kboard, Vlast_command) = save_last_command;
 
   {
     Lisp_Object val;
     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);
   }