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

[David PONCE <david.ponce@wanadoo.fr>]

[CC'd this msg again to the devel ML for help]

Hello,

>     I made the following patch which seems to work better. WDYT?
> 
> You changed the code quite a bit, so I can't quickly see what the
> user-level behavior is.  Would you please describe what has changed
> at that level?

I redid the patch more simpler. Mainly the face widget now inherits
its behavior from the symbol widget and include the sample display in
the :format specification. The sample display is now updated as you
type the face name in the input field (it is inspired of the behavior
of the color widget).

It works well excepted that sometimes, when doing M-TAB completion, I
encounter this bug:

Debugger entered--Lisp error: (args-out-of-range 1094 1094)
  get-char-property(1094 field #<buffer *Customize Face: Header Line*>)
  widget-field-end(...)
  widget-field-find(1229)
  widget-before-change(1229 1234)
  lisp-complete-symbol(facep)
  #[nil "ÀÁ!&#135;" [lisp-complete-symbol facep] 2 nil nil]()
  call-interactively(#[nil "ÀÁ!&#135;" [lisp-complete-symbol facep] 2 nil nil])
  widget-default-complete(...)
  widget-apply(... :complete)
  widget-complete()
  call-interactively(widget-complete)

I am not sure it is due to my change nor have any idea on what could
cause it.  Maybe a guru of the custom/widget internals could help?

Thanks!
David 


2005-04-01  David Ponce  <david@dponce.com>

	* cus-edit.el (face): Derive from symbol widget.  Display sample
	of the current face on the fly.
	(widget-face-sample-face-get, widget-face-notify): New functions.

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	31 Mar 2005 10:35:30 -0000
***************
*** 3296,3360 ****
  (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.
--- 3296,3332 ----
  (defvar widget-face-prompt-value-history nil
    "History of input to `widget-face-prompt-value'.")
  
! (define-widget 'face 'symbol
!   "A Lisp face name (with sample)."
!   :format "%t: (%{sample%}) %v"
!   :tag "Face"
!   :value 'default
!   :sample-face-get 'widget-face-sample-face-get
!   :notify 'widget-face-notify
!   :match (lambda (widget value) (facep value))
    :complete-function (lambda ()
  		       (interactive)
  		       (lisp-complete-symbol 'facep))
    :prompt-match 'facep
    :prompt-history 'widget-face-prompt-value-history
    :validate (lambda (widget)
  	      (unless (facep (widget-value widget))
! 		(widget-put widget
! 			    :error (format "Invalid face: %S"
! 					   (widget-value widget)))
! 		widget)))
! 
! (defun widget-face-sample-face-get (widget)
!   (let ((value (widget-value widget)))
!     (if (facep value)
! 	value
!       'default)))
! 
! (defun widget-face-notify (widget child &optional event)
!   "Update the sample, and notify the parent."
!   (overlay-put (widget-get widget :sample-overlay)
! 	       'face (widget-apply widget :sample-face-get))
!   (widget-default-notify widget child event))
  
  
  ;;; The `hook' Widget.