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

added a #:dialog-mixin argument to message-box and related functions

Browse Source 
Also minor rackety (just enough to get keyword arguments)

original commit: 92537076211b5b2c111ad8f8482c8354a8335029
This commit is contained in:
Robby Findler 2011-09-03 21:41:22 -05:00
parent 30dc7eaf8c
commit 8d75df199f
2 changed files with 92 additions and 77 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,9 +1,8 @@
(module messagebox mzscheme
#lang racket/base
(require mzlib/class
mzlib/class100
mzlib/etc
mzlib/string
(prefix wx: "kernel.rkt")
(prefix-in wx: "kernel.rkt")
"const.rkt"
"check.rkt"
"helper.rkt"
@ -24,7 +23,8 @@
(lambda (who title message
button1 button2 button3
parent style close-result
check? two-results? check-message)
check? two-results? check-message
dialog-mixin)
(check-label-string who title)
(check-string/false who message)
(when check?
@ -46,7 +46,8 @@
who title message
button1 button2 button3
parent style close-result
check? two-results? check-message))]
check? two-results? check-message
dialog-mixin))]
[es (if parent
(send parent get-eventspace)
(wx:current-eventspace))])
@ -65,51 +66,53 @@
(lambda (who title message
button1 button2 button3
parent style close-result
check? two-results? check-message)
check? two-results? check-message
dialog-mixin)
(let* ([strings (regexp-split #rx"\n" message)]
[single? (and (< (length strings) 10)
(andmap (lambda (s) (< (string-length s) 60)) strings))]
[f (make-object (class100 dialog% ()
(public
[get-message
(lambda () message)])
(augment
[can-close? (lambda ()
(if (memq 'disallow-close style)
(begin
(wx:bell)
#f)
#t))])
(override
[on-subwindow-event
(lambda (w e)
(if (send e button-down?)
(if (is-a? w button%)
#f
(if (or (is-a? w message%)
(and
(is-a? w editor-canvas%)
(let-values ([(w h) (send w get-client-size)])
(< (send e get-x) w))))
(begin
(send w popup-menu
(let ([m (make-object popup-menu%)])
(make-object menu-item%
"Copy Message"
m
(lambda (i e)
(send (wx:get-the-clipboard)
set-clipboard-string
message
(send e get-time-stamp))))
m)
(send e get-x)
(send e get-y))
#t)
#f))
#f))])
(sequence
(super-init title parent box-width))))]
[f (make-object (dialog-mixin
(class100 dialog% ()
(public
[get-message
(lambda () message)])
(augment
[can-close? (lambda ()
(if (memq 'disallow-close style)
(begin
(wx:bell)
#f)
#t))])
(override
[on-subwindow-event
(lambda (w e)
(if (send e button-down?)
(if (is-a? w button%)
#f
(if (or (is-a? w message%)
(and
(is-a? w editor-canvas%)
(let-values ([(w h) (send w get-client-size)])
(< (send e get-x) w))))
(begin
(send w popup-menu
(let ([m (make-object popup-menu%)])
(make-object menu-item%
"Copy Message"
m
(lambda (i e)
(send (wx:get-the-clipboard)
set-clipboard-string
message
(send e get-time-stamp))))
m)
(send e get-x)
(send e get-y))
#t)
#f))
#f))])
(sequence
(super-init title parent box-width)))))]
[result close-result]
[icon-id (cond
[(memq 'stop style) 'stop]
@ -224,20 +227,21 @@
result))))))
(define message-box/custom
(opt-lambda (title message
button1
button2
button3
[parent #f]
[style '(no-default)]
[close-result #f])
(lambda (title message
button1
button2
button3
[parent #f]
[style '(no-default)]
[close-result #f]
#:dialog-mixin [dialog-mixin values])
(do-message-box/custom 'message-box/custom
title message button1 button2 button3
parent style close-result
#f #f #f)))
#f #f #f dialog-mixin)))
(define do-message-box
(lambda (who title message parent style check? check-message)
(lambda (who title message parent style check? check-message dialog-mixin)
(check-label-string who title)
(check-string/false who message)
(when check?
@ -276,7 +280,8 @@
(list default)
(list default 'disallow-close)))
close-val
check? #t check-message)])
check? #t check-message
dialog-mixin)])
(let ([result (case result
[(1) one-v]
[(2) two-v])])
@ -285,23 +290,25 @@
result))))))
(define message-box
(opt-lambda (title message [parent #f] [style '(ok)])
(do-message-box 'message-box title message parent style #f #f)))
(lambda (title message [parent #f] [style '(ok)] #:dialog-mixin [dialog-mixin values])
(do-message-box 'message-box title message parent style #f #f dialog-mixin)))
(define message+check-box/custom
(opt-lambda (title message
(lambda (title message
checkbox-message
button1
button2
button3
[parent #f]
[style '(no-default)]
[close-result #f])
[close-result #f]
#:dialog-mixin [dialog-mixin values])
(do-message-box/custom 'message+check-box/custom
title message button1 button2 button3
parent style close-result
#t #t checkbox-message)))
parent style close-result
#t #t checkbox-message
dialog-mixin)))
(define message+check-box
(opt-lambda (title message check-message [parent #f] [style '(ok)])
(do-message-box 'message-box title message parent style #t check-message))))
(lambda (title message check-message [parent #f] [style '(ok)] #:dialog-mixin [dialog-mixin values])
(do-message-box 'message-box title message parent style #t check-message dialog-mixin)))

32
collects/scribblings/gui/dialog-funcs.scrbl
View File

@ -196,7 +196,8 @@ See also @racket[path-dialog%] for a richer interface.
@defproc[(message-box [title label-string?]
[message string?]
[parent (or/c (is-a?/c frame%) (is-a?/c dialog%) #f) #f]
[style (listof (or/c 'ok 'ok-cancel 'yes-no 'caution 'stop)) '(ok)])
[style (listof (or/c 'ok 'ok-cancel 'yes-no 'caution 'stop)) '(ok)]
[#:dialog-mixin dialog-mixin (make-mixin-contract dialog%) values])
(or/c 'ok 'cancel 'yes 'no)]{
See also @racket[message-box/custom].
@ -239,10 +240,14 @@ The class that implements the dialog provides a @racket[get-message]
a string. (The dialog is accessible through the
@racket[get-top-level-windows] function.)
The @racket[message-box] function can be called int a thread other
The @racket[message-box] function can be called in a thread other
than the handler thread of the relevant eventspace (i.e., the eventspace of
@racket[parent], or the current eventspace if @racket[parent] is @racket[#f]), in which case the
current thread blocks while the dialog runs on the handler thread.}
current thread blocks while the dialog runs on the handler thread.
The @racket[dialog-mixin] argument is applied to the class that implements the dialog
before the dialog is created.
}
@defproc[(message-box/custom [title label-string?]
[message string]
@ -254,7 +259,8 @@ The @racket[message-box] function can be called int a thread other
'disallow-close 'no-default
'default=1 'default=2 'default=3))
'(no-default)]
[close-result any/c #f])
[close-result any/c #f]
[#:dialog-mixin dialog-mixin (make-mixin-contract dialog%) values])
(or/c 1 2 3 close-result)]{
Displays a message to the user in a (modal) dialog, using
@ -324,10 +330,14 @@ The class that implements the dialog provides a @racket[get-message]
a string. (The dialog is accessible through the
@racket[get-top-level-windows] function.)
The @racket[message-box/custom] function can be called int a thread
The @racket[message-box/custom] function can be called in a thread
other than the handler thread of the relevant eventspace (i.e., the eventspace of
@racket[parent], or the current eventspace if @racket[parent] is @racket[#f]), in which case the
current thread blocks while the dialog runs on the handler thread.}
current thread blocks while the dialog runs on the handler thread.
The @racket[dialog-mixin] argument is applied to the class that implements the dialog
before the dialog is created.
}
@defproc[(message+check-box [title label-string?]
[message string?]
@ -335,7 +345,8 @@ The @racket[message-box/custom] function can be called int a thread
[parent (or/c (is-a?/c frame%) (is-a?/c dialog%) #f) #f]
[style (listof (or/c 'ok 'ok-cancel 'yes-no
'caution 'stop 'checked))
'(ok)])
'(ok)]
[#:dialog-mixin dialog-mixin (make-mixin-contract dialog%) values])
(values (or/c 'ok 'cancel 'yes 'no) boolean?)]{
See also @racket[message+check-box/custom].
@ -361,7 +372,8 @@ Like @racket[message-box], except that
'disallow-close 'no-default
'default=1 'default=2 'default=3))
'(no-default)]
[close-result any/c #f])
[close-result any/c #f]
[#:dialog-mixin dialog-mixin (make-mixin-contract dialog%) values])
(or/c 1 2 3 (λ (x) (eq? x close-result)))]{
Like @racket[message-box/custom], except that
@ -372,10 +384,6 @@ Like @racket[message-box/custom], except that
@item{@racket[style] can contain @racket['checked] to indicate that the check box
should be initially checked.}
]
}
@defproc[(get-text-from-user [title string?]