65 lines
1.8 KiB
Racket
65 lines
1.8 KiB
Racket
#lang racket/base
|
|
(require racket/class
|
|
"../../lock.rkt"
|
|
"queue.rkt")
|
|
|
|
(provide (protect-out dialog-mixin))
|
|
|
|
(define dialog-level-counter 0)
|
|
|
|
(define (dialog-mixin %)
|
|
(class %
|
|
(super-new)
|
|
|
|
(define close-sema #f)
|
|
(define close-sema-ready? #f)
|
|
|
|
(define dialog-level 0)
|
|
(define/override (get-dialog-level) dialog-level)
|
|
|
|
(define/override (frame-relative-dialog-status win)
|
|
(let ([dl (send win get-dialog-level)])
|
|
(cond
|
|
[(= dl dialog-level) 'same]
|
|
[(dl . > . dialog-level) #f]
|
|
[else 'other])))
|
|
|
|
(define/override (direct-show on?)
|
|
;; atomic mode
|
|
(when on?
|
|
(set! dialog-level-counter (add1 dialog-level-counter))
|
|
(set! dialog-level dialog-level-counter))
|
|
(unless on?
|
|
(set! dialog-level 0))
|
|
(unless on?
|
|
(when close-sema-ready?
|
|
(semaphore-post close-sema)
|
|
(set! close-sema #f)
|
|
(set! close-sema-ready? #f)))
|
|
(when on?
|
|
;; mark `close-sema' as having a corresponding `show #t'
|
|
;; so that a future `show #f' can clear it; without this
|
|
;; extra flag, `close-sema' could be set, `show #f' could
|
|
;; post it, and then the `show #t' that created hte sema
|
|
;; could happen after the `show #f'
|
|
(set! close-sema-ready? #t))
|
|
(super direct-show on?))
|
|
|
|
(define/private (get-show-semaphore)
|
|
(atomically
|
|
(let ([s (or close-sema (make-semaphore))])
|
|
(unless close-sema (set! close-sema s))
|
|
(semaphore-peek-evt s))))
|
|
|
|
(define/public (show-without-yield)
|
|
(get-show-semaphore) ; in case some other thread wants to wait
|
|
(super show #t))
|
|
|
|
(define/override (show on?)
|
|
(if on?
|
|
(let ([s (get-show-semaphore)])
|
|
(super show on?)
|
|
(yield s)
|
|
(void))
|
|
(super show on?)))))
|