diff lisp/cus-edit.el @ 398:74fd4e045ea6 r21-2-29

Import from CVS: tag r21-2-29
author cvs
date Mon, 13 Aug 2007 11:13:30 +0200
parents 6719134a07c2
children de805c49cfc1
line wrap: on
line diff
--- a/lisp/cus-edit.el	Mon Aug 13 11:12:06 2007 +0200
+++ b/lisp/cus-edit.el	Mon Aug 13 11:13:30 2007 +0200
@@ -1,9 +1,9 @@
 ;;; cus-edit.el --- Tools for customizating Emacs and Lisp packages.
 ;;
-;; Copyright (C) 1996, 1997 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997, 2000 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
 ;; Version: 1.9960-x
 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
@@ -399,7 +399,7 @@
     (custom-unlispify-menu-entry symbol t)))
 
 (defun custom-prefix-add (symbol prefixes)
-  ;; Addd SYMBOL to list of ignored PREFIXES.
+  ;; Add SYMBOL to list of ignored PREFIXES.
   (cons (or (get symbol 'custom-prefix)
 	    (concat (symbol-name symbol) "-"))
 	prefixes))
@@ -617,7 +617,7 @@
 
 ;;; The Customize Commands
 
-(defun custom-prompt-variable (prompt-var prompt-val)
+(defun custom-prompt-variable (prompt-var prompt-val &optional comment)
   "Prompt for a variable and a value and return them as a list.
 PROMPT-VAR is the prompt for the variable, and PROMPT-VAL is the
 prompt for the value.  The %s escape in PROMPT-VAL is replaced with
@@ -627,10 +627,13 @@
 it were the arg to `interactive' (which see) to interactively read the value.
 
 If the variable has a `custom-type' property, it must be a widget and the
-`:prompt-value' property of that widget will be used for reading the value."
+`:prompt-value' property of that widget will be used for reading the value.
+
+If optional COMMENT argument is non nil, also prompt for a comment and return
+it as the third element in the list."
   (let* ((var (read-variable prompt-var))
-	 (minibuffer-help-form '(describe-variable var)))
-    (list var
+	 (minibuffer-help-form '(describe-variable var))
+	 (val
 	  (let ((prop (get var 'variable-interactive))
 		(type (get var 'custom-type))
 		(prompt (format prompt-val var)))
@@ -649,24 +652,36 @@
 					    (symbol-value var))
 					(not (boundp var))))
 		  (t
-		   (eval-minibuffer prompt)))))))
+		   (eval-minibuffer prompt))))))
+    (if comment
+	(list var val
+	      (read-string "Comment: " (get var 'variable-comment)))
+      (list var val))
+    ))
 
 ;;;###autoload
-(defun customize-set-value (var val)
+(defun customize-set-value (var val &optional comment)
   "Set VARIABLE to VALUE.  VALUE is a Lisp object.
 
 If VARIABLE has a `variable-interactive' property, that is used as if
 it were the arg to `interactive' (which see) to interactively read the value.
 
 If VARIABLE has a `custom-type' property, it must be a widget and the
-`:prompt-value' property of that widget will be used for reading the value."
+`:prompt-value' property of that widget will be used for reading the value.
+
+If given a prefix (or a COMMENT argument), also prompt for a comment."
   (interactive (custom-prompt-variable "Set variable: "
-				       "Set %s to value: "))
-
-  (set var val))
+				       "Set %s to value: "
+				       current-prefix-arg))
+
+  (set var val)
+  (cond ((string= comment "")
+	 (put var 'variable-comment nil))
+	(comment
+	 (put var 'variable-comment comment))))
 
 ;;;###autoload
-(defun customize-set-variable (var val)
+(defun customize-set-variable (var val &optional comment)
   "Set the default for VARIABLE to VALUE.  VALUE is a Lisp object.
 
 If VARIABLE has a `custom-set' property, that is used for setting
@@ -679,14 +694,24 @@
 it were the arg to `interactive' (which see) to interactively read the value.
 
 If VARIABLE has a `custom-type' property, it must be a widget and the
-`:prompt-value' property of that widget will be used for reading the value. "
+`:prompt-value' property of that widget will be used for reading the value.
+
+If given a prefix (or a COMMENT argument), also prompt for a comment."
   (interactive (custom-prompt-variable "Set variable: "
-				       "Set customized value for %s to: "))
+				       "Set customized value for %s to: "
+				       current-prefix-arg))
   (funcall (or (get var 'custom-set) 'set-default) var val)
-  (put var 'customized-value (list (custom-quote val))))
+  (put var 'customized-value (list (custom-quote val)))
+  (cond ((string= comment "")
+	 (put var 'variable-comment nil)
+	 (put var 'customized-variable-comment nil))
+	(comment
+	 (put var 'variable-comment comment)
+	 (put var 'customized-variable-comment comment))))
+
 
 ;;;###autoload
-(defun customize-save-variable (var val)
+(defun customize-save-variable (var val &optional comment)
   "Set the default for VARIABLE to VALUE, and save it for future sessions.
 If VARIABLE has a `custom-set' property, that is used for setting
 VARIABLE, otherwise `set-default' is used.
@@ -698,11 +723,21 @@
 it were the arg to `interactive' (which see) to interactively read the value.
 
 If VARIABLE has a `custom-type' property, it must be a widget and the
-`:prompt-value' property of that widget will be used for reading the value. "
+`:prompt-value' property of that widget will be used for reading the value.
+
+If given a prefix (or a COMMENT argument), also prompt for a comment."
   (interactive (custom-prompt-variable "Set and ave variable: "
-				       "Set and save value for %s as: "))
+				       "Set and save value for %s as: "
+				       current-prefix-arg))
   (funcall (or (get var 'custom-set) 'set-default) var val)
   (put var 'saved-value (list (custom-quote val)))
+  (custom-push-theme 'theme-value var 'user 'set (list (custom-quote val)))
+  (cond ((string= comment "")
+	 (put var 'variable-comment nil)
+	 (put var 'saved-variable-comment nil))
+	(comment
+	 (put var 'variable-comment comment)
+	 (put var 'saved-variable-comment comment)))
   (custom-save-all))
 
 ;;;###autoload
@@ -842,10 +877,12 @@
   (interactive)
   (let ((found nil))
     (mapatoms (lambda (symbol)
-		(and (get symbol 'customized-face)
+		(and (or (get symbol 'customized-face)
+			 (get symbol 'customized-face-comment))
 		     (find-face symbol)
 		     (push (list symbol 'custom-face) found))
-		(and (get symbol 'customized-value)
+		(and (or (get symbol 'customized-value)
+			 (get symbol 'customized-variable-comment))
 		     (boundp symbol)
 		     (push (list symbol 'custom-variable) found))))
     (if (not found)
@@ -859,10 +896,12 @@
   (interactive)
   (let ((found nil))
     (mapatoms (lambda (symbol)
-		(and (get symbol 'saved-face)
+		(and (or (get symbol 'saved-face)
+			 (get symbol 'saved-face-comment))
 		     (find-face symbol)
 		     (push (list symbol 'custom-face) found))
-		(and (get symbol 'saved-value)
+		(and (or (get symbol 'saved-value)
+			 (get symbol 'saved-variable-comment))
 		     (boundp symbol)
 		     (push (list symbol 'custom-variable) found))))
     (if (not found )
@@ -994,7 +1033,6 @@
   (widget-insert "\nOperate on everything in this buffer:\n ")
   (widget-create 'push-button
 		 :tag "Set"
-		 :tag-glyph '("set-up" "set-down")
 		 :help-echo "\
 Make your editing in this buffer take effect for this session"
 		 :action (lambda (widget &optional event)
@@ -1002,7 +1040,6 @@
   (widget-insert " ")
   (widget-create 'push-button
 		 :tag "Save"
-		 :tag-glyph '("save-up" "save-down")
 		 :help-echo "\
 Make your editing in this buffer take effect for future Emacs sessions"
 		 :action (lambda (widget &optional event)
@@ -1038,7 +1075,6 @@
   (widget-insert "  ")
   (widget-create 'push-button
 		 :tag "Done"
-		 :tag-glyph '("done-up" "done-down")
 		 :help-echo "Remove the buffer"
 		 :action (lambda (widget &optional event)
 			   (Custom-buffer-done)))
@@ -1211,7 +1247,7 @@
 
 (defun custom-browse-insert-prefix (prefix)
   "Insert PREFIX.  On XEmacs convert it to line graphics."
-  ;; ### Unfinished.
+  ;; #### Unfinished.
   (if nil ; (string-match "XEmacs" emacs-version)
       (progn
 	(insert "*")
@@ -1705,6 +1741,77 @@
       (delete-region start (point)))
     found))
 
+;;; The `custom-comment' Widget.
+
+;; like the editable field
+(defface custom-comment-face '((((class grayscale color)
+				 (background light))
+				(:background "gray85"))
+			       (((class grayscale color)
+				 (background dark))
+				(:background "dim gray"))
+			       (t
+				(:italic t)))
+  "Face used for comments on variables or faces"
+  :group 'custom-faces)
+
+;; like font-lock-comment-face
+(defface custom-comment-tag-face
+  '((((class color) (background dark)) (:foreground "gray80"))
+    (((class color) (background light)) (:foreground "blue4"))
+    (((class grayscale) (background light))
+     (:foreground "DimGray" :bold t :italic t))
+    (((class grayscale) (background dark))
+     (:foreground "LightGray" :bold t :italic t))
+    (t (:bold t)))
+  "Face used for variables or faces comment tags"
+  :group 'custom-faces)
+
+(define-widget 'custom-comment 'string
+  "User comment"
+  :tag "Comment"
+  :help-echo "Edit a comment here"
+  :sample-face 'custom-comment-tag-face
+  :value-face 'custom-comment-face
+  :value-set 'custom-comment-value-set
+  :create 'custom-comment-create
+  :delete 'custom-comment-delete)
+
+(defun custom-comment-create (widget)
+  (let (ext)
+    (widget-default-create widget)
+    (widget-put widget :comment-extent
+		(setq ext (make-extent (widget-get widget :from)
+				       (widget-get widget :to))))
+    (set-extent-property ext 'start-open t)
+    (when (equal (widget-get widget :value) "")
+      (set-extent-property ext 'invisible t))
+    ))
+
+(defun custom-comment-delete (widget)
+  (widget-default-delete widget)
+  (delete-extent (widget-get widget :comment-extent)))
+
+(defun custom-comment-value-set (widget value)
+  (widget-default-value-set widget value)
+  (if (equal value "")
+      (set-extent-property (widget-get widget :comment-extent)
+			   'invisible t)
+    (set-extent-property (widget-get widget :comment-extent)
+			 'invisible nil)))
+
+;; Those functions are for the menu. WIDGET is NOT the comment widget. It's
+;; the global custom one
+(defun custom-comment-show (widget)
+  (set-extent-property
+   (widget-get (widget-get widget :comment-widget) :comment-extent)
+   'invisible nil))
+
+(defun custom-comment-invisible-p (widget)
+  (extent-property
+   (widget-get (widget-get widget :comment-widget) :comment-extent)
+   'invisible))
+
 ;;; The `custom-variable' Widget.
 
 (defface custom-variable-tag-face '((((class color)
@@ -1870,23 +1977,40 @@
 		    :value value)
 		   children))))
     (unless (eq custom-buffer-style 'tree)
-      ;; Now update the state.
       (unless (eq (preceding-char) ?\n)
 	(widget-insert "\n"))
-      (if (eq state 'hidden)
-	  (widget-put widget :custom-state state)
-	(custom-variable-state-set widget))
       ;; Create the magic button.
       (let ((magic (widget-create-child-and-convert
 		    widget 'custom-magic nil)))
 	(widget-put widget :custom-magic magic)
 	(push magic buttons))
-      ;; Update properties.
-      (widget-put widget :custom-form form)
+      ;; Insert documentation.
+      ;; #### NOTE: this is ugly!!!! I need to do update the :buttons property
+      ;; before the call to `widget-default-format-handler'. Otherwise, I
+      ;; loose my current `buttons'. This function shouldn't be called like
+      ;; this anyway. The doc string widget should be added like the others.
+      ;; --dv
       (widget-put widget :buttons buttons)
+      (widget-default-format-handler widget ?h)
+      ;; The comment field
+      (unless (eq state 'hidden)
+	(let* ((comment (get symbol 'variable-comment))
+	       (comment-widget
+		(widget-create-child-and-convert
+		 widget 'custom-comment
+		 :parent widget
+		 :value (or comment ""))))
+	  (widget-put widget :comment-widget comment-widget)
+	  ;; Don't push it !!! Custom assumes that the first child is the
+	  ;; value one.
+	  (setq children (append children (list comment-widget)))))
+      ;; Update the rest of the properties properties.
+      (widget-put widget :custom-form form)
       (widget-put widget :children children)
-      ;; Insert documentation.
-      (widget-default-format-handler widget ?h)
+      ;; Now update the state.
+      (if (eq state 'hidden)
+	  (widget-put widget :custom-state state)
+	(custom-variable-state-set widget))
       ;; See also.
       (unless (eq state 'hidden)
 	(when (eq (widget-get widget :custom-level) 1)
@@ -1910,22 +2034,32 @@
 	 (value (if (default-boundp symbol)
 		    (funcall get symbol)
 		  (widget-get widget :value)))
+	 (comment (get symbol 'variable-comment))
 	 tmp
-	 (state (cond ((setq tmp (get symbol 'customized-value))
+	 temp
+	 (state (cond ((progn (setq tmp (get symbol 'customized-value))
+			      (setq temp
+				    (get symbol 'customized-variable-comment))
+			      (or tmp temp))
 		       (if (condition-case nil
-			       (equal value (eval (car tmp)))
+			       (and (equal value (eval (car tmp)))
+				    (equal comment temp))
 			     (error nil))
 			   'set
 			 'changed))
-		      ((setq tmp (get symbol 'saved-value))
+		      ((progn (setq tmp (get symbol 'saved-value))
+			      (setq temp (get symbol 'saved-variable-comment))
+			      (or tmp temp))
 		       (if (condition-case nil
-			       (equal value (eval (car tmp)))
+			       (and (equal value (eval (car tmp)))
+				    (equal comment temp))
 			     (error nil))
 			   'saved
 			 'changed))
 		      ((setq tmp (get symbol 'standard-value))
 		       (if (condition-case nil
-			       (equal value (eval (car tmp)))
+			       (and (equal value (eval (car tmp)))
+				    (equal comment nil))
 			     (error nil))
 			   'standard
 			 'changed))
@@ -1945,7 +2079,8 @@
 	    (memq (widget-get widget :custom-state) '(modified changed)))))
     ("Reset to Saved" custom-variable-reset-saved
      (lambda (widget)
-       (and (get (widget-value widget) 'saved-value)
+       (and (or (get (widget-value widget) 'saved-value)
+		(get (widget-value widget) 'saved-variable-comment))
 	    (memq (widget-get widget :custom-state)
 		  '(modified set changed rogue)))))
     ("Reset to Standard Settings" custom-variable-reset-standard
@@ -1954,6 +2089,8 @@
 	    (memq (widget-get widget :custom-state)
 		  '(modified set changed saved rogue)))))
     ("---" ignore ignore)
+    ("Add Comment" custom-comment-show custom-comment-invisible-p)
+    ("---" ignore ignore)
     ("Don't show as Lisp expression" custom-variable-edit
      (lambda (widget)
        (eq (widget-get widget :custom-form) 'lisp)))
@@ -2005,18 +2142,34 @@
 	 (child (car (widget-get widget :children)))
 	 (symbol (widget-value widget))
 	 (set (or (get symbol 'custom-set) 'set-default))
-	  val)
+	 (comment-widget (widget-get widget :comment-widget))
+	 (comment (widget-value comment-widget))
+	 val)
     (cond ((eq state 'hidden)
 	   (error "Cannot set hidden variable"))
 	  ((setq val (widget-apply child :validate))
 	   (goto-char (widget-get val :from))
 	   (error "%s" (widget-get val :error)))
 	  ((memq form '(lisp mismatch))
+	   (when (equal comment "")
+	     (setq comment nil)
+	     ;; Make the comment invisible by hand if it's empty
+	     (set-extent-property (widget-get comment-widget :comment-extent)
+				  'invisible t))
 	   (funcall set symbol (eval (setq val (widget-value child))))
-	   (put symbol 'customized-value (list val)))
+	   (put symbol 'customized-value (list val))
+	   (put symbol 'variable-comment comment)
+	   (put symbol 'customized-variable-comment comment))
 	  (t
+	   (when (equal comment "")
+	     (setq comment nil)
+	     ;; Make the comment invisible by hand if it's empty
+	     (set-extent-property (widget-get comment-widget :comment-extent)
+				  'invisible t))
 	   (funcall set symbol (setq val (widget-value child)))
-	   (put symbol 'customized-value (list (custom-quote val)))))
+	   (put symbol 'customized-value (list (custom-quote val)))
+	   (put symbol 'variable-comment comment)
+	   (put symbol 'customized-variable-comment comment)))
     (custom-variable-state-set widget)
     (custom-redraw-magic widget)))
 
@@ -2027,6 +2180,8 @@
 	 (child (car (widget-get widget :children)))
 	 (symbol (widget-value widget))
 	 (set (or (get symbol 'custom-set) 'set-default))
+	 (comment-widget (widget-get widget :comment-widget))
+	 (comment (widget-value comment-widget))
 	 val)
     (cond ((eq state 'hidden)
 	   (error "Cannot set hidden variable"))
@@ -2034,14 +2189,34 @@
 	   (goto-char (widget-get val :from))
 	   (error "%s" (widget-get val :error)))
 	  ((memq form '(lisp mismatch))
+	   (when (equal comment "")
+	     (setq comment nil)
+	     ;; Make the comment invisible by hand if it's empty
+	     (set-extent-property (widget-get comment-widget :comment-extent)
+				  'invisible t))
 	   (put symbol 'saved-value (list (widget-value child)))
-	   (funcall set symbol (eval (widget-value child))))
+	   (custom-push-theme 'theme-value symbol 'user
+			      'set (list (widget-value child)))
+	   (funcall set symbol (eval (widget-value child)))
+	   (put symbol 'variable-comment comment)
+	   (put symbol 'saved-variable-comment comment))
 	  (t
+	   (when (equal comment "")
+	     (setq comment nil)
+	     ;; Make the comment invisible by hand if it's empty
+	     (set-extent-property (widget-get comment-widget :comment-extent)
+				  'invisible t))
 	   (put symbol
 		'saved-value (list (custom-quote (widget-value
 						  child))))
-	   (funcall set symbol (widget-value child))))
+	   (custom-push-theme 'theme-value symbol 'user
+			      'set (list (custom-quote (widget-value
+						  child))))
+	   (funcall set symbol (widget-value child))
+	   (put symbol 'variable-comment comment)
+	   (put symbol 'saved-variable-comment comment)))
     (put symbol 'customized-value nil)
+    (put symbol 'customized-variable-comment nil)
     (custom-save-all)
     (custom-variable-state-set widget)
     (custom-redraw-magic widget)))
@@ -2049,28 +2224,45 @@
 (defun custom-variable-reset-saved (widget)
   "Restore the saved value for the variable being edited by WIDGET."
   (let* ((symbol (widget-value widget))
-	 (set (or (get symbol 'custom-set) 'set-default)))
-    (if (get symbol 'saved-value)
-	(condition-case nil
-	    (funcall set symbol (eval (car (get symbol 'saved-value))))
-	  (error nil))
-      (signal 'error (list "No saved value for variable" symbol)))
+	 (set (or (get symbol 'custom-set) 'set-default))
+	 (comment-widget (widget-get widget :comment-widget))
+	 (value (get symbol 'saved-value))
+	 (comment (get symbol 'saved-variable-comment)))
+    (cond ((or value comment)
+	   (put symbol 'variable-comment comment)
+	   (condition-case nil
+	       (funcall set symbol (eval (car value)))
+	     (error nil)))
+	  (t
+	   (signal 'error (list "No saved value for variable" symbol))))
     (put symbol 'customized-value nil)
+    (put symbol 'customized-variable-comment nil)
     (widget-put widget :custom-state 'unknown)
+    ;; This call will possibly make the comment invisible
     (custom-redraw widget)))
 
 (defun custom-variable-reset-standard (widget)
   "Restore the standard setting for the variable being edited by WIDGET."
   (let* ((symbol (widget-value widget))
-	 (set (or (get symbol 'custom-set) 'set-default)))
+	 (set (or (get symbol 'custom-set) 'set-default))
+	 (comment-widget (widget-get widget :comment-widget)))
     (if (get symbol 'standard-value)
 	(funcall set symbol (eval (car (get symbol 'standard-value))))
       (signal 'error (list "No standard setting known for variable" symbol)))
+    (put symbol 'variable-comment nil)
     (put symbol 'customized-value nil)
-    (when (get symbol 'saved-value)
+    (put symbol 'customized-variable-comment nil)
+    (when (or (get symbol 'saved-value) (get symbol 'saved-variable-comment))
       (put symbol 'saved-value nil)
+      (custom-push-theme 'theme-value symbol 'user 'reset 'standard)
+      ;; As a special optimizations we do not (explictly)
+      ;; save resets to standard when no theme set the value.
+      (if (null (cdr (get symbol 'theme-value)))
+	  (put symbol 'theme-value nil))
+      (put symbol 'saved-variable-comment nil)
       (custom-save-all))
     (widget-put widget :custom-state 'unknown)
+    ;; This call will possibly make the comment invisible
     (custom-redraw widget)))
 
 ;;; The `custom-face-edit' Widget.
@@ -2080,7 +2272,7 @@
   :format "%t: %v"
   :tag "Attributes"
   :extra-offset 12
-  :button-args '(:help-echo "Control whether this attribute have any effect")
+  :button-args '(:help-echo "Control whether this attribute has any effect")
   :args (mapcar (lambda (att)
 		  (list 'group
 			:inline t
@@ -2116,19 +2308,33 @@
 					   pm)
 				    (const :format "MSWindows "
 					   :sibling-args (:help-echo "\
-Windows NT/95/97")
+Microsoft Windows, displays")
 					   mswindows)
-				    (const :format "DOS "
+				    (const :format "MSPrinter "
 					   :sibling-args (:help-echo "\
-Plain MS-DOS")
-					   pc)
+Microsoft Windows, printers")
+					   msprinter)
 				    (const :format "TTY%n"
 					   :sibling-args (:help-echo "\
 Plain text terminals")
 					   tty)))
 		  (group :sibling-args (:help-echo "\
+Only match display or printer devices")
+			 (const :format "Output: "
+				class)
+			 (checklist :inline t
+				    :offset 0
+				    (const :format "Display "
+					   :sibling-args (:help-echo "\
+Match display devices")
+					   display)
+				    (const :format "Printer%n"
+					   :sibling-args (:help-echo "\
+Match printer devices")
+					   printer)))
+		  (group :sibling-args (:help-echo "\
 Only match the frames with the specified color support")
-			 (const :format "Class: "
+			 (const :format "Color support: "
 				class)
 			 (checklist :inline t
 				    :offset 0
@@ -2225,6 +2431,7 @@
 (defun custom-face-value-create (widget)
   "Create a list of the display specifications for WIDGET."
   (let ((buttons (widget-get widget :buttons))
+	children
 	(symbol (widget-get widget :value))
 	(tag (widget-get widget :tag))
 	(state (widget-get widget :custom-state))
@@ -2274,6 +2481,16 @@
 	   (widget-put widget :buttons buttons)
 	   ;; Insert documentation.
 	   (widget-default-format-handler widget ?h)
+	   ;; The comment field
+	   (unless (eq state 'hidden)
+	     (let* ((comment (get symbol 'face-comment))
+		    (comment-widget
+		     (widget-create-child-and-convert
+		      widget 'custom-comment
+		      :parent widget
+		      :value (or comment ""))))
+	       (widget-put widget :comment-widget comment-widget)
+	       (push comment-widget children)))
 	   ;; See also.
 	   (unless (eq state 'hidden)
 	     (when (eq (widget-get widget :custom-level) 1)
@@ -2288,12 +2505,7 @@
 	     (unless (widget-get widget :custom-form)
 		 (widget-put widget :custom-form custom-face-default-form))
 	     (let* ((symbol (widget-value widget))
-		    (spec (or (get symbol 'customized-face)
-			      (get symbol 'saved-face)
-			      (get symbol 'face-defface-spec)
-			      ;; Attempt to construct it.
-			      (list (list t (face-custom-attributes-get
-					     symbol (selected-frame))))))
+		    (spec (custom-face-get-spec symbol))
 		    (form (widget-get widget :custom-form))
 		    (indent (widget-get widget :indent))
 		    (edit (widget-create-child-and-convert
@@ -2312,7 +2524,8 @@
 				  'sexp))
 			   :value spec)))
 	       (custom-face-state-set widget)
-	       (widget-put widget :children (list edit)))
+	       (push edit children)
+	       (widget-put widget :children children))
 	     (message "Creating face editor...done"))))))
 
 (defvar custom-face-menu
@@ -2320,11 +2533,14 @@
     ("Save for Future Sessions" custom-face-save)
     ("Reset to Saved" custom-face-reset-saved
      (lambda (widget)
-       (get (widget-value widget) 'saved-face)))
+       (or (get (widget-value widget) 'saved-face)
+	   (get (widget-value widget) 'saved-face-comment))))
     ("Reset to Standard Setting" custom-face-reset-standard
      (lambda (widget)
        (get (widget-value widget) 'face-defface-spec)))
     ("---" ignore ignore)
+    ("Add Comment" custom-comment-show custom-comment-invisible-p)
+    ("---" ignore ignore)
     ("Show all display specs" custom-face-edit-all
      (lambda (widget)
        (not (eq (widget-get widget :custom-form) 'all))))
@@ -2361,15 +2577,30 @@
 
 (defun custom-face-state-set (widget)
   "Set the state of WIDGET."
-  (let ((symbol (widget-value widget)))
-    (widget-put widget :custom-state (cond ((get symbol 'customized-face)
-					    'set)
-					   ((get symbol 'saved-face)
-					    'saved)
-					   ((get symbol 'face-defface-spec)
-					    'standard)
-					   (t
-					    'rogue)))))
+  (let* ((symbol (widget-value widget))
+	 (comment (get symbol 'face-comment))
+	 tmp temp)
+    (widget-put widget :custom-state
+		(cond ((progn
+			 (setq tmp (get symbol 'customized-face))
+			 (setq temp (get symbol 'customized-face-comment))
+			 (or tmp temp))
+		       (if (equal temp comment)
+			   'set
+			 'changed))
+		      ((progn
+			 (setq tmp (get symbol 'saved-face))
+			 (setq temp (get symbol 'saved-face-comment))
+			 (or tmp temp))
+		       (if (equal temp comment)
+			   'saved
+			 'changed))
+		      ((get symbol 'face-defface-spec)
+		       (if (equal comment nil)
+			   'standard
+			 'changed))
+		      (t
+		       'rogue)))))
 
 (defun custom-face-action (widget &optional event)
   "Show the menu for `custom-face' WIDGET.
@@ -2390,9 +2621,18 @@
   "Make the face attributes in WIDGET take effect."
   (let* ((symbol (widget-value widget))
 	 (child (car (widget-get widget :children)))
-	 (value (widget-value child)))
+	 (value (widget-value child))
+	 (comment-widget (widget-get widget :comment-widget))
+	 (comment (widget-value comment-widget)))
+    (when (equal comment "")
+      (setq comment nil)
+      ;; Make the comment invisible by hand if it's empty
+      (set-extent-property (widget-get comment-widget :comment-extent)
+			   'invisible t))
     (put symbol 'customized-face value)
-    (face-spec-set symbol value)
+    (face-spec-set symbol value nil '(custom))
+    (put symbol 'customized-face-comment comment)
+    (put symbol 'face-comment comment)
     (custom-face-state-set widget)
     (custom-redraw-magic widget)))
 
@@ -2400,10 +2640,21 @@
   "Make the face attributes in WIDGET default."
   (let* ((symbol (widget-value widget))
 	 (child (car (widget-get widget :children)))
-	 (value (widget-value child)))
-    (face-spec-set symbol value)
+	 (value (widget-value child))
+	 (comment-widget (widget-get widget :comment-widget))
+	 (comment (widget-value comment-widget)))
+    (when (equal comment "")
+      (setq comment nil)
+      ;; Make the comment invisible by hand if it's empty
+      (set-extent-property (widget-get comment-widget :comment-extent)
+			   'invisible t))
+    (face-spec-set symbol value nil '(custom))
     (put symbol 'saved-face value)
+    (custom-push-theme 'theme-face symbol 'user 'set value)
     (put symbol 'customized-face nil)
+    (put symbol 'face-comment comment)
+    (put symbol 'customized-face-comment nil)
+    (put symbol 'saved-face-comment comment)
     (custom-save-all)
     (custom-face-state-set widget)
     (custom-redraw-magic widget)))
@@ -2412,12 +2663,18 @@
   "Restore WIDGET to the face's default attributes."
   (let* ((symbol (widget-value widget))
 	 (child (car (widget-get widget :children)))
-	 (value (get symbol 'saved-face)))
-    (unless value
+	 (value (get symbol 'saved-face))
+	 (comment (get symbol 'saved-face-comment))
+	 (comment-widget (widget-get widget :comment-widget)))
+    (unless (or value comment)
       (signal 'error (list "No saved value for this face" symbol)))
     (put symbol 'customized-face nil)
-    (face-spec-set symbol value)
+    (put symbol 'customized-face-comment nil)
+    (face-spec-set symbol value nil '(custom))
+    (put symbol 'face-comment comment)
     (widget-value-set child value)
+    ;; This call manages the comment visibility
+    (widget-value-set comment-widget (or comment ""))
     (custom-face-state-set widget)
     (custom-redraw-magic widget)))
 
@@ -2425,15 +2682,25 @@
   "Restore WIDGET to the face's standard settings."
   (let* ((symbol (widget-value widget))
 	 (child (car (widget-get widget :children)))
-	 (value (get symbol 'face-defface-spec)))
+	 (value (get symbol 'face-defface-spec))
+	 (comment-widget (widget-get widget :comment-widget)))
     (unless value
       (signal 'error (list "No standard setting for this face" symbol)))
     (put symbol 'customized-face nil)
-    (when (get symbol 'saved-face)
+    (put symbol 'customized-face-comment nil)
+    (when (or (get symbol 'saved-face) (get symbol 'saved-face-comment))
       (put symbol 'saved-face nil)
+      (custom-push-theme 'theme-face symbol 'user 'reset 'standard)
+      ;; Do not explictly save resets to standards without themes.
+      (if (null (cdr (get symbol 'theme-face)))
+	  (put symbol  'theme-face nil))
+      (put symbol 'saved-face-comment nil)
       (custom-save-all))
-    (face-spec-set symbol value)
+    (face-spec-set symbol value nil '(custom))
+    (put symbol 'face-comment nil)
     (widget-value-set child value)
+    ;; This call manages the comment visibility
+    (widget-value-set comment-widget "")
     (custom-face-state-set widget)
     (custom-redraw-magic widget)))
 
@@ -2503,7 +2770,7 @@
   :tag "Hook")
 
 (defun custom-hook-convert-widget (widget)
-  ;; Handle `:custom-options'.
+  ;; Handle `:options'.
   (let* ((options (widget-get widget :options))
 	 (other `(editable-list :inline t
 				:entry-format "%i %d%v"
@@ -2982,7 +3249,7 @@
   :group 'customize)
 
 (defun custom-save-delete (symbol)
-  "Delete the call to SYMBOL form `custom-file'.
+  "Delete the call to SYMBOL form in `custom-file'.
 Leave point at the location of the call, or after the last expression."
   (let ((find-file-hooks nil)
 	(auto-mode-alist nil))
@@ -3002,87 +3269,152 @@
 	  (throw 'found nil))))))
 
 (defun custom-save-variables ()
-  "Save all customized variables in `custom-file'."
-  (save-excursion
-    (custom-save-delete 'custom-set-variables)
-    (let ((standard-output (current-buffer)))
-      (unless (bolp)
-	(princ "\n"))
-      (princ "(custom-set-variables")
-      (mapatoms (lambda (symbol)
-		  (let ((value (get symbol 'saved-value))
-			(requests (get symbol 'custom-requests))
-			(now (not (or (get symbol 'standard-value)
-				      (and (not (boundp symbol))
-					   (not (get symbol 'force-value)))))))
-		    (when value
-		      (princ "\n '(")
-		      (prin1 symbol)
-		      (princ " ")
-		      (prin1 (car value))
-		      (cond (requests
-			     (if now
-				 (princ " t ")
-			       (princ " nil "))
-			     (prin1 requests)
-			     (princ ")"))
-			    (now
-			     (princ " t)"))
-			    (t
-			     (princ ")")))))))
+   "Save all customized variables in `custom-file'."
+   (save-excursion
+     (custom-save-delete 'custom-load-themes)
+     (custom-save-delete 'custom-reset-variables)
+     (custom-save-delete 'custom-set-variables)
+     (custom-save-loaded-themes)
+     (custom-save-resets 'theme-value 'custom-reset-variables nil)
+     (let ((standard-output (current-buffer)))
+       (unless (bolp)
+ 	(princ "\n"))
+       (princ "(custom-set-variables")
+       (mapatoms (lambda (symbol)		 
+ 		  (let ((spec (car-safe (get symbol 'theme-value)))
+ 			(requests (get symbol 'custom-requests))
+ 			(now (not (or (get symbol 'standard-value)
+ 				      (and (not (boundp symbol))
+ 					   (not (eq (get symbol 'force-value)
+						    'rogue))))))
+			(comment (get symbol 'saved-variable-comment)))
+ 		    (when (or (and spec (eq (car spec) 'user)
+ 			       (eq (second spec) 'set)) comment)
+ 		      (princ "\n '(")
+ 		      (prin1 symbol)
+ 		      (princ " ")
+		      ;; This comment stuff is in the way ####
+		      ;; Is (eq (third spec) (car saved-value)) ????
+ 		      ;; (prin1 (third spec))
+		      (prin1 (car (get symbol 'saved-value)))
+		      (when (or now requests comment)
+			(princ (if now " t" " nil")))
+		      (when (or comment requests)
+			(princ " ")
+			(prin1 requests))
+		      (when comment
+			(princ " ")
+			(prin1 comment))
+		      (princ ")")))))
       (princ ")")
       (unless (looking-at "\n")
 	(princ "\n")))))
 
+(defvar custom-save-face-ignoring nil)
+
+(defun custom-save-face-internal (symbol)
+  (let ((theme-spec (car-safe (get symbol 'theme-face)))
+	(comment (get symbol 'saved-face-comment))
+	(now (not (or (get symbol 'face-defface-spec)
+	      (and (not (find-face symbol))
+		   (not (eq (get symbol 'force-face) 'rogue)))))))
+    (when (or (and (not (memq symbol custom-save-face-ignoring))
+	       ;; Don't print default face here.
+	       theme-spec
+	       (eq (car theme-spec) 'user)
+	       (eq (second theme-spec) 'set)) comment)
+      (princ "\n '(")
+      (prin1 symbol)
+      (princ " ")
+      (prin1 (get symbol 'saved-face))
+      (if (or comment now)
+	  (princ (if now " t" " nil")))
+      (when comment
+	  (princ " ")
+	  (prin1 comment))
+      (princ ")"))))
+
 (defun custom-save-faces ()
   "Save all customized faces in `custom-file'."
   (save-excursion
+    (custom-save-delete 'custom-reset-faces)
     (custom-save-delete 'custom-set-faces)
+    (custom-save-resets 'theme-face 'custom-reset-faces '(default))
     (let ((standard-output (current-buffer)))
       (unless (bolp)
 	(princ "\n"))
       (princ "(custom-set-faces")
-      (let ((value (get 'default 'saved-face)))
 	;; The default face must be first, since it affects the others.
-	(when value
-	  (princ "\n '(default ")
-	  (prin1 value)
-	  (if (or (get 'default 'face-defface-spec)
-		  (and (not (find-face 'default))
-		       (not (get 'default 'force-face))))
-	      (princ ")")
-	    (princ " t)"))))
-      (mapatoms (lambda (symbol)
-		  (let ((value (get symbol 'saved-face)))
-		    (when (and (not (eq symbol 'default))
-			       ;; Don't print default face here.
-			       value)
-		      (princ "\n '(")
-		      (prin1 symbol)
-		      (princ " ")
-		      (prin1 value)
-		      (if (or (get symbol 'face-defface-spec)
-			      (and (not (find-face symbol))
-				   (not (get symbol 'force-face))))
-			  (princ ")")
-			(princ " t)"))))))
+      (custom-save-face-internal 'default)
+      (let ((custom-save-face-ignoring '(default)))
+	(mapatoms #'custom-save-face-internal))
       (princ ")")
       (unless (looking-at "\n")
 	(princ "\n")))))
 
+(defun custom-save-resets (property setter special)
+  (let (started-writing ignored-special)
+    ;; (custom-save-delete setter) Done by caller 
+    (let ((standard-output (current-buffer))
+	  (mapper `(lambda (object)
+		    (let ((spec (car-safe (get object (quote ,property)))))
+		      (when (and (not (memq object ignored-special))
+				 (eq (car spec) 'user)
+				 (eq (second spec) 'reset))
+			;; Do not write reset statements unless necessary.
+			(unless started-writing
+			  (setq started-writing t)
+			  (unless (bolp)
+			    (princ "\n"))
+			(princ "(")
+			(princ (quote ,setter))
+			(princ "\n '(")
+			(prin1 object)
+			(princ " ")
+			(prin1 (third spec))
+			(princ ")")))))))
+      (mapc mapper special)
+      (setq ignored-special special)
+      (mapatoms mapper)
+      (when started-writing
+	(princ ")\n")))))
+			
+
+(defun custom-save-loaded-themes ()
+  (let ((themes (reverse (get 'user 'theme-loads-themes)))
+	(standard-output (current-buffer)))
+    (when themes
+      (unless (bolp) (princ "\n"))
+      (princ "(custom-load-themes")
+      (mapc (lambda (theme)
+	      (princ "\n   '")
+	      (prin1 theme)) themes)
+      (princ " )\n"))))	 
+
 ;;;###autoload
 (defun customize-save-customized ()
   "Save all user options which have been set in this session."
   (interactive)
   (mapatoms (lambda (symbol)
 	      (let ((face (get symbol 'customized-face))
-		    (value (get symbol 'customized-value)))
+		    (value (get symbol 'customized-value))
+		    (face-comment (get symbol 'customized-face-comment))
+		    (variable-comment
+		     (get symbol 'customized-variable-comment)))
 		(when face
 		  (put symbol 'saved-face face)
+		  (custom-push-theme 'theme-face symbol 'user 'set value)
 		  (put symbol 'customized-face nil))
 		(when value
 		  (put symbol 'saved-value value)
-		  (put symbol 'customized-value nil)))))
+		  (custom-push-theme 'theme-value symbol 'user 'set value)
+		  (put symbol 'customized-value nil))
+		(when variable-comment
+		  (put symbol 'saved-variable-comment variable-comment)
+		  (put symbol 'customized-variable-comment nil))
+		(when face-comment
+		  (put symbol 'saved-face-comment face-comment)
+		  (put symbol 'customized-face-comment nil)))))
   ;; We really should update all custom buffers here.
   (custom-save-all))