[mcclim-cvs] CVS update: mcclim/gadgets.lisp

[Andy Hefner]

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)