Commit 05d22d02 authored by Chong Yidong's avatar Chong Yidong
Browse files

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.
parent df187c62
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> 2010-10-10 Dan Nicolaescu <dann@ics.uci.edu>
   
* shell.el (shell-mode-map): * shell.el (shell-mode-map):
......
...@@ -3102,27 +3102,7 @@ face attributes (as specified by a `default' defface entry)." ...@@ -3102,27 +3102,7 @@ face attributes (as specified by a `default' defface entry)."
(defun custom-face-edit-fix-value (widget value) (defun custom-face-edit-fix-value (widget value)
"Ignoring WIDGET, convert :bold and :italic in VALUE to new form. "Ignoring WIDGET, convert :bold and :italic in VALUE to new form.
Also change :reverse-video to :inverse-video." Also change :reverse-video to :inverse-video."
(if (listp value) (custom-fix-face-spec 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))
(defun custom-face-edit-convert-widget (widget) (defun custom-face-edit-convert-widget (widget)
"Convert :args as widget types in WIDGET." "Convert :args as widget types in WIDGET."
......
...@@ -819,8 +819,9 @@ See `custom-known-themes' for a list of known themes." ...@@ -819,8 +819,9 @@ See `custom-known-themes' for a list of known themes."
(setting (assq theme old)) ; '(theme value) (setting (assq theme old)) ; '(theme value)
(theme-settings ; '(prop symbol theme value) (theme-settings ; '(prop symbol theme value)
(get theme 'theme-settings))) (get theme 'theme-settings)))
(if (eq mode 'reset) (cond
;; Remove a setting. ;; Remove a setting:
((eq mode 'reset)
(when setting (when setting
(let (res) (let (res)
(dolist (theme-setting theme-settings) (dolist (theme-setting theme-settings)
...@@ -828,9 +829,9 @@ See `custom-known-themes' for a list of known themes." ...@@ -828,9 +829,9 @@ See `custom-known-themes' for a list of known themes."
(eq (cadr theme-setting) symbol)) (eq (cadr theme-setting) symbol))
(setq res theme-setting))) (setq res theme-setting)))
(put theme 'theme-settings (delq res theme-settings))) (put theme 'theme-settings (delq res theme-settings)))
(put symbol prop (delq setting old))) (put symbol prop (delq setting old))))
(if setting ;; Alter an existing setting:
;; Alter an existing setting. (setting
(let (res) (let (res)
(dolist (theme-setting theme-settings) (dolist (theme-setting theme-settings)
(if (and (eq (car theme-setting) prop) (if (and (eq (car theme-setting) prop)
...@@ -839,28 +840,59 @@ See `custom-known-themes' for a list of known themes." ...@@ -839,28 +840,59 @@ See `custom-known-themes' for a list of known themes."
(put theme 'theme-settings (put theme 'theme-settings
(cons (list prop symbol theme value) (cons (list prop symbol theme value)
(delq res theme-settings))) (delq res theme-settings)))
(setcar (cdr setting) value)) (setcar (cdr setting) value)))
;; Add a new setting. ;; Add a new setting:
(t
(unless old
;; If the user changed the value outside of Customize, we ;; If the user changed the value outside of Customize, we
;; first save the current value to a fake theme, `changed'. ;; first save the current value to a fake theme, `changed'.
;; This ensures that the user-set value comes back if the ;; This ensures that the user-set value comes back if the
;; theme is later disabled. ;; theme is later disabled.
(if (null old) (cond ((and (eq prop 'theme-value)
(if (and (eq prop 'theme-value)
(boundp symbol)) (boundp symbol))
(let ((sv (get symbol 'standard-value))) (let ((sv (get symbol 'standard-value)))
(unless (and sv (unless (and sv
(equal (eval (car sv)) (symbol-value symbol))) (equal (eval (car sv)) (symbol-value symbol)))
(setq old (list (list 'changed (symbol-value symbol)))))) (setq old (list (list 'changed (symbol-value symbol)))))))
(if (and (facep symbol) ((and (facep symbol)
(not (face-spec-match-p symbol (get symbol 'face-defface-spec)))) (not (face-attr-match-p
(setq old (list (list 'changed (list symbol
(append '(t) (custom-face-attributes-get symbol nil))))))))) (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 symbol prop (cons (list theme value) old))
(put theme 'theme-settings (put theme 'theme-settings
(cons (list prop symbol theme value) (cons (list prop symbol theme value) theme-settings))))))
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) (defun custom-set-variables (&rest args)
"Install user customizations of variable values specified in ARGS. "Install user customizations of variable values specified in ARGS.
...@@ -1062,7 +1094,10 @@ property `theme-feature' (which is usually a symbol created by ...@@ -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." This also enables the theme; use `disable-theme' to disable it."
;; Note we do no check for validity of the theme here. ;; Note we do no check for validity of the theme here.
;; This allows to pull in themes by a file-name convention ;; 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. ;; If reloading, clear out the old theme settings.
(when (custom-theme-p theme) (when (custom-theme-p theme)
(disable-theme theme) (disable-theme theme)
...@@ -1073,6 +1108,21 @@ This also enables the theme; use `disable-theme' to disable it." ...@@ -1073,6 +1108,21 @@ This also enables the theme; use `disable-theme' to disable it."
(cons custom-theme-directory load-path) (cons custom-theme-directory load-path)
load-path))) load-path)))
(load (symbol-name (custom-make-theme-feature theme))))) (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. ;;; Enabling and disabling loaded themes.
...@@ -1085,7 +1135,10 @@ If it is already enabled, just give it highest precedence (after `user'). ...@@ -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 If THEME does not specify any theme settings, this tries to load
the theme from its theme file, by calling `load-theme'." 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)) (if (not (custom-theme-p theme))
(load-theme theme) (load-theme theme)
;; This could use a bit of optimization -- cyd ;; This could use a bit of optimization -- cyd
...@@ -1143,7 +1196,7 @@ and always takes precedence over other Custom Themes." ...@@ -1143,7 +1196,7 @@ and always takes precedence over other Custom Themes."
See `custom-enabled-themes' for a list of enabled themes." See `custom-enabled-themes' for a list of enabled themes."
(interactive (list (intern (interactive (list (intern
(completing-read (completing-read
"Disable Custom theme: " "Disable custom theme: "
(mapcar 'symbol-name custom-enabled-themes) (mapcar 'symbol-name custom-enabled-themes)
nil t)))) nil t))))
(when (custom-theme-enabled-p theme) (when (custom-theme-enabled-p theme)
...@@ -1151,13 +1204,20 @@ See `custom-enabled-themes' for a list of enabled themes." ...@@ -1151,13 +1204,20 @@ See `custom-enabled-themes' for a list of enabled themes."
(dolist (s settings) (dolist (s settings)
(let* ((prop (car s)) (let* ((prop (car s))
(symbol (cadr s)) (symbol (cadr s))
(spec-list (get symbol prop))) (val (assq-delete-all theme (get symbol prop))))
(put symbol prop (assq-delete-all theme spec-list)) (put symbol prop val)
(if (eq prop 'theme-value) (cond
(custom-theme-recalc-variable symbol) ((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))))) (custom-theme-recalc-face symbol)))))
(setq custom-enabled-themes (setq custom-enabled-themes
(delq theme custom-enabled-themes)))) (delq theme custom-enabled-themes)))))
(defun custom-variable-theme-value (variable) (defun custom-variable-theme-value (variable)
"Return (list VALUE) indicating the custom theme value of 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." ...@@ -1183,10 +1243,10 @@ This function returns nil if no custom theme specifies a value for VARIABLE."
(defun custom-theme-recalc-face (face) (defun custom-theme-recalc-face (face)
"Set FACE according to currently enabled custom themes." "Set FACE according to currently enabled custom themes."
(if (facep face) (if (get face 'face-alias)
(face-spec-set face (setq face (get face 'face-alias)))
(get (or (get face 'face-alias) face) (face-spec-set face (get face 'face-override-spec)))
'face-override-spec))))
;;; XEmacs compability functions ;;; XEmacs compability functions
......
...@@ -721,7 +721,20 @@ shall be displayed." ...@@ -721,7 +721,20 @@ shall be displayed."
(cons (concat "\\." extension "\\'") 'imagemagick) (cons (concat "\\." extension "\\'") 'imagemagick)
image-type-file-name-regexps))))) 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) (provide 'image)
......
...@@ -1563,23 +1563,21 @@ a face or button specification." ...@@ -1563,23 +1563,21 @@ a face or button specification."
(kill-buffer "*GNU Emacs*"))) (kill-buffer "*GNU Emacs*")))
" ") " ")
(when (or user-init-file custom-file) (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 (insert-button
" " :on-glyph checked :off-glyph unchecked 'checked nil " "
'display unchecked 'follow-link t :on-glyph image-checkbox-checked
:off-glyph image-checkbox-unchecked
'checked nil 'display image-checkbox-unchecked 'follow-link t
'action (lambda (button) 'action (lambda (button)
(if (overlay-get button 'checked) (if (overlay-get button 'checked)
(progn (overlay-put button 'checked nil) (progn (overlay-put button 'checked nil)
(overlay-put button 'display (overlay-get button :off-glyph)) (overlay-put button 'display
(overlay-get button :off-glyph))
(setq startup-screen-inhibit-startup-screen nil)) (setq startup-screen-inhibit-startup-screen nil))
(overlay-put button 'checked t) (overlay-put button 'checked t)
(overlay-put button 'display (overlay-get button :on-glyph)) (overlay-put button 'display
(setq startup-screen-inhibit-startup-screen t))))) (overlay-get button :on-glyph))
(setq startup-screen-inhibit-startup-screen t))))
(fancy-splash-insert :face '(variable-pitch (:height 0.9)) (fancy-splash-insert :face '(variable-pitch (:height 0.9))
" Never show it again."))))) " Never show it again.")))))
......
...@@ -2195,19 +2195,9 @@ when he invoked the menu." ...@@ -2195,19 +2195,9 @@ when he invoked the menu."
;; We could probably do the same job as the images using single ;; We could probably do the same job as the images using single
;; space characters in a boxed face with a stretch specification to ;; space characters in a boxed face with a stretch specification to
;; make them square. ;; make them square.
:on-glyph '(create-image "\300\300\141\143\067\076\034\030" :on-glyph image-checkbox-checked
'xbm t :width 8 :height 8
:background "grey75" ; like default mode line
:foreground "black"
:relief -2
:ascent 'center)
:off "[ ]" :off "[ ]"
:off-glyph '(create-image (make-string 8 0) :off-glyph image-checkbox-unchecked
'xbm t :width 8 :height 8
:background "grey75"
:foreground "black"
:relief -2
:ascent 'center)
:help-echo "Toggle this item." :help-echo "Toggle this item."
:action 'widget-checkbox-action) :action 'widget-checkbox-action)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment