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*)