Mercurial > emacs

changeset 110811:4d1b1a2c88c6

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Improvements to face customization interface. * lisp/cus-edit.el (custom-variable, custom-face): Doc fix. (custom-face-edit): Add value-create attribute. (custom-face-edit-value-create) (custom-face-edit-value-visibility-action): New functions. Hide unused face attributes by default, and add a visibility toggle. (custom-face-edit-deactivate): Show empty values with shadow face. (custom-face-selected): Only use this for face specs with default attributes. (custom-face-value-create): Cleanup. * lisp/wid-edit.el (widget-checklist-value-create): Use dolist. (widget-checklist-match-find): Make second arg optional.
author Chong Yidong <cyd@stupidchicken.com>
date Thu, 07 Oct 2010 20:05:12 -0400
parents 07053df95af6
children 3d3d15223058
files lisp/ChangeLog lisp/cus-edit.el lisp/wid-edit.el
diffstat 3 files changed, 212 insertions(+), 163 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Thu Oct 07 22:26:11 2010 +0000
+++ b/lisp/ChangeLog	Thu Oct 07 20:05:12 2010 -0400
@@ -1,3 +1,18 @@
+2010-10-07  Chong Yidong  <cyd@stupidchicken.com>
+
+	* cus-edit.el (custom-variable, custom-face): Doc fix.
+	(custom-face-edit): Add value-create attribute.
+	(custom-face-edit-value-create)
+	(custom-face-edit-value-visibility-action): New functions.  Hide
+	unused face attributes by default, and add a visibility toggle.
+	(custom-face-edit-deactivate): Show empty values with shadow face.
+	(custom-face-selected): Only use this for face specs with default
+	attributes.
+	(custom-face-value-create): Cleanup.
+
+	* wid-edit.el (widget-checklist-value-create): Use dolist.
+	(widget-checklist-match-find): Make second arg optional.
+
 2010-10-07  Glenn Morris  <rgm@gnu.org>
 
 	* hilit-chg.el (hilit-chg-get-diff-info, hilit-chg-get-diff-list-hk):
--- a/lisp/cus-edit.el	Thu Oct 07 22:26:11 2010 +0000
+++ b/lisp/cus-edit.el	Thu Oct 07 20:05:12 2010 -0400
@@ -1914,7 +1914,7 @@
 SET for current session only." "\
 something in this group has been set but not saved.")
     (changed ":" custom-changed "\
-CHANGED outside Customize; operating on it here may be unreliable." "\
+CHANGED outside Customize." "\
 something in this group has been changed outside customize.")
     (saved "!" custom-saved "\
 SAVED and set." "\
@@ -2456,16 +2456,22 @@
 (define-widget 'custom-variable 'custom
   "A widget for displaying a Custom variable.
 
-The following property has a special meaning for this widget:
-:hidden-states - A list of widget states for which the widget's initial
-                 contents should be hidden."
+The following properties have special meanings for this widget:
+
+:hidden-states should be a list of widget states for which the
+  widget's initial contents are to be hidden.
+
+:custom-form should be a symbol describing how to display and
+  edit the variable---either `edit' (using edit widgets),
+  `lisp' (as a Lisp sexp), or `mismatch' (should not happen);
+  if nil, use the return value of `custom-variable-default-form'."
   :format "%v"
   :help-echo "Set or reset this variable."
   :documentation-property #'custom-variable-documentation
   :custom-category 'option
   :custom-state nil
   :custom-menu 'custom-variable-menu-create
-  :custom-form nil ; defaults to value of `custom-variable-default-form'
+  :custom-form nil
   :value-create 'custom-variable-value-create
   :action 'custom-variable-action
   :hidden-states '(standard)
@@ -3026,24 +3032,64 @@
 ;;; The `custom-face-edit' Widget.
 
 (define-widget 'custom-face-edit 'checklist
-  "Edit face attributes."
-  :format "%t: %v"
-  :tag "Attributes"
-  :extra-offset 13
+  "Widget for editing face attributes."
+  :format "%v"
+  :extra-offset 3
   :button-args '(:help-echo "Control whether this attribute has any effect.")
   :value-to-internal 'custom-face-edit-fix-value
   :match (lambda (widget value)
 	   (widget-checklist-match widget
 				   (custom-face-edit-fix-value widget value)))
+  :value-create 'custom-face-edit-value-create
   :convert-widget 'custom-face-edit-convert-widget
   :args (mapcar (lambda (att)
-		  (list 'group
-			:inline t
+		  (list 'group :inline t
 			:sibling-args (widget-get (nth 1 att) :sibling-args)
 			(list 'const :format "" :value (nth 0 att))
 			(nth 1 att)))
 		custom-face-attributes))
 
+(defun custom-face-edit-value-create (widget)
+  (let* ((value (widget-get widget :value)) ; list of key-value pairs
+	 (alist (widget-checklist-match-find widget value))
+	 (args  (widget-get widget :args))
+	 (show-all (widget-get widget :show-all-attributes))
+	 (buttons (widget-get widget :buttons))
+	 entry)
+    (unless (looking-back "^ *")
+      (insert ?\n))
+    (insert-char ?\s (widget-get widget :extra-offset))
+    (if (or alist show-all)
+	(dolist (prop args)
+	  (setq entry (assq prop alist))
+	  (if (or entry show-all)
+	      (widget-checklist-add-item widget prop entry)))
+      (insert (propertize "-- Empty face --" 'face 'shadow) ?\n))
+    (let ((indent (widget-get widget :indent)))
+      (if indent (insert-char ?\s (widget-get widget :indent))))
+    (push (widget-create-child-and-convert
+	   widget 'visibility
+	   :help-echo "Show or hide all face attributes."
+	   :button-face 'custom-visibility
+	   :pressed-face 'custom-visibility
+	   :mouse-face 'highlight
+	   :on "Hide Unused Attributes"    :off "Show All Attributes"
+	   :on-image nil :off-image nil
+	   :always-active t
+	   :action 'custom-face-edit-value-visibility-action
+	   show-all)
+	  buttons)
+    (insert ?\n)
+    (widget-put widget :buttons buttons)
+    (widget-put widget :children (nreverse (widget-get widget :children)))))
+
+(defun custom-face-edit-value-visibility-action (widget &rest ignore)
+  ;; Toggle hiding of face attributes.
+  (let ((parent (widget-get widget :parent)))
+    (widget-put parent :show-all-attributes
+		(not (widget-get parent :show-all-attributes)))
+    (custom-redraw parent)))
+
 (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."
@@ -3092,7 +3138,7 @@
       (save-excursion
 	(goto-char from)
 	(widget-default-delete widget)
-	(insert tag ": *\n")
+	(insert tag ": " (propertize "--" 'face 'shadow) "\n")
 	(widget-put widget :inactive
 		    (cons value (cons from (- (point) from))))))))
 
@@ -3235,14 +3281,23 @@
   :version "20.3")
 
 (define-widget 'custom-face 'custom
-  "Customize face."
+  "Widget for customizing a face.
+The widget value is the face name (a symbol).
+
+The following properties have special meanings for this widget:
+
+:custom-form should be a symbol describing how to display and
+  edit the face attributes---either `selected' (attributes for
+  selected display only), `all' (all attributes), `lisp' (as a
+  Lisp sexp), or `mismatch' (should not happen); if nil, use
+  the return value of `custom-face-default-form'."
   :sample-face 'custom-face-tag
   :help-echo "Set or reset this face."
   :documentation-property #'face-doc-string
   :value-create 'custom-face-value-create
   :action 'custom-face-action
   :custom-category 'face
-  :custom-form nil ; defaults to value of `custom-face-default-form'
+  :custom-form nil
   :custom-set 'custom-face-set
   :custom-mark-to-save 'custom-face-mark-to-save
   :custom-reset-current 'custom-redraw
@@ -3273,30 +3328,16 @@
   (not (face-spec-set-match-display value (selected-frame))))
 
 (define-widget 'custom-face-selected 'group
-  "Edit the attributes of the selected display in a face specification."
-  :args '((choice :inline t
-		  (group :tag "With Defaults" :inline t
-		   (group (const :tag "" default)
-			  (custom-face-edit :tag " Default\n Attributes"))
-		   (repeat :format ""
-			   :inline t
-			   (group custom-display-unselected sexp))
-		   (group (sexp :format "")
-			  (custom-face-edit :tag " Overriding\n Attributes"))
-		   (repeat :format ""
-			   :inline t
-			   sexp))
-		  (group :tag "No Defaults" :inline t
-			 (repeat :format ""
-				 :inline t
-				 (group custom-display-unselected sexp))
-			 (group (sexp :format "")
-				(custom-face-edit :tag "\n Attributes"))
-			 (repeat :format ""
-				 :inline t
-				 sexp)))))
-
-
+  "Widget for editing the attributes of a face on the selected display."
+  :args '((group :tag "No Defaults" :inline t
+		 (repeat :format ""
+			 :inline t
+			 (group custom-display-unselected sexp))
+		 (group (sexp :format "")
+			(custom-face-edit :tag "\n Attributes"))
+		 (repeat :format ""
+			 :inline t
+			 sexp))))
 
 (defconst custom-face-selected (widget-convert 'custom-face-selected)
   "Converted version of the `custom-face-selected' widget.")
@@ -3344,120 +3385,114 @@
 
 (defun custom-face-value-create (widget)
   "Create a list of the display specifications for WIDGET."
-  (let ((buttons (widget-get widget :buttons))
-	children
-	(symbol (widget-get widget :value))
-	(tag (widget-get widget :tag))
-	(state (widget-get widget :custom-state))
-	(begin (point))
-	(is-last (widget-get widget :custom-last))
-	(prefix (widget-get widget :custom-prefix)))
-    (unless tag
-      (setq tag (prin1-to-string symbol)))
-    (cond ((eq custom-buffer-style 'tree)
-	   (insert prefix (if is-last " `--- " " |--- "))
-	   (push (widget-create-child-and-convert
-		  widget 'custom-browse-face-tag)
-		 buttons)
-	   (insert " " tag "\n")
-	   (widget-put widget :buttons buttons))
-	  (t
-	   ;; Visibility.
-	   (push (widget-create-child-and-convert
-		  widget 'custom-visibility
-		  :help-echo "Hide or show this face."
-		  :on "Hide"
-		  :off "Show"
-		  :on-image "down"
-		  :off-image "right"
-		  :action 'custom-toggle-parent
-		  (not (eq state 'hidden)))
-		 buttons)
-	   (insert " ")
-	   ;; Create tag.
-	   (insert tag)
-	   (widget-specify-sample widget begin (point))
-	   (if (eq custom-buffer-style 'face)
-	       (insert " ")
-	     (if (string-match "face\\'" tag)
-		 (insert ":")
-	       (insert " face: ")))
-	   ;; Sample.
-	   (push (widget-create-child-and-convert widget 'item
-						  :format "(%{%t%})"
-						  :sample-face symbol
-						  :tag "sample")
-		 buttons)
-	   ;; Magic.
-	   (insert "\n")
-	   (let ((magic (widget-create-child-and-convert
-			 widget 'custom-magic nil)))
-	     (widget-put widget :custom-magic magic)
-	     (push magic buttons))
-	   ;; Update buttons.
-	   (widget-put widget :buttons buttons)
-	   ;; Insert documentation.
-	   (widget-put widget :documentation-indent 3)
-	   (widget-add-documentation-string-button
-	    widget :visibility-widget 'custom-visibility)
-
-	   ;; The comment field
-	   (unless (eq state 'hidden)
-	     (let* ((comment (get symbol 'face-comment))
-		    (comment-widget
-		     (widget-create-child-and-convert
-		      widget 'custom-comment
-		      :parent widget
-		      :value (or comment ""))))
-	       (widget-put widget :comment-widget comment-widget)
-	       (push comment-widget children)))
-	   ;; See also.
-	   (unless (eq state 'hidden)
-	     (when (eq (widget-get widget :custom-level) 1)
-	       (custom-add-parent-links widget))
-	     (custom-add-see-also widget))
-	   ;; Editor.
-	   (unless (eq (preceding-char) ?\n)
-	     (insert "\n"))
-	   (unless (eq state 'hidden)
-	     (message "Creating face editor...")
-	     (custom-load-widget widget)
-	     (unless (widget-get widget :custom-form)
-		 (widget-put widget :custom-form custom-face-default-form))
-	     (let* ((symbol (widget-value widget))
-		    (spec (or (get symbol 'customized-face)
-			      (get symbol 'saved-face)
-			      (get symbol 'face-defface-spec)
-			      ;; Attempt to construct it.
-			      (list (list t (custom-face-attributes-get
-					     symbol (selected-frame))))))
-		    (form (widget-get widget :custom-form))
-		    (indent (widget-get widget :indent))
-		    edit)
-	       ;; If the user has changed this face in some other way,
-	       ;; edit it as the user has specified it.
-	       (if (not (face-spec-match-p symbol spec (selected-frame)))
-		   (setq spec (list (list t (face-attr-construct symbol (selected-frame))))))
-	       (setq spec (custom-pre-filter-face-spec spec))
-	       (setq edit (widget-create-child-and-convert
-			   widget
-			   (cond ((and (eq form 'selected)
-				       (widget-apply custom-face-selected
-						     :match spec))
-				  (when indent (insert-char ?\  indent))
-				  'custom-face-selected)
-				 ((and (not (eq form 'lisp))
-				       (widget-apply custom-face-all
-						     :match spec))
-				  'custom-face-all)
-				 (t
-				  (when indent (insert-char ?\  indent))
-				  'sexp))
-			   :value spec))
-	       (custom-face-state-set widget)
-	       (push edit children)
-	       (widget-put widget :children children))
-	     (message "Creating face editor...done"))))))
+  (let* ((buttons (widget-get widget :buttons))
+	 (symbol  (widget-get widget :value))
+	 (tag (or (widget-get widget :tag)
+		  (prin1-to-string symbol)))
+	 (hiddenp (eq (widget-get widget :custom-state) 'hidden))
+	 children)
+
+    (if (eq custom-buffer-style 'tree)
+
+	;; Draw a tree-style `custom-face' widget
+	(progn
+	  (insert (widget-get widget :custom-prefix)
+		  (if (widget-get widget :custom-last) " `--- " " |--- "))
+	  (push (widget-create-child-and-convert
+		 widget 'custom-browse-face-tag)
+		buttons)
+	  (insert " " tag "\n")
+	  (widget-put widget :buttons buttons))
+
+      ;; Draw an ordinary `custom-face' widget
+      (let ((opoint (point)))
+	;; Visibility indicator.
+	(push (widget-create-child-and-convert
+	       widget 'custom-visibility
+	       :help-echo "Hide or show this face."
+	       :on "Hide" :off "Show"
+	       :on-image "down" :off-image "right"
+	       :action 'custom-toggle-parent
+	       (not hiddenp))
+	      buttons)
+	;; Face name (tag).
+	(insert " " tag)
+	(widget-specify-sample widget opoint (point)))
+      (insert
+       (cond ((eq custom-buffer-style 'face) " ")
+	     ((string-match "face\\'" tag)   ":")
+	     (t " face: ")))
+
+      ;; Face sample.
+      (push (widget-create-child-and-convert
+	     widget 'item
+	     :format "(%{%t%})" :sample-face symbol :tag "sample")
+	    buttons)
+      ;; Magic.
+      (insert "\n")
+      (let ((magic (widget-create-child-and-convert
+		    widget 'custom-magic nil)))
+	(widget-put widget :custom-magic magic)
+	(push magic buttons))
+
+      ;; Update buttons.
+      (widget-put widget :buttons buttons)
+
+      ;; Insert documentation.
+      (widget-put widget :documentation-indent 3)
+      (widget-add-documentation-string-button
+       widget :visibility-widget 'custom-visibility)
+      ;; The comment field
+      (unless hiddenp
+	(let* ((comment (get symbol 'face-comment))
+	       (comment-widget
+		(widget-create-child-and-convert
+		 widget 'custom-comment
+		 :parent widget
+		 :value (or comment ""))))
+	  (widget-put widget :comment-widget comment-widget)
+	  (push comment-widget children)))
+
+      ;; Editor.
+      (unless (eq (preceding-char) ?\n)
+	(insert "\n"))
+      (unless hiddenp
+	(custom-load-widget widget)
+	(unless (widget-get widget :custom-form)
+	  (widget-put widget :custom-form custom-face-default-form))
+
+	(let* ((spec (or (get symbol 'customized-face)
+			 (get symbol 'saved-face)
+			 (get symbol 'face-defface-spec)
+			 ;; Attempt to construct it.
+			 (list (list t (custom-face-attributes-get
+					symbol (selected-frame))))))
+	       (form (widget-get widget :custom-form))
+	       (indent (widget-get widget :indent))
+	       edit-widget-type edit)
+	  ;; If the user has changed this face in some other way,
+	  ;; edit it as the user has specified it.
+	  (if (not (face-spec-match-p symbol spec (selected-frame)))
+	      (setq spec `((t ,(face-attr-construct symbol
+						    (selected-frame))))))
+	  (setq spec (custom-pre-filter-face-spec spec))
+
+	  (cond ((and (eq form 'selected)
+		      (widget-apply custom-face-selected :match spec))
+		 (when indent (insert-char ?\s indent))
+		 (setq edit-widget-type 'custom-face-selected))
+		((and (not (eq form 'lisp))
+		      (widget-apply custom-face-all :match spec))
+		 (setq edit-widget-type 'custom-face-all))
+		(t
+		 (when indent
+		   (insert-char ?\s indent))
+		 (setq edit-widget-type 'sexp)))
+	  (setq edit (widget-create-child-and-convert
+		      widget edit-widget-type :value spec))
+	  (custom-face-state-set widget)
+	  (push edit children)
+	  (widget-put widget :children children))))))
 
 (defvar custom-face-menu
   `(("Set for Current Session" custom-face-set)
--- a/lisp/wid-edit.el	Thu Oct 07 22:26:11 2010 +0000
+++ b/lisp/wid-edit.el	Thu Oct 07 20:05:12 2010 -0400
@@ -2237,11 +2237,10 @@
 
 (defun widget-checklist-value-create (widget)
   ;; Insert all values
-  (let ((alist (widget-checklist-match-find widget (widget-get widget :value)))
-	(args (widget-get widget :args)))
-    (while args
-      (widget-checklist-add-item widget (car args) (assq (car args) alist))
-      (setq args (cdr args)))
+  (let ((alist (widget-checklist-match-find widget))
+	(args  (widget-get widget :args)))
+    (dolist (item args)
+      (widget-checklist-add-item widget item (assq item alist)))
     (widget-put widget :children (nreverse (widget-get widget :children)))))
 
 (defun widget-checklist-add-item (widget type chosen)
@@ -2314,9 +2313,10 @@
 		     values nil)))))
     (cons found rest)))
 
-(defun widget-checklist-match-find (widget vals)
+(defun widget-checklist-match-find (widget &optional vals)
   "Find the vals which match a type in the checklist.
 Return an alist of (TYPE MATCH)."
+  (or vals (setq vals (widget-get widget :value)))
   (let ((greedy (widget-get widget :greedy))
 	(args (copy-sequence (widget-get widget :args)))
 	found)
@@ -2809,11 +2809,10 @@
 	argument answer found)
     (while args
       (setq argument (car args)
-	    args (cdr args)
-	    answer (widget-match-inline argument vals))
-      (if answer
-	  (setq vals (cdr answer)
-		found (append found (car answer)))
+	    args     (cdr args))
+      (if (setq answer (widget-match-inline argument vals))
+	  (setq found (append found (car answer))
+		vals (cdr answer))
 	(setq vals nil
 	      args nil)))
     (if answer