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

add yet another dialog-mixin argument to a standard dialog, this time

Browse Source 
get-text-from-user

also, some minor rackety to that function/file

original commit: 57c59d2ed7e1e8a29d492d533a8b3f5673022824
This commit is contained in:
Robby Findler 2011-09-05 20:03:00 -05:00
parent 1f69a824fa
commit 2c7390edb8
2 changed files with 36 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

70
collects/mred/private/moredialogs.rkt
View File

@ -1,19 +1,14 @@
(module moredialogs mzscheme
(require mzlib/class
mzlib/etc
mzlib/list
(prefix wx: "kernel.rkt")
(prefix wx: racket/snip)
#lang racket/base
(require racket/class
(prefix-in wx: "kernel.rkt")
(prefix-in wx: racket/snip)
"lock.rkt"
"const.rkt"
"check.rkt"
"wx.rkt"
"helper.rkt"
"editor.rkt"
"mrtop.rkt"
"mrcanvas.rkt"
"mrpopup.rkt"
"mrmenu.rkt"
"mritem.rkt"
"mrpanel.rkt"
"mrtextfield.rkt")
@ -190,34 +185,33 @@
(define (can-get-page-setup-from-user?)
(wx:can-show-print-setup?))
(define get-text-from-user
(case-lambda
[(title message) (get-text-from-user title message #f "" null)]
[(title message parent) (get-text-from-user title message parent "" null)]
[(title message parent init-val) (get-text-from-user title message parent init-val null)]
[(title message parent init-val style)
(check-label-string 'get-text-from-user title)
(check-label-string/false 'get-text-from-user message)
(check-top-level-parent/false 'get-text-from-user parent)
(check-string 'get-text-from-user init-val)
(check-style 'get-text-from-user #f '(password) style)
(let* ([f (make-object dialog% title parent box-width)]
[ok? #f]
[done (lambda (?) (lambda (b e) (set! ok? ?) (send f show #f)))])
(let ([t (make-object text-field% message f (lambda (t e) (when (eq? (send e get-event-type) 'text-field-enter)
((done #t) #f #f)))
init-val (list* 'single 'vertical-label style))]
[p (make-object horizontal-pane% f)])
(send p set-alignment 'right 'center)
(send f stretchable-height #f)
(ok-cancel
(lambda () (make-object button% "OK" p (done #t) '(border)))
(lambda () (make-object button% "Cancel" p (done #f))))
(send (send t get-editor) select-all)
(send t focus)
(send f center)
(send f show #t)
(and ok? (send t get-value))))]))
(define (get-text-from-user title message
[parent #f]
[init-val ""]
[style null]
#:dialog-mixin [dialog-mixin values])
(check-label-string 'get-text-from-user title)
(check-label-string/false 'get-text-from-user message)
(check-top-level-parent/false 'get-text-from-user parent)
(check-string 'get-text-from-user init-val)
(check-style 'get-text-from-user #f '(password) style)
(define f (make-object (dialog-mixin dialog%) title parent box-width))
(define ok? #f)
(define ((done ?) b e) (set! ok? ?) (send f show #f))
(define t (make-object text-field% message f (lambda (t e) (when (eq? (send e get-event-type) 'text-field-enter)
((done #t) #f #f)))
init-val (list* 'single 'vertical-label style)))
(define p (make-object horizontal-pane% f))
(send p set-alignment 'right 'center)
(send f stretchable-height #f)
(ok-cancel
(lambda () (make-object button% "OK" p (done #t) '(border)))
(lambda () (make-object button% "Cancel" p (done #f))))
(send (send t get-editor) select-all)
(send t focus)
(send f center)
(send f show #t)
(and ok? (send t get-value)))
(define get-choices-from-user
(case-lambda
@ -347,4 +341,4 @@
(send f center)
(send f show #t)
(and ok?
(get-current-color))))])))
(get-current-color))))]))

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

@ -390,7 +390,8 @@ Like @racket[message-box/custom], except that
[message (or/c string? #f)]
[parent (or/c (is-a?/c frame%) (is-a?/c dialog%) #f) #f]
[init-val string? ""]
[style (listof 'password) null])
[style (listof 'password) null]
[#:dialog-mixin dialog-mixin (make-mixin-contract dialog%) values])
(or/c string? #f)]{
Gets a text string from the user via a modal dialog, using
@ -406,8 +407,8 @@ If @racket[style] includes @racket['password], the dialog's text field
draws each character of its content using a generic symbol, instead
of the actual character.
The @racket[dialog-mixin] argument is applied to the class that implements the dialog
before the dialog is created.
}
@defproc[(get-choices-from-user [title string?]