Mercurial > emacs

changeset 110914:ccdc694ce7bd

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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.
author Chong Yidong <cyd@stupidchicken.com>
date Mon, 11 Oct 2010 00:49:59 -0400
parents 1ba912b1a63c
children d0d0047ca0fb
files lisp/ChangeLog lisp/cus-edit.el lisp/custom.el lisp/image.el lisp/startup.el lisp/wid-edit.el
diffstat 6 files changed, 165 insertions(+), 102 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Sun Oct 10 18:57:48 2010 -0700
+++ b/lisp/ChangeLog	Mon Oct 11 00:49:59 2010 -0400
@@ -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):
--- a/lisp/cus-edit.el	Sun Oct 10 18:57:48 2010 -0700
+++ b/lisp/cus-edit.el	Mon Oct 11 00:49:59 2010 -0400
@@ -3102,27 +3102,7 @@
 (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."
--- a/lisp/custom.el	Sun Oct 10 18:57:48 2010 -0700
+++ b/lisp/custom.el	Mon Oct 11 00:49:59 2010 -0400
@@ -819,48 +819,80 @@
 	 (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 @@
 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 @@
 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 @@
 		       (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 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 @@
 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 @@
 
 (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
 
--- a/lisp/image.el	Sun Oct 10 18:57:48 2010 -0700
+++ b/lisp/image.el	Mon Oct 11 00:49:59 2010 -0400
@@ -721,7 +721,20 @@
 	 (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)
 
--- a/lisp/startup.el	Sun Oct 10 18:57:48 2010 -0700
+++ b/lisp/startup.el	Mon Oct 11 00:49:59 2010 -0400
@@ -1563,23 +1563,21 @@
 		 (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.")))))
 
--- a/lisp/wid-edit.el	Sun Oct 10 18:57:48 2010 -0700
+++ b/lisp/wid-edit.el	Mon Oct 11 00:49:59 2010 -0400
@@ -2195,19 +2195,9 @@
   ;; 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)