Interface improvements to cus-theme.el.

* cus-edit.el (custom-face-widget-to-spec)
(custom-face-get-current-spec, custom-face-state): New functions.
(custom-face-set, custom-face-mark-to-save)
(custom-face-value-create, custom-face-state-set): Use them.

* cus-theme.el (custom-theme--listed-faces): New var.
(customize-create-theme): Use *Custom Theme* as the buffer name.
Set revert-buffer-function.  Optional arg BUFFER.  Insert all
faces listed in custom-theme--listed-faces.
(custom-theme-revert): New function.
(custom-theme-add-variable, custom-theme-add-face): Insert at the
bottom of the list.
(custom-theme-write): Prompt for theme name if empty.
(custom-theme-write-variables): Use dolist.
(custom-theme-write-faces): Handle hidden (collapsed) widgets.

1 files changed, 62 insertions, 57 deletions

diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index 279b8f25932..8a9775b0ebf 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -3379,6 +3379,30 @@ SPEC must be a full face spec."
   "Return the customized SPEC in a form suitable for setting the face."
   (custom-filter-face-spec spec 3))
 
+(defun custom-face-widget-to-spec (widget)
+  "Return a face spec corresponding to WIDGET.
+WIDGET should be a `custom-face' widget."
+  (unless (eq (widget-type widget) 'custom-face)
+    (error "Invalid widget"))
+  (let ((child (car (widget-get widget :children))))
+    (custom-post-filter-face-spec
+     (if (eq (widget-type child) 'custom-face-edit)
+	 `((t ,(widget-value child)))
+       (widget-value child)))))
+
+(defun custom-face-get-current-spec (face)
+  (let ((spec (or (get face 'customized-face)
+		  (get face 'saved-face)
+		  (get face 'face-defface-spec)
+		  ;; Attempt to construct it.
+		  `((t ,(custom-face-attributes-get
+			 face (selected-frame)))))))
+    ;; If the user has changed this face in some other way,
+    ;; edit it as the user has specified it.
+    (if (not (face-spec-match-p face spec (selected-frame)))
+	(setq spec `((t ,(face-attr-construct face (selected-frame))))))
+    (custom-pre-filter-face-spec spec)))
+
 (defun custom-face-value-create (widget)
   "Create a list of the display specifications for WIDGET."
   (let* ((buttons (widget-get widget :buttons))
@@ -3464,21 +3488,10 @@ SPEC must be a full face spec."
 	(unless (widget-get widget :custom-form)
 	  (widget-put widget :custom-form custom-face-default-form))
 
-	(let* ((spec (or (get symbol 'customized-face)
-			 (get symbol 'saved-face)
-			 (get symbol 'face-defface-spec)
-			 ;; Attempt to construct it.
-			 (list (list t (custom-face-attributes-get
-					symbol (selected-frame))))))
+	(let* ((spec (custom-face-get-current-spec symbol))
 	       (form (widget-get widget :custom-form))
 	       (indent (widget-get widget :indent))
 	       face-alist face-entry spec-default spec-match editor)
-	  ;; If the user has changed this face in some other way,
-	  ;; edit it as the user has specified it.
-	  (if (not (face-spec-match-p symbol spec (selected-frame)))
-	      (setq spec `((t ,(face-attr-construct symbol
-						    (selected-frame))))))
-	  (setq spec (custom-pre-filter-face-spec spec))
 
 	  ;; Find a display in SPEC matching the selected display.
 	  ;; This will use the usual face customization interface.
@@ -3570,43 +3583,43 @@ widget.  If FILTER is nil, ACTION is always valid.")
   (widget-put widget :custom-form 'lisp)
   (custom-redraw widget))
 
-(defun custom-face-state-set (widget)
-  "Set the state of WIDGET."
-  (let* ((symbol (widget-value widget))
-	 (comment (get symbol 'face-comment))
-	 tmp temp
+(defun custom-face-state (face)
+  "Return the current state of the face FACE.
+This is one of `set', `saved', `changed', `themed', or `rogue'."
+  (let* ((comment (get face 'face-comment))
 	 (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)
-		     (cond
-		      ((eq 'user (caar (get symbol 'theme-face)))
-		       'saved)
-		      ((eq 'changed (caar (get symbol 'theme-face)))
-		       'changed)
-		      (t 'themed))
-		   'changed))
-		((get symbol 'face-defface-spec)
-		 (if (equal comment nil)
-		     'standard
-		   'changed))
-		(t
-		 'rogue))))
-    ;; If the user called set-face-attribute to change the default
-    ;; for new frames, this face is "set outside of Customize".
+	  (cond
+	   ((or (get face 'customized-face)
+		(get face 'customized-face-comment))
+	    (if (equal (get face 'customized-face-comment) comment)
+		'set
+	      'changed))
+	   ((or (get face 'saved-face)
+		(get face 'saved-face-comment))
+	    (if (equal (get face 'saved-face-comment) comment)
+		(cond
+		 ((eq 'user (caar (get face 'theme-face)))
+		  'saved)
+		 ((eq 'changed (caar (get face 'theme-face)))
+		  'changed)
+		 (t 'themed))
+	      'changed))
+	   ((get face 'face-defface-spec)
+	    (if (equal comment nil)
+		'standard
+	      'changed))
+	   (t 'rogue))))
+    ;; If the user called set-face-attribute to change the default for
+    ;; new frames, this face is "set outside of Customize".
     (if (and (not (eq state 'rogue))
-	     (get symbol 'face-modified))
-	(setq state 'changed))
-    (widget-put widget :custom-state state)))
+	     (get face 'face-modified))
+	'changed
+      state)))
+
+(defun custom-face-state-set (widget)
+  "Set the state of WIDGET."
+  (widget-put widget :custom-state
+	      (custom-face-state (widget-value widget))))
 
 (defun custom-face-action (widget &optional event)
   "Show the menu for `custom-face' WIDGET.
@@ -3626,11 +3639,7 @@ Optional EVENT is the location for the menu."
 (defun custom-face-set (widget)
   "Make the face attributes in WIDGET take effect."
   (let* ((symbol (widget-value widget))
-	 (child (car (widget-get widget :children)))
-	 (value (custom-post-filter-face-spec
-		 (if (eq (widget-type child) 'custom-face-edit)
-		     `((t ,(widget-value child)))
-		   (widget-value child))))
+	 (value  (custom-face-widget-to-spec widget))
 	 (comment-widget (widget-get widget :comment-widget))
 	 (comment (widget-value comment-widget)))
     (when (equal comment "")
@@ -3652,11 +3661,7 @@ Optional EVENT is the location for the menu."
 (defun custom-face-mark-to-save (widget)
   "Mark for saving the face edited by WIDGET."
   (let* ((symbol (widget-value widget))
-	 (child (car (widget-get widget :children)))
-	 (value (custom-post-filter-face-spec
-		 (if (eq (widget-type child) 'custom-face-edit)
-		     `((t ,(widget-value child)))
-		   (widget-value child))))
+	 (value  (custom-face-widget-to-spec widget))
 	 (comment-widget (widget-get widget :comment-widget))
 	 (comment (widget-value comment-widget)))
     (when (equal comment "")