Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv17747
Modified Files: menu.lisp Log Message: Further hacking to polish the "pixie" look. Enabled pixie-style menus, revamped various compose-space and handle-repaint methods. Minor changes to menu.lisp allowing pixie to customize the decoration of submenu windows, and to detect when menu buttons are in a vertical menu (versus the menu bar). Changed drawing of the arrow widget on scroll bars and submenu buttons to use a small bitmap rather than polygon drawing, as the polygon drawing was awkward and (due to rounding?) did not look right.
On CLX, Pixie can be invoked as follows: (setf *default-frame-manager* (make-instance 'climi::pixie/clx-look :port (find-port)))
--- /project/mcclim/cvsroot/mcclim/menu.lisp 2006/12/14 19:43:51 1.37 +++ /project/mcclim/cvsroot/mcclim/menu.lisp 2006/12/23 11:52:27 1.38 @@ -119,6 +119,12 @@ (sheet-children (first (sheet-children (frame-panes submenu-frame)))) '())))
+(defclass submenu-border (border-pane) ()) + +(defclass submenu-border-pane (raised-pane) + () + (:default-initargs :border-width 2 :background *3d-normal-color*)) + (defun create-substructure (sub-menu client) (let* ((frame *application-frame*) (manager (frame-manager frame)) @@ -130,7 +136,7 @@ 'menu))) (rack (make-pane-1 manager frame 'vrack-pane :background *3d-normal-color* :contents items)) - (raised (make-pane-1 manager frame 'raised-pane :border-width 2 :background *3d-normal-color* :contents (list rack)))) + (raised (make-pane-1 manager frame 'submenu-border :contents (list rack)))) (with-slots (bottomp) sub-menu (multiple-value-bind (xmin ymin xmax ymax) (bounding-rectangle* (sheet-region sub-menu)) @@ -277,6 +283,7 @@ :label name :text-style *enabled-text-style* :client client + :vertical vertical :value-changed-callback #'(lambda (gadget val) (declare (ignore gadget val)) @@ -285,6 +292,7 @@ :label name :text-style *disabled-text-style* :client client + :vertical vertical :value-changed-callback #'(lambda (gadget val) (declare (ignore gadget val)) @@ -296,6 +304,7 @@ :label name :text-style *enabled-text-style* :client client + :vertical vertical :value-changed-callback #'(lambda (gadget val) (declare (ignore gadget val)) @@ -308,6 +317,7 @@ (:divider (make-pane-1 manager frame 'menu-divider-leaf-pane :label name + :vertical vertical :client client)) (:menu (make-pane-1 manager frame (if vertical @@ -315,6 +325,7 @@ 'menu-button-submenu-pane) :label name :client client + :vertical vertical :frame-manager manager :command-table value :bottomp bottomp)) @@ -372,7 +383,7 @@ (append (loop for item in menu collect - (make-menu-button-from-menu-item + (make-menu-button-from-menu-item item nil :bottomp t :vertical nil