make `message-box' and variants work when called for a non-handler thread

This could be done to many other dialogs, but it seems especially
 worthwhile for `message-box'.
 Closes PR 11601.
This commit is contained in:
Matthew Flatt 2011-01-07 17:56:29 -07:00
parent 92775c5e4e
commit d4e3d42d19
2 changed files with 30 additions and 11 deletions

View File

@ -41,6 +41,27 @@
l))
style)
(let ([go (lambda ()
(create-message-box/custom
who title message
button1 button2 button3
parent style close-result
check? two-results? check-message))])
(if (eq? (current-thread) (wx:eventspace-handler-thread (wx:current-eventspace)))
;; In the right thread:
(go)
;; Not in the right thread:
(let ([ch (make-channel)])
(wx:queue-callback
(lambda ()
(channel-put ch (call-with-values go list))))
(apply values (channel-get ch)))))))
(define create-message-box/custom
(lambda (who title message
button1 button2 button3
parent style close-result
check? two-results? check-message)
(let* ([strings (regexp-split #rx"\n" message)]
[single? (and (< (length strings) 10)
(andmap (lambda (s) (< (string-length s) 60)) strings))]
@ -212,7 +233,7 @@
#f #f #f)))
(define do-message-box
(opt-lambda (who title message parent style check? check-message)
(lambda (who title message parent style check? check-message)
(check-label-string who title)
(check-string/false who message)
(when check?

View File

@ -180,10 +180,9 @@ See also @scheme[path-dialog%].
[parent (or/c (is-a?/c frame%) (is-a?/c dialog%) false/c) #f]
[style (listof (one-of/c 'ok 'ok-cancel 'yes-no 'caution 'stop)) '(ok)])
(one-of/c 'ok 'cancel 'yes 'no)]{
See also @scheme[message-box/custom].
Displays a message to the user in a (modal) dialog, using
@scheme[parent] as the parent window if it is specified. The dialog's
title is @scheme[title]. The @scheme[message] string can be arbitrarily
@ -220,12 +219,11 @@ In addition, @scheme[style] can contain @scheme['caution] to make the
The class that implements the dialog provides a @scheme[get-message]
method that takes no arguments and returns the text of the message as
a string. (The dialog is accessible through the
@scheme[get-top-level-windows] function.)
@scheme[get-top-level-windows] function.)
}
The @racket[message-box] function can be called int a thread other
than the current eventspace's handler thread, in which case the
current thread blocks while the dialog runs on the handler thread.}
@defproc[(message-box/custom [title label-string?]
[message string]
@ -307,9 +305,9 @@ The class that implements the dialog provides a @scheme[get-message]
a string. (The dialog is accessible through the
@scheme[get-top-level-windows] function.)
}
The @racket[message-box/custom] function can be called int a thread
other than the current eventspace's handler thread, in which case the
current thread blocks while the dialog runs on the handler thread.}
@defproc[(message+check-box [title label-string?]
[message string]