[PATCH] Handle varalias chains, custom variables in #'user-variable-p.

# HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net&gt; # Date 1219490164 -7200 # Node ID ae71aca5638c1ebf2318176677058b439838e064 # Parent c4fd85dd95bd72e8c7899ed48075c2fb26e365fa Handle varalias chains, custom variables in #'user-variable-p. lisp/ChangeLog addition: 2008-08-23 Aidan Kehoe <kehoea(a)parhasard.net&gt; * custom.el: Move #'custom-variable-p to C, since it's now called from #'user-variable-p. src/ChangeLog addition: 2008-08-23 Aidan Kehoe <kehoea(a)parhasard.net&gt; * eval.c (Fuser_variable_p): Moved to symbols.c * symbols.c (Fcustom_variable_p): Moved here from custom.el. (user_variable_alias_check_fun): Mapper function used in `user-variable-p'. (Fuser_variable_p): Moved here from eval.c, to allow it to examine the variable alias chain. Expanded to check each entry in the variable alias chain for signs of being a user variable; documentation updated, noting the differences between GNU's behaviour and ours (ours is a little more sensible) (map_varalias_chain): New. Given a C function, call it at least once for each symbol in a symbol's varalias chain, signalling an error if there's a cycle, and returning immediately if the function returns something other than Qzero. (Fdefvaralias): Correct the use of the word "alias" in the docstring and in the argument name. Motivate this in a comment. Add support for a DOCSTRING argument, something GNU has too. Document this; document the differing argument order compared to GNU, and how one might work around that. * gc.c (vars_of_gc): Start the docstring of `garbage-collection-messages' with an asterisk, to indicate that it's a user variable. diff -r c4fd85dd95bd -r ae71aca5638c lisp/ChangeLog --- a/lisp/ChangeLog Wed Aug 20 17:39:56 2008 +0200 +++ b/lisp/ChangeLog Sat Aug 23 13:16:04 2008 +0200 ＠＠ -1,3 +1,8 ＠＠ +2008-08-23 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + * custom.el: Move #'custom-variable-p to C, since it's now called + from #'user-variable-p. + 2008-08-09 Aidan Kehoe <kehoea(a)parhasard.net&gt; * subr.el (skip-chars-quote): New. diff -r c4fd85dd95bd -r ae71aca5638c lisp/custom.el --- a/lisp/custom.el Wed Aug 20 17:39:56 2008 +0200 +++ b/lisp/custom.el Sat Aug 23 13:16:04 2008 +0200 ＠＠ -514,11 +514,9 ＠＠ (put symbol 'custom-autoload t) (custom-add-load symbol load)) -;; This test is also in the C code of `user-variable-p'. -(defun custom-variable-p (variable) - "Return non-nil if VARIABLE is a custom variable." - (or (get variable 'standard-value) - (get variable 'custom-autoload))) +;; XEmacs; +;; #'custom-variable-p is in symbols.c, since it's called from +;; #'user-variable-p. ;;; Loading files needed to customize a symbol. ;;; This is in custom.el because menu-bar.el needs it for toggle cmds. diff -r c4fd85dd95bd -r ae71aca5638c src/ChangeLog --- a/src/ChangeLog Wed Aug 20 17:39:56 2008 +0200 +++ b/src/ChangeLog Sat Aug 23 13:16:04 2008 +0200 ＠＠ -1,3 +1,28 ＠＠ +2008-08-23 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + * eval.c (Fuser_variable_p): Moved to symbols.c + * symbols.c (Fcustom_variable_p): Moved here from custom.el. + (user_variable_alias_check_fun): Mapper function used in + `user-variable-p'. + (Fuser_variable_p): Moved here from eval.c, to allow it to examine + the variable alias chain. Expanded to check each entry in the + variable alias chain for signs of being a user variable; + documentation updated, noting the differences between GNU's + behaviour and ours (ours is a little more sensible) + (map_varalias_chain): New. + Given a C function, call it at least once for each symbol in a + symbol's varalias chain, signalling an error if there's a cycle, + and returning immediately if the function returns something other + than Qzero. + (Fdefvaralias): Correct the use of the word "alias" in the + docstring and in the argument name. Motivate this in a + comment. Add support for a DOCSTRING argument, something GNU has + too. Document this; document the differing argument order compared + to GNU, and how one might work around that. + * gc.c (vars_of_gc): Start the docstring of + `garbage-collection-messages' with an asterisk, to indicate that + it's a user variable. + 2008-08-09 Aidan Kehoe <kehoea(a)parhasard.net&gt; Integrate Romain Francoise' 2005-09-14 (pre-GPLV3) GNU change, diff -r c4fd85dd95bd -r ae71aca5638c src/eval.c --- a/src/eval.c Wed Aug 20 17:39:56 2008 +0200 +++ b/src/eval.c Sat Aug 23 13:16:04 2008 +0200 ＠＠ -1356,29 +1356,8 ＠＠ return sym; } -DEFUN ("user-variable-p", Fuser_variable_p, 1, 1, 0, /* -Return t if VARIABLE is intended to be set and modified by users. -\(The alternative is a variable used internally in a Lisp program.) -Determined by whether the first character of the documentation -for the variable is `*'. -*/ - (variable)) -{ - Lisp_Object documentation = Fget (variable, Qvariable_documentation, Qnil); - - return - ((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)) ? - Qt : Qnil; -} +/* XEmacs: user-variable-p is in symbols.c, since it needs to mess around + with the symbol variable aliases. */ DEFUN ("macroexpand-internal", Fmacroexpand_internal, 1, 2, 0, /* Return result of expanding macros at top level of FORM. ＠＠ -6582,7 +6561,6 ＠＠ DEFSUBR (Fdefmacro); DEFSUBR (Fdefvar); DEFSUBR (Fdefconst); - DEFSUBR (Fuser_variable_p); DEFSUBR (Flet); DEFSUBR (FletX); DEFSUBR (Fwhile); diff -r c4fd85dd95bd -r ae71aca5638c src/gc.c --- a/src/gc.c Wed Aug 20 17:39:56 2008 +0200 +++ b/src/gc.c Sat Aug 23 13:16:04 2008 +0200 ＠＠ -2166,7 +2166,7 ＠＠ */ ); DEFVAR_BOOL ("garbage-collection-messages", &garbage_collection_messages /* - Non-nil means display messages at start and end of garbage collection. +*Non-nil means display messages at start and end of garbage collection. */ ); garbage_collection_messages = 0; diff -r c4fd85dd95bd -r ae71aca5638c src/symbols.c --- a/src/symbols.c Wed Aug 20 17:39:56 2008 +0200 +++ b/src/symbols.c Sat Aug 23 13:16:04 2008 +0200 ＠＠ -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 ＠＠ -2754,6 +2757,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 varias aliases. */ + mapped = map_varalias_chain (symbol, Qt, user_variable_alias_check_fun); + if (EQ (Qzero, mapped)) + { + return Qnil; + } + + assert (make_int (1) == mapped); + + return Qt; +} + +  /* ＠＠ -3136,20 +3211,110 ＠＠ 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 (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. + +The order of the arguments of the GNU Emacs implementation (checked in to +CVS in 2002, at least six years later than the XEmacs implementation ...) +are reversed. If you're writing portable code, you'll need a macro that +checks for the xemacs feature; something like: + +\(defmacro portable-defvaralias (variable aliased &optional docstring) + \(if (featurep 'xemacs) + `(defvaralias ,variable ,＠(cons aliased (if docstring (list docstring)))) + `(defvaralias ,aliased ,＠(cons variable (if docstring (list docstring)))))) + +This won't have any run-time penalty once you byte-compile your code. */ - (variable, alias)) + (variable, aliased, docstring)) { struct symbol_value_varalias *bfwd; Lisp_Object valcontents; ＠＠ -3159,7 +3324,7 ＠＠ valcontents = XSYMBOL (variable)->value; - if (NILP (alias)) + if (NILP (aliased)) { if (SYMBOL_VALUE_VARALIAS_P (valcontents)) { ＠＠ -3170,11 +3335,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; } ＠＠ -3186,7 +3355,7 ＠＠ bfwd = ALLOC_LCRECORD_TYPE (struct symbol_value_varalias, &lrecord_symbol_value_varalias); bfwd->magic.type = SYMVAL_VARALIAS; - bfwd->aliasee = alias; + bfwd->aliasee = aliased; bfwd->shadowed = valcontents; valcontents = wrap_symbol_value_magic (bfwd); ＠＠ -3195,8 +3364,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'. */ ＠＠ -3755,6 +3924,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); -- ¿Dónde estará ahora mi sobrino Yoghurtu Nghé, que tuvo que huir precipitadamente de la aldea por culpa de la escasez de rinocerontes? _______________________________________________ XEmacs-Beta mailing list XEmacs-Beta(a)xemacs.org http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-beta