[mcclim-cvs] CVS mcclim/Backends/beagle/native-panes

rschlatte rschlatte at common-lisp.net
Fri May 16 14:05:23 UTC 2008


Update of /project/mcclim/cvsroot/mcclim/Backends/beagle/native-panes
In directory clnet:/tmp/cvs-serv3307/Backends/beagle/native-panes

Modified Files:
	beagle-fundamental-button-pane.lisp 
	beagle-scroll-bar-pane.lisp beagle-slider-pane.lisp 
Log Message:
    Try to make beagle backend run both on 64-bit and 32-bit clozure cl
      * Only tested on 64-bit clozure cl 1.2rc1
      * hacked until clim-listener runs; chances are I missed many 'short-floats
      * Also don't (re)define symbols in the ccl package


--- /project/mcclim/cvsroot/mcclim/Backends/beagle/native-panes/beagle-fundamental-button-pane.lisp	2005/06/12 16:53:26	1.1
+++ /project/mcclim/cvsroot/mcclim/Backends/beagle/native-panes/beagle-fundamental-button-pane.lisp	2008/05/16 14:05:15	1.2
@@ -77,10 +77,11 @@
 
 
 (defun %beagle-get-label-size (label sheet)
-  (let ((retsize 0.0)
+  (let ((retsize (cg-floatify 0.0))
 	(dictionary (reuse-attribute-dictionary (sheet-medium sheet)
 						(send (@class ns-font)
-						      :system-font-of-size 0.0))))
+						      :system-font-of-size 
+						      (cg-floatify 0.0)))))
     (slet ((label-size (send (ccl::%make-nsstring label)
 			     :size-with-attributes dictionary)))
       (setf retsize label-size)
@@ -100,12 +101,13 @@
 (defmethod compose-space ((pb beagle-push-button-pane) &key width height)
   (declare (ignore width height))
   ;; - magic numbers are from the HIG
-  (let ((column-spacing           12.0)
-	(row-spacing              12.0)
-	(standard-width-sans-ends 41.0)
-	(standard-end-size        28.0)
-	(standard-width           69.0)  ; width of OK, Cancel buttons
-	(standard-height          20.0)
+  (let ((column-spacing           #.(cg-floatify 12.0))
+	(row-spacing              #.(cg-floatify 12.0))
+	(standard-width-sans-ends #.(cg-floatify 41.0))
+	(standard-end-size        #.(cg-floatify 28.0))
+                                        ; width of OK, Cancel buttons
+	(standard-width           #.(cg-floatify 69.0))
+	(standard-height          #.(cg-floatify 20.0))
 	(label-size               (%beagle-get-label-size (gadget-label pb) pb)))
       (let ((width (if (< (pref label-size :<NSS>ize.width) standard-width-sans-ends)
 		       standard-width-sans-ends
@@ -125,10 +127,10 @@
 			   (sheet beagle-push-button-pane))
 
   (let* ((q (compose-space sheet))
-	 (rect (ccl::make-ns-rect 0.0
-				  0.0
-				  (coerce (space-requirement-width q) 'short-float)
-				  (coerce (space-requirement-height q) 'short-float)))
+	 (rect (make-ns-rect 0.0
+			     0.0
+			     (space-requirement-width q)
+			     (space-requirement-height q)))
 	 (mirror (make-instance 'lisp-button :with-frame rect)))
     (send mirror 'retain)
 
--- /project/mcclim/cvsroot/mcclim/Backends/beagle/native-panes/beagle-scroll-bar-pane.lisp	2006/04/25 18:50:31	1.9
+++ /project/mcclim/cvsroot/mcclim/Backends/beagle/native-panes/beagle-scroll-bar-pane.lisp	2008/05/16 14:05:17	1.10
@@ -21,10 +21,10 @@
   ;; bar; otherwise we get a :vertical bar.
 
   (let* ((q (compose-space sheet))
-	 (rect (ccl::make-ns-rect 0.0
-				  0.0
-				  (space-requirement-width q)
-				  (space-requirement-height q)))
+	 (rect (make-ns-rect 0.0
+				0.0
+				(space-requirement-width q)
+				(space-requirement-height q)))
 	 (mirror (make-instance 'lisp-scroller :with-frame rect)))
     (send mirror 'retain)
 
@@ -33,7 +33,7 @@
     (send mirror :set-enabled #$YES)
 
     ;; Make knob fill pane initially.
-    (send mirror :set-float-value 0.0 :knob-proportion 1.0)
+    (send mirror :set-float-value 0.0 :knob-proportion #.(cg-floatify 1.0))
     (setf (toolkit-object sheet) mirror)
     (setf (view-lisp-scroller mirror) sheet)
 
@@ -99,7 +99,7 @@
 		       (/ ts (+ range ts)))))
     (send (toolkit-object scroll-bar)
 	  :set-float-value (coerce (clamp value 0.0 1.0) 'short-float)
-	  :knob-proportion (coerce (clamp loz-size 0.0 1.0) 'short-float))))
+	  :knob-proportion (cg-floatify (clamp loz-size 0.0 1.0)))))
 
 (defmethod (setf gadget-min-value) :after
     (new-value (pane beagle-scroll-bar-pane))
@@ -153,7 +153,7 @@
 		     (/ size range))))
     (send (toolkit-object gadget)
 	  :set-float-value (coerce position 'short-float)
-	  :knob-proportion (coerce loz-size 'short-float)))))
+	  :knob-proportion (cg-floatify loz-size)))))
 
 
 ;;; Called in the Cocoa App thread.
--- /project/mcclim/cvsroot/mcclim/Backends/beagle/native-panes/beagle-slider-pane.lisp	2005/06/12 13:27:42	1.1
+++ /project/mcclim/cvsroot/mcclim/Backends/beagle/native-panes/beagle-slider-pane.lisp	2008/05/16 14:05:18	1.2
@@ -26,10 +26,10 @@
   ;; bar; otherwise we get a :vertical bar.
 
   (let* ((q (compose-space sheet))
-	 (rect (ccl::make-ns-rect 0.0
-				  0.0
-				  (coerce (space-requirement-width q) 'short-float)
-				  (coerce (space-requirement-height q) 'short-float)))
+	 (rect (make-ns-rect 0.0
+			     0.0
+			     (space-requirement-width q)
+			     (space-requirement-height q)))
 	 (mirror (make-instance 'lisp-slider :with-frame rect)))
     (send mirror 'retain)
 




More information about the Mcclim-cvs mailing list