emacs-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

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


From: David PONCE
Subject: Re: Inherited face appears as a function in customize-face buffer
Date: Mon, 4 Apr 2005 14:20:45 +0200 (CEST)

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  <address@hidden>

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






reply via email to

[Prev in Thread] Current Thread [Next in Thread]