More cleanups and minor fixes for Customize.

* cus-edit.el (custom-face-edit-fix-value): Use
custom-fix-face-spec.

* custom.el (custom-push-theme): Cleanup (use cond).
(disable-theme): Recompute the saved-face property.
(custom-theme-recalc-face): Follow face alias before setting prop.

* custom.el (custom-fix-face-spec): New function; code moved from
custom-face-edit-fix-value.
(custom-push-theme): Use it when checking if a face has been
changed outside customize.
(custom-available-themes): New function.
(load-theme): Use it.

* image.el (image-checkbox-checked, image-checkbox-unchecked): New
variables, containing checkbox images.

* startup.el (fancy-startup-tail):
* wid-edit.el (checkbox): Use them.

6 files changed, 167 insertions, 104 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index c2f222d4d9b..a4a9ab216a9 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,25 @@
+2010-10-11  Chong Yidong  <cyd@stupidchicken.com>
+
+        * custom.el (custom-fix-face-spec): New function; code moved from
+        custom-face-edit-fix-value.
+        (custom-push-theme): Use it when checking if a face has been
+        changed outside customize.
+        (custom-available-themes): New function.
+        (load-theme): Use it.
+
+        * cus-edit.el (custom-face-edit-fix-value): Use
+        custom-fix-face-spec.
+
+        * custom.el (custom-push-theme): Cleanup (use cond).
+        (disable-theme): Recompute the saved-face property.
+        (custom-theme-recalc-face): Follow face alias before setting prop.
+
+        * image.el (image-checkbox-checked, image-checkbox-unchecked): New
+        variables, containing checkbox images.
+
+        * startup.el (fancy-startup-tail):
+        * wid-edit.el (checkbox): Use them.
+
 2010-10-10  Dan Nicolaescu  <dann@ics.uci.edu>
 
         * shell.el (shell-mode-map):
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index 8a9775b0ebf..1b69d0c59b2 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -3102,27 +3102,7 @@ face attributes (as specified by a `default' defface entry)."
 (defun custom-face-edit-fix-value (widget value)
   "Ignoring WIDGET, convert :bold and :italic in VALUE to new form.
 Also change :reverse-video to :inverse-video."
-  (if (listp value)
-      (let (result)
-        (while value
-          (let ((key (car value))
-                (val (car (cdr value))))
-            (cond ((eq key :italic)
-                   (push :slant result)
-                   (push (if val 'italic 'normal) result))
-                  ((eq key :bold)
-                   (push :weight result)
-                   (push (if val 'bold 'normal) result))
-                  ((eq key :reverse-video)
-                   (push :inverse-video result)
-                   (push val result))
-                  (t
-                   (push key result)
-                   (push val result))))
-          (setq value (cdr (cdr value))))
-        (setq result (nreverse result))
-        result)
-    value))
+  (custom-fix-face-spec value))
 
 (defun custom-face-edit-convert-widget (widget)
   "Convert :args as widget types in WIDGET."
diff --git a/lisp/custom.el b/lisp/custom.el
index d6ecc6dfbd5..681b55f9178 100644
--- a/lisp/custom.el
+++ b/lisp/custom.el
@@ -819,48 +819,80 @@ See `custom-known-themes' for a list of known themes."
          (setting (assq theme old))  ; '(theme value)
          (theme-settings             ; '(prop symbol theme value)
           (get theme 'theme-settings)))
-    (if (eq mode 'reset)
-        ;; Remove a setting.
-        (when setting
-          (let (res)
-            (dolist (theme-setting theme-settings)
-              (if (and (eq (car  theme-setting) prop)
-                       (eq (cadr theme-setting) symbol))
-                  (setq res theme-setting)))
-            (put theme 'theme-settings (delq res theme-settings)))
-          (put symbol prop (delq setting old)))
-      (if setting
-          ;; Alter an existing setting.
-          (let (res)
-            (dolist (theme-setting theme-settings)
-              (if (and (eq (car  theme-setting) prop)
-                       (eq (cadr theme-setting) symbol))
-                  (setq res theme-setting)))
-            (put theme 'theme-settings
-                 (cons (list prop symbol theme value)
-                       (delq res theme-settings)))
-            (setcar (cdr setting) value))
-        ;; Add a new setting.
+    (cond
+     ;; Remove a setting:
+     ((eq mode 'reset)
+      (when setting
+        (let (res)
+          (dolist (theme-setting theme-settings)
+            (if (and (eq (car  theme-setting) prop)
+                     (eq (cadr theme-setting) symbol))
+                (setq res theme-setting)))
+          (put theme 'theme-settings (delq res theme-settings)))
+        (put symbol prop (delq setting old))))
+     ;; Alter an existing setting:
+     (setting
+      (let (res)
+        (dolist (theme-setting theme-settings)
+          (if (and (eq (car  theme-setting) prop)
+                   (eq (cadr theme-setting) symbol))
+              (setq res theme-setting)))
+        (put theme 'theme-settings
+             (cons (list prop symbol theme value)
+                   (delq res theme-settings)))
+        (setcar (cdr setting) value)))
+     ;; Add a new setting:
+     (t
+      (unless old
         ;; If the user changed the value outside of Customize, we
         ;; first save the current value to a fake theme, `changed'.
         ;; This ensures that the user-set value comes back if the
         ;; theme is later disabled.
-        (if (null old)
-            (if (and (eq prop 'theme-value)
-                     (boundp symbol))
-                (let ((sv (get symbol 'standard-value)))
-                  (unless (and sv
-                               (equal (eval (car sv)) (symbol-value symbol)))
-                    (setq old (list (list 'changed (symbol-value symbol))))))
-              (if (and (facep symbol)
-                       (not (face-spec-match-p symbol (get symbol 'face-defface-spec))))
-                  (setq old (list (list 'changed (list
-                    (append '(t) (custom-face-attributes-get symbol nil)))))))))
-        (put symbol prop (cons (list theme value) old))
-        (put theme 'theme-settings
-             (cons (list prop symbol theme value)
-                   theme-settings))))))
-
+        (cond ((and (eq prop 'theme-value)
+                    (boundp symbol))
+               (let ((sv (get symbol 'standard-value)))
+                 (unless (and sv
+                              (equal (eval (car sv)) (symbol-value symbol)))
+                   (setq old (list (list 'changed (symbol-value symbol)))))))
+              ((and (facep symbol)
+                    (not (face-attr-match-p
+                          symbol
+                          (custom-fix-face-spec
+                           (face-spec-choose
+                            (get symbol 'face-defface-spec))))))
+               (setq old `((changed
+                            (,(append '(t) (custom-face-attributes-get
+                                            symbol nil)))))))))
+      (put symbol prop (cons (list theme value) old))
+      (put theme 'theme-settings
+           (cons (list prop symbol theme value) theme-settings))))))
+
+(defun custom-fix-face-spec (spec)
+  "Convert face SPEC, replacing obsolete :bold and :italic attributes.
+Also change :reverse-video to :inverse-video."
+  (when (listp spec)
+    (if (or (memq :bold spec)
+            (memq :italic spec)
+            (memq :inverse-video spec))
+        (let (result)
+          (while spec
+            (let ((key (car spec))
+                  (val (car (cdr spec))))
+              (cond ((eq key :italic)
+                     (push :slant result)
+                     (push (if val 'italic 'normal) result))
+                    ((eq key :bold)
+                     (push :weight result)
+                     (push (if val 'bold 'normal) result))
+                    ((eq key :reverse-video)
+                     (push :inverse-video result)
+                     (push val result))
+                    (t
+                     (push key result)
+                     (push val result))))
+            (setq spec (cddr spec)))
+          (nreverse result))
+      spec)))
 
 (defun custom-set-variables (&rest args)
   "Install user customizations of variable values specified in ARGS.
@@ -895,7 +927,7 @@ COMMENT is a comment string about SYMBOL.
 EXP itself is saved unevaluated as SYMBOL property `saved-value' and
 in SYMBOL's list property `theme-value' \(using `custom-push-theme')."
   (custom-check-theme theme)
- 
+
   ;; Process all the needed autoloads before anything else, so that the
   ;; subsequent code has all the info it needs (e.g. which var corresponds
   ;; to a minor mode), regardless of the ordering of the variables.
@@ -1062,7 +1094,10 @@ property `theme-feature' (which is usually a symbol created by
 This also enables the theme; use `disable-theme' to disable it."
   ;; Note we do no check for validity of the theme here.
   ;; This allows to pull in themes by a file-name convention
-  (interactive "SCustom theme name: ")
+  (interactive
+   (list
+    (intern (completing-read "Load custom theme: "
+                             (mapcar 'symbol-name (custom-available-themes))))))
   ;; If reloading, clear out the old theme settings.
   (when (custom-theme-p theme)
     (disable-theme theme)
@@ -1073,6 +1108,21 @@ This also enables the theme; use `disable-theme' to disable it."
                        (cons custom-theme-directory load-path)
                      load-path)))
     (load (symbol-name (custom-make-theme-feature theme)))))
+
+(defun custom-available-themes ()
+  (let* ((load-path (if (file-directory-p custom-theme-directory)
+                        (cons custom-theme-directory load-path)
+                      load-path))
+         sym themes)
+    (dolist (dir load-path)
+      (dolist (file (file-expand-wildcards
+                     (expand-file-name "*-theme.el" dir) t))
+        (setq file (file-name-nondirectory file))
+        (and (string-match "\\`\\(.+\\)-theme.el\\'" file)
+             (setq sym (intern (match-string 1 file)))
+             (not (memq sym '(cus user changed color)))
+             (push sym themes))))
+    (delete-dups themes)))
 
 ;;; Enabling and disabling loaded themes.
 
@@ -1085,7 +1135,10 @@ If it is already enabled, just give it highest precedence (after `user').
 
 If THEME does not specify any theme settings, this tries to load
 the theme from its theme file, by calling `load-theme'."
-  (interactive "SEnable Custom theme: ")
+  (interactive (list (intern
+                      (completing-read
+                       "Enable custom theme: "
+                       obarray (lambda (sym) (get sym 'theme-settings))))))
   (if (not (custom-theme-p theme))
       (load-theme theme)
     ;; This could use a bit of optimization -- cyd
@@ -1143,21 +1196,28 @@ and always takes precedence over other Custom Themes."
 See `custom-enabled-themes' for a list of enabled themes."
   (interactive (list (intern
                       (completing-read
-                       "Disable Custom theme: "
+                       "Disable custom theme: "
                        (mapcar 'symbol-name custom-enabled-themes)
                        nil t))))
   (when (custom-theme-enabled-p theme)
     (let ((settings (get theme 'theme-settings)))
       (dolist (s settings)
-        (let* ((prop (car s))
+        (let* ((prop   (car s))
                (symbol (cadr s))
-               (spec-list (get symbol prop)))
-          (put symbol prop (assq-delete-all theme spec-list))
-          (if (eq prop 'theme-value)
-              (custom-theme-recalc-variable symbol)
+               (val (assq-delete-all theme (get symbol prop))))
+          (put symbol prop val)
+          (cond
+           ((eq prop 'theme-value)
+            (custom-theme-recalc-variable symbol))
+           ((eq prop 'theme-face)
+            ;; If the face spec specified by this theme is in the
+            ;; saved-face property, reset that property.
+            (when (equal (nth 3 s) (get symbol 'saved-face))
+              (put symbol 'saved-face
+                   (and val (cadr (car val)))))
             (custom-theme-recalc-face symbol)))))
-    (setq custom-enabled-themes
-          (delq theme custom-enabled-themes))))
+      (setq custom-enabled-themes
+            (delq theme custom-enabled-themes)))))
 
 (defun custom-variable-theme-value (variable)
   "Return (list VALUE) indicating the custom theme value of VARIABLE.
@@ -1183,10 +1243,10 @@ This function returns nil if no custom theme specifies a value for VARIABLE."
 
 (defun custom-theme-recalc-face (face)
   "Set FACE according to currently enabled custom themes."
-  (if (facep face)
-      (face-spec-set face
-                     (get (or (get face 'face-alias) face)
-                          'face-override-spec))))
+  (if (get face 'face-alias)
+      (setq face (get face 'face-alias)))
+  (face-spec-set face (get face 'face-override-spec)))
+
 
 ;;; XEmacs compability functions
 
diff --git a/lisp/image.el b/lisp/image.el
index 2ca2971b4aa..8dd88f627a1 100644
--- a/lisp/image.el
+++ b/lisp/image.el
@@ -721,7 +721,20 @@ shall be displayed."
          (cons (concat "\\." extension "\\'") 'imagemagick)
          image-type-file-name-regexps)))))
 
-
+
+;;; Inline stock images
+
+(defvar image-checkbox-checked
+  (create-image "\300\300\141\143\067\076\034\030"
+                'xbm t :width 8 :height 8 :background "grey75"
+                :foreground "black" :relief -2 :ascent 'center)
+  "Image of a checked checkbox.")
+
+(defvar image-checkbox-unchecked
+  (create-image (make-string 8 0)
+                'xbm t :width 8 :height 8 :background "grey75"
+                :foreground "black" :relief -2 :ascent 'center)
+  "Image of an unchecked checkbox.")
 
 (provide 'image)
 
diff --git a/lisp/startup.el b/lisp/startup.el
index c029eff54cf..aa791f2a04a 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -1563,23 +1563,21 @@ a face or button specification."
                  (kill-buffer "*GNU Emacs*")))
        "  ")
       (when (or user-init-file custom-file)
-        (let ((checked (create-image "\300\300\141\143\067\076\034\030"
-                                     'xbm t :width 8 :height 8 :background "grey75"
-                                     :foreground "black" :relief -2 :ascent 'center))
-              (unchecked (create-image (make-string 8 0)
-                                       'xbm t :width 8 :height 8 :background "grey75"
-                                       :foreground "black" :relief -2 :ascent 'center)))
-          (insert-button
-           " " :on-glyph checked :off-glyph unchecked 'checked nil
-           'display unchecked 'follow-link t
-           'action (lambda (button)
-                     (if (overlay-get button 'checked)
-                         (progn (overlay-put button 'checked nil)
-                                (overlay-put button 'display (overlay-get button :off-glyph))
-                                (setq startup-screen-inhibit-startup-screen nil))
-                       (overlay-put button 'checked t)
-                       (overlay-put button 'display (overlay-get button :on-glyph))
-                       (setq startup-screen-inhibit-startup-screen t)))))
+        (insert-button
+         " "
+         :on-glyph image-checkbox-checked
+         :off-glyph image-checkbox-unchecked
+         'checked nil 'display image-checkbox-unchecked 'follow-link t
+         'action (lambda (button)
+                   (if (overlay-get button 'checked)
+                       (progn (overlay-put button 'checked nil)
+                              (overlay-put button 'display
+                                           (overlay-get button :off-glyph))
+                              (setq startup-screen-inhibit-startup-screen nil))
+                     (overlay-put button 'checked t)
+                     (overlay-put button 'display
+                                  (overlay-get button :on-glyph))
+                     (setq startup-screen-inhibit-startup-screen t))))
         (fancy-splash-insert :face '(variable-pitch (:height 0.9))
                              " Never show it again.")))))
 
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index a6dca41bc28..3b9a0372de5 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -2195,19 +2195,9 @@ when he invoked the menu."
   ;; We could probably do the same job as the images using single
   ;; space characters in a boxed face with a stretch specification to
   ;; make them square.
-  :on-glyph '(create-image "\300\300\141\143\067\076\034\030"
-                           'xbm t :width 8 :height 8
-                           :background "grey75" ; like default mode line
-                           :foreground "black"
-                           :relief -2
-                           :ascent 'center)
+  :on-glyph image-checkbox-checked
   :off "[ ]"
-  :off-glyph '(create-image (make-string 8 0)
-                            'xbm t :width 8 :height 8
-                            :background "grey75"
-                            :foreground "black"
-                            :relief -2
-                            :ascent 'center)
+  :off-glyph image-checkbox-unchecked
   :help-echo "Toggle this item."
   :action 'widget-checkbox-action)