[mcclim-cvs] CVS update: mcclim/Backends/beagle/windowing/frame-manager.lisp mcclim/Backends/beagle/windowing/mirror.lisp

[Duncan Rose]

Update of /project/mcclim/cvsroot/mcclim/Backends/beagle/windowing
In directory common-lisp.net:/tmp/cvs-serv24047/beagle/windowing

Modified Files:
	frame-manager.lisp mirror.lisp 
Log Message:
Some refactoring of events.lisp; made an effort to trawl for
memory allocations and ensure they're freed appropriately.
Estimate this to be around 70-80% done. Seems to give
performance and stability benefits.

Date: Fri May 20 00:25:37 2005
Author: drose

Index: mcclim/Backends/beagle/windowing/frame-manager.lisp
diff -u mcclim/Backends/beagle/windowing/frame-manager.lisp:1.1 mcclim/Backends/beagle/windowing/frame-manager.lisp:1.2
--- mcclim/Backends/beagle/windowing/frame-manager.lisp:1.1	Tue May 17 00:13:21 2005
+++ mcclim/Backends/beagle/windowing/frame-manager.lisp	Fri May 20 00:25:36 2005
@@ -140,8 +140,9 @@
       (multiple-value-bind (w h x y) (climi::frame-geometry* frame)
 	(declare (ignore w h))
 	(when (and x y)
-	  (send (send mirror 'window) :set-frame-top-left-point
-		(ccl::make-ns-point (coerce x 'short-float) (coerce y 'short-float)))))
+	  (let ((point (ccl::make-ns-point (coerce x 'short-float) (coerce y 'short-float))))
+	    (send (send mirror 'window) :set-frame-top-left-point point)
+	    (#_free point))))
       (when (sheet-enabled-p sheet)
 	(send (send mirror 'window) :make-key-and-order-front nil)))))
 
@@ -161,9 +162,9 @@
       (multiple-value-bind (w h x y) (climi::frame-geometry* frame)
 	(declare (ignore w h))
 	(when (and x y)
+	  (let ((point (ccl::make-ns-point (coerce x 'short-float) (coerce y 'short-float))))
 ;;	  (format *debug-io* "Setting frame top left point to (~a, ~a)~%" x y)
-	  (send (send mirror 'window) :set-frame-top-left-point
-		(ccl::make-ns-point (coerce x 'short-float) (coerce y 'short-float)))))
+	    (send (send mirror 'window) :set-frame-top-left-point point))))
       (when (sheet-enabled-p sheet)
 	(send (send mirror 'window) :make-key-and-order-front nil)))))
 


Index: mcclim/Backends/beagle/windowing/mirror.lisp
diff -u mcclim/Backends/beagle/windowing/mirror.lisp:1.2 mcclim/Backends/beagle/windowing/mirror.lisp:1.3
--- mcclim/Backends/beagle/windowing/mirror.lisp:1.2	Wed May 18 22:21:58 2005
+++ mcclim/Backends/beagle/windowing/mirror.lisp	Fri May 20 00:25:36 2005
@@ -77,6 +77,7 @@
 		     (round-coordinate (space-requirement-height q))))
 	   (rect (ccl::make-ns-rect x y width height))
 	   (mirror (make-instance view :with-frame rect)))
+      (#_free rect)
       (send mirror 'retain)
       (send mirror 'establish-tracking-rect)
       (setf (view-background-colour mirror) (%beagle-pixel port desired-color))
@@ -217,7 +218,8 @@
 	(let ((vtable (slot-value port 'view-table)))
 	  (setf (gethash clim-mirror vtable) sheet))
 	;; Things don't work if we don't do this... hopefully it will help. Maybe it won't.
-	(send top-level-frame :make-key-and-order-front nil)))))
+	(send top-level-frame :make-key-and-order-front nil)
+	(#_free rect)))))
 
 ;;; The parent of this sheet is the NSScreen... how'd that happen? Very strange. Well, that
 ;;; means we can't add this sheet to its parent; so what's this sheet used for, and how
@@ -288,6 +290,7 @@
 	(let ((vtable (slot-value port 'view-table)))
 	  (setf (gethash clim-mirror vtable) sheet))
 ;;;	(send menu-frame :set-level (ccl::%get-ptr (ccl::foreign-symbol-address "_NSPopUpMenuWindowLevel")))
+	(#_free rect)
 	;; Things don't work if we don't do this... hopefully it will help. Maybe it won't.
 	(send menu-frame :make-key-and-order-front nil)))))