--- a/src/symbols.c	Sat Dec 26 00:20:27 2009 -0600
+++ b/src/symbols.c	Sat Dec 26 21:18:49 2009 -0600
@@ -84,6 +84,9 @@
 static Lisp_Object *value_slot_past_magic (Lisp_Object sym);
 static Lisp_Object follow_varalias_pointers (Lisp_Object symbol,
 					     Lisp_Object follow_past_lisp_magic);
+static Lisp_Object map_varalias_chain (Lisp_Object symbol,
+                                       Lisp_Object follow_past_lisp_magic,
+                                       Lisp_Object (*fn) (Lisp_Object arg));
 
 
 static Lisp_Object
@@ -136,7 +139,7 @@
   return external_remprop (&XSYMBOL (symbol)->plist, property, 0, ERROR_ME);
 }
 
-DEFINE_BASIC_LISP_OBJECT_WITH_PROPS ("symbol", symbol,
+DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT_WITH_PROPS ("symbol", symbol,
 						mark_symbol, print_symbol,
 						0, 0, 0, symbol_description,
 						symbol_getprop,
@@ -255,17 +258,17 @@
   return object;
 }
 
-DEFUN ("intern-soft", Fintern_soft, 1, 2, 0, /*
+DEFUN ("intern-soft", Fintern_soft, 1, 3, 0, /*
 Return the canonical symbol named NAME, or nil if none exists.
 NAME may be a string or a symbol.  If it is a symbol, that exact
 symbol is searched for.
 Optional second argument OBARRAY specifies the obarray to use;
 it defaults to the value of the variable `obarray'.
+Optional third argument DEFAULT says what Lisp object to return if there is
+no canonical symbol named NAME, and defaults to nil. 
 */
-       (name, obarray))
+       (name, obarray, default_))
 {
-  /* #### Bug!  (intern-soft "nil") returns nil.  Perhaps we should
-     add a DEFAULT-IF-NOT-FOUND arg, like in get.  */
   Lisp_Object tem;
   Lisp_Object string;
 
@@ -282,7 +285,7 @@
 
   tem = oblookup (obarray, XSTRING_DATA (string), XSTRING_LENGTH (string));
   if (INTP (tem) || (SYMBOLP (name) && !EQ (name, tem)))
-    return Qnil;
+    return default_;
   else
     return tem;
 }
@@ -714,10 +717,42 @@
 {
   /* This function can GC */
   Ffset (symbol, newdef);
-  LOADHIST_ATTACH (symbol);
+  LOADHIST_ATTACH (Fcons (Qdefun, symbol));
   return newdef;
 }
 
+DEFUN ("subr-name", Fsubr_name, 1, 1, 0, /*
+Return name of function SUBR.
+SUBR must be a built-in function.  
+*/
+       (subr))
+{
+  const char *name;
+  CHECK_SUBR (subr);
+
+  name = XSUBR (subr)->name;
+  return make_string ((const Ibyte *)name, strlen (name));
+}
+
+DEFUN ("special-form-p", Fspecial_form_p, 1, 1, 0, /*
+Return whether SUBR is a special form.
+
+A special form is a built-in function (a subr, that is a function
+implemented in C, not Lisp) which does not necessarily evaluate all its
+arguments.  Much of the basic XEmacs Lisp syntax is implemented by means of
+special forms; examples are `let', `condition-case', `defun', `setq' and so
+on.
+
+If you intend to write a Lisp function that does not necessarily evaluate
+all its arguments, the portable (across emacs variants, and across Lisp
+implementations) way to go about it is to write a macro instead.  See
+`defmacro' and `backquote'.
+*/
+       (subr))
+{
+  subr = indirect_function (subr, 0);
+  return (SUBRP (subr) && XSUBR (subr)->max_args == UNEVALLED) ? Qt : Qnil;
+}
 
 DEFUN ("setplist", Fsetplist, 2, 2, 0, /*
 Set SYMBOL's property list to NEWPLIST, and return NEWPLIST.
@@ -1008,28 +1043,28 @@
   { XD_END }
 };
 
-DEFINE_LISP_OBJECT ("symbol-value-forward",
+DEFINE_DUMPABLE_LISP_OBJECT ("symbol-value-forward",
 			       symbol_value_forward,
 			       0,
 			       print_symbol_value_magic, 0, 0, 0,
 			       symbol_value_forward_description,
 			       struct symbol_value_forward);
 
-DEFINE_LISP_OBJECT ("symbol-value-buffer-local",
+DEFINE_DUMPABLE_LISP_OBJECT ("symbol-value-buffer-local",
 			       symbol_value_buffer_local,
 			       mark_symbol_value_buffer_local,
 			       print_symbol_value_magic, 0, 0, 0,
 			       symbol_value_buffer_local_description,
 			       struct symbol_value_buffer_local);
 
-DEFINE_LISP_OBJECT ("symbol-value-lisp-magic",
+DEFINE_DUMPABLE_LISP_OBJECT ("symbol-value-lisp-magic",
 			       symbol_value_lisp_magic,
 			       mark_symbol_value_lisp_magic,
 			       print_symbol_value_magic, 0, 0, 0,
 			       symbol_value_lisp_magic_description,
 			       struct symbol_value_lisp_magic);
 
-DEFINE_LISP_OBJECT ("symbol-value-varalias",
+DEFINE_DUMPABLE_LISP_OBJECT ("symbol-value-varalias",
 			       symbol_value_varalias,
 			       mark_symbol_value_varalias,
 			       print_symbol_value_magic, 0, 0, 0,
@@ -2106,7 +2141,7 @@
 
   GC_PROPERTY_LIST_LOOP_3 (symbol, val, args)
     {
-      val = Feval (val);
+      val = IGNORE_MULTIPLE_VALUES (Feval (val));
       Fset_default (symbol, val);
       retval = val;
     }
@@ -2717,6 +2752,78 @@
   else
     return local_info != 0 ? Qt : Qnil;
 }
+
+DEFUN ("custom-variable-p", Fcustom_variable_p, 1, 1, 0, /*
+Return non-nil if SYMBOL names a custom variable.
+Does not follow the variable alias chain.
+*/
+       (symbol))
+{
+  return (!(NILP (Fget(symbol, intern ("standard-value"), Qnil))) 
+          || !(NILP (Fget(symbol, intern ("custom-autoload"), Qnil)))) ?
+    Qt: Qnil;
+}
+
+static Lisp_Object
+user_variable_alias_check_fun (Lisp_Object symbol)
+{
+  Lisp_Object documentation = Fget (symbol, Qvariable_documentation, Qnil);
+      
+  if ((INTP (documentation) && XINT (documentation) < 0) ||
+      (STRINGP (documentation) &&
+       (string_byte (documentation, 0) == '*')) ||
+      /* If (STRING . INTEGER), a negative integer means a user variable. */
+      (CONSP (documentation)
+       && STRINGP (XCAR (documentation))
+       && INTP (XCDR (documentation))
+       && XINT (XCDR (documentation)) < 0) ||
+      !NILP (Fcustom_variable_p (symbol)))
+    {
+      return make_int(1);
+    }
+
+  return Qzero;
+}
+
+DEFUN ("user-variable-p", Fuser_variable_p, 1, 1, 0, /*
+Return t if SYMBOL names a variable intended to be set and modified by users.
+\(The alternative is a variable used internally in a Lisp program.)
+A symbol names a user variable if
+\(1) the first character of its documentation is `*', or
+\(2) it is customizable (`custom-variable-p' gives t), or
+\(3) it names a variable alias that eventually resolves to another user variable.
+
+The GNU Emacs implementation of `user-variable-p' returns nil if there is a
+loop in the chain of symbols.  Since this is indistinguishable from the case
+where a symbol names a non-user variable, XEmacs signals a
+`cyclic-variable-indirection' error instead; use `condition-case' to catch
+this error if you really want to avoid this.
+*/
+       (symbol))
+{
+  Lisp_Object mapped;
+
+  if (!SYMBOLP (symbol))
+    {
+      return Qnil; 
+    }
+
+  /* Called for its side-effects, we want it to signal if there's a loop. */
+  follow_varalias_pointers (symbol, Qt);
+
+  /* Look through the various aliases. */
+  mapped = map_varalias_chain (symbol, Qt, user_variable_alias_check_fun);
+  if (EQ (Qzero, mapped))
+    {
+      return Qnil;
+    }
+
+  assert (EQ (make_int (1), mapped));
+
+  return Qt;
+}
+
+
 
 
 /*
@@ -2992,7 +3099,7 @@
 pity, thereby invalidating your code.
 */
        (variable, handler_type, handler, harg,
-	UNUSED (keep_existing)))
+	UNUSED (keep_existing )))
 {
   Lisp_Object valcontents;
   struct symbol_value_lisp_magic *bfwd;
@@ -3100,20 +3207,98 @@
   return hare;
 }
 
-DEFUN ("defvaralias", Fdefvaralias, 2, 2, 0, /*
+/* Map FN over the chain of variable aliases for SYMBOL. If FN returns
+   something other than Qzero for some link in the chain, return that
+   immediately. Otherwise return Qzero (which is not a symbol).
+
+   FN may be called twice on the same symbol if the varalias chain is
+   cyclic. Prevent this by calling follow_varalias_pointers first for its
+   side-effects.
+
+   Signals a cyclic-variable-indirection error if a cyclic structure is
+   detected. */
+
+static Lisp_Object
+map_varalias_chain (Lisp_Object symbol,
+                    Lisp_Object follow_past_lisp_magic,
+                    Lisp_Object (*fn) (Lisp_Object arg))
+{
+#define VARALIAS_INDIRECTION_SUSPICION_LENGTH 16
+  Lisp_Object tortoise, hare, val, res;
+  int count;
+
+  assert (fn);
+
+  /* quick out just in case */
+  if (!SYMBOL_VALUE_MAGIC_P (XSYMBOL (symbol)->value))
+    {
+      return (fn)(symbol);
+    }
+
+  /* Compare implementation of indirect_function().  */
+  for (hare = tortoise = symbol, count = 0;
+       val = fetch_value_maybe_past_magic (hare, follow_past_lisp_magic),
+	 SYMBOL_VALUE_VARALIAS_P (val);
+       hare = symbol_value_varalias_aliasee (XSYMBOL_VALUE_VARALIAS (val)),
+	 count++)
+    {
+      res = (fn) (hare);
+      if (!EQ (Qzero, res))
+        {
+          return res;
+        }
+
+      if (count < VARALIAS_INDIRECTION_SUSPICION_LENGTH) continue;
+
+      if (count & 1)
+	tortoise = symbol_value_varalias_aliasee
+	  (XSYMBOL_VALUE_VARALIAS (fetch_value_maybe_past_magic
+				   (tortoise, follow_past_lisp_magic)));
+      if (EQ (hare, tortoise))
+        return Fsignal (Qcyclic_variable_indirection, list1 (symbol));
+    }
+
+  return (fn) (hare);
+}
+
+/*
+
+OED entry, 2nd edition, IPA transliterated using Kirshenbaum: 
+
+alias ('eIlI@s, '&lI@s), adv. and n.
+[...]
+B. n. (with pl. aliases.)
+1. Another name, an assumed name.
+1605 Camden Rem. (1614) 147 An Alias or double name cannot preiudice the honest.
+1831 Edin. Rev. LIII. 364 He has been assuming various aliases.
+1861 Macaulay Hist. Eng. V. 92 The monk who was sometimes called Harrison
+and sometimes went by the alias of Johnson.
+
+The alias is the fake name. Let's try to follow that usage in our
+documentation.
+
+*/
+
+DEFUN ("defvaralias", Fdefvaralias, 2, 3, 0, /*
 Define a variable as an alias for another variable.
 Thenceforth, any operations performed on VARIABLE will actually be
-performed on ALIAS.  Both VARIABLE and ALIAS should be symbols.
-If ALIAS is nil, remove any aliases for VARIABLE.
-ALIAS can itself be aliased, and the chain of variable aliases
+performed on ALIASED.  Both VARIABLE and ALIASED should be symbols.
+If ALIASED is nil and VARIABLE is an existing alias, remove that alias.
+ALIASED can itself be an alias, and the chain of variable aliases
 will be followed appropriately.
 If VARIABLE already has a value, this value will be shadowed
 until the alias is removed, at which point it will be restored.
 Currently VARIABLE cannot be a built-in variable, a variable that
 has a buffer-local value in any buffer, or the symbols nil or t.
-\(ALIAS, however, can be any type of variable.)
+\(ALIASED, however, can be any type of variable.)
+
+Optional argument DOCSTRING is documentation for VARIABLE in its use as an
+alias for ALIASED.  The XEmacs help code ignores this documentation, using
+the documentation of ALIASED instead, and the docstring, if specified, is
+not shadowed in the same way that the value is.  Only use it if you know
+what you're doing.
 */
-       (variable, alias))
+       (variable, aliased, docstring))
 {
   struct symbol_value_varalias *bfwd;
   Lisp_Object valcontents;
@@ -3123,7 +3308,7 @@
 
   valcontents = XSYMBOL (variable)->value;
 
-  if (NILP (alias))
+  if (NILP (aliased))
     {
       if (SYMBOL_VALUE_VARALIAS_P (valcontents))
 	{
@@ -3134,11 +3319,15 @@
       return Qnil;
     }
 
-  CHECK_SYMBOL (alias);
+  CHECK_SYMBOL (aliased);
+
+  if (!NILP (docstring))
+    Fput (variable, Qvariable_documentation, docstring);
+
   if (SYMBOL_VALUE_VARALIAS_P (valcontents))
     {
       /* transmogrify */
-      XSYMBOL_VALUE_VARALIAS (valcontents)->aliasee = alias;
+      XSYMBOL_VALUE_VARALIAS (valcontents)->aliasee = aliased;
       return Qnil;
     }
 
@@ -3150,7 +3339,7 @@
   bfwd =
     XSYMBOL_VALUE_VARALIAS (ALLOC_LISP_OBJECT (symbol_value_varalias));
   bfwd->magic.type = SYMVAL_VARALIAS;
-  bfwd->aliasee = alias;
+  bfwd->aliasee = aliased;
   bfwd->shadowed = valcontents;
 
   valcontents = wrap_symbol_value_magic (bfwd);
@@ -3159,8 +3348,8 @@
 }
 
 DEFUN ("variable-alias", Fvariable_alias, 1, 2, 0, /*
-If VARIABLE is aliased to another variable, return that variable.
-VARIABLE should be a symbol.  If VARIABLE is not aliased, return nil.
+If VARIABLE is an alias of another variable, return that variable.
+VARIABLE should be a symbol.  If VARIABLE is not an alias, return nil.
 Variable aliases are created with `defvaralias'.  See also
 `indirect-variable'.
 */
@@ -3248,7 +3437,7 @@
 Lisp_Object Qnull_pointer;
 #endif
 
-#ifndef MC_ALLOC
+#ifndef NEW_GC
 /* some losing systems can't have static vars at function scope... */
 static const struct symbol_value_magic guts_of_unbound_marker =
 { /* struct symbol_value_magic */
@@ -3266,7 +3455,7 @@
   0, /* value */
   SYMVAL_UNBOUND_MARKER
 };
-#endif /* not MC_ALLOC */
+#endif /* not NEW_GC */
 
 void
 init_symbols_once_early (void)
@@ -3298,7 +3487,7 @@
   {
     /* Required to get around a GCC syntax error on certain
        architectures */
-#ifdef MC_ALLOC
+#ifdef NEW_GC
     struct symbol_value_magic *tem = (struct symbol_value_magic *)
       mc_alloc (sizeof (struct symbol_value_magic));
     MARK_LRECORD_AS_LISP_READONLY (tem);
@@ -3311,9 +3500,9 @@
     inc_lrecord_stats (sizeof (struct symbol_value_magic), 
 		       (const struct lrecord_header *) tem);
 #endif /* ALLOC_TYPE_STATS */
-#else /* not MC_ALLOC */
+#else /* not NEW_GC */
     const struct symbol_value_magic *tem = &guts_of_unbound_marker;
-#endif /* not MC_ALLOC */
+#endif /* not NEW_GC */
 
     Qunbound = wrap_symbol_value_magic (tem);
   }
@@ -3450,7 +3639,7 @@
 #endif
 
 #ifdef HAVE_SHLIB
-#ifndef MC_ALLOC
+#ifndef NEW_GC
 /*
  * If we are not in a pure undumped Emacs, we need to make a duplicate of
  * the subr. This is because the only time this function will be called
@@ -3510,7 +3699,7 @@
     subr = newsubr;							      \
   }									      \
 } while (0)
-#else /* MC_ALLOC */
+#else /* NEW_GC */
 /* 
  * If we have the new allocator enabled, we do not need to make a
  * duplicate of the subr.  The new allocator already does allocate all
@@ -3548,7 +3737,7 @@
       signal_ferror (Qdll_error, "Attempt to redefine %s", subr_name (subr)); \
   }									      \
 } while (0)
-#endif /* MC_ALLOC */
+#endif /* NEW_GC */
 #else /* ! HAVE_SHLIB */
 #define check_module_subr(subr)
 #endif
@@ -3702,6 +3891,8 @@
   DEFSUBR (Ffset);
   DEFSUBR (Fdefine_function);
   Ffset (intern ("defalias"), intern ("define-function"));
+  DEFSUBR (Fsubr_name);
+  DEFSUBR (Fspecial_form_p);
   DEFSUBR (Fsetplist);
   DEFSUBR (Fsymbol_value_in_buffer);
   DEFSUBR (Fsymbol_value_in_console);
@@ -3717,6 +3908,8 @@
   DEFSUBR (Fkill_local_variable);
   DEFSUBR (Fkill_console_local_variable);
   DEFSUBR (Flocal_variable_p);
+  DEFSUBR (Fcustom_variable_p);
+  DEFSUBR (Fuser_variable_p);
   DEFSUBR (Fdefvaralias);
   DEFSUBR (Fvariable_alias);
   DEFSUBR (Findirect_variable);