[mcclim-cvs] CVS mcclim

ahefner ahefner at common-lisp.net
Mon Feb 5 02:57:18 UTC 2007


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

Modified Files:
	gadgets.lisp 
Log Message:
Trivial changes (change :max-height of push-button-pane to +fill+, move
functions around).



--- /project/mcclim/cvsroot/mcclim/gadgets.lisp	2006/12/27 14:47:23	1.103
+++ /project/mcclim/cvsroot/mcclim/gadgets.lisp	2007/02/05 02:57:18	1.104
@@ -203,13 +203,9 @@
                         ;; immediate-sheet-input-mixin
                         ;; immediate-repainting-mixin
 			basic-pane
-                        gadget
-                        )
-  ;; Half-baked attempt to be compatible with Lispworks. ??? -moore
-  ;; Inherited from basic-pane with different defaults.
-  ((foreground  :initform +black+)
-   #+IGNORE (background  :initform +white+)  ; This is evil.. -Hefner
-   ))
+                        gadget)
+  ())
+                        
 
 
 ;; Where is this standard-gadget from? --GB
@@ -701,8 +697,8 @@
 (defclass enter/exit-arms/disarms-mixin ()
   ()
   (:documentation
-   "Mixin class for gadgets, which will be armed, when the mouse enters and 
-    disarmed, when the mouse leaves."))
+   "Mixin class for gadgets which are armed when the mouse enters and 
+    disarmed when the mouse leaves."))
 
 (defmethod handle-event :before ((pane enter/exit-arms/disarms-mixin) (event pointer-enter-event))
   (declare (ignorable event))
@@ -737,7 +733,12 @@
   (declare (ignorable client))
   (disarm-gadget gadget))
 
-;;
+;;;; ------------------------------------------------------------------------------------------
+;;;;
+;;;;  Drawing Utilities for Concrete Gadgets
+;;;;
+
+;;; Labels
 
 (defmethod compose-label-space ((gadget labelled-gadget-mixin) &key (wider 0) (higher 0))
   (with-slots (label align-x align-y) gadget
@@ -769,11 +770,6 @@
                   :text-style (pane-text-style pane)
                   :ink ink))))
 
-;;;; ------------------------------------------------------------------------------------------
-;;;;
-;;;;  Drawing Utilities for Concrete Gadgets
-;;;;
-
 ;;; 3D-ish Look
 
 ;; DRAW-BORDERED-POLYGON medium point-seq &key border-width style
@@ -950,7 +946,10 @@
          medium
          (polygon-points (make-rectangle* x1 y1 x2 y2))
          options))
-  
+
+(defun draw-engraved-label* (pane x1 y1 x2 y2)
+  (draw-label* pane (1+ x1) (1+ y1) (1+ x2) (1+ y2) :ink *3d-light-color*)
+  (draw-label* pane x1 y1 x2 y2 :ink *3d-dark-color*))  
 
 ;;;;
 ;;;; 3D-BORDER-MIXIN Class
@@ -1040,7 +1039,7 @@
 		      :initarg :show-as-default-p
 		      :accessor push-button-show-as-default-p))
   (:default-initargs
-   :text-style (make-text-style :sans-serif nil nil)
+    :text-style (make-text-style :sans-serif nil nil)
     :background *3d-normal-color*
     :align-x :center
     :align-y :center
@@ -1076,10 +1075,6 @@
       (setf pressedp nil)
       (dispatch-repaint pane +everywhere+))))
 
-(defun draw-engraved-label* (pane x1 y1 x2 y2)
-  (draw-label* pane (1+ x1) (1+ y1) (1+ x2) (1+ y2) :ink *3d-light-color*)
-  (draw-label* pane x1 y1 x2 y2 :ink *3d-dark-color*))
-
 (defmethod handle-repaint ((pane push-button-pane) region)
   (declare (ignore region))
   (with-slots (armed pressedp) pane
@@ -2044,7 +2039,7 @@
          (h (* n (generic-list-pane-item-height pane))))
     (make-space-requirement :width w     :height h
                             :min-width w :min-height h
-                            :max-width +fill+ :max-height h)))
+                            :max-width +fill+ :max-height +fill+)))
 
 (defmethod allocate-space ((pane generic-list-pane) w h)
   (resize-sheet pane w h))




More information about the Mcclim-cvs mailing list