Mercurial > emacs

--- a/lisp/ChangeLog	Fri Mar 12 16:42:05 2010 -0500
+++ b/lisp/ChangeLog	Fri Mar 12 17:56:30 2010 -0500
@@ -1,3 +1,31 @@
+2010-03-12  Chong Yidong  <cyd@stupidchicken.com>
+
+	* cus-edit.el: Resort topmost custom groups.
+	(custom-buffer-sort-alphabetically): Default to t.
+	(customize-apropos): Use apropos-parse-pattern.
+	(custom-search-field): New var.
+	(custom-buffer-create-internal): Add custom-apropos search field.
+	(custom-add-parent-links): Don't display parent doc.
+	(custom-group-value-create): Don't sort top-level custom group.
+	(custom-magic-value-create): Show visibility button before option
+	name.
+
+	(custom-variable-state): New fun, from custom-variable-state-set.
+	(custom-variable-state-set): Use it.
+	(custom-group-value-create): Hide options with standard values
+	using the :hidden-states property.  Use progress reporter.
+
+	(custom-show): Simplify.
+	(custom-visibility): Disable images by default.
+	(custom-variable): New property :hidden-states.
+	(custom-variable-value-create): Enable images for
+	custom-visibility widgets.  Use :hidden-states property to
+	determine initial visibility.
+
+	* wid-edit.el (widget-image-find): Give images center ascent.
+	(visibility): Add :on-image and :off-image properties.
+	(widget-visibility-value-create): Use them.
+
 2010-03-12  Chong Yidong  <cyd@stupidchicken.com>

 	* cus-edit.el (processes): Remove from development group.
--- a/lisp/cus-edit.el	Fri Mar 12 16:42:05 2010 -0500
+++ b/lisp/cus-edit.el	Fri Mar 12 17:56:30 2010 -0500
@@ -166,6 +166,23 @@
   "Basic text editing facilities."
   :group 'emacs)

+(defgroup convenience nil
+  "Convenience features for faster editing."
+  :group 'emacs)
+
+(defgroup files nil
+  "Support for editing files."
+  :group 'emacs)
+
+(defgroup wp nil
+  "Support for editing text files."
+  :tag "Text"
+  :group 'emacs)
+
+(defgroup data nil
+  "Support for editing binary data files."
+  :group 'emacs)
+
 (defgroup abbrev nil
   "Abbreviation handling, typing shortcuts, macros."
   :tag "Abbreviations"
@@ -201,10 +218,6 @@
   "Process, subshell, compilation, and job control support."
   :group 'external)

-(defgroup convenience nil
-  "Convenience features for faster editing."
-  :group 'emacs)
-
 (defgroup programming nil
   "Support for programming in other languages."
   :group 'emacs)
@@ -301,18 +314,6 @@
   "Support for Emacs frames and window systems."
   :group 'environment)

-(defgroup data nil
-  "Support for editing files of data."
-  :group 'emacs)
-
-(defgroup files nil
-  "Support for editing files."
-  :group 'emacs)
-
-(defgroup wp nil
-  "Word processing."
-  :group 'emacs)
-
 (defgroup tex nil
   "Code related to the TeX formatter."
   :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces)
@@ -671,8 +672,8 @@
   :group 'custom-browse)

 ;;;###autoload
-(defcustom custom-buffer-sort-alphabetically nil
-  "If non-nil, sort each customization group alphabetically in Custom buffer."
+(defcustom custom-buffer-sort-alphabetically t
+  "Whether to sort customization groups alphabetically in Custom buffer."
   :type 'boolean
   :group 'custom-buffer)

@@ -1373,42 +1374,52 @@
       (custom-buffer-create (custom-sort-items found t nil)
 			    "*Customize Saved*"))))

+(declare-function apropos-parse-pattern "apropos" (pattern))
+
 ;;;###autoload
-(defun customize-apropos (regexp &optional all)
-  "Customize all loaded options, faces and groups matching REGEXP.
-If ALL is `options', include only options.
-If ALL is `faces', include only faces.
-If ALL is `groups', include only groups.
-If ALL is t (interactively, with prefix arg), include variables
+(defun customize-apropos (pattern &optional type)
+  "Customize all loaded options, faces and groups matching PATTERN.
+PATTERN can be a word, a list of words (separated by spaces),
+or a regexp (using some regexp special characters).  If it is a word,
+search for matches for that word as a substring.  If it is a list of words,
+search for matches for any two (or more) of those words.
+
+If TYPE is `options', include only options.
+If TYPE is `faces', include only faces.
+If TYPE is `groups', include only groups.
+If TYPE is t (interactively, with prefix arg), include variables
 that are not customizable options, as well as faces and groups
 \(but we recommend using `apropos-variable' instead)."
-  (interactive "sCustomize (regexp): \nP")
-  (let ((found nil))
-    (mapatoms (lambda (symbol)
-		(when (string-match regexp (symbol-name symbol))
-		  (when (and (not (memq all '(faces options)))
-			     (get symbol 'custom-group))
-		    (push (list symbol 'custom-group) found))
-		  (when (and (not (memq all '(options groups)))
-			     (custom-facep symbol))
-		    (push (list symbol 'custom-face) found))
-		  (when (and (not (memq all '(groups faces)))
-			     (boundp symbol)
-			     (eq (indirect-variable symbol) symbol)
-			     (or (get symbol 'saved-value)
-				 (custom-variable-p symbol)
-				 (and (not (memq all '(nil options)))
-				      (get symbol 'variable-documentation))))
-		    (push (list symbol 'custom-variable) found)))))
+  (interactive (list (apropos-read-pattern "symbol") current-prefix-arg))
+  (require 'apropos)
+  (apropos-parse-pattern pattern)
+  (let (found tests)
+    (mapatoms
+     `(lambda (symbol)
+	(when (string-match apropos-regexp (symbol-name symbol))
+	  ,(if (not (memq type '(faces options)))
+	       '(if (get symbol 'custom-group)
+		    (push (list symbol 'custom-group) found)))
+	  ,(if (not (memq type '(options groups)))
+	       '(if (custom-facep symbol)
+		    (push (list symbol 'custom-face) found)))
+	  ,(if (not (memq type '(groups faces)))
+	       `(if (and (boundp symbol)
+			 (eq (indirect-variable symbol) symbol)
+			 (or (get symbol 'saved-value)
+			     (custom-variable-p symbol)
+			     ,(if (not (memq type '(nil options)))
+				  '(get symbol 'variable-documentation))))
+		    (push (list symbol 'custom-variable) found))))))
     (if (not found)
 	(error "No %s matching %s"
-               (if (eq all t)
-                   "items"
-                 (format "customizable %s"
-                         (if (memq all '(options faces groups))
-                             (symbol-name all)
-                           "items")))
-               regexp)
+	       (if (eq type t)
+		   "items"
+		 (format "customizable %s"
+			 (if (memq type '(options faces groups))
+			     (symbol-name type)
+			   "items")))
+	       pattern)
       (custom-buffer-create
        (custom-sort-items found t custom-buffer-order-groups)
        "*Customize Apropos*"))))
@@ -1531,6 +1542,12 @@
 (defvar custom-button-pressed nil
   "Face used for pressed buttons in customization buffers.")

+(defcustom custom-search-field t
+  "If non-nil, show a search field in Custom buffers."
+  :type 'boolean
+  :version "24.1"
+  :group 'custom-buffer)
+
 (defcustom custom-raised-buttons (not (equal (face-valid-attribute-values :box)
 					     '(("unspecified" . unspecified))))
   "If non-nil, indicate active buttons in a `raised-button' style.
@@ -1554,14 +1571,9 @@
   (let ((init-file (or custom-file user-init-file)))
     ;; Insert verbose help at the top of the custom buffer.
     (when custom-buffer-verbose-help
-      (widget-insert "Editing a setting changes only the text in this buffer."
-		     (if init-file
-			 "
-To apply your changes, use the Save or Set buttons.
-Saving a change normally works by editing your init file."
-		       "
-Currently, these settings cannot be saved for future Emacs sessions,
-possibly because you started Emacs with `-q'.")
+      (widget-insert (if init-file
+			 "To apply changes, use the Save or Set buttons."
+		       "Custom settings cannot be saved; maybe you started Emacs with `-q'.")
 		     "\nFor details, see ")
       (widget-create 'custom-manual
 		     :tag "Saving Customizations"
@@ -1573,6 +1585,26 @@
 		     "(emacs)Top")
       (widget-insert "."))
     (widget-insert "\n")
+
+    ;; Insert the search field.
+    (when custom-search-field
+      (widget-insert "\n")
+      (let* ((echo "Search for custom items")
+	     (search-widget
+	      (widget-create
+	       'editable-field
+	       :size 40 :help-echo echo
+	       :action `(lambda (widget &optional event)
+			  (customize-apropos (widget-value widget))))))
+	(widget-insert " ")
+	(widget-create-child-and-convert
+	 search-widget 'push-button
+	 :tag "Search"
+	 :help-echo echo :action
+	 (lambda (widget &optional event)
+	   (customize-apropos (widget-value (widget-get widget :parent)))))
+	(widget-insert "\n")))
+
     ;; The custom command buttons are also in the toolbar, so for a
     ;; time they were not inserted in the buffer if the toolbar was in use.
     ;; But it can be a little confusing for the buffer layout to
@@ -1580,10 +1612,9 @@
     ;; mention that a custom buffer can in theory be created in a
     ;; frame with a toolbar, then later viewed in one without.
     ;; So now the buttons are always inserted in the buffer.  (Bug#1326)
-;;;    (when (not (and (bound-and-true-p tool-bar-mode) (display-graphic-p)))
     (if custom-buffer-verbose-help
-	(widget-insert "\n
- Operate on all settings in this buffer that are not marked HIDDEN:\n"))
+	(widget-insert "
+ Operate on all settings in this buffer:\n"))
     (let ((button (lambda (tag action active help icon)
 		    (widget-insert " ")
 		    (if (eval active)
@@ -1979,63 +2010,64 @@
 		   (nth 3 entry)))
 	 (form (widget-get parent :custom-form))
 	 children)
-    (while (string-match "\\`\\(.*\\)%c\\(.*\\)\\'" text)
-      (setq text (concat (match-string 1 text)
-			 (symbol-name category)
-			 (match-string 2 text))))
-    (when (and custom-magic-show
-	       (or (not hidden)
-		   (memq category custom-magic-show-hidden)))
-      (insert "   ")
+    (unless (eq state 'hidden)
+      (while (string-match "\\`\\(.*\\)%c\\(.*\\)\\'" text)
+	(setq text (concat (match-string 1 text)
+			   (symbol-name category)
+			   (match-string 2 text))))
+      (when (and custom-magic-show
+		 (or (not hidden)
+		     (memq category custom-magic-show-hidden)))
+	(insert "   ")
+	(when (and (eq category 'group)
+		   (not (and (eq custom-buffer-style 'links)
+			     (> (widget-get parent :custom-level) 1))))
+	  (insert-char ?\  (* custom-buffer-indent
+			      (widget-get parent :custom-level))))
+	(push (widget-create-child-and-convert
+	       widget 'choice-item
+	       :help-echo "Change the state of this item."
+	       :format (if hidden "%t" "%[%t%]")
+	       :button-prefix 'widget-push-button-prefix
+	       :button-suffix 'widget-push-button-suffix
+	       :mouse-down-action 'widget-magic-mouse-down-action
+	       :tag "State")
+	      children)
+	(insert ": ")
+	(let ((start (point)))
+	  (if (eq custom-magic-show 'long)
+	      (insert text)
+	    (insert (symbol-name state)))
+	  (cond ((eq form 'lisp)
+		 (insert " (lisp)"))
+		((eq form 'mismatch)
+		 (insert " (mismatch)")))
+	  (put-text-property start (point) 'face 'custom-state))
+	(insert "\n"))
       (when (and (eq category 'group)
 		 (not (and (eq custom-buffer-style 'links)
 			   (> (widget-get parent :custom-level) 1))))
 	(insert-char ?\  (* custom-buffer-indent
 			    (widget-get parent :custom-level))))
-      (push (widget-create-child-and-convert
-	     widget 'choice-item
-	     :help-echo "Change the state of this item."
-	     :format (if hidden "%t" "%[%t%]")
-	     :button-prefix 'widget-push-button-prefix
-	     :button-suffix 'widget-push-button-suffix
-	     :mouse-down-action 'widget-magic-mouse-down-action
-	     :tag "State")
-	    children)
-      (insert ": ")
-      (let ((start (point)))
-	(if (eq custom-magic-show 'long)
-	    (insert text)
-	  (insert (symbol-name state)))
-	(cond ((eq form 'lisp)
-	       (insert " (lisp)"))
-	      ((eq form 'mismatch)
-	       (insert " (mismatch)")))
-	(put-text-property start (point) 'face 'custom-state))
-      (insert "\n"))
-    (when (and (eq category 'group)
-	       (not (and (eq custom-buffer-style 'links)
-			 (> (widget-get parent :custom-level) 1))))
-      (insert-char ?\  (* custom-buffer-indent
-			  (widget-get parent :custom-level))))
-    (when custom-magic-show-button
-      (when custom-magic-show
-	(let ((indent (widget-get parent :indent)))
-	  (when indent
-	    (insert-char ?  indent))))
-      (push (widget-create-child-and-convert
-	     widget 'choice-item
-	     :mouse-down-action 'widget-magic-mouse-down-action
-	     :button-face face
-	     :button-prefix ""
-	     :button-suffix ""
-	     :help-echo "Change the state."
-	     :format (if hidden "%t" "%[%t%]")
-	     :tag (if (memq form '(lisp mismatch))
-		      (concat "(" magic ")")
-		    (concat "[" magic "]")))
-	    children)
-      (insert " "))
-    (widget-put widget :children children)))
+      (when custom-magic-show-button
+	(when custom-magic-show
+	  (let ((indent (widget-get parent :indent)))
+	    (when indent
+	      (insert-char ?  indent))))
+	(push (widget-create-child-and-convert
+	       widget 'choice-item
+	       :mouse-down-action 'widget-magic-mouse-down-action
+	       :button-face face
+	       :button-prefix ""
+	       :button-suffix ""
+	       :help-echo "Change the state."
+	       :format (if hidden "%t" "%[%t%]")
+	       :tag (if (memq form '(lisp mismatch))
+			(concat "(" magic ")")
+		      (concat "[" magic "]")))
+	      children)
+	(insert " "))
+      (widget-put widget :children children))))

 (defun custom-magic-reset (widget)
   "Redraw the :custom-magic property of WIDGET."
@@ -2197,12 +2229,9 @@
 (defun custom-show (widget value)
   "Non-nil if WIDGET should be shown with VALUE by default."
   (let ((show (widget-get widget :custom-show)))
-    (cond ((null show)
-	   nil)
-	  ((eq t show)
-	   t)
-	  (t
-	   (funcall show widget value)))))
+    (if (functionp show)
+	(funcall show widget value)
+      show)))

 (defun custom-load-widget (widget)
   "Load all dependencies for WIDGET."
@@ -2280,8 +2309,7 @@
 	       (insert ", "))))
       (widget-put widget :buttons buttons))))

-(defun custom-add-parent-links (widget &optional initial-string
-				       doc-initial-string)
+(defun custom-add-parent-links (widget &optional initial-string doc-initial-string)
   "Add \"Parent groups: ...\" to WIDGET if the group has parents.
 The value is non-nil if any parents were found.
 If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"."
@@ -2300,36 +2328,6 @@
 			 symbol)
 			buttons)
 		  (setq parents (cons symbol parents)))))
-    (and (null (get name 'custom-links)) ;No links of its own.
-         (= (length parents) 1)         ;A single parent.
-         (let* ((links (delq nil (mapcar (lambda (w)
-					   (unless (eq (widget-type w)
-						       'custom-group-link)
-					     w))
-					 (get (car parents) 'custom-links))))
-                (many (> (length links) 2)))
-           (when links
-             (let ((pt (point))
-                   (left-margin (+ left-margin 2)))
-	       (insert "\n" (or doc-initial-string "Group documentation:") " ")
-	       (while links
-		 (push (widget-create-child-and-convert
-			widget (car links)
-			:button-face 'custom-link
-			:mouse-face 'highlight
-			:pressed-face 'highlight)
-		       buttons)
-		 (setq links (cdr links))
-		 (cond ((null links)
-			(insert ".\n"))
-		       ((null (cdr links))
-			(if many
-			    (insert ", and ")
-			  (insert " and ")))
-		       (t
-                        (insert ", "))))
-               (fill-region-as-paragraph pt (point))
-               (delete-to-left-margin (1+ pt) (+ pt 2))))))
     (if parents
         (insert "\n")
       (delete-region start (point)))
@@ -2404,8 +2402,6 @@

 ;;; The `custom-variable' Widget.

-;; When this was underlined blue, users confused it with a
-;; Mosaic-style hyperlink...
 (defface custom-variable-tag
   `((((class color)
       (background dark))
@@ -2450,7 +2446,11 @@
     (documentation-property variable 'variable-documentation)))

 (define-widget 'custom-variable 'custom
-  "Customize variable."
+  "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."
   :format "%v"
   :help-echo "Set or reset this variable."
   :documentation-property #'custom-variable-documentation
@@ -2460,6 +2460,7 @@
   :custom-form nil ; defaults to value of `custom-variable-default-form'
   :value-create 'custom-variable-value-create
   :action 'custom-variable-action
+  :hidden-states '(standard)
   :custom-set 'custom-variable-set
   :custom-mark-to-save 'custom-variable-mark-to-save
   :custom-reset-current 'custom-redraw
@@ -2494,7 +2495,6 @@
   (let* ((buttons (widget-get widget :buttons))
 	 (children (widget-get widget :children))
 	 (form (widget-get widget :custom-form))
-	 (state (widget-get widget :custom-state))
 	 (symbol (widget-get widget :value))
 	 (tag (widget-get widget :tag))
 	 (type (custom-variable-type symbol))
@@ -2504,17 +2504,17 @@
 	 (last (widget-get widget :custom-last))
 	 (value (if (default-boundp symbol)
 		    (funcall get symbol)
-		  (widget-get conv :value))))
-    ;; If the widget is new, the child determines whether it is hidden.
-    (cond (state)
-	  ((custom-show type value)
-	   (setq state 'unknown))
-	  (t
-	   (setq state 'hidden)))
+		  (widget-get conv :value)))
+	 (state (or (widget-get widget :custom-state)
+		    (if (memq (custom-variable-state symbol value)
+			      (widget-get widget :hidden-states))
+			'hidden))))
+
     ;; If we don't know the state, see if we need to edit it in lisp form.
+    (unless state
+      (setq state (if (custom-show type value) 'unknown 'hidden)))
     (when (eq state 'unknown)
       (unless (widget-apply conv :match value)
-	;; (widget-apply (widget-convert type) :match value)
 	(setq form 'mismatch)))
     ;; Now we can create the child widget.
     (cond ((eq custom-buffer-style 'tree)
@@ -2527,21 +2527,36 @@
 	  ((eq state 'hidden)
 	   ;; Indicate hidden value.
 	   (push (widget-create-child-and-convert
+		  widget 'custom-visibility
+		  :help-echo "Show the value of this option."
+		  :on-image "down"
+		  :on "Hide"
+		  :off-image "right"
+		  :off "Show Value"
+		  :action 'custom-toggle-parent
+		  nil)
+		 buttons)
+	   (insert " ")
+	   (push (widget-create-child-and-convert
 		  widget 'item
-		  :format "%{%t%}: "
+		  :format "%{%t%} "
 		  :sample-face 'custom-variable-tag
 		  :tag tag
 		  :parent widget)
-		 buttons)
-	   (push (widget-create-child-and-convert
-		  widget 'visibility
-		  :help-echo "Show the value of this option."
-		  :off "Show Value"
-		  :action 'custom-toggle-parent
-		  nil)
 		 buttons))
 	  ((memq form '(lisp mismatch))
 	   ;; In lisp mode edit the saved value when possible.
+	   (push (widget-create-child-and-convert
+		  widget 'custom-visibility
+		  :help-echo "Hide the value of this option."
+		  :on "Hide"
+		  :off "Show"
+		  :on-image "down"
+		  :off-image "right"
+		  :action 'custom-toggle-parent
+		  t)
+		 buttons)
+	   (insert " ")
 	   (let* ((value (cond ((get symbol 'saved-value)
 				(car (get symbol 'saved-value)))
 			       ((get symbol 'standard-value)
@@ -2552,15 +2567,6 @@
 				(custom-quote (widget-get conv :value))))))
 	     (insert (symbol-name symbol) ": ")
 	     (push (widget-create-child-and-convert
-		    widget 'visibility
-		    :help-echo "Hide the value of this option."
-		    :on "Hide Value"
-		    :off "Show Value"
-		    :action 'custom-toggle-parent
-		    t)
-		   buttons)
-	     (insert " ")
-	     (push (widget-create-child-and-convert
 		    widget 'sexp
 		    :button-face 'custom-variable-button-face
 		    :format "%v"
@@ -2570,6 +2576,17 @@
 		   children)))
 	  (t
 	   ;; Edit mode.
+	   (push (widget-create-child-and-convert
+		  widget 'custom-visibility
+		  :help-echo "Hide or show this option."
+		  :on "Hide"
+		  :off "Show"
+		  :on-image "down"
+		  :off-image "right"
+		  :action 'custom-toggle-parent
+		  t)
+		 buttons)
+	   (insert " ")
 	   (let* ((format (widget-get type :format))
 		  tag-format value-format)
 	     (unless (string-match ":" format)
@@ -2586,15 +2603,6 @@
 		    :sample-face 'custom-variable-tag
 		    tag)
 		   buttons)
-	     (insert " ")
-	     (push (widget-create-child-and-convert
-		    widget 'visibility
-		    :help-echo "Hide the value of this option."
-		    :on "Hide Value"
-		    :off "Show Value"
-		    :action 'custom-toggle-parent
-		    t)
-		   buttons)
 	     (push (widget-create-child-and-convert
 		    widget type
 		    :format value-format
@@ -2626,7 +2634,7 @@
 	  ;; Don't push it !!! Custom assumes that the first child is the
 	  ;; value one.
 	  (setq children (append children (list comment-widget)))))
-      ;; Update the rest of the properties properties.
+      ;; Update the rest of the properties.
       (widget-put widget :custom-form form)
       (widget-put widget :children children)
       ;; Now update the state.
@@ -2649,61 +2657,69 @@
   (apply 'widget-apply (car (widget-get (widget-get widget :parent) :children))
 	 :mouse-down-action args))

-(defun custom-variable-state-set (widget)
-  "Set the state of WIDGET."
-  (let* ((symbol (widget-value widget))
-	 (get (or (get symbol 'custom-get) 'default-value))
+(defun custom-variable-state (symbol val)
+  "Return the state of SYMBOL if its value is VAL.
+If SYMBOL has a non-nil `custom-get' property, it overrides VAL.
+Possible return values are `standard', `saved', `set', `themed',
+`changed', and `rogue'."
+  (let* ((get (or (get symbol 'custom-get) 'default-value))
 	 (value (if (default-boundp symbol)
 		    (funcall get symbol)
-		  (widget-get widget :value)))
+		  val))
 	 (comment (get symbol 'variable-comment))
 	 tmp
-	 temp
-	 (state (cond ((progn (setq tmp (get symbol 'customized-value))
-			      (setq temp
-				    (get symbol 'customized-variable-comment))
-			      (or tmp temp))
-		       (if (condition-case nil
-			       (and (equal value (eval (car tmp)))
-				    (equal comment temp))
-			     (error nil))
-			   'set
-			 'changed))
-		      ((progn (setq tmp (get symbol 'theme-value))
-			      (setq temp (get symbol 'saved-variable-comment))
-			      (or tmp temp))
-		       (if (condition-case nil
-			       (and (equal comment temp)
-				    (equal value
-					   (eval
-					    (car (custom-variable-theme-value
-						  symbol)))))
-			     (error nil))
-			   (cond
-			    ((eq (caar tmp) 'user) 'saved)
-			    ((eq (caar tmp) 'changed)
-                             (if (condition-case nil
-                                     (and (null comment)
-                                          (equal value
-                                                 (eval
-                                                  (car (get symbol 'standard-value)))))
-                                   (error nil))
-                                 ;; The value was originally set outside
-                                 ;; custom, but it was set to the standard
-                                 ;; value (probably an autoloaded defcustom).
-                                 'standard
-                               'changed))
-			    (t 'themed))
-			 'changed))
-		      ((setq tmp (get symbol 'standard-value))
-		       (if (condition-case nil
-			       (and (equal value (eval (car tmp)))
-				    (equal comment nil))
-			     (error nil))
-			   'standard
-			 'changed))
-		      (t 'rogue))))
-    (widget-put widget :custom-state state)))
+	 temp)
+    (cond ((progn (setq tmp (get symbol 'customized-value))
+		  (setq temp
+			(get symbol 'customized-variable-comment))
+		  (or tmp temp))
+	   (if (condition-case nil
+		   (and (equal value (eval (car tmp)))
+			(equal comment temp))
+		 (error nil))
+	       'set
+	     'changed))
+	  ((progn (setq tmp (get symbol 'theme-value))
+		  (setq temp (get symbol 'saved-variable-comment))
+		  (or tmp temp))
+	   (if (condition-case nil
+		   (and (equal comment temp)
+			(equal value
+			       (eval
+				(car (custom-variable-theme-value
+				      symbol)))))
+		 (error nil))
+	       (cond
+		((eq (caar tmp) 'user) 'saved)
+		((eq (caar tmp) 'changed)
+		 (if (condition-case nil
+			 (and (null comment)
+			      (equal value
+				     (eval
+				      (car (get symbol 'standard-value)))))
+		       (error nil))
+		     ;; The value was originally set outside
+		     ;; custom, but it was set to the standard
+		     ;; value (probably an autoloaded defcustom).
+		     'standard
+		   'changed))
+		(t 'themed))
+	     'changed))
+	  ((setq tmp (get symbol 'standard-value))
+	   (if (condition-case nil
+		   (and (equal value (eval (car tmp)))
+			(equal comment nil))
+		 (error nil))
+	       'standard
+	     'changed))
+	  (t 'rogue))))
+
+(defun custom-variable-state-set (widget &optional state)
+  "Set the state of WIDGET to STATE.
+If STATE is nil, the value is computed by `custom-variable-state'."
+  (widget-put widget :custom-state
+	      (or state (custom-variable-state (widget-value widget)
+					       (widget-get widget :value)))))

 (defun custom-variable-standard-value (widget)
   (get (widget-value widget) 'standard-value))
@@ -2989,7 +3005,9 @@
   :button-face 'custom-visibility
   :pressed-face 'custom-visibility
   :mouse-face 'highlight
-  :pressed-face 'highlight)
+  :pressed-face 'highlight
+  :on-image nil
+  :off-image nil)

 (defface custom-visibility
   '((t :height 0.8 :inherit link))
@@ -3336,6 +3354,18 @@
 	   (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))
@@ -3350,16 +3380,6 @@
 						  :sample-face symbol
 						  :tag "sample")
 		 buttons)
-	   ;; Visibility.
-	   (insert " ")
-	   (push (widget-create-child-and-convert
-		  widget 'visibility
-		  :help-echo "Hide or show this face."
-		  :on "Hide Face"
-		  :off "Show Face"
-		  :action 'custom-toggle-parent
-		  (not (eq state 'hidden)))
-		 buttons)
 	   ;; Magic.
 	   (insert "\n")
 	   (let ((magic (widget-create-child-and-convert
@@ -3911,8 +3931,11 @@
 	     (insert " " tag "\n")
 	     (widget-put widget :buttons buttons)
 	     (message "Creating group...")
-	     (let* ((members (custom-sort-items members
-			      custom-browse-sort-alphabetically
+	     (let* ((members (custom-sort-items
+			      members
+			      ;; Never sort the top-level custom group.
+			      (unless (eq symbol 'emacs)
+				custom-browse-sort-alphabetically)
 			      custom-browse-order-groups))
 		    (prefixes (widget-get widget :custom-prefixes))
 		    (custom-prefix-list (custom-prefix-add symbol prefixes))
@@ -3970,17 +3993,21 @@

 	  ;; Nested style.
 	  (t				;Visible.
+	   ;; Draw a horizontal line (this works for both graphical
+	   ;; and text displays):
+	   (let ((p (point)))
+	     (insert "\n")
+	     (put-text-property p (1+ p) 'face '(:underline t))
+	     (overlay-put (make-overlay p (1+ p))
+			  'before-string
+			  (propertize "\n" 'face '(:underline t)
+				      'display '(space :align-to 999))))
+
 	   ;; Add parent groups references above the group.
-	   (if t    ;;; This should test that the buffer
-		    ;;; was made to display a group.
-	       (when (eq level 1)
-		 (if (custom-add-parent-links widget
-					      "Parent groups:"
-					      "Parent group documentation:")
-		     (insert "\n"))))
-	   ;; Create level indicator.
+	   (when (eq level 1)
+	     (if (custom-add-parent-links widget "Parent groups:")
+		 (insert "\n")))
 	   (insert-char ?\  (* custom-buffer-indent (1- level)))
-	   (insert "/- ")
 	   ;; Create tag.
 	   (let ((start (point)))
 	     (insert tag " group: ")
@@ -4000,12 +4027,7 @@
 		    (not (eq state 'hidden)))
 		   buttons)
 	     (insert " "))
-	   ;; Create more dashes.
-	   ;; Use 76 instead of 75 to compensate for the temporary "<"
-	   ;; added by `widget-insert'.
-	   (insert-char ?- (- 76 (current-column)
-			      (* custom-buffer-indent level)))
-	   (insert "\\\n")
+	   (insert "\n")
 	   ;; Create magic button.
 	   (let ((magic (widget-create-child-and-convert
 			 widget 'custom-magic
@@ -4031,43 +4053,50 @@
 					     ?\ ))
 	   ;; Members.
 	   (message "Creating group...")
-	   (let* ((members (custom-sort-items members
-					      custom-buffer-sort-alphabetically
-					      custom-buffer-order-groups))
+	   (let* ((members (custom-sort-items
+			    members
+			    ;; Never sort the top-level custom group.
+			    (unless (eq symbol 'emacs)
+			      custom-buffer-sort-alphabetically)
+			    custom-buffer-order-groups))
 		  (prefixes (widget-get widget :custom-prefixes))
 		  (custom-prefix-list (custom-prefix-add symbol prefixes))
-		  (length (length members))
+		  (len (length members))
 		  (count 0)
-		  (children (mapcar (lambda (entry)
-				      (widget-insert "\n")
-				      (message "\
-Creating group members... %2d%%"
-					       (/ (* 100.0 count) length))
-				      (setq count (1+ count))
-				      (prog1
-					  (widget-create-child-and-convert
-					   widget (nth 1 entry)
-					   :group widget
-					   :tag (custom-unlispify-tag-name
-						 (nth 0 entry))
-					   :custom-prefixes custom-prefix-list
-					   :custom-level (1+ level)
-					   :value (nth 0 entry))
-					(unless (eq (preceding-char) ?\n)
-					  (widget-insert "\n"))))
-				    members)))
-	     (message "Creating group magic...")
+		  (reporter (make-progress-reporter
+			     "Creating group entries..." 0 len))
+		  children)
+	     (setq children
+		   (mapcar
+		    (lambda (entry)
+		      (widget-insert "\n")
+		      (progress-reporter-update reporter (setq count (1+ count)))
+		      (let ((sym (nth 0 entry))
+			    (type (nth 1 entry))
+			    hidden-p)
+			(prog1
+			    (widget-create-child-and-convert
+			     widget type
+			     :group widget
+			     :tag (custom-unlispify-tag-name sym)
+			     :custom-prefixes custom-prefix-list
+			     :custom-level (1+ level)
+			     :value sym)
+			  (unless (eq (preceding-char) ?\n)
+			    (widget-insert "\n")))))
+		    members))
 	     (mapc 'custom-magic-reset children)
-	     (message "Creating group state...")
 	     (widget-put widget :children children)
 	     (custom-group-state-update widget)
-	     (message "Creating group... done"))
+	     (progress-reporter-done reporter))
 	   ;; End line
-	   (insert "\n")
-	   (insert-char ?\  (* custom-buffer-indent (1- level)))
-	   (insert "\\- " (widget-get widget :tag) " group end ")
-	   (insert-char ?- (- 75 (current-column) (* custom-buffer-indent level)))
-	   (insert "/\n")))))
+	   (let ((p (point)))
+	     (insert "\n")
+	     (put-text-property p (1+ p) 'face '(:underline t))
+	     (overlay-put (make-overlay p (1+ p))
+			  'before-string
+			  (propertize "\n" 'face '(:underline t)
+				      'display '(space :align-to 999))))))))

 (defvar custom-group-menu
   `(("Set for Current Session" custom-group-set
--- a/lisp/wid-edit.el	Fri Mar 12 16:42:05 2010 -0500
+++ b/lisp/wid-edit.el	Fri Mar 12 17:56:30 2010 -0500
@@ -639,8 +639,7 @@
 	   (dolist (elt widget-image-conversion)
 	     (dolist (ext (cdr elt))
 	       (push (list :type (car elt) :file (concat image ext)) specs)))
-	   (setq specs (nreverse specs))
-	   (find-image specs)))
+ 	   (find-image (nreverse specs))))
 	(t
 	 ;; Oh well.
 	 nil)))
@@ -2806,11 +2805,19 @@
 ;;; The `visibility' Widget.

 (define-widget 'visibility 'item
-  "An indicator and manipulator for hidden items."
+  "An indicator and manipulator for hidden items.
+
+The following properties have special meanings for this widget:
+:on-image  Image filename or spec to display when the item is visible.
+:on        Text shown if the \"on\" image is nil or cannot be displayed.
+:off-image Image filename or spec to display when the item is hidden.
+:off       Text shown if the \"off\" image is nil cannot be displayed."
   :format "%[%v%]"
   :button-prefix ""
   :button-suffix ""
+  :on-image "down"
   :on "Hide"
+  :off-image "right"
   :off "Show"
   :value-create 'widget-visibility-value-create
   :action 'widget-toggle-action
@@ -2818,21 +2825,17 @@

 (defun widget-visibility-value-create (widget)
   ;; Insert text representing the `on' and `off' states.
-  (let ((on (widget-get widget :on))
-	(off (widget-get widget :off)))
-    (if on
-	(setq on (concat widget-push-button-prefix
-			 on
-			 widget-push-button-suffix))
-      (setq on ""))
-    (if off
-	(setq off (concat widget-push-button-prefix
-			  off
-			  widget-push-button-suffix))
-      (setq off ""))
-    (if (widget-value widget)
-	(widget-image-insert widget on "down" "down-pushed")
-      (widget-image-insert widget off "right" "right-pushed"))))
+  (let* ((val (widget-value widget))
+	 (text (widget-get widget (if val :on :off)))
+	 (img (widget-image-find
+	       (widget-get widget (if val :on-image :off-image)))))
+    (widget-image-insert widget
+			 (if text
+			     (concat widget-push-button-prefix text
+				     widget-push-button-suffix)
+			   "")
+			 (if img
+			     (append img '(:ascent center))))))

 ;;; The `documentation-link' Widget.
 ;;
@@ -2935,7 +2938,7 @@
 		(widget-create-child-and-convert
 		 widget (widget-get widget :visibility-widget)
 		 :help-echo "Show or hide rest of the documentation."
-		 :on "Hide Rest"
+		 :on "Hide"
 		 :off "More"
 		 :always-active t
 		 :action 'widget-parent-action