Further customize buffer de-cluttering

[Kim F. Storm]

This patch extends my previous patch with some cleanup of the face
customization which was not handled correctly by the previous patch.


I noticed that there is no item on the State menu to reset a face to
the standard value [with emacs -q].  Is that ok?



Index: wid-edit.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/wid-edit.el,v
retrieving revision 1.161
diff -c -r1.161 wid-edit.el
*** wid-edit.el 13 Jan 2006 19:56:10 -0000      1.161
--- wid-edit.el 14 Jan 2006 02:22:00 -0000
***************
*** 403,409 ****
      ;; We want to avoid the face with image buttons.
      (unless (widget-get widget :suppress-face)
        (overlay-put overlay 'face (widget-apply widget :button-face-get))
!       (overlay-put overlay 'mouse-face 
                   (widget-apply widget :mouse-face-get)))
      (overlay-put overlay 'pointer 'hand)
      (overlay-put overlay 'follow-link follow-link)
--- 403,409 ----
      ;; We want to avoid the face with image buttons.
      (unless (widget-get widget :suppress-face)
        (overlay-put overlay 'face (widget-apply widget :button-face-get))
!       (overlay-put overlay 'mouse-face
                   (widget-apply widget :mouse-face-get)))
      (overlay-put overlay 'pointer 'hand)
      (overlay-put overlay 'follow-link follow-link)
***************
*** 1418,1423 ****
--- 1418,1425 ----
    (call-interactively (or (widget-get widget :complete-function)
                          widget-complete-field)))
  
+ (defvar widget-choice-menu-image nil)
+ 
  (defun widget-default-create (widget)
    "Create WIDGET at point in the current buffer."
    (widget-specify-insert
***************
*** 1425,1431 ****
         button-begin button-end
         sample-begin sample-end
         doc-begin doc-end
!        value-pos)
       (insert (widget-get widget :format))
       (goto-char from)
       ;; Parse escapes in format.
--- 1427,1433 ----
         button-begin button-end
         sample-begin sample-end
         doc-begin doc-end
!        value-pos value-choice-button)
       (insert (widget-get widget :format))
       (goto-char from)
       ;; Parse escapes in format.
***************
*** 1438,1445 ****
                (setq button-begin (point))
                (insert (widget-get-indirect widget :button-prefix)))
               ((eq escape ?\])
!               (insert (widget-get-indirect widget :button-suffix))
!               (setq button-end (point)))
               ((eq escape ?\{)
                (setq sample-begin (point)))
               ((eq escape ?\})
--- 1440,1473 ----
                (setq button-begin (point))
                (insert (widget-get-indirect widget :button-prefix)))
               ((eq escape ?\])
!               (save-excursion
!                 (setq button-end (point))
!                 (when value-choice-button
!                   (goto-char button-begin)
!                   (when (search-forward ":" button-end t)
!                     (setq button-end (1- (point))))
!                   (goto-char button-end)
!                   (when (eq (preceding-char) ?\n)
!                     (backward-char 1))
!                   (insert " ")
!                   (if (display-graphic-p)
!                       (insert-image
!                        (or widget-choice-menu-image
!                            (setq widget-choice-menu-image
!                                  (create-image 
"\377\176\176\074\074\030\030\377"
!                                                'xbm t :width 8 :height 8
!                                                :foreground
!                                                (if (facep 'custom-button)
!                                                    (face-foreground 
'custom-button)
!                                                  "black")
!                                                :background
!                                                (if (facep 'custom-button)
!                                                    (face-background 
'custom-button)
!                                                  "lightgrey")
!                                                :ascent 'center))) ">")
!                     (insert (propertize "?>" )))
!                   (setq button-end (point)))
!                 (insert (widget-get-indirect widget :button-suffix))))
               ((eq escape ?\{)
                (setq sample-begin (point)))
               ((eq escape ?\})
***************
*** 1471,1476 ****
--- 1499,1507 ----
                (if (and button-begin (not button-end))
                    (widget-apply widget :value-create)
                  (setq value-pos (point))))
+              ((eq escape ?V)
+               (widget-apply widget :value-create)
+               (setq value-choice-button t))
               (t
                (widget-apply widget :format-handler escape)))))
       ;; Specify button, sample, and doc, and insert value.
***************
*** 3562,3568 ****
  (define-widget 'choice 'menu-choice
    "A union of several sexp types."
    :tag "Choice"
!   :format "%{%t%}: %[Value Menu%] %v"
    :button-prefix 'widget-push-button-prefix
    :button-suffix 'widget-push-button-suffix
    :prompt-value 'widget-choice-prompt-value)
--- 3593,3599 ----
  (define-widget 'choice 'menu-choice
    "A union of several sexp types."
    :tag "Choice"
!   :format "%{%t%}: %[%V%]"
    :button-prefix 'widget-push-button-prefix
    :button-suffix 'widget-push-button-suffix
    :prompt-value 'widget-choice-prompt-value)
***************
*** 3631,3637 ****
    :prompt-value 'widget-boolean-prompt-value
    :button-prefix 'widget-push-button-prefix
    :button-suffix 'widget-push-button-suffix
!   :format "%{%t%}: %[Toggle%]  %v\n"
    :on "on (non-nil)"
    :off "off (nil)")
  
--- 3662,3668 ----
    :prompt-value 'widget-boolean-prompt-value
    :button-prefix 'widget-push-button-prefix
    :button-suffix 'widget-push-button-suffix
!   :format "%{%t%}: %v  %[Toggle%]\n"
    :on "on (non-nil)"
    :off "off (nil)")
  

Index: cus-edit.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/cus-edit.el,v
retrieving revision 1.276
diff -c -r1.276 cus-edit.el
*** cus-edit.el 13 Jan 2006 19:47:44 -0000      1.276
--- cus-edit.el 14 Jan 2006 02:21:06 -0000
***************
*** 2519,2532 ****
                    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
--- 2519,2533 ----
                    tag)
                   buttons)
             (insert " ")
!            (unless (atom value)
!              (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
***************
*** 2546,2552 ****
        ;; this anyway. The doc string widget should be added like the others.
        ;; --dv
        (widget-put widget :buttons buttons)
!       (insert "\n")
        ;; Insert documentation.
        (widget-default-format-handler widget ?h)
  
--- 2547,2554 ----
        ;; this anyway. The doc string widget should be added like the others.
        ;; --dv
        (widget-put widget :buttons buttons)
!       (unless (eq (preceding-char) ?\n)
!       (insert "\n"))
        ;; Insert documentation.
        (widget-default-format-handler widget ?h)
  
***************
*** 2881,2887 ****
  
  (define-widget 'custom-face-edit 'checklist
    "Edit face attributes."
!   :format "%t: %v"
    :tag "Attributes"
    :extra-offset 13
    :button-args '(:help-echo "Control whether this attribute has any effect.")
--- 2883,2889 ----
  
  (define-widget 'custom-face-edit 'checklist
    "Edit face attributes."
!   :format "%t:\n             %v"
    :tag "Attributes"
    :extra-offset 13
    :button-args '(:help-echo "Control whether this attribute has any effect.")
***************
*** 3127,3150 ****
  
  (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)))))
--- 3129,3152 ----
  
  (define-widget 'custom-face-selected 'group
    "Edit the attributes of the selected display in a face specification."
!   :args '((choice :tag "Attributes" :inline t
                  (group :tag "With Defaults" :inline t
!                        (group (const :tag "" :format "%t" default)
!                               (custom-face-edit :tag "With Defaults"))
                         (repeat :format ""
                                 :inline t
                                 (group custom-display-unselected sexp))
                         (group (sexp :format "")
!                               (custom-face-edit :tag "Overriding Attributes"))
!                        (repeat :format ""
!                                :inline t
!                                sexp))
!                 (group :tag "No Defaults" :inline t
!                        (group (sexp :format "")
!                               (custom-face-edit :tag "No Defaults"))
!                        (repeat :format ""
!                                :inline t
!                                (group custom-display-unselected sexp))
                         (repeat :format ""
                                 :inline t
                                 sexp)))))
***************
*** 3292,3305 ****
                           (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)
--- 3294,3308 ----
                           (cond ((and (eq form 'selected)
                                       (widget-apply custom-face-selected
                                                     :match spec))
!                                 (when indent (insert-char ?\s indent))
                                  'custom-face-selected)
                                 ((and (not (eq form 'lisp))
                                       (widget-apply custom-face-all
                                                     :match spec))
+                                 (when indent (insert-char ?\s indent))
                                  'custom-face-all)
                                 (t
!                                 (when indent (insert-char ?\s indent))
                                  'sexp))
                           :value spec))
               (custom-face-state-set widget)

-- 
Kim F. Storm <address@hidden> http://www.cua.dk