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)))))