cocoa allocation repairs

original commit: 227300dc94eb0c97f69668f7dcfc6fbffbc3bb02

collects/mred/private/wx/cocoa/filedialog.rkt

@@ -19,15 +19,13 @@
 (define (file-selector message directory filename 
                        extension
                        filters style parent)
-  (let ([ns (if (memq 'put style)
+  (let ([ns (as-objc-allocation-with-retain
+             (if (memq 'put style)
                 (tell NSSavePanel savePanel)
-                (tell NSOpenPanel openPanel))]
+                (tell NSOpenPanel openPanel)))]
         [parent (and parent
                      (not (send parent get-sheet))
                      parent)])
-    ;; Why? This looks like a leak, but we get crashes
-    ;; without it.
-    (retain ns)
 
     (let ([extensions (append
                        (if extension (list extension) null)
@@ -84,12 +82,14 @@
                (when parent (tell app endSheet: ns))
                (when front (tellv (send front get-cocoa-window)
                                   makeKeyAndOrderFront: #f)))))])
-      (if (zero? result)
-          #f
-          (if (memq 'multi style)
-              (let ([urls (tell ns URLs)])
-                (for/list ([i (in-range (tell #:type _NSUInteger urls count))])
-                  (nsurl->string (tell urls objectAtIndex: #:type _NSUInteger i))))
-              (let ([url (tell ns URL)])
-                (nsurl->string url)))))))
+      (begin0
+       (if (zero? result)
+           #f
+           (if (memq 'multi style)
+               (let ([urls (tell ns URLs)])
+                 (for/list ([i (in-range (tell #:type _NSUInteger urls count))])
+                   (nsurl->string (tell urls objectAtIndex: #:type _NSUInteger i))))
+               (let ([url (tell ns URL)])
+                 (nsurl->string url))))
+       (release ns)))))
 

collects/mred/private/wx/cocoa/procs.rkt

@@ -125,18 +125,20 @@
 (define-cocoa NSCalibratedRGBColorSpace _id)
 
 (define (get-highlight-background-color)
-  (let ([hi (tell (tell NSColor selectedTextBackgroundColor) 
-                  colorUsingColorSpaceName: NSCalibratedRGBColorSpace)]
+  (let ([hi (as-objc-allocation-with-retain
+             (tell (tell NSColor selectedTextBackgroundColor) 
+                   colorUsingColorSpaceName: NSCalibratedRGBColorSpace))]
         [as-color (lambda (v)
                     (inexact->exact (floor (* 255.0 v))))])
-    (unless hi (error "selection background color lookup failed!"))
-    (make-object color%
-                 (as-color
-                  (tell #:type _CGFloat hi redComponent))
-                 (as-color
-                  (tell #:type _CGFloat hi greenComponent))
-                 (as-color
-                  (tell #:type _CGFloat hi blueComponent)))))
+    (begin0
+     (make-object color%
+                  (as-color
+                   (tell #:type _CGFloat hi redComponent))
+                  (as-color
+                   (tell #:type _CGFloat hi greenComponent))
+                  (as-color
+                   (tell #:type _CGFloat hi blueComponent)))
+     (release hi))))
 
 (define (get-highlight-text-color)
   #f)

collects/mred/private/wx/cocoa/utils.rkt

@@ -13,6 +13,7 @@
          define-appkit
          define-mz
          as-objc-allocation
+         as-objc-allocation-with-retain
          retain release
          with-autorelease
          clean-menu-label
@@ -37,6 +38,11 @@
 (define-syntax-rule (as-objc-allocation expr)
   ((objc-allocator (lambda () expr))))
 
+(define-syntax-rule (as-objc-allocation-with-retain expr)
+  ((objc-allocator (lambda () (let ([v expr])
+                                (tellv v retain)
+                                v)))))
+
 (define release ((deallocator) objc-delete))
 (define retain ((retainer release car)
                 (lambda (obj)