Update of /project/mcclim/cvsroot/mcclim/Looks In directory clnet:/tmp/cvs-serv18507

Modified Files: pixie.lisp Log Message: Clean up the Pixie look. Make explicit which panes are implemented by pixie, rather than hacks involving find-symbol. Disable ugly menubar. Cleanup grungy pixels on the shadows of buttons, scroll-bars, and the slider gadget.

--- /project/mcclim/cvsroot/mcclim/Looks/pixie.lisp 2006/03/29 10:43:50 1.16 +++ /project/mcclim/cvsroot/mcclim/Looks/pixie.lisp 2006/12/19 04:07:15 1.17 @@ -19,7 +19,25 @@ (defclass pixie-look (frame-manager) ()) #+clx (defclass pixie/clx-look (pixie-look clim-clx::clx-frame-manager) ())

-; our stub inside clim proper + +(defmacro define-pixie-gadget (abstract-type pixie-type &key (enabled t)) + `(defmethod make-pane-1 ((fm pixie-look) + (frame application-frame) + (type (eql ',abstract-type)) + &rest args) + (declare (ignorable fm frame type args)) + (format *trace-output* "~& make-pane-1 ~A => ~A~%" ',abstract-type ',pixie-type) + ,(if enabled + `(apply #'make-instance + ',pixie-type + :frame frame + :manager fm + :port (port frame) + args) + `(call-next-method)))) + +;; Let us please stop playing these stupid symbol games. +#+NIL (defmethod make-pane-1 ((fm pixie-look) (frame application-frame) type &rest args) (apply #'make-instance (or (find-symbol (concatenate 'string "PIXIE-" (symbol-name type)) :climi) @@ -68,11 +86,11 @@ (y1 (+ y1 2)) (x2 (- x2 1)) (y2 (- y2 1))) - (draw-line* pane x1 y2 (+ x2 1) y2 :ink +gray54+) ; <- not a typo - (draw-line* pane x2 y1 x2 (+ y2 1) :ink +gray54+)) + (draw-line* pane x1 y2 x2 y2 :ink +gray54+) + (draw-line* pane x2 y1 x2 y2 :ink +gray54+)) ;; now for the black outline - (draw-line* pane x1 y2 (+ x2 1) y2 :ink +black+) - (draw-line* pane x2 y1 x2 (+ y2 1) :ink +black+) + (draw-line* pane x1 y2 x2 y2 :ink +black+) + (draw-line* pane x2 y1 x2 y2 :ink +black+) (draw-label* pane x1 y1 x2 y2 :ink (pane-inking-color pane))))

@@ -88,9 +106,9 @@ (y2 (- y2 2))) (draw-line* pane x1 y1 (+ x2 1) y1 :ink +black+) (draw-line* pane x1 y1 x1 (+ y2 1) :ink +black+)) - ;; now for the black outline - (draw-line* pane x1 y2 (+ x2 1) y2 :ink +white+) - (draw-line* pane x2 y1 x2 (+ y2 1) :ink +white+) + ;; now for the white outline + (draw-line* pane x1 y2 x2 y2 :ink +white+) + (draw-line* pane x2 y1 x2 y2 :ink +white+) (draw-label* pane x1 y1 x2 y2 :ink (pane-inking-color pane)))

@@ -141,6 +159,7 @@ (defconstant +pixie-slider-thumb-height+ 34) (defconstant +pixie-slider-thumb-half-width+ 8)

+ (defclass pixie-slider-pane (pixie-gadget draggable-arming-mixin slider-pane) ((dragging :initform nil) @@ -160,6 +179,8 @@ :border-style :inset :border-width 1))

+(define-pixie-gadget slider pixie-slider-pane) + (defmethod compose-space ((pane pixie-slider-pane) &key width height) (declare (ignore width height)) (if (eq (gadget-orientation pane) :vertical) @@ -334,8 +355,8 @@ (x1 (+ x1 2)) (x2 (- x2 3))) (draw-line* pane x1 y1 x2 y1 :ink +gray58+) - (draw-line* pane x1 y2 (+ x2 1) y2 :ink +white+) - (draw-line* pane x2 y1 x2 (+ y2 1) :ink +white+))))))))) + (draw-line* pane x1 y2 x2 y2 :ink +white+) + (draw-line* pane x2 y1 x2 y2 :ink +white+)))))))))

; Scrollbar

@@ -387,6 +408,8 @@ :max-value 1 :orientation :vertical))

+(define-pixie-gadget scroll-bar pixie-scroll-bar-pane) + (defmethod compose-space ((pane pixie-scroll-bar-pane) &key width height) (declare (ignore width height)) (if (eq (gadget-orientation pane) :vertical) @@ -657,6 +680,8 @@ ; silly menu-bar isn't named pane, so this catches it (defclass pixie-menu-bar (pixie-menu-bar-pane) ())

+(define-pixie-gadget menu-bar pixie-menu-bar-pane :enabled nil) + (defmethod handle-repaint ((pane pixie-menu-bar-pane) region) (declare (ignore region)) (with-special-choices (pane) @@ -858,6 +883,8 @@

(defclass pixie-toggle-button-pane (pixie-gadget toggle-button-pane) ())

+(define-pixie-gadget toggle-button pixie-toggle-button-pane) + (defmethod draw-toggle-button-indicator ((pane pixie-toggle-button-pane) (type (eql :one-of)) value x1 y1 x2 y2) (multiple-value-bind (cx cy) (values (/ (+ x1 x2) 2) (/ (+ y1 y2) 2)) (let ((radius (/ (- y2 y1) 2))) @@ -924,6 +951,8 @@ (dragging :initform nil)))

+(define-pixie-gadget push-button pixie-push-button-pane) + (defmethod compose-space ((gadget pixie-push-button-pane) &key width height) (declare (ignore width height)) (space-requirement+* (space-requirement+* (compose-label-space gadget) @@ -996,6 +1025,10 @@

(defclass pixie-text-field-pane (text-field-pane) ())

+;; Why does pixie need its own text area subclass? Leave it disabled for now. +; (define-pixie-class text-field-pane pixie-text-field-pane) + + (defmethod initialize-instance :after ((pane pixie-text-field-pane) &rest rest) (unless (getf rest :normal) (setf (slot-value pane 'current-color) +white+