summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorChong Yidong <cyd@stupidchicken.com>2010-10-11 00:49:59 -0400
committerChong Yidong <cyd@stupidchicken.com>2010-10-11 00:49:59 -0400
commit05d22d02175330f9a9899d5daa431b1fdaf28470 (patch)
treeb1cf3b77165eb9c54e028b44eb96466ab6210c6f
parentdf187c6252439abcc958bbeb507344d6781b46e7 (diff)
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.
-rw-r--r--lisp/ChangeLog22
-rw-r--r--lisp/cus-edit.el22
-rw-r--r--lisp/custom.el166
-rw-r--r--lisp/image.el15
-rw-r--r--lisp/startup.el32
-rw-r--r--lisp/wid-edit.el14
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)