Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv5661
Modified Files: menu.lisp Log Message: Hack the MENU-BAR to draw its own 3d effect instead of wrapping a RAISED-PANE around it. This way the frame manager gets to decide on the appearance of the menu bar.
* menu.lisp (MAKE-MENU-BAR): Don't wrap the menu bar pane in a raising. (HANDLE-REPAINT, COMPOSE-SPACE, BOX-LAYOUT-MIXIN/HORIZONTALLY-ALLOCATE-SPACE): New methods on menu-bar.
--- /project/mcclim/cvsroot/mcclim/menu.lisp 2004/11/07 19:33:31 1.34 +++ /project/mcclim/cvsroot/mcclim/menu.lisp 2006/05/13 00:03:41 1.35 @@ -362,20 +362,55 @@ (max-width +fill+) max-height min-width min-height) (with-slots (menu) (find-command-table command-table) - (raising () - (make-pane-1 *pane-realizer* *application-frame* - 'menu-bar - :background *3d-normal-color* - :width width :height height - :max-width max-width :max-height max-height - :min-width min-width :min-height min-height - :contents - (append - (loop for item in menu - collect - (make-menu-button-from-menu-item - item nil - :bottomp t - :vertical nil - :command-table command-table)) - (list +fill+)))))) + (make-pane-1 *pane-realizer* *application-frame* + 'menu-bar + :background *3d-normal-color* + :width width :height height + :max-width max-width :max-height max-height + :min-width min-width :min-height min-height + :contents + (append + (loop for item in menu + collect + (make-menu-button-from-menu-item + item nil + :bottomp t + :vertical nil + :command-table command-table)) + (list +fill+))))) + +(defmethod handle-repaint ((pane menu-bar) region) + (declare (ignore region)) + (with-slots (border-width) pane + (multiple-value-call #'draw-bordered-rectangle* + pane + (bounding-rectangle* (sheet-region pane)) + :style :outset + :border-width 2))) + +(defmethod compose-space ((pane menu-bar) &key width height) + (declare (ignore width height)) + (space-requirement+ (call-next-method) + (make-space-requirement :height 4 :max-height 4))) + +(defmethod box-layout-mixin/horizontally-allocate-space + ((pane menu-bar) real-width real-height) + (with-slots (x-spacing) pane + (let ((widths + (box-layout-mixin/horizontally-allocate-space-aux* + pane real-width real-height)) + (x 2)) + (loop + for child in (box-layout-mixin-clients pane) + for width in widths + do + (when (box-client-pane child) + (layout-child (box-client-pane child) + :expand + :expand + x + 2 + width + (- real-height 4))) + (incf x width) + (incf x x-spacing)))))