[mcclim-cvs] CVS mcclim

[ahefner]

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