add show-without-yield' to dialog%'

This commit is contained in:
Matthew Flatt 2010-12-28 10:42:30 -07:00
parent 5339be7594
commit 8ac21c745f
4 changed files with 47 additions and 12 deletions

View File

@ -240,6 +240,11 @@
(check-style cwho #f '(no-caption resize-border no-sheet close-button) style))) (check-style cwho #f '(no-caption resize-border no-sheet close-button) style)))
(rename [super-on-subwindow-char on-subwindow-char]) (rename [super-on-subwindow-char on-subwindow-char])
(private-field [wx #f]) (private-field [wx #f])
(public
[show-without-yield (lambda ()
(as-entry
(lambda ()
(send wx call-show #t (lambda () (send wx show-without-yield))))))])
(override (override
[on-subwindow-char (lambda (w event) [on-subwindow-char (lambda (w event)
(super-on-subwindow-char w event) (super-on-subwindow-char w event)

View File

@ -12,6 +12,7 @@
(super-new) (super-new)
(define close-sema #f) (define close-sema #f)
(define close-sema-ready? #f)
(define dialog-level 0) (define dialog-level 0)
(define/override (get-dialog-level) dialog-level) (define/override (get-dialog-level) dialog-level)
@ -31,17 +32,32 @@
(unless on? (unless on?
(set! dialog-level 0)) (set! dialog-level 0))
(unless on? (unless on?
(when close-sema (when close-sema-ready?
(semaphore-post close-sema) (semaphore-post close-sema)
(set! close-sema #f))) (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?)) (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?) (define/override (show on?)
(if on? (if on?
(let ([s (atomically (let ([s (get-show-semaphore)])
(let ([s (or close-sema (make-semaphore))])
(unless close-sema (set! close-sema s))
(semaphore-peek-evt s)))])
(super show on?) (super show on?)
(yield s) (yield s)
(void)) (void))

View File

@ -346,6 +346,17 @@
1 1) 1 1)
(set! already-trying? #f) (set! already-trying? #f)
(resized)]))))))]) (resized)]))))))])
(public
[call-show
(lambda (on? do-show)
(when on?
(position-for-initial-show))
(if on?
(hash-table-put! top-level-windows this #t)
(hash-table-remove! top-level-windows this))
(as-exit ; as-exit because there's an implicit wx:yield for dialogs
do-show))])
(override (override
;; show: add capability to set perform-updates ;; show: add capability to set perform-updates
@ -356,12 +367,8 @@
;; pass now to superclass's show. ;; pass now to superclass's show.
[show [show
(lambda (on?) (lambda (on?)
(when on? (call-show
(position-for-initial-show)) on?
(if on?
(hash-table-put! top-level-windows this #t)
(hash-table-remove! top-level-windows this))
(as-exit ; as-exit because there's an implicit wx:yield for dialogs
(lambda () (super show on?))))] (lambda () (super show on?))))]
[on-visible [on-visible

View File

@ -114,4 +114,11 @@ If @scheme[show?] is true, the method does not immediately return. Instead,
method returns as soon as possible after the dialog is hidden. method returns as soon as possible after the dialog is hidden.
} }
@defmethod[(show-without-yield)
void?]{
Like @racket[(send @#,this-obj[] @#,method[dialog% show] #t)], but returns
immediately instead of @racket[yield]ing.}
} }