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

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

Hello,

> 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?

I think I finally found the cause of the above bug.  It is due to a
side effect of the field narrowing done in `widget-complete' and the
call to `widget-field-end' (so to `get-char-property') done via the
`before-change-functions' hook `widget-before-change'.

I fixed that by temporarily removing field narrowing in
`widget-field-end' before to call `get-char-property'.

Here is a new complete patch that seems to work great now.  WDYT?

Sincerely,
David

2005-04-04  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.
	(widget-face-value-create): Remove.

	* wid-edit.el (widget-field-end): Temporarily remove field
	narrowing before to call `get-char-property'.

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	4 Apr 2005 12:14:37 -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.
Index: lisp/wid-edit.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/wid-edit.el,v
retrieving revision 1.136
diff -c -r1.136 wid-edit.el
*** lisp/wid-edit.el	29 Jan 2005 17:21:12 -0000	1.136
--- lisp/wid-edit.el	4 Apr 2005 12:14:44 -0000
***************
*** 1185,1193 ****
      ;; or if a special `boundary' field has been added after the widget
      ;; field.
      (if (overlayp overlay)
! 	(if (and (not (eq (get-char-property (overlay-end overlay)
! 					     'field
! 					     (widget-field-buffer widget))
  			  'boundary))
  		 (or widget-field-add-space
  		     (null (widget-get widget :size))))
--- 1185,1201 ----
      ;; or if a special `boundary' field has been added after the widget
      ;; field.
      (if (overlayp overlay)
! 	(if (and (not (eq (with-current-buffer
! 			      (widget-field-buffer widget)
! 			    (save-restriction
! 			      ;; `widget-narrow-to-field' can be
! 			      ;; active when this function is called
! 			      ;; from an change-functions hook. So
! 			      ;; temporarily remove field narrowing
! 			      ;; before to call `get-char-property'.
! 			      (widen)
! 			      (get-char-property (overlay-end overlay)
! 						 'field)))
  			  'boundary))
  		 (or widget-field-add-space
  		     (null (widget-get widget :size))))