font-dialog clean up and cocoa: play-sound

collects/mred/private/fontdialog.rkt

@@ -73,7 +73,7 @@
 							  [(3) 'unsmoothed])
 							(send sip get-value)))))]
 	       [bp (instantiate horizontal-pane% (f) [stretchable-height #f])]
-	       [ms-button (if (eq? (system-type) 'windows)
+	       [ms-button (if (eq? (wx:font-from-user-platform-mode) 'dialog)
 			      (begin0
 			       (make-object button% "Use System Dialog..." bp
 					    (lambda (b e)

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

@@ -78,6 +78,7 @@
    find-graphical-system-path
    play-sound
    get-panel-background
+   font-from-user-platform-mode
    get-font-from-user
    color-from-user-platform-mode
    get-color-from-user

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

@@ -16,6 +16,7 @@
          "../common/printer.rkt"
          "menu-bar.rkt"
          "agl.rkt"
+         "sound.rkt"
          "../../lock.rkt"
          "../common/handlers.rkt"
          (except-in "../common/default-procs.rkt"
@@ -31,6 +32,7 @@
  application-pref-handler
  color-from-user-platform-mode
  get-color-from-user
+ font-from-user-platform-mode
  get-font-from-user
  get-panel-background
  play-sound
@@ -67,8 +69,6 @@
 
 (import-class NSScreen NSCursor)
 
-(define-unimplemented get-font-from-user)
-(define-unimplemented play-sound)
 (define-unimplemented find-graphical-system-path)
 (define-unimplemented send-event)
 (define-unimplemented write-resource)
@@ -76,6 +76,9 @@
 
 (define (color-from-user-platform-mode) "Show Picker")
 
+(define-unimplemented get-font-from-user)
+(define (font-from-user-platform-mode) #f)
+
 (define (register-collecting-blit canvas x y w h on off on-x on-y off-x off-y)
   (send canvas register-collecting-blit x y w h on off on-x on-y off-x off-y))
 (define (unregister-collecting-blit canvas)

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

@@ -0,0 +1,35 @@
+#lang racket/base
+(require ffi/unsafe
+         ffi/unsafe/objc
+         "utils.rkt"
+         "types.rkt")
+
+(provide play-sound)
+
+(import-class NSSound)
+
+(define-objc-class MySound NSSound
+  [result
+   sema]
+  [-a _void (sound: [_id sound] didFinishPlaying: [_BOOL ok?])
+      (set! result ok?)
+      (semaphore-post sema)
+      (tellv self release)])
+
+(define (play-sound path async?)
+  (let ([s (as-objc-allocation
+            (tell (tell MySound alloc)
+                  initWithContentsOfFile: #:type _NSString (if (path? path)
+                                                               (path->string path)
+                                                               path)
+                  byReference: #:type _BOOL #t))]
+        [sema (make-semaphore)])
+    (tellv s setDelegate: s)
+    (set-ivar! s sema sema)
+    (tellv s retain) ; don't use `retain', because we dont' want auto-release
+    (tellv s play)
+    (if async?
+        (begin
+          (semaphore-wait sema)
+          (get-ivar s result))
+        #t)))

collects/mred/private/wx/gtk/platform.rkt

@@ -78,6 +78,7 @@
    find-graphical-system-path
    play-sound
    get-panel-background
+   font-from-user-platform-mode
    get-font-from-user
    color-from-user-platform-mode
    get-color-from-user

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

@@ -24,6 +24,7 @@
  get-color-from-user
  color-from-user-platform-mode
  get-font-from-user
+ font-from-user-platform-mode
  get-panel-background
  play-sound
  find-graphical-system-path
@@ -59,7 +60,6 @@
  make-gl-bitmap
  check-for-break)
 
-(define-unimplemented get-font-from-user)
 (define-unimplemented play-sound)
 (define-unimplemented find-graphical-system-path)
 (define-unimplemented location->window)
@@ -71,6 +71,9 @@
 
 (define (color-from-user-platform-mode) 'dialog)
 
+(define (font-from-user-platform-mode) #f)
+(define-unimplemented get-font-from-user)
+
 (define (register-collecting-blit canvas x y w h on off on-x on-y off-x off-y)
   (send canvas register-collecting-blit x y w h on off on-x on-y off-x off-y))
 (define (unregister-collecting-blit canvas)

collects/mred/private/wx/platform.rkt

@@ -63,6 +63,7 @@
                 find-graphical-system-path
                 play-sound
                 get-panel-background
+                font-from-user-platform-mode
                 get-font-from-user
                 color-from-user-platform-mode
                 get-color-from-user

collects/mred/private/wx/win32/platform.rkt

@@ -79,6 +79,7 @@
    find-graphical-system-path
    play-sound
    get-panel-background
+   font-from-user-platform-mode
    get-font-from-user
    color-from-user-platform-mode
    get-color-from-user

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

@@ -23,6 +23,7 @@
  get-color-from-user
  color-from-user-platform-mode
  get-font-from-user
+ font-from-user-platform-mode
  get-panel-background
  play-sound
  find-graphical-system-path
@@ -57,7 +58,6 @@
  make-gl-bitmap
  check-for-break)
 
-(define-unimplemented get-font-from-user)
 (define-unimplemented play-sound)
 (define-unimplemented find-graphical-system-path)
 (define-unimplemented location->window)
@@ -68,6 +68,9 @@
 
 (define (color-from-user-platform-mode) 'dialog)
 
+(define (font-from-user-platform-mode) #f)
+(define-unimplemented get-font-from-user)
+
 (define (get-panel-background)
   (let ([c (GetSysColor COLOR_BTNFACE)])
     (make-object color% (GetRValue c) (GetGValue c) (GetBValue c))))