X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fxemacs-chise.git.1;a=blobdiff_plain;f=lisp%2Fcustom.el;h=4e17045035b726eb14e38358b6580211b9b7883e;hp=77dd59d5ab12d007a2116346f922d93250d2477c;hb=4217f715cf3120a5591ce18f6ad90be7d6df465d;hpb=a5f466de30a3e927ed1146b0c7e3870e71465c8f

diff --git a/lisp/custom.el b/lisp/custom.el
index 77dd59d..4e17045 100644
--- a/lisp/custom.el
+++ b/lisp/custom.el
@@ -3,7 +3,7 @@
 ;; Copyright (C) 1996, 1997 Free Software Foundation, Inc.
 
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
-;; Maintainer: Hrvoje Niksic <hniksic@srce.hr>
+;; Maintainer: Hrvoje Niksic <hniksic@xemacs.org>
 ;; Keywords: help, faces, dumped
 ;; Version: 1.9960-x
 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
@@ -31,12 +31,18 @@
 
 ;; This file only contain the code needed to declare and initialize
 ;; user options.  The code to customize options is autoloaded from
-;; `cus-edit.el'. 
+;; `cus-edit.el'.
 ;;
 ;; The code implementing face declarations is in `cus-face.el'
 
 ;;; Code:
 
+(eval-when-compile
+  (load "cl-macs" nil t))
+
+(autoload 'custom-declare-face "cus-face")
+(autoload 'defun* "cl-macs")
+
 (require 'widget)
 
 (defvar custom-define-hook nil
@@ -55,8 +61,8 @@ symbol."
   (unless (default-boundp symbol)
     ;; Use the saved value if it exists, otherwise the standard setting.
     (set-default symbol (if (get symbol 'saved-value)
-			    (eval (car (get symbol 'saved-value)))
-			  (eval value)))))
+                            (eval (car (get symbol 'saved-value)))
+                          (eval value)))))
 
 (defun custom-initialize-set (symbol value)
   "Initialize SYMBOL with VALUE.
@@ -64,83 +70,83 @@ Like `custom-initialize-default', but use the function specified by
 `:set' to initialize SYMBOL."
   (unless (default-boundp symbol)
     (funcall (or (get symbol 'custom-set) 'set-default)
-	     symbol 
-	     (if (get symbol 'saved-value)
-		 (eval (car (get symbol 'saved-value)))
-	       (eval value)))))
+             symbol
+             (if (get symbol 'saved-value)
+                 (eval (car (get symbol 'saved-value)))
+               (eval value)))))
 
 (defun custom-initialize-reset (symbol value)
   "Initialize SYMBOL with VALUE.
 Like `custom-initialize-set', but use the function specified by
 `:get' to reinitialize SYMBOL if it is already bound."
     (funcall (or (get symbol 'custom-set) 'set-default)
-	     symbol 
-	     (cond ((default-boundp symbol)
-		    (funcall (or (get symbol 'custom-get) 'default-value)
-			     symbol))
-		   ((get symbol 'saved-value)
-		    (eval (car (get symbol 'saved-value))))
-		   (t
-		    (eval value)))))
+             symbol
+             (cond ((default-boundp symbol)
+                    (funcall (or (get symbol 'custom-get) 'default-value)
+                             symbol))
+                   ((get symbol 'saved-value)
+                    (eval (car (get symbol 'saved-value))))
+                   (t
+                    (eval value)))))
 
 (defun custom-initialize-changed (symbol value)
   "Initialize SYMBOL with VALUE.
-Like `custom-initialize-reset', but only use the `:set' function if the 
+Like `custom-initialize-reset', but only use the `:set' function if the
 not using the standard setting.  Otherwise, use the `set-default'."
   (cond ((default-boundp symbol)
-	 (funcall (or (get symbol 'custom-set) 'set-default)
-		  symbol
-		  (funcall (or (get symbol 'custom-get) 'default-value)
-			   symbol)))
-	((get symbol 'saved-value)
-	 (funcall (or (get symbol 'custom-set) 'set-default)
-		  symbol
-		  (eval (car (get symbol 'saved-value)))))
-	(t
-	 (set-default symbol (eval value)))))
+         (funcall (or (get symbol 'custom-set) 'set-default)
+                  symbol
+                  (funcall (or (get symbol 'custom-get) 'default-value)
+                           symbol)))
+        ((get symbol 'saved-value)
+         (funcall (or (get symbol 'custom-set) 'set-default)
+                  symbol
+                  (eval (car (get symbol 'saved-value)))))
+        (t
+         (set-default symbol (eval value)))))
 
 (defun custom-declare-variable (symbol value doc &rest args)
   "Like `defcustom', but SYMBOL and VALUE are evaluated as normal arguments."
   ;; Remember the standard setting.
   (put symbol 'standard-value (list value))
   ;; Maybe this option was rogue in an earlier version.  It no longer is.
-  (when (get symbol 'force-value)
-    ;; It no longer is.    
+  (when (eq (get symbol 'force-value) 'rogue)
+    ;; It no longer is.
     (put symbol 'force-value nil))
   (when doc
     (put symbol 'variable-documentation doc))
   (let ((initialize 'custom-initialize-reset)
-	(requests nil))
-    (while args 
+        (requests nil))
+    (while args
       (let ((arg (car args)))
-	(setq args (cdr args))
-	(check-argument-type 'keywordp arg)
-	(let ((keyword arg)
-	      (value (car args)))
-	  (unless args
-	    (signal 'error (list "Keyword is missing an argument" keyword)))
-	  (setq args (cdr args))
-	  (cond ((eq keyword :initialize)
-		 (setq initialize value))
-		((eq keyword :set)
-		 (put symbol 'custom-set value))
-		((eq keyword :get)
-		 (put symbol 'custom-get value))
-		((eq keyword :require)
-		 (setq requests (cons value requests)))
-		((eq keyword :type)
-		 (put symbol 'custom-type value))
-		((eq keyword :options)
-		 (if (get symbol 'custom-options)
-		     ;; Slow safe code to avoid duplicates.
-		     (mapc (lambda (option)
-			     (custom-add-option symbol option))
-			   value)
-		   ;; Fast code for the common case.
-		   (put symbol 'custom-options (copy-sequence value))))
-		(t
-		 (custom-handle-keyword symbol keyword value
-					'custom-variable))))))
+        (setq args (cdr args))
+        (check-argument-type 'keywordp arg)
+        (let ((keyword arg)
+              (value (car args)))
+          (unless args
+            (signal 'error (list "Keyword is missing an argument" keyword)))
+          (setq args (cdr args))
+          (cond ((eq keyword :initialize)
+                 (setq initialize value))
+                ((eq keyword :set)
+                 (put symbol 'custom-set value))
+                ((eq keyword :get)
+                 (put symbol 'custom-get value))
+                ((eq keyword :require)
+                 (setq requests (cons value requests)))
+                ((eq keyword :type)
+                 (put symbol 'custom-type value))
+                ((eq keyword :options)
+                 (if (get symbol 'custom-options)
+                     ;; Slow safe code to avoid duplicates.
+                     (mapc (lambda (option)
+                             (custom-add-option symbol option))
+                           value)
+                   ;; Fast code for the common case.
+                   (put symbol 'custom-options (copy-sequence value))))
+                (t
+                 (custom-handle-keyword symbol keyword value
+                                        'custom-variable))))))
     (put symbol 'custom-requests requests)
     ;; Do the actual initialization.
     (funcall initialize symbol value))
@@ -158,29 +164,34 @@ Neither SYMBOL nor VALUE needs to be quoted.
 If SYMBOL is not already bound, initialize it to VALUE.
 The remaining arguments should have the form
 
-   [KEYWORD VALUE]... 
+   [KEYWORD VALUE]...
 
 The following KEYWORD's are defined:
 
-:type	VALUE should be a widget type for editing the symbols value.
-	The default is `sexp'.
+:type   VALUE should be a widget type for editing the symbols value.
+        The default is `sexp'.
 :options VALUE should be a list of valid members of the widget type.
-:group  VALUE should be a customization group.  
+:group  VALUE should be a customization group.
         Add SYMBOL to that group.
 :initialize VALUE should be a function used to initialize the
-	variable.  It takes two arguments, the symbol and value
-	given in the `defcustom' call.  The default is
-	`custom-initialize-set' 
-:set	VALUE should be a function to set the value of the symbol. 
-	It takes two arguments, the symbol to set and the value to
-	give it.  The default is `set-default'.
-:get	VALUE should be a function to extract the value of symbol.
-	The function takes one argument, a symbol, and should return
-	the current value for that symbol.  The default is
-	`default-value'. 
+        variable.  It takes two arguments, the symbol and value
+        given in the `defcustom' call.  The default is
+        `custom-initialize-set'
+:set    VALUE should be a function to set the value of the symbol.
+        It takes two arguments, the symbol to set and the value to
+        give it.  The default is `custom-set-default'.
+:get    VALUE should be a function to extract the value of symbol.
+        The function takes one argument, a symbol, and should return
+        the current value for that symbol.  The default is
+        `default-value'.
 :require VALUE should be a feature symbol.  Each feature will be
-	required after initialization, of the the user have saved this
-	option.
+        required after initialization, of the user have saved this
+        option.
+:version VALUE should be a string specifying that the variable was
+        first introduced, or its default value was changed, in Emacs
+        version VERSION.
+:set-after VARIABLE specifies that SYMBOL should be set after VARIABLE when
+	both have been customized.
 
 Read the section about customization in the Emacs Lisp manual for more
 information."
@@ -221,7 +232,7 @@ For the DISPLAY to match a FRAME, the REQ property of the frame must
 match one of the ITEM.  The following REQ are defined:
 
 `type' (the value of `window-system')
-  Should be one of `x' or `tty'.
+  Should be one of `x', `mswindows', or `tty'.
 
 `class' (the frame's color support)
   Should be one of `color', `grayscale', or `mono'.
@@ -237,7 +248,7 @@ information."
 
 (defun custom-declare-group (symbol members doc &rest args)
   "Like `defgroup', but SYMBOL is evaluated as a normal argument."
-  (while members 
+  (while members
     (apply 'custom-add-to-group symbol (car members))
     (pop members))
   (put symbol 'custom-group (nconc members (get symbol 'custom-group)))
@@ -248,15 +259,15 @@ information."
       (setq args (cdr args))
       (check-argument-type 'keywordp arg)
       (let ((keyword arg)
-	    (value (car args)))
-	(unless args
-	  (signal 'error (list "Keyword is missing an argument" keyword)))
-	(setq args (cdr args))
-	(cond ((eq keyword :prefix)
-	       (put symbol 'custom-prefix value))
-	      (t
-	       (custom-handle-keyword symbol keyword value
-				      'custom-group))))))
+            (value (car args)))
+        (unless args
+          (signal 'error (list "Keyword is missing an argument" keyword)))
+        (setq args (cdr args))
+        (cond ((eq keyword :prefix)
+               (put symbol 'custom-prefix value))
+              (t
+               (custom-handle-keyword symbol keyword value
+                                      'custom-group))))))
   (run-hooks 'custom-define-hook)
   symbol)
 
@@ -273,7 +284,7 @@ edit faces, and `custom-group' for editing groups.
 
 The remaining arguments should have the form
 
-   [KEYWORD VALUE]... 
+   [KEYWORD VALUE]...
 
 The following KEYWORD's are defined:
 
@@ -291,9 +302,9 @@ information."
   "To existing GROUP add a new OPTION of type WIDGET.
 If there already is an entry for that option, overwrite it."
   (let* ((members (get group 'custom-group))
-	 (old (assq option members)))
+         (old (assq option members)))
     (if old
-	(setcar (cdr old) widget)
+        (setcar (cdr old) widget)
       (put group 'custom-group (nconc members (list (list option widget))))))
   (puthash group t custom-group-hash-table))
 
@@ -302,16 +313,16 @@ If there already is an entry for that option, overwrite it."
 (defun custom-handle-all-keywords (symbol args type)
   "For customization option SYMBOL, handle keyword arguments ARGS.
 Third argument TYPE is the custom option type."
-  (while args 
+  (while args
     (let ((arg (car args)))
       (setq args (cdr args))
       (check-argument-type 'keywordp arg)
       (let ((keyword arg)
-	    (value (car args)))
-	(unless args
-	  (signal 'error (list "Keyword is missing an argument" keyword)))
-	(setq args (cdr args))
-	(custom-handle-keyword symbol keyword value type)))))  
+            (value (car args)))
+        (unless args
+          (signal 'error (list "Keyword is missing an argument" keyword)))
+        (setq args (cdr args))
+        (custom-handle-keyword symbol keyword value type)))))
 
 (defun custom-handle-keyword (symbol keyword value type)
   "For customization option SYMBOL, handle KEYWORD with VALUE.
@@ -326,9 +337,30 @@ Fourth argument TYPE is the custom option type."
 	 (custom-add-load symbol value))
 	((eq keyword :tag)
 	 (put symbol 'custom-tag value))
+ 	((eq keyword :set-after)
+	 (custom-add-dependencies symbol value))
 	(t
 	 (signal 'error (list "Unknown keyword" keyword)))))
 
+(defun custom-add-dependencies (symbol value)
+  "To the custom option SYMBOL, add dependencies specified by VALUE.
+VALUE should be a list of symbols.  For each symbol in that list,
+this specifies that SYMBOL should be set after the specified symbol, if
+both appear in constructs like `custom-set-variables'."
+  (unless (listp value)
+    (error "Invalid custom dependency `%s'" value))
+  (let* ((deps (get symbol 'custom-dependencies))
+	 (new-deps deps))
+    (while value
+      (let ((dep (car value)))
+	(unless (symbolp dep)
+	  (error "Invalid custom dependency `%s'" dep))
+	(unless (memq dep new-deps)
+	  (setq new-deps (cons dep new-deps)))
+	(setq value (cdr value))))
+    (unless (eq deps new-deps)
+      (put symbol 'custom-dependencies new-deps))))
+
 (defun custom-add-option (symbol option)
   "To the variable SYMBOL add OPTION.
 
@@ -356,46 +388,321 @@ LOAD should be either a library file name, or a feature name."
     (unless (member load loads)
       (put symbol 'custom-loads (cons load loads)))))
 
+;;; deftheme macro
+
+(defvar custom-known-themes '(user standard)
+   "Themes that have been defthemed.")
+
+;;  #### add strings for group
+;; #### during bootstrap we cannot use cl-macs stuff
+(defun* custom-define-theme (theme feature &optional doc
+         &key short-description immediate variable-reset-string
+         variable-set-string face-set-string face-reset-string
+         &allow-other-keys)
+  (push theme custom-known-themes)
+  (put theme 'theme-feature feature)
+  (put theme 'theme-documentation doc)
+  (if immediate (put theme 'theme-immediate immediate))
+  (if variable-reset-string
+      (put theme 'theme-variable-reset-string variable-reset-string ))
+  (if variable-set-string
+      (put theme 'theme-variable-set-string variable-set-string ))
+  (if face-reset-string
+      (put theme 'theme-face-reset-string face-reset-string ))
+  (if face-set-string
+      (put theme 'theme-face-set-string face-set-string ))
+  (if short-description
+      (put theme 'theme-short-description short-description )))
+
+(defun custom-make-theme-feature (theme)
+  (intern (concat (symbol-name theme) "-theme")))
+
+(defmacro deftheme (theme &rest body)
+  "(deftheme THEME &optional DOC &key KEYWORDS)
+
+Define a theme labeled by SYMBOL THEME. The optional argument DOC is a
+doc string describing the theme. It is optionally followed by the
+following keyword arguments
+
+:short-description DESC
+      DESC is a short (one line) description of the theme. If not given DOC
+      is used.
+:immediate FLAG
+      If FLAG is non-nil variables set in this theme are bound
+      immediately when loading the theme.
+:variable-set-string VARIABLE_-SET-STRING
+      A string used by the UI to indicate that the value takes it
+      setting from this theme. It is passed to FORMAT with the
+      name of the theme a additional argument.
+      If not given, a generic description is used.
+:variable-reset-string VARIABLE-RESET-STRING
+      As above but used in the case the variable has been forced to
+      the value in this theme.
+:face-set-string FACE-SET-STRING
+:face-reset-string FACE-RESET-STRING
+      As above but for faces."
+  (let ((feature (custom-make-theme-feature theme)))
+    `(custom-define-theme (quote ,theme) (quote ,feature) ,@body)))
+
+(defsubst custom-theme-p (theme)
+  "Non-nil when THEME has been defined."
+  (memq theme custom-known-themes))
+
+(defsubst custom-check-theme (theme)
+  "Check whether THEME is valid and signal an error if NOT."
+  (unless (custom-theme-p theme)
+    (error "Unknown theme `%s'" theme)))
+
+
+; #### do we need to deftheme 'user and/or 'standard here to make the
+;      code in cus-edit cleaner?.
+
 ;;; Initializing.
 
-(defun custom-set-variables (&rest args)
-  "Initialize variables according to user preferences.  
+(defun custom-push-theme (prop symbol theme mode value)
+  (let ((old (get symbol prop)))
+    (if (eq (car-safe (car-safe old)) theme)
+        (setq old (cdr old)))
+    (put symbol prop (cons (list theme mode value) old))))
+
+(defvar custom-local-buffer nil
+  "Non-nil, in a Customization buffer, means customize a specific buffer.
+If this variable is non-nil, it should be a buffer,
+and it means customize the local bindings of that buffer.
+This variable is a permanent local, and it normally has a local binding
+in every Customization buffer.")
+(put 'custom-local-buffer 'permanent-local t)
 
-The arguments should be a list where each entry has the form:
+(defun custom-set-variables (&rest args)
+  "Initialize variables according to user preferences.
+The settings are registered as theme `user'.
+Each argument should be a list of the form:
 
-  (SYMBOL VALUE [NOW])
+  (SYMBOL VALUE [NOW [REQUEST [COMMENT]]])
 
 The unevaluated VALUE is stored as the saved value for SYMBOL.
 If NOW is present and non-nil, VALUE is also evaluated and bound as
-the default value for the SYMBOL."
-  (while args 
-    (let ((entry (car args)))
-      (if (listp entry)
-	  (let* ((symbol (nth 0 entry))
-		 (value (nth 1 entry))
-		 (now (nth 2 entry))
-		 (requests (nth 3 entry))
-		 (set (or (get symbol 'custom-set) 'set-default)))
-	    (put symbol 'saved-value (list value))
-	    (cond (now 
-		   ;; Rogue variable, set it now.
-		   (put symbol 'force-value t)
-		   (funcall set symbol (eval value)))
-		  ((default-boundp symbol)
-		   ;; Something already set this, overwrite it.
-		   (funcall set symbol (eval value))))
-	    (when requests
-	      (put symbol 'custom-requests requests)
-	      (mapc 'require requests))
-	    (setq args (cdr args)))
-	;; Old format, a plist of SYMBOL VALUE pairs.
-	(message "Warning: old format `custom-set-variables'")
-	(ding)
-	(sit-for 2)
-	(let ((symbol (nth 0 args))
-	      (value (nth 1 args)))
-	  (put symbol 'saved-value (list value)))
-	(setq args (cdr (cdr args)))))))
+the default value for the SYMBOL.
+REQUEST is a list of features we must 'require for SYMBOL.
+COMMENT is a comment string about SYMBOL."
+  (apply 'custom-theme-set-variables 'user args))
+
+(defun custom-theme-set-variables (theme &rest args)
+  "Initialize variables according to settings specified by args.
+Records the settings as belonging to THEME.
+
+See `custom-set-variables' for a description of the arguments ARGS."
+  (custom-check-theme theme)
+  (setq args
+	(sort args
+	      (lambda (a1 a2)
+		(let* ((sym1 (car a1))
+		       (sym2 (car a2))
+		       (1-then-2 (memq sym1 (get sym2 'custom-dependencies)))
+		       (2-then-1 (memq sym2 (get sym1 'custom-dependencies))))
+		  (cond ((and 1-then-2 2-then-1)
+			 (error "Circular custom dependency between `%s' and `%s'"
+				sym1 sym2))
+			(1-then-2 t)
+			(2-then-1 nil)
+			;; Put symbols with :require last.  The macro
+			;; define-minor-mode generates a defcustom
+			;; with a :require and a :set, where the
+			;; setter function calls the mode function.
+			;; Putting symbols with :require last ensures
+			;; that the mode function will see other
+			;; customized values rather than default
+			;; values.
+			(t (nth 3 a2)))))))
+  (let ((immediate (get theme 'theme-immediate)))
+    (while args
+      (let ((entry (car args)))
+        (if (listp entry)
+            (let* ((symbol (nth 0 entry))
+                   (value (nth 1 entry))
+                   (now (nth 2 entry))
+                   (requests (nth 3 entry))
+                   (comment (nth 4 entry))
+                   (set (or (get symbol 'custom-set) 'custom-set-default)))
+              (put symbol 'saved-value (list value))
+              (custom-push-theme 'theme-value symbol theme 'set value)
+              (put symbol 'saved-variable-comment comment)
+	  ;; Allow for errors in the case where the setter has
+	  ;; changed between versions, say, but let the user know.
+	      (condition-case data
+              (cond ((or now immediate)
+                     ;; Rogue variable, set it now.
+                     (put symbol 'force-value (if now 'rogue 'immediate))
+                     (funcall set symbol (eval value)))
+                    ((default-boundp symbol)
+                     ;; Something already set this, overwrite it.
+                     (funcall set symbol (eval value))))
+	      (error 
+	       (message "Error setting %s: %s" symbol data)))
+              (and (or now (default-boundp symbol))
+                 (put symbol 'variable-comment comment))
+              (when requests
+                (put symbol 'custom-requests requests)
+                (mapc 'require requests))
+              (setq args (cdr args)))
+          ;; Old format, a plist of SYMBOL VALUE pairs.
+          (message "Warning: old format `custom-set-variables'")
+          (ding)
+          (sit-for 2)
+          (let ((symbol (nth 0 args))
+                (value (nth 1 args)))
+            (put symbol 'saved-value (list value))
+            (custom-push-theme 'theme-value symbol theme 'set value))
+          (setq args (cdr (cdr args))))))))
+
+(defvar custom-loaded-themes nil
+  "Themes in the order they are loaded.")
+
+(defun custom-theme-loaded-p (theme)
+  "Return non-nil when THEME has been loaded."
+  (memq theme custom-loaded-themes))
+
+(defun provide-theme (theme)
+  "Indicate that this file provides THEME."
+  (custom-check-theme theme)
+  (provide (get theme 'theme-feature))
+  (push theme custom-loaded-themes))
+
+(defun require-theme (theme &optional soft)
+  "Try to load a theme by requiring its feature."
+  ;; Note we do no check for validity of the theme here.
+  ;; This allows to pull in themes by a file-name convention
+  (require (get theme 'theme-feature (custom-make-theme-feature theme))))
+
+(defun custom-do-theme-reset (theme)
+  ; #### untested! slow!
+  (let (spec-list)
+    (mapatoms (lambda (symbol)
+                (setq spec-list (get symbol 'theme-value))
+                (when spec-list
+                  (setq spec-list (delete-if (lambda (elt)
+                                               (eq (car elt) theme))
+                                             spec-list))
+                  (put symbol 'theme-value spec-list)
+                  (custom-theme-reset-internal symbol 'user))
+                (setq spec-list (get symbol 'theme-face))
+                (when spec-list
+                  (setq spec-list (delete-if (lambda (elt)
+                                               (eq (car elt) theme))
+                                             spec-list))
+                  (put symbol 'theme-face spec-list)
+                  (custom-theme-reset-internal-face symbol 'user))))))
+
+(defun custom-theme-load-themes (by-theme &rest body)
+  "Load the themes specified by BODY and record them as required by
+theme BY-THEME. BODY is a sequence of
+       - a SYMBOL
+            require the theme SYMBOL
+       - a list (reset THEME)
+            Undo all the settings made by THEME.
+       - a list (hidden THEME)
+            require the THEME but hide it from the user."
+  (custom-check-theme by-theme)
+  (dolist (theme body)
+    (cond ((and (consp theme) (eq (car theme) 'reset))
+           (custom-do-theme-reset (cadr theme)))
+          ((and (consp theme) (eq (car theme) 'hidden))
+           (require-theme (cadr theme))
+           (unless (custom-theme-loaded-p (cadr theme))
+             (put (cadr theme) 'theme-hidden t)))
+          (t
+           (require-theme theme)
+           (remprop theme 'theme-hidden)))
+    (push theme (get by-theme 'theme-loads-themes))))
+
+(defun custom-load-themes (&rest body)
+  "Load themes for the USER theme as specified by BODY.
+
+BODY is as with custom-theme-load-themes."
+  (apply #'custom-theme-load-themes 'user body))
+
+
+
+
+(defsubst copy-upto-last (elt list)
+  "Copy all the elements of the list upto the last occurrence of elt."
+  ;; Is it faster to do more work in C than to do less in elisp?
+  (nreverse (cdr (member elt (reverse list)))))
+
+(defun custom-theme-value (theme theme-spec-list)
+  "Determine the value for THEME defined by THEME-SPEC-LIST.
+Returns (list value) if found. Nil otherwise."
+  ;; Note we do _NOT_ signal an error if the theme is unknown
+  ;; it might have gone away without the user knowing.
+  (let ((theme-or-lower (memq theme (cons 'user custom-loaded-themes)))
+        value)
+    (mapc #'(lambda (theme-spec)
+              (when (member (car theme-spec) theme-or-lower)
+                (setq value (cdr theme-spec))
+                ;; We need to continue because if theme =A and we found
+                ;; B then if the load order is B A C B
+                ;; we actually want the value in C.
+                (setq theme-or-lower (copy-upto-last (car theme-spec)
+                                                     theme-or-lower))
+                ;; We could should circuit if this is now nil.
+                ))
+          theme-spec-list)
+    (if value
+        (if (eq (car value) 'set)
+            (list (cadr value))
+          ;; Yet another reset spec. car value = reset
+          (custom-theme-value (cadr value) theme-spec-list)))))
+
+
+(defun custom-theme-variable-value (variable theme)
+  "Return (list value) value of VARIABLE in THEME if the THEME modifies the
+VARIABLE.  Nil otherwise."
+  (custom-theme-value theme (get variable 'theme-value)))
+
+(defun custom-theme-reset-internal (symbol to-theme)
+  (let ((value (custom-theme-variable-value symbol to-theme))
+        was-in-theme)
+    (setq was-in-theme value)
+    (setq value (or value (get symbol 'standard-value)))
+    (when value
+      (put symbol 'saved-value was-in-theme)
+      (if (or (get 'force-value symbol) (default-boundp symbol))
+          (funcall (get symbol 'custom-set 'set-default) symbol
+                   (eval (car value)))))
+    value))
+
+
+(defun custom-theme-reset-variables (theme &rest args)
+  "Reset the value of the variables to values previously defined.
+Associate this setting with THEME.
+
+ARGS is a list of lists of the form
+
+    (variable to-theme)
+
+This means reset variable to its value in to-theme."
+  (custom-check-theme theme)
+  (mapc #'(lambda (arg)
+            (apply #'custom-theme-reset-internal arg)
+            (custom-push-theme 'theme-value (car arg) theme 'reset (cadr arg)))
+        args))
+
+(defun custom-reset-variables (&rest args)
+    "Reset the value of the variables to values previously defined.
+Associate this setting with the `user' theme.
+
+The ARGS are as in `custom-theme-reset-variables'."
+    (apply #'custom-theme-reset-variables 'user args))
+
+(defun custom-set-default (variable value)
+  "Default :set function for a customizable variable.
+Normally, this sets the default value of VARIABLE to VALUE,
+but if `custom-local-buffer' is non-nil,
+this sets the local binding in that buffer instead."
+  (if custom-local-buffer
+      (with-current-buffer custom-local-buffer
+	(set variable value))
+    (set-default variable value)))
 
 ;;; The End.