[PATCH] defaults.el: record and revert changing XEmacs defaults across time

On Thu, 03 Feb 2005, nix(a)esperi.org.uk mused: Have a package, everyone. I'm not sure where it belongs; if we want both core *and* the packages to be able to use it (which is kind of the point), we're in a bit of a bind. Can core reasonably require new packages when you upgrade it, or are they completely decoupled? (I seem to recall a change to auto-mode-alist construction in core that required new packages...) If the core can force new packages, it should probably go in xemacs-base... packages certainly can't require a new core, so it can't go in core if we want the packages to be able to use it without testing. (This sounds rather backwards to me, given the sort of things core contains; i.e., standard XEmacs things that the packages can use without testing, but I understand why it's the case.) Anyway, wherever it goes, here it is for people to laugh at. (Adjust the (not) in the heading comments if you actually accept it.) It's a bit more elaborate than I originally anticipated, because it occurred to me that site admins might not want *their* customizations blown away, and that you might want to go back to later defaults. All these things are now automatically tracked by keeping track of the current values of variables when `defaults-changed-at' and `defaults-as-at' run. An example: (defvar foo "bang up to date" "A variable with a default value that's changed repeatedly.") (defaults-changed-at "2005-01-10" 'foo "foo bar baz") (defaults-changed-at "2005-01-01" 'foo "ye olde value") (defaults-changed-at "2004-01-01" 'foo nil) foo -> "bang up to date" (defaults-as-at "2004-05-10") ; roll back into the far past foo -> "ye olde value" (defaults-as-at "2005-01-10") ; roll forward to past the last value foo -> "bang up to date" (defaults-as-at "2005-01-09") ; roll back a bit foo -> "foo bar baz" (defaults-as-at "2003-01-01") ; further back foo -> nil (setq foo "womble") ; change value by hand (defaults-as-at "2004-05-10") ; roll back again foo -> "womble" ; rolling no longer affects it (setq foo "ye olde value") ; back to the default (defaults-as-at "now") ; all the way forward to the present day foo -> "bang up to date" ; it's affected again ;; defaults.el --- Record and revert changing XEmacs defaults across time. ;;; Copyright (C) 2005 Nix <nix(a)esperi.org.uk&gt;. ;; Author: Nix <nix(a)esperi.org.uk&gt; ;; Created: 2005-02-04 ;; Keywords: lisp ;; Version: 0.1 ;; This file is (not) part of XEmacs. ;; This library is free software; you can redistribute it and/or modify it ;; under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; It is distributed in the hope that it will be useful, but WITHOUT ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY ;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public ;; License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this library; see the file COPYING. If not, write to the ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA ;; 02111-1307, USA. ;;; Commentary: ;; This package implements a time-based history scheme for XEmacs defaults, ;; allowing users to keep the defaults used by their copy of XEmacs the same ;; as they historically were, no matter how much the XEmacs maintainers may ;; change those defaults. ;; In brief, every modification to an XEmacs default is followed by a call ;; to the function `defaults-changed-at', stating the date on which the ;; modification was made, and what the previous value was, as in this ;; hypothetical case: ;; ;;;###autoload ;; (defcustom pending-delete-mode t ;; "Non-nil when Pending Delete mode is enabled. In Pending Delete mode, typed ;; text replaces the selected region. Normally, you shouldn't modify this ;; variable by hand, but use the function `pending-delete-mode' instead. However, ;; you can customize the default value from the options menu (auto delete ;; selection)." ;;:type 'boolean ;;:set (lambda (symbol value) ;; (pending-delete-mode (or value 0))) ;;:initialize 'custom-initialize-default ;;:require 'pending-del ;;:group 'keyboard) ;; (defaults-changed-at "2005-02-04" 'pending-delete-mode nil) ;; The site administrator or local user can then call `defaults-as-at' to reset ;; the XEmacs defaults back to their values as of the earlier date: this restores ;; all variables which had been changed *after* the stated date; so ;; (defaults-as-at "2005-02-04") would not revert the value of ;; `pending-delete-mode' above, but (defaults-as-at "2005-02-03") would do so. ;; (defaults-as-at "now") reverts to the latest defaults. ;; If the value is subsequently changed from that in force when ;; `defaults-changed-at' is called, except by a call to `defaults-as-at', ;; it is not changed again by future calls to `defaults-as-at'. Site-local ;; changes to defaults are thus preserved --- alas, as are changes made by ;; Lisp code in packages. ;;; Todo: ;; Handle default variables which are deleted or have come to depend on the ;; values of other variables. ;;; Requirements: (require 'cl) ;;; User-customizable variables: ;;; Internal variables: (defvar defaults-history nil "The history of all changed defaults. An alist of elements of the form (DATE VARIABLE VALUE). The list is sorted into chronological order, if necessary, whenever `defaults-as-at' is called. DATE may be the string \"now\", indicating the latest default value, or a date in the form YYYY-MM-DD. Maintained by `defaults-changed-at'.") (defvar defaults-history-presently-sorted t "nil if the `defaults-history' list requires resorting before use.") (defvar defaults-default-values (make-hash-table :test 'eq) "A mapping from symbol name to default value. Used by `defaults-changed-at' to determine if default values have been changed by any means outside of its control: if they have, it leaves them alone on the basis that their values are no longer the default in any version of XEmacs.") (defvar defaults-unbound-symbol (make-symbol "unbound") "Used in the `defaults-default-values' hash to indicate an unbound variable.") (defvar defaults-unbound-property (make-symbol "unbound-property") "Used in various parts of the `defaults' package to differentiate between nil and unbound values in hash tables and property lists.") ;;; Utility functions: (defmacro defaults-define-alist-element-predicate (name predicate) "Generate a predicate named NAME that tests an alist according to PREDICATE. The resulting predicate is passed the car of two elements, and is suitable for passing to `sort', `:test' fnuctions, and such things." `(defun ,＠(list name) (first second) ,＠(list (concat "Returns t if FIRST and SECOND are equal under " "`" (symbol-name (eval predicate)) "'.")) (funcall (symbol-function ,predicate) (first first) (first second)))) (defun defaults-string-greater-p (first second) "Returns t if the string FIRST is greater than SECOND." (string-lessp second first)) (defaults-define-alist-element-predicate defaults-string-alist-greater-p 'defaults-string-greater-p) (defun defaults-known-for (variable) "Return t if a default is known for the variable VARIABLE. Will be true once `defaults-changed-at' has been called for VARIABLE." (not (eq (gethash variable defaults-default-values defaults-unbound-property) defaults-unbound-property))) (defun defaults-memoize-current-value (variable &optional value) "Remember the current value of VARIABLE in the `defaults-default-values' hash. If the variable does not presently exist, the `defaults-unbound-symbol' is remembered instead. Also remember it in the `defaults-history' hash if we've never been called before, against a date of \"now\"." (condition-case nil (progn (unless (defaults-known-for variable) (setq defaults-history (nconc defaults-history (list (list "now" variable (or value (symbol-value variable))))))) (puthash variable (or value (symbol-value variable)) defaults-default-values)) (void-variable (unless (defaults-known-for variable) (setq defaults-history (nconc defaults-history (list (list "now" variable defaults-unbound-symbol))))) (puthash variable defaults-unbound-symbol defaults-default-values)))) (defun defaults-variable-is-unchanged (variable) "Return t if the VARIABLE is unchanged from its default." (or ;; Either it is unbound, and it originally was unbound... (and (not (boundp variable)) (equal (gethash variable defaults-default-values) defaults-unbound-symbol)) ;; or it is bound and has a value, and it originally had that value. (and (boundp variable) (equal (gethash variable defaults-default-values) (symbol-value variable))))) ;;; User-callable functions: ;;;###autoload (defun defaults-changed-at (date variable old-value) "Record an old default value for VARIABLE, as of DATE. DATE should be formatted in ISO standard notation, `YYYY-MM-DD'. A call to this function should be introduced whenever a change is made to the default value of a variable in an XEmacs package or the XEmacs Lisp core. This enables users to revert to the values of defaults as they were at a particular date via calls to the `defaults-as-at' function. Example: ;; (defaults-changed-at \"2005-02-04\" 'pending-delete-mode nil) ;; ;;;###autoload ;; (defcustom pending-delete-mode t ;; [...]" ;; Remember the old value. (setq defaults-history (nconc defaults-history (list (list date variable old-value)))) ;; Remember the current value of the variable. (defaults-memoize-current-value variable) ;; The defaults history is no longer sorted. (setq defaults-history-presently-sorted nil)) ;; Not exactly efficient; may change variables' values repeatedly. ;; This isn't important, as this function is hardly a hot spot. ;;;###autoload (defun defaults-as-at (date) "Return XEmacs defaults to their values as of DATE. A DATE of \"now\" reverts to the latest defaults. The old values are derived from calls to the `defaults-changed-at' function." ;; Sort the list into chronological order, if necessary. ;; This ensures that newer, but still relevant, variable values will take ;; precedence over older ones. (unless defaults-history-presently-sorted (setq defaults-history (sort defaults-history 'defaults-string-alist-greater-p)) (setq defaults-history-presently-sorted t)) (let ((history-left defaults-history)) ;; Check each element... (while history-left (let* ((history-element (first history-left)) (el-date (first history-element)) (el-variable (second history-element)) (el-value (third history-element))) (setq history-left (rest history-left)) ;; ... to see if it's for a date in the future of the requested date, ;; and the variable's current value is unchanged from the default, ;; or the value is `now' and we're looking for `now'. (when (or (defaults-string-greater-p el-date date) (and (string= el-date date) (string= el-date "now"))) (when (defaults-variable-is-unchanged el-variable) ;; Reset the variable and re-put the `standard-value', if present, ;; for customize. (Does customize require anything else to be set?) (set el-variable el-value) (if (not (eq (get el-variable 'standard-value defaults-unbound-property) defaults-unbound-property)) (put el-variable 'standard-value (list el-value)))) ;; Remember the new default value. (defaults-memoize-current-value el-variable el-value)))))) (provide 'defaults) -- `Blish is clearly in love with language. Unfortunately, language dislikes him intensely.' --- Russ Allbery