switch cocoa dialog% to common mixin

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

@@ -2,34 +2,15 @@
 (require scheme/class
           "../../syntax.rkt"
           "../common/queue.rkt"
+          "../common/dialog.rkt"
           "../../lock.rkt"
          "frame.rkt")
 
 (provide dialog%)
 
-(defclass dialog% frame%
+(define dialog% 
+  (class (dialog-mixin frame%)
     (super-new [is-dialog? #t])
 
-  (define close-sema #f)
-
-  (define/override (direct-show on?)
-    (unless on?
-      (atomically
-       (when close-sema
-         (semaphore-post close-sema)
-         (set! close-sema #f))))
-    (super direct-show on?))
-
     ;; #t result avoids children sheets
-  (define/override (get-sheet) #t)
+    (define/override (get-sheet) #t)))
-
-  (define/override (show on?)
-    (if on?
-        (let ([s (atomically
-                  (let ([s (or close-sema (make-semaphore))])
-                    (unless close-sema (set! close-sema s))
-                    (semaphore-peek-evt s)))])
-          (super show on?)
-          (yield s)
-          (void))
-        (super show on?))))

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

@@ -34,8 +34,6 @@
 (define empty-mb (new menu-bar%))
 (define root-fake-frame #f)
 
-(define dialog-level-counter 0)
-
 (define all-windows (make-hash))
 
 (define-objc-mixin (MyWindowMethods Superclass)
@@ -52,7 +50,8 @@
       (queue-window*-event wxb (lambda (wx)
                                  (unless (other-modal? wx)
                                    (when (send wx on-close)
-                                     (send wx direct-show #f)))))
+                                     (atomically
+                                      (send wx direct-show #f))))))
       #f]
   [-a _void (windowDidResize: [_id notification])
       (when wxb
@@ -187,21 +186,10 @@
        (tell NSGraphicsContext graphicsContextWithWindow: cocoa)))
 
     (define is-a-dialog? is-dialog?)
-    (define dialog-level 0)
     (define/public (frame-is-dialog?) is-a-dialog?)
-    (define/public (frame-relative-dialog-status win) 
-      ;; called in event-pump thread
-      (cond
-       [is-a-dialog? (let ([dl (send win get-dialog-level)])
-                       (cond
-                        [(= dl dialog-level) 'same]
-                        [(dl . > . dialog-level) #f]
-                        [else 'other]))]
-       [else #f]))
 
-    (define/override (get-dialog-level) 
+    (define/public (frame-relative-dialog-status win) #f)
-      ;; called in event-pump thread
+    (define/override (get-dialog-level) 0)
-      dialog-level)
 
     (define/public (clean-up)
       ;; When a window is resized, then any drawing that is in flight
@@ -215,9 +203,11 @@
     (define/public (get-sheet) child-sheet)
     (define/public (set-sheet s) (set! child-sheet s))
 
+    (define caption? (not (memq 'no-caption style)))
+    (define/public (can-have-sheet?) caption?)
+
     (define/public (direct-show on?)
-      (as-entry
+      ;; in atomic mode
-       (lambda ()
       (when (and (not on?)
                  (eq? front this))
         (set! front #f)
@@ -226,13 +216,10 @@
           (show-children)
           (hide-children))
       (if on?
-             (begin
-               (when is-a-dialog?
-                 (set! dialog-level-counter (add1 dialog-level-counter))
-                 (set! dialog-level dialog-level-counter))
           (if (and is-a-dialog?
                    (let ([p (get-parent)])
                      (and p 
+                          (send p can-have-sheet?)
                           (not (send p get-sheet)))))
               (let ([p (get-parent)])
                 (send p set-sheet this)
@@ -242,10 +229,9 @@
                       modalDelegate: #f
                       didEndSelector: #:type _SEL #f
                       contextInfo: #f))
-                   (tellv cocoa makeKeyAndOrderFront: #f)))
+              (tellv cocoa makeKeyAndOrderFront: #f))
           (begin
             (when is-a-dialog?
-                 (set! dialog-level 0)
               (let ([p (get-parent)])
                 (when (and p
                            (eq? this (send p get-sheet)))
@@ -273,7 +259,7 @@
             (hash-remove! all-windows num)))
       (when on?
         (let ([b (eventspace-wait-cursor-count (get-eventspace))])
-             (set-wait-cursor-mode (not (zero? b))))))))
+          (set-wait-cursor-mode (not (zero? b))))))
     
     (define/override (show on?)
       (let ([es (get-eventspace)])
@@ -290,7 +276,8 @@
                                     (do-paint-children)
                                     (semaphore-post s)))
                   (sync/timeout 1 s))))))
-      (direct-show on?))
+      (atomically
+       (direct-show on?)))
 
     (define/private (do-paint-children)
       (when saved-child
@@ -300,7 +287,8 @@
 
     (define/public (destroy)
       (when child-sheet (send child-sheet destroy))
-      (direct-show #f))
+      (atomically
+       (direct-show #f)))
 
     (define/override (hide-children)
       (when saved-child

collects/mred/private/wx/common/dialog.rkt

@@ -31,10 +31,9 @@
       (unless on?
         (set! dialog-level 0))
       (unless on?
-        (atomically
         (when close-sema
           (semaphore-post close-sema)
-           (set! close-sema #f))))
+          (set! close-sema #f)))
       (super direct-show on?))
 
     (define/override (show on?)