Inherited face appears as a function in customize-face buffer

Inherited face appears as a function in customize-face buffer

[David Ponce]

Hi,

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?

Thanks!
Sincerely,
David

In GNU Emacs 22.0.50.7 (i686-pc-linux-gnu, GTK+ Version 2.4.14)
  of 2005-03-27 on localhost
Distributor `The X.Org Foundation', version 11.0.60700000
configured using `configure '--with-gtk'

Important settings:
   value of $LC_ALL: nil
   value of $LC_COLLATE: nil
   value of $LC_CTYPE: nil
   value of $LC_MESSAGES: nil
   value of $LC_MONETARY: nil
   value of $LC_NUMERIC: nil
   value of $LC_TIME: nil
   value of $LANG: en_US.UTF-8
   locale-coding-system: utf-8
   default-enable-multibyte-characters: t

Major mode: Custom

Minor modes in effect:
   tooltip-mode: t
   tool-bar-mode: t
   mouse-wheel-mode: t
   menu-bar-mode: t
   blink-cursor-mode: t
   unify-8859-on-encoding-mode: t
   utf-translate-cjk-mode: t
   line-number-mode: t

Recent messages:
Resetting customization items...done
Creating customization setup...done
Invalid face reference: "default" [16 times]
Creating customization items...
Creating face editor...done
Creating customization items ...done
Resetting customization items...done
Creating customization setup...done
Invalid face reference: "default" [3 times]
Loading emacsbug...done

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

[David PONCE]

[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.

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

[David PONCE]

Oops! here is the correct change log. Sorry!

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

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

[Richard Stallman]

    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 hope we have one.  I don't know any more about this code than you
do; probably less, since I have had more time to forget.

The experience of Custom has confirmed my previous negative opinion of
object oriented programming.  I think it would be a lot easier to
maintain Custom if it were rewritten not to use widgets.  However, we
can't do that before the coming release.

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

[David PONCE]

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

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

[Richard Stallman]

It looks clean to me.  I have never understood widgets very well,
so I don't know whether it is correct.  But if it seems to work
better than the present code, it must be a step forward.

I wish someone here had enough expertise to be able to
assure us it is correct--but I think nobody does.

So would someone please install the change?
And thanks.

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

[David PONCE]

Hi,

> It looks clean to me.  I have never understood widgets very well,
> so I don't know whether it is correct.  But if it seems to work
> better than the present code, it must be a step forward.
> 
> I wish someone here had enough expertise to be able to
> assure us it is correct--but I think nobody does.
> 
> So would someone please install the change?
> And thanks.

I installed the change.

David

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

[Ralf Angeli]

* David PONCE (2005-04-05) writes:

>> It looks clean to me.  I have never understood widgets very well,
>> so I don't know whether it is correct.  But if it seems to work
>> better than the present code, it must be a step forward.
>> 
>> I wish someone here had enough expertise to be able to
>> assure us it is correct--but I think nobody does.
>> 
>> So would someone please install the change?
>> And thanks.
>
> I installed the change.

Thanks!

I just compared this functionality in CVS Emacs with Emacs 21.  In
Emacs 21 it is easier to select a face because there is this "Select
Face" button which presents you with a minibuffer prompt including
auto-completion of face names.  Additionally you can change the faced
used for inheritance right away.

The latter functionality is not so important for me and can lead to
strange results if click on all the "Show" buttons for faces with
multiple nested inheritance (the `font-latex-title-*-face' faces in
AUCTeX are an example for this).  But it would be very nice to have
the completion mechanism back and maybe a link to the face used for
inheritance in case it should not be displayed right away as in Emacs
21.

-- 
Ralf

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

[Ralf Angeli]

* Ralf Angeli (2005-04-06) writes:

> I just compared this functionality in CVS Emacs with Emacs 21.  In
> Emacs 21 it is easier to select a face because there is this "Select
> Face" button which presents you with a minibuffer prompt including
> auto-completion of face names.  Additionally you can change the faced
> used for inheritance right away.

I just recognized that completion is working with `ESC TAB' and
`M-C-i' (`M-TAB' is taken by the window manager).  So this is at least
something.

-- 
Ralf