Update of /project/mcclim/cvsroot/mcclim In directory common-lisp.net:/tmp/cvs-serv22327
Modified Files: gadgets.lisp Log Message: Add standard-sheet-input-mixin to superclasses of generic-list-pane in order to make it work within the popup menu of the option-pane in unithreaded SBCL (and presumably other non-MP lisps). This feels like a hack.
Date: Sun Jan 30 22:09:55 2005 Author: ahefner
Index: mcclim/gadgets.lisp diff -u mcclim/gadgets.lisp:1.86 mcclim/gadgets.lisp:1.87 --- mcclim/gadgets.lisp:1.86 Sat Jan 1 21:25:38 2005 +++ mcclim/gadgets.lisp Sun Jan 30 22:09:55 2005 @@ -100,8 +100,6 @@
;; - the slider needs a total overhaul
-;; - OPTION-PANE needs an implmentation - ;; - TEXT-FILED, TEXT-AREA dito
;; - GADGET-COLOR-MIXIN is currently kind of dangling, we should reuse @@ -1984,6 +1982,7 @@ :documentation "A function to compare two items for equality.")))
(defclass generic-list-pane (list-pane meta-list-pane + standard-sheet-input-mixin ;; Hmm.. value-changed-repaint-mixin mouse-wheel-scroll-mixin) ((highlight-ink :initform +royalblue4+ @@ -2405,22 +2404,25 @@ (multiple-value-bind (x0 y0 x1 y1) (multiple-value-call #'values (transform-position (sheet-delta-transformation parent nil) cx0 cy0) - (transform-position (sheet-delta-transformation parent nil) cx1 cy1)) - (let* ((topmost-pane (if scroll-p + (transform-position (sheet-delta-transformation parent nil) cx1 cy1)) + ;; Note: This :suggested-width/height business is really a silly hack + ;; which I could have easily worked around without adding kludges + ;; to the scroller-pane.. + (let* ((topmost-pane (if scroll-p ;list-pane (scrolling (:scroll-bar :vertical :suggest-height height ;; Doesn't appear to be working.. :suggest-width (if scroll-p (+ 30 (bounding-rectangle-width list-pane)))) list-pane) list-pane)) - (topmost-pane (outlining (:thickness 1) topmost-pane)) + (topmost-pane (outlining (:thickness 1) topmost-pane)) (composed-height (space-requirement-height (compose-space topmost-pane :width (- x1 x0) :height height))) - (menu-frame (make-menu-frame topmost-pane - :min-width (bounding-rectangle-width parent) - :left x0 - :top (if (eq position :below) - y1 - (- y0 composed-height 1))))) + (menu-frame (make-menu-frame topmost-pane + :min-width (bounding-rectangle-width parent) + :left x0 + :top (if (eq position :below) + y1 + (- y0 composed-height 1))))) (values list-pane topmost-pane menu-frame)))))))
(defun popup-list-box (parent)