[mcclim-cvs] CVS mcclim

[ahefner]

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

Modified Files:
	menu-choose.lisp 
Log Message:
If we're going to stick with these rather unorthodox menus, at least
wrap in a 3D border to make them less jarring. Changed color to use
the default 3D gadget background, and made less sensitive to the exact
hierarchy of gadgets in the menu frame.


--- /project/mcclim/cvsroot/mcclim/menu-choose.lisp	2006/08/05 19:54:31	1.19
+++ /project/mcclim/cvsroot/mcclim/menu-choose.lisp	2007/02/05 03:00:54	1.20
@@ -180,15 +180,16 @@
          (fm (frame-manager associated-frame)))
     (with-look-and-feel-realization (fm associated-frame) ; hmm... checkme
       (let* ((menu-stream (make-pane-1 fm associated-frame 'clim-stream-pane
-                                       :background +gray80+))
+                                       :background *3d-normal-color* #+NIL +gray80+))
              (container (scrolling (:scroll-bar scroll-bars)
                           menu-stream))
-	     (frame (make-menu-frame (if label
-                                         (labelling (:label label
-                                                     :label-alignment :top
-                                                     :background +gray80+)
-                                           container)
-                                         container)
+	     (frame (make-menu-frame (raising ()
+				       (if label
+					   (labelling (:label label
+						       :name 'label
+						       :label-alignment :top)
+					     container)
+					   container))
 				     :left nil
 				     :top nil)))
         (adopt-frame fm frame)
@@ -316,12 +317,11 @@
                                   :resize-frame t)))
 
     ;; Modify the size and location of the frame as well.
-    (let* ((label-pane (sheet-parent (pane-scroller menu)))
-           (top-level-pane (sheet-parent label-pane)))
-      (when (not (typep label-pane 'label-pane))
-        ;; Oops, we have no label. Rebind...
-        (setf top-level-pane label-pane)
-        (setf label-pane nil))
+    (let* ((top-level-pane (labels ((searching (pane)
+				      (if (typep pane 'top-level-sheet-pane)
+					  pane
+					  (searching (sheet-parent pane)))))
+			     (searching menu))))
       (multiple-value-bind (frame-width frame-height)
           (menu-size top-level-pane *application-frame*)
         (multiple-value-bind (res-max-x res-max-y) (max-x-y *application-frame*)