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

add some keymap:call/text-keymap-initializer calls

Browse Source 
closes PR 14013
This commit is contained in:
Robby Findler 2013-09-12 15:30:33 -05:00
parent d5a798c2a9
commit 10fe09ad8d
2 changed files with 119 additions and 102 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
pkgs/drracket-pkgs/drracket/drracket/private/frame.rkt
View File

@ -385,19 +385,23 @@
(new horizontal-panel% [parent dialog]
[stretchable-height #f] [alignment '(right center)]))
(define file-text-field
(new text-field% [parent file-panel]
[callback void] [min-width 300] [stretchable-width #t]
[init-value (caddr pref)]
[label (string-constant install-plt-filename)]))
(keymap:call/text-keymap-initializer
(λ ()
(new text-field% [parent file-panel]
[callback void] [min-width 300] [stretchable-width #t]
[init-value (caddr pref)]
[label (string-constant install-plt-filename)]))))
(define file-button
(new button% [parent file-panel]
[callback (λ (x y) (browse))]
[label (string-constant browse...)]))
(define url-text-field
(new text-field% [parent url-panel]
[min-width 300] [stretchable-width #t] [callback void]
[init-value (cadr pref)]
[label (string-constant install-plt-url)]))
(keymap:call/text-keymap-initializer
(λ ()
(new text-field% [parent url-panel]
[min-width 300] [stretchable-width #t] [callback void]
[init-value (cadr pref)]
[label (string-constant install-plt-url)]))))
(define-values (ok-button cancel-button)
(gui-utils:ok/cancel-buttons
button-panel
@ -551,10 +555,13 @@
(update-bindings))
(define bp (make-object horizontal-panel% this))
(define search-field (new text-field%
[parent this]
[label (string-constant mfs-search-string)]
[callback (λ (a b) (update-bindings))]))
(define search-field
(keymap:call/text-keymap-initializer
(λ ()
(new text-field%
[parent this]
[label (string-constant mfs-search-string)]
[callback (λ (a b) (update-bindings))]))))
(define b-name (new button%
[label (string-constant keybindings-sort-by-name)]
[parent bp]

190
pkgs/drracket-pkgs/drracket/drracket/private/unit.rkt
View File

@ -334,66 +334,72 @@
; ;;;;
(define (get-fraction-from-user parent)
(let* ([dlg (make-object dialog% (string-constant enter-fraction))]
[hp (make-object horizontal-panel% dlg)]
[_1 (make-object message% (string-constant whole-part) hp)]
[whole (make-object text-field% #f hp void)]
[vp (make-object vertical-panel% hp)]
[hp2 (make-object horizontal-panel% vp)]
[num (make-object text-field% #f hp2 void)]
[num-m (make-object message% (string-constant numerator) hp2)]
[hp3 (make-object horizontal-panel% vp)]
[den (make-object text-field% #f hp3 void)]
[den-m (make-object message% (string-constant denominator) hp3)]
[bp (make-object horizontal-panel% dlg)]
[ok? #f]
[validate-number
(λ ()
(let ([num-s (string->number (send num get-value))]
[den-s (string->number (send den get-value))]
[whole-s (if (string=? (send whole get-value) "")
0
(string->number (send whole get-value)))])
(cond
[(or (not whole-s) (not (integer? whole-s)))
(string-constant insert-number/bad-whole-part)]
[(or (not num-s) (not (integer? num-s)) (< num-s 0))
(string-constant insert-number/bad-numerator)]
[(or (not den-s) (not (integer? den-s)) (<= den-s 0))
(string-constant insert-number/bad-denominator)]
[else
(if (< whole-s 0)
(- whole-s (/ num-s den-s))
(+ whole-s (/ num-s den-s)))])))]
[ok-callback
(λ ()
(let ([v (validate-number)])
(cond
[(number? v)
(set! ok? #t)
(send dlg show #f)]
[else
(message-box
(string-constant drscheme)
v
dlg
#:dialog-mixin frame:focus-table-mixin)])))]
[cancel-callback
(λ () (send dlg show #f))])
(let-values ([(ok cancel)
(gui-utils:ok/cancel-buttons
bp
(λ (x y) (ok-callback))
(λ (x y) (cancel-callback)))])
(let ([mw (max (send den-m get-width) (send num-m get-width))])
(send den-m min-width mw)
(send num-m min-width mw))
(send bp set-alignment 'right 'center)
(send dlg show #t)
(and ok?
(let ([v (validate-number)])
(and (number? v)
v))))))
(define dlg (make-object dialog% (string-constant enter-fraction)))
(define hp (make-object horizontal-panel% dlg))
(make-object message% (string-constant whole-part) hp)
(define whole
(keymap:call/text-keymap-initializer
(λ ()
(make-object text-field% #f hp void))))
(define vp (make-object vertical-panel% hp))
(define hp2 (make-object horizontal-panel% vp))
(define num
(keymap:call/text-keymap-initializer
(λ ()
(make-object text-field% #f hp2 void))))
(define num-m (make-object message% (string-constant numerator) hp2))
(define hp3 (make-object horizontal-panel% vp))
(define den
(keymap:call/text-keymap-initializer
(λ ()
(make-object text-field% #f hp3 void))))
(define den-m (make-object message% (string-constant denominator) hp3))
(define bp (make-object horizontal-panel% dlg))
(define ok? #f)
(define (validate-number)
(define num-s (string->number (send num get-value)))
(define den-s (string->number (send den get-value)))
(define whole-s (if (string=? (send whole get-value) "")
0
(string->number (send whole get-value))))
(cond
[(or (not whole-s) (not (integer? whole-s)))
(string-constant insert-number/bad-whole-part)]
[(or (not num-s) (not (integer? num-s)) (< num-s 0))
(string-constant insert-number/bad-numerator)]
[(or (not den-s) (not (integer? den-s)) (<= den-s 0))
(string-constant insert-number/bad-denominator)]
[else
(if (< whole-s 0)
(- whole-s (/ num-s den-s))
(+ whole-s (/ num-s den-s)))]))
(define (ok-callback)
(define v (validate-number))
(cond
[(number? v)
(set! ok? #t)
(send dlg show #f)]
[else
(message-box
(string-constant drscheme)
v
dlg
#:dialog-mixin frame:focus-table-mixin)]))
(define (cancel-callback) (send dlg show #f))
(define-values (ok cancel)
(gui-utils:ok/cancel-buttons
bp
(λ (x y) (ok-callback))
(λ (x y) (cancel-callback))))
(let ([mw (max (send den-m get-width) (send num-m get-width))])
(send den-m min-width mw)
(send num-m min-width mw))
(send bp set-alignment 'right 'center)
(send dlg show #t)
(and ok?
(let ([v (validate-number)])
(and (number? v)
v))))
;; create-executable : (instanceof drracket:unit:frame<%>) -> void
(define (create-executable frame)
@ -1571,19 +1577,21 @@
(send-url (url->string url2)))]
[parent logger-gui-content-panel])
(set! logger-text-field
(new text-field%
[parent logger-gui-content-panel]
[label "‹level›@‹name› ..."]
[init-value (send (get-interactions-text) get-user-log-receiver-args-str)]
[callback
(λ (tf evt)
(define str (send (send tf get-editor) get-text))
(define args (parse-logger-args str))
(preferences:set 'drracket:logger-receiver-string str)
(send (get-interactions-text) set-user-log-receiver-args
str
(if (null? args) #f args))
(set-logger-text-field-bg-color args))]))
(keymap:call/text-keymap-initializer
(λ ()
(new text-field%
[parent logger-gui-content-panel]
[label "‹level›@‹name› ..."]
[init-value (send (get-interactions-text) get-user-log-receiver-args-str)]
[callback
(λ (tf evt)
(define str (send (send tf get-editor) get-text))
(define args (parse-logger-args str))
(preferences:set 'drracket:logger-receiver-string str)
(send (get-interactions-text) set-user-log-receiver-args
str
(if (null? args) #f args))
(set-logger-text-field-bg-color args))]))))
(set-logger-text-field-bg-color (parse-logger-args (send logger-text-field get-value)))
(set! logger-checkbox
(new check-box%
@ -4791,23 +4799,25 @@
(update-ok-button-state))
(define tb
(new text-field%
[label #f]
[parent top-hp]
[init-value (if current-limit
(format "~a" current-limit)
"128")]
[stretchable-width #f]
[min-width 100]
[callback
(λ (tf e)
(let ([ed (send tf get-editor)])
(cond
[(is-valid-number? ed)
(background clear-sd)]
[else
(background yellow-sd)]))
(update-ok-button-state))]))
(keymap:call/text-keymap-initializer
(λ ()
(new text-field%
[label #f]
[parent top-hp]
[init-value (if current-limit
(format "~a" current-limit)
"128")]
[stretchable-width #f]
[min-width 100]
[callback
(λ (tf e)
(let ([ed (send tf get-editor)])
(cond
[(is-valid-number? ed)
(background clear-sd)]
[else
(background yellow-sd)]))
(update-ok-button-state))]))))
(define (update-ok-button-state)
(cond