Update of /project/mcclim/cvsroot/mcclim In directory common-lisp.net:/tmp/cvs-serv5799

Modified Files: gadgets.lisp Log Message: Some attempts to make the different gadget classes match look.

PUSH-BUTTON-PANE, TOGGLE-BUTTON-PANE: Changed default spacing initargs to get a better match in look.

GENERIC-OPTION-PANE: - Space is computed a little different now to match the look of the push button. - The widget size now is always square and matched to the overall height of the optione pane. - We circmumvent the flawed behavior of DRAW-TEXT* and compute the base line on our own.

Date: Tue Nov 29 14:04:16 2005 Author: gbaumann

Index: mcclim/gadgets.lisp diff -u mcclim/gadgets.lisp:1.92 mcclim/gadgets.lisp:1.93 --- mcclim/gadgets.lisp:1.92 Mon Nov 28 18:00:32 2005 +++ mcclim/gadgets.lisp Tue Nov 29 14:04:16 2005 @@ -1090,7 +1090,7 @@ :align-x :center :align-y :center :x-spacing 4 - :y-spacing 4)) + :y-spacing 2))

(defmethod compose-space ((gadget push-button-pane) &key width height) (declare (ignore width height)) @@ -1161,8 +1161,8 @@ :text-style (make-text-style :sans-serif nil nil) :align-x :left :align-y :center - :x-spacing 3 - :y-spacing 3 + :x-spacing 2 + :y-spacing 2 :background *3d-normal-color*))

(defmethod compose-space ((pane toggle-button-pane) &key width height) @@ -2257,8 +2257,9 @@ (generic-option-pane-compute-label-from-value gadget new-value)))

(defmethod generic-option-pane-widget-size (pane) - (declare (ignore pane)) - (values 22 16)) + ;; We now always make the widget occupying a square. + (let ((h (bounding-rectangle-height pane))) + (values h h)))

(defun draw-engraved-vertical-separator (pane x y0 y1 highlight-color shadow-color) (draw-line* pane (1+ x) (1+ y0) (1+ x) (1- y1) :ink highlight-color) @@ -2297,20 +2298,22 @@

(defmethod compose-space ((pane generic-option-pane) &key width height) (declare (ignore width height)) - (multiple-value-bind (w-width w-height) - (generic-option-pane-widget-size pane) - (let* ((horizontal-padding 20) - (vertical-padding 10) - (l-width (generic-option-pane-compute-max-label-width pane)) - (l-height (text-style-height (pane-text-style pane) (sheet-medium pane))) - (total-width (+ horizontal-padding l-width w-width)) - (total-height (+ vertical-padding (max l-height w-height)))) - (make-space-requirement :min-width total-width - :width total-width - :max-width +fill+ - :min-height total-height - :height total-height - :max-height total-height)))) + (let* ((horizontal-padding 8) ;### 2px border + 2px padding each side + (vertical-padding 8) ;### this should perhaps be computed from + ;### border-width and spacing. + (l-width (generic-option-pane-compute-max-label-width pane)) + (l-height (text-style-height (pane-text-style pane) (sheet-medium pane))) + (total-width (+ horizontal-padding l-width + ;; widget width + l-height + 8)) + (total-height (+ vertical-padding l-height))) + (make-space-requirement :min-width total-width + :width total-width + :max-width +fill+ + :min-height total-height + :height total-height + :max-height total-height)))

(defmethod generic-option-pane-draw-widget (pane) (with-bounding-rectangle* (x0 y0 x1 y1) pane @@ -2519,8 +2522,14 @@ (declare (ignore widget-height)) (draw-rectangle* pane x0 y0 x1 y1 :ink (effective-gadget-background pane)) (let* ((tx1 (- x1 widget-width))) - (draw-text* pane (slot-value pane 'current-label) (/ (- tx1 x0) 2) (/ (- y1 y0) 2) - :align-x :center :align-y :center)) + (draw-text* pane (slot-value pane 'current-label) + (/ (- tx1 x0) 2) + (/ (+ (- y1 y0) + (- (text-style-ascent (pane-text-style pane) pane) + (text-style-descent (pane-text-style pane) pane))) + 2) + :align-x :center + :align-y :baseline)) (generic-option-pane-draw-widget pane))))