Those patches (was Re: Some new contributions)

From: Andrew Dorrell <andrewd_at_mountains.net.au>
Date: Thu, 03 Sep 1998 10:27:46 +1000

Erick Gallesio wrote:
>
> Andrew Dorrell writes:
>
> > PS. I have a couple of simple patches to the <Gauge> and <XPaned>
> > classes which correct minor operationsal problems with them which I
> > hope to post soon also.
> >
> Can you please send them so that I can integrate them for the next
> release. Thanks by advance
>
> -- Erick

I have attached diff files generated using:

diff orig-file modified-file > file.diff

Hope these can be used...

Allow me also to explain the modification:

1. Gauge has been modofied so that the background colour is
implemented using a second (private) box on the canvas (instead of the
canvas background colour. Why? - with the old scheme the gauge border
took on the gauge background colour rather than the parent background
colour which made things look really yucky when using gauges with
sunken borders etc.

2. Paned incorporates the modifications originally posted by Erik
which make the fration slot active. This requires the bulk patch (aka
3.99.3) in order to work.

Regards,

-- 
Mr Andrew Dorrell                                *
Faculty of Engineering             /---\  Whoo?      *
University of Technology, Sydney   (o o) /     *
AUSTRALIA                          ( : )            .
                                    ^ ^
                                                    *

41a42
> priv-bg ;; The background is also implemented as a box
49a51,57
> (background :accessor background
> :init-keyword :background
> :allocation :active
> :after-slot-set! (lambda(o v)
> (when (slot-bound? o 'priv-bg)
> ((Id o) 'itemconfigure (slot-ref o 'priv-bg)
> :fill v :outline v))))
74,76c82,85
< (fg (foreground self)))
< (slot-set! self 'highlight-thickness 0)
< (slot-set! self 'relief "raised")

---
> 	(fg (foreground self))
> 	(bg (get-keyword :background initargs (background (parent self)))))
>     (slot-set! self 'priv-bg
> 	       (Id 'create 'rectangle 0 0 0 0 :outline bg :fill bg))
78a88,90
>     (slot-set! self 'highlight-thickness (get-keyword :highlight-thickness initargs 0))
>     (slot-set! self 'relief              (get-keyword :relief initargs "raised"))
>     (slot-set! self 'background bg)
82c94
< ;;;; configure-gauge
---
> ;;;; configure-gauge (original)
84,90c96,115
< (define-method configure-gauge ((self <Gauge>))
<   (when (slot-bound? self 'priv-box)
<     (let ((width  (winfo 'width  self))
< 	  (height (winfo 'height self)))
<       ((Id self) 'coords (slot-ref self 'priv-box) 
< 	  	  0 0 
< 		  (quotient (* width (value self)) 100) height))))
---
> ;(define-method configure-gauge ((self <Gauge>))
> ;  (when (slot-bound? self 'priv-box)
> ;    (let ((width  (winfo 'width  self))
> ;	  (height (winfo 'height self)))
> ;      ((Id self) 'coords (slot-ref self 'priv-box) 
> ;	  	  0 0 
> ;		  (quotient (* width (value self)) 100) height))))
> ;; modified
>  (define-method configure-gauge ((self <Gauge>))
>    (when (slot-bound? self 'priv-box)
>      (let* ((offset (+ (border-width self) (highlight-thickness self)))
> 	    (width  (- (winfo 'width  self) offset))
> 	    (height (- (winfo 'height self) offset)))
>        ((Id self) 'coords (slot-ref self 'priv-bg)
> 	offset offset width height)
>        ((Id self) 'coords (slot-ref self 'priv-box) 
> 	offset offset
> 	(quotient (* width (value self)) 100) height)
>        ((Id self) 'itemconfigure (slot-ref self 'priv-box) :outline
> 	(if (zero? (value self)) (background self) (foreground self))))))

22c22
< ;;;; Last file update: 31-Jan-1998 16:04

---
> ;;;; Last file update: 26-Jul-1998 12:57
53a54,56
> (define-class  <Tk-active-and-propagated-metaclass>
>       (<Tk-active-metaclass> <Tk-composite-metaclass>)
>       ())
66c69,72
<    (fraction        :init-keyword :fraction)
---
>    (fraction        :accessor	  fraction
> 		    :init-keyword :fraction
> 		    :allocation   :active
> 		    :after-slot-set! (lambda(o v) (place-grip o)))
94c100,101
< 		    :propagate-to (frame))))
---
> 		    :propagate-to (frame)))
>   :metaclass <Tk-active-and-propagated-metaclass>)
186c193,196
<    (fraction     :init-keyword :fraction)
---
>    (fraction        :accessor	  fraction
> 		    :init-keyword :fraction
> 		    :allocation   :active
> 		    :after-slot-set! (lambda(o v) (place-grip o)))
214c224,225
< 		    :propagate-to (frame))))
---
> 		    :propagate-to (frame)))
>   :metaclass <Tk-active-and-propagated-metaclass>)  

Received on Thu Sep 03 1998 - 02:28:50 CEST