unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
* Re: Inherited face appears as a function in customize-face buffer
@ 2005-04-05  6:43 David PONCE
  2005-04-06  9:21 ` Ralf Angeli
  0 siblings, 1 reply; 9+ messages in thread
From: David PONCE @ 2005-04-05  6:43 UTC (permalink / raw)
  Cc: emacs-pretest-bug, emacs-devel

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

^ permalink raw reply	[flat|nested] 9+ messages in thread
* Re: Inherited face appears as a function in customize-face buffer
@ 2005-04-04 12:20 David PONCE
  2005-04-05  4:22 ` Richard Stallman
  0 siblings, 1 reply; 9+ messages in thread
From: David PONCE @ 2005-04-04 12:20 UTC (permalink / raw)
  Cc: emacs-pretest-bug, emacs-devel

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

^ permalink raw reply	[flat|nested] 9+ messages in thread
* Re: Inherited face appears as a function in customize-face buffer
@ 2005-04-01  8:49 David PONCE
  0 siblings, 0 replies; 9+ messages in thread
From: David PONCE @ 2005-04-01  8:49 UTC (permalink / raw)
  Cc: emacs-pretest-bug, emacs-devel

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.

^ permalink raw reply	[flat|nested] 9+ messages in thread
* Re: Inherited face appears as a function in customize-face buffer
@ 2005-04-01  8:40 David PONCE
  2005-04-02  4:19 ` Richard Stallman
  0 siblings, 1 reply; 9+ messages in thread
From: David PONCE @ 2005-04-01  8:40 UTC (permalink / raw)
  Cc: emacs-pretest-bug, emacs-devel

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

^ permalink raw reply	[flat|nested] 9+ messages in thread
* Inherited face appears as a function in customize-face buffer
@ 2005-03-27  9:28 David Ponce
  0 siblings, 0 replies; 9+ messages in thread
From: David Ponce @ 2005-03-27  9:28 UTC (permalink / raw)
  Cc: Emacs Devel

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

^ permalink raw reply	[flat|nested] 9+ messages in thread

end of thread, other threads:[~2005-04-06 11:43 UTC | newest]

Thread overview: 9+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2005-04-05  6:43 Inherited face appears as a function in customize-face buffer David PONCE
2005-04-06  9:21 ` Ralf Angeli
2005-04-06 11:43   ` Ralf Angeli
  -- strict thread matches above, loose matches on Subject: below --
2005-04-04 12:20 David PONCE
2005-04-05  4:22 ` Richard Stallman
2005-04-01  8:49 David PONCE
2005-04-01  8:40 David PONCE
2005-04-02  4:19 ` Richard Stallman
2005-03-27  9:28 David Ponce

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).