'temacs -nw' should not call missing functions

[gnu-emacs] / src / data.c

diff --git a/src/data.c b/src/data.c
index 2de1c19452c53c444839b7ba62b8386706c84c71..3992792fdd06f75054cdafd8a932866d9f88d730 100644 (file)
--- a/src/data.c
+++ b/src/data.c
@@ -1,5 +1,5 @@
 /* Primitive operations on Lisp data types for GNU Emacs Lisp interpreter.
-   Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2014 Free Software
+   Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2015 Free Software
    Foundation, Inc.
 
 This file is part of GNU Emacs.
@@ -89,7 +89,8 @@ static Lisp_Object Qdefun;
 Lisp_Object Qinteractive_form;
 static Lisp_Object Qdefalias_fset_function;
 
-static void swap_in_symval_forwarding (struct Lisp_Symbol *, struct Lisp_Buffer_Local_Value *);
+static void swap_in_symval_forwarding (struct Lisp_Symbol *,
+                                      struct Lisp_Buffer_Local_Value *);
 
 static bool
 BOOLFWDP (union Lisp_Fwd *a)
@@ -729,7 +730,7 @@ DEFUN ("fset", Ffset, Sfset, 2, 2, 0,
 
   /* Convert to eassert or remove after GC bug is found.  In the
      meantime, check unconditionally, at a slight perf hit.  */
-  if (valid_lisp_object_p (definition) < 1)
+  if (! valid_lisp_object_p (definition))
     emacs_abort ();
 
   set_symbol_function (symbol, definition);
@@ -971,6 +972,51 @@ do_symval_forwarding (register union Lisp_Fwd *valcontents)
     }
 }
 
+/* Used to signal a user-friendly error when symbol WRONG is
+   not a member of CHOICE, which should be a list of symbols.  */
+
+void
+wrong_choice (Lisp_Object choice, Lisp_Object wrong)
+{
+  ptrdiff_t i = 0, len = XINT (Flength (choice));
+  Lisp_Object obj, *args;
+  AUTO_STRING (one_of, "One of ");
+  AUTO_STRING (comma, ", ");
+  AUTO_STRING (or, " or ");
+  AUTO_STRING (should_be_specified, " should be specified");
+
+  USE_SAFE_ALLOCA;
+  SAFE_ALLOCA_LISP (args, len * 2 + 1);
+
+  args[i++] = one_of;
+
+  for (obj = choice; !NILP (obj); obj = XCDR (obj))
+    {
+      args[i++] = SYMBOL_NAME (XCAR (obj));
+      args[i++] = (NILP (XCDR (obj)) ? should_be_specified
+                  : NILP (XCDR (XCDR (obj))) ? or : comma);
+    }
+
+  obj = Fconcat (i, args);
+  SAFE_FREE ();
+  xsignal2 (Qerror, obj, wrong);
+}
+
+/* Used to signal a user-friendly error if WRONG is not a number or
+   integer/floating-point number outsize of inclusive MIN..MAX range.  */
+
+static void
+wrong_range (Lisp_Object min, Lisp_Object max, Lisp_Object wrong)
+{
+  AUTO_STRING (value_should_be_from, "Value should be from ");
+  AUTO_STRING (to, " to ");
+  xsignal2 (Qerror,
+           Fconcat (4, ((Lisp_Object [])
+                        {value_should_be_from, Fnumber_to_string (min),
+                         to, Fnumber_to_string (max)})),
+           wrong);
+}
+
 /* Store NEWVAL into SYMBOL, where VALCONTENTS is found in the value cell
    of SYMBOL.  If SYMBOL is buffer-local, VALCONTENTS should be the
    buffer-independent contents of the value cell: forwarded just one
@@ -1027,10 +1073,33 @@ store_symval_forwarding (union Lisp_Fwd *valcontents, register Lisp_Object newva
        int offset = XBUFFER_OBJFWD (valcontents)->offset;
        Lisp_Object predicate = XBUFFER_OBJFWD (valcontents)->predicate;
 
-       if (!NILP (predicate) && !NILP (newval)
-           && NILP (call1 (predicate, newval)))
-         wrong_type_argument (predicate, newval);
+       if (!NILP (newval))
+         {
+           if (SYMBOLP (predicate))
+             {
+               Lisp_Object prop;
+
+               if ((prop = Fget (predicate, Qchoice), !NILP (prop)))
+                 {
+                   if (NILP (Fmemq (newval, prop)))
+                     wrong_choice (prop, newval);
+                 }
+               else if ((prop = Fget (predicate, Qrange), !NILP (prop)))
+                 {
+                   Lisp_Object min = XCAR (prop), max = XCDR (prop);
 
+                   if (!NUMBERP (newval)
+                       || !NILP (arithcompare (newval, min, ARITH_LESS))
+                       || !NILP (arithcompare (newval, max, ARITH_GRTR)))
+                     wrong_range (min, max, newval);
+                 }
+               else if (FUNCTIONP (predicate))
+                 {
+                   if (NILP (call1 (predicate, newval)))
+                     wrong_type_argument (predicate, newval);
+                 }
+             }
+         }
        if (buf == NULL)
          buf = current_buffer;
        set_per_buffer_value (buf, offset, newval);
@@ -1246,10 +1315,10 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where,
 
            /* Find the new binding.  */
            XSETSYMBOL (symbol, sym); /* May have changed via aliasing.  */
-           tem1 = Fassq (symbol,
-                         (blv->frame_local
-                          ? XFRAME (where)->param_alist
-                          : BVAR (XBUFFER (where), local_var_alist)));
+           tem1 = assq_no_quit (symbol,
+                                (blv->frame_local
+                                 ? XFRAME (where)->param_alist
+                                 : BVAR (XBUFFER (where), local_var_alist)));
            set_blv_where (blv, where);
            blv->found = 1;
 
@@ -1887,19 +1956,11 @@ DEFUN ("local-variable-p", Flocal_variable_p, Slocal_variable_p,
        1, 2, 0,
        doc: /* Non-nil if VARIABLE has a local binding in buffer BUFFER.
 BUFFER defaults to the current buffer.  */)
-  (register Lisp_Object variable, Lisp_Object buffer)
+  (Lisp_Object variable, Lisp_Object buffer)
 {
-  register struct buffer *buf;
+  struct buffer *buf = decode_buffer (buffer);
   struct Lisp_Symbol *sym;
 
-  if (NILP (buffer))
-    buf = current_buffer;
-  else
-    {
-      CHECK_BUFFER (buffer);
-      buf = XBUFFER (buffer);
-    }
-
   CHECK_SYMBOL (variable);
   sym = XSYMBOL (variable);
 
@@ -2253,7 +2314,7 @@ bool-vector.  IDX starts at 0.  */)
        {
          if (! SINGLE_BYTE_CHAR_P (c))
            {
-             int i;
+             ptrdiff_t i;
 
              for (i = SBYTES (array) - 1; i >= 0; i--)
                if (SREF (array, i) >= 0x80)