Re: Inherited face appears as a function in customize-face buffer

[David PONCE]

>>In latest CVS Emacs the "Inherit" face attribute appears as a
>>"Function" widget in the `customize-face' buffer.
>>
>>In Emacs 21.3 it appears as expected, that is a "Face" widget allowing
>>to customize the inherited face.
>>
>>Also when adding a new inherited face its default value it initialized
>>to "default" and I got this message:
>>
>>Invalid face reference: "default"
>>
>>It is easy to reproduce:
>>
>>emacs -q -no-site-file
>>M-x customize-face RET header-line RET
>>
>>Can others confirm this behaviour?
> 
> 
> I am seeing this too.  It was caused by the change to cus-edit.el on
> 2005-02-27:
> 
>       * cus-edit.el (custom-buffer-create-internal): Improve progress msgs.
>       (custom-magic-alist): Change the status descriptions again.
>       (face widget-type): Total rewrite based on `restricted-sexp'
>       to eliminate the confusing double hiding levels.

Hi,

I made the following patch which seems to work better. WDYT?

Sincerely,
David


Index: lisp/cus-edit.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/cus-edit.el,v
retrieving revision 1.216
diff -c -r1.216 cus-edit.el
*** lisp/cus-edit.el    27 Feb 2005 21:37:03 -0000      1.216
--- lisp/cus-edit.el    30 Mar 2005 15:35:14 -0000
***************
*** 3293,3360 ****
  
  ;;; The `face' Widget.
  
! (defvar widget-face-prompt-value-history nil
!   "History of input to `widget-face-prompt-value'.")
! 
! (define-widget 'face 'restricted-sexp
!   "A Lisp face name."
!   :complete-function (lambda ()
!                      (interactive)
!                      (lisp-complete-symbol 'facep))
!   :prompt-value 'widget-field-prompt-value
!   :prompt-internal 'widget-symbol-prompt-internal
!   :prompt-match 'facep
!   :prompt-history 'widget-face-prompt-value-history
    :value-create 'widget-face-value-create
!   :action 'widget-field-action
!   :match-alternatives '(facep)
!   :validate (lambda (widget)
!             (unless (facep (widget-value widget))
!               (widget-put widget :error (format "Invalid face: %S"
!                                                 (widget-value widget)))
!               widget))
!   :value 'ignore
!   :tag "Function")
! 
! 
! ;;; There is a bug here: the sample doesn't get redisplayed
! ;;; in the new font when you specify one.  Does anyone know how to
! ;;; make that work?  -- rms.
  
  (defun widget-face-value-create (widget)
    "Create an editable face name field."
!   (let ((buttons (widget-get widget :buttons))
!       (symbol (widget-get widget :value)))
      ;; Sample.
      (push (widget-create-child-and-convert widget 'item
                                           :format "(%{%t%})"
                                           :sample-face symbol
                                           :tag "sample")
          buttons)
-     (insert " ")
      ;; Update buttons.
!     (widget-put widget :buttons buttons))
  
!   (let ((size (widget-get widget :size))
!       (value (widget-get widget :value))
!       (from (point))
!       ;; This is changed to a real overlay in `widget-setup'.  We
!       ;; need the end points to behave differently until
!       ;; `widget-setup' is called.
!       (overlay (cons (make-marker) (make-marker))))
!     (widget-put widget :field-overlay overlay)
!     (insert value)
!     (and size
!        (< (length value) size)
!        (insert-char ?\  (- size (length value))))
!     (unless (memq widget widget-field-list)
!       (setq widget-field-new (cons widget widget-field-new)))
!     (move-marker (cdr overlay) (point))
!     (set-marker-insertion-type (cdr overlay) nil)
!     (when (null size)
!       (insert ?\n))
!     (move-marker (car overlay) from)
!     (set-marker-insertion-type (car overlay) t)))
  
  
  ;;; The `hook' Widget.
--- 3293,3357 ----
  
  ;;; The `face' Widget.
  
! (define-widget 'face 'default
!   "Select and customize a face."
!   :convert-widget 'widget-value-convert-widget
!   :button-prefix 'widget-push-button-prefix
!   :button-suffix 'widget-push-button-suffix
!   :format "%{%t%}: %[select face%] %v"
!   :tag "Face"
!   :value 'default
    :value-create 'widget-face-value-create
!   :value-delete 'widget-face-value-delete
!   :value-get 'widget-value-value-get
!   :validate 'widget-children-validate
!   :action 'widget-face-action
!   :match (lambda (widget value) (symbolp value)))
  
  (defun widget-face-value-create (widget)
    "Create an editable face name field."
!   (let* ((buttons (widget-get widget :buttons))
!        (symbol (widget-value widget))
!        child)
      ;; Sample.
      (push (widget-create-child-and-convert widget 'item
                                           :format "(%{%t%})"
                                           :sample-face symbol
                                           :tag "sample")
          buttons)
      ;; Update buttons.
!     (widget-put widget :buttons buttons)
!     (insert " ")
!     ;; Face name.
!     (setq child (widget-create-child-and-convert
!                widget 'symbol
!                :format ": %v"
!                :custom-level nil
!                :value symbol))
!     ;; Update children.
!     (widget-put widget :children (list child))))
! 
! (defun widget-face-value-delete (widget)
!   "Remove the child from the options."
!   (let ((child (car (widget-get widget :children))))
!     (setq custom-options (delq child custom-options))
!     (widget-children-value-delete widget)))
! 
! (defvar widget-face-prompt-value-history nil
!   "History of entered face names.")
  
! (defun widget-face-action (widget &optional event)
!   "Prompt for a face."
!   (let ((answer (completing-read "Face: "
!                                (mapcar (lambda (face)
!                                          (list (symbol-name face)))
!                                        (face-list))
!                                nil nil nil
!                                'widget-face-prompt-value-history)))
!     (unless (zerop (length answer))
!       (widget-value-set widget (intern answer))
!       (widget-apply widget :notify widget event)
!       (widget-setup))))
  
  
  ;;; The `hook' Widget.