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.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index c2f222d4d9bc71c8a60901bb78bec7a6a01d3209..a4a9ab216a97ec9ba54b6ca691ac48a87a55b50b 100644 (file)
--- 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 8a9775b0ebf9c1857622404768653350d9dc4ba0..1b69d0c59b28b0c14b9dcb593bbeda7125731407 100644 (file)
--- 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 d6ecc6dfbd502f3121471231cfa593df19f5106b..681b55f9178361434fec99c453b0742b3fde6656 100644 (file)
--- 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)))
 \f
 (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)))
 \f
 ;;; 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)))
+
 \f
 ;;; XEmacs compability functions
 

diff --git a/lisp/image.el b/lisp/image.el
index 2ca2971b4aa891224ba79efcb0dca491f54580b0..8dd88f627a11ccf9751d954f024643a84671abbb 100644 (file)
--- a/lisp/image.el
+++ b/lisp/image.el
@@ -721,7 +721,20 @@ shall be displayed."
         (cons (concat "\\." extension "\\'") 'imagemagick)
         image-type-file-name-regexps)))))
 
-
+\f
+;;; 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 c029eff54cfee19a64264a7229d4569c228b827d..aa791f2a04a988a30c72066406a09f94620e4b70 100644 (file)
--- 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 a6dca41bc2884f8b0262dac5acb6135c600dfedd..3b9a0372de5e2eccc0c861cdb04ec41cc51273cd 100644 (file)
--- 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)