suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source 
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
collects/mred/private/messagebox.rkt
View File

@ -41,6 +41,27 @@
l)) l))
style) 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)] (let* ([strings (regexp-split #rx"\n" message)]
[single? (and (< (length strings) 10) [single? (and (< (length strings) 10)
(andmap (lambda (s) (< (string-length s) 60)) strings))] (andmap (lambda (s) (< (string-length s) 60)) strings))]
@ -212,7 +233,7 @@
#f #f #f))) #f #f #f)))
(define do-message-box (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-label-string who title)
(check-string/false who message) (check-string/false who message)
(when check? (when check?

16
collects/scribblings/gui/dialog-funcs.scrbl
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] [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)]) [style (listof (one-of/c 'ok 'ok-cancel 'yes-no 'caution 'stop)) '(ok)])
(one-of/c 'ok 'cancel 'yes 'no)]{ (one-of/c 'ok 'cancel 'yes 'no)]{
See also @scheme[message-box/custom]. See also @scheme[message-box/custom].
Displays a message to the user in a (modal) dialog, using Displays a message to the user in a (modal) dialog, using
@scheme[parent] as the parent window if it is specified. The dialog's @scheme[parent] as the parent window if it is specified. The dialog's
title is @scheme[title]. The @scheme[message] string can be arbitrarily title is @scheme[title]. The @scheme[message] string can be arbitrarily
@ -222,10 +221,9 @@ The class that implements the dialog provides a @scheme[get-message]
a string. (The dialog is accessible through the 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?] @defproc[(message-box/custom [title label-string?]
[message 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 a string. (The dialog is accessible through the
@scheme[get-top-level-windows] function.) @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?] @defproc[(message+check-box [title label-string?]
[message string] [message string]