original commit: 443387f1fa83ad6e7a609a67150464f855023f50
This commit is contained in:
Matthew Flatt 2004-11-09 17:08:32 +00:00
parent 8ae436f708
commit 8725f0c793
3 changed files with 33 additions and 21 deletions

View File

@ -35,7 +35,7 @@
clipboard<%>
color%
color-database<%>
combo-text-field%
combo-field%
control-event%
control<%>
current-eventspace

View File

@ -4771,9 +4771,12 @@
(check-container-parent cwho parent)
(check-callback cwho callback)
(check-string cwho init-value)
(check-style cwho req-styles (cons combo-flag
'(hscroll password vertical-label horizontal-label deleted))
style))
(check-style cwho
req-styles
(append
(if choices? null '(hscroll password))
'(vertical-label horizontal-label deleted))
(remq combo-flag style)))
(define text-field%
(class100*/kw basic-control% ()
@ -4814,36 +4817,45 @@
(check-container-ready cwho parent)))
label parent callback ibeam))))))
(define combo-text-field%
(define combo-field%
(class100*/kw text-field% ()
[(label choices parent callback [init-value ""] [style '()])
control%-keywords]
(inherit set-value popup-menu get-size focus get-editor)
(sequence
(check-text-field-args '(constructor combo-text-field)
(check-text-field-args '(constructor combo-field)
label
#f choices
parent callback init-value
style #f))
(public
[on-popup (lambda (e)
(let-values ([(w h) (get-size)]
[(cw) (send (mred->wx this) get-canvas-width)])
(send menu set-min-width cw)
(popup-menu menu (- w cw) h)))]
[get-menu (lambda () menu)]
[append (lambda (item)
(check-label-string '(method combo-field% append) item)
(make-object menu-item% item menu
(lambda (i e)
(focus)
(set-value item)
(let ([e (get-editor)])
(send e set-position 0 (send e last-position))))))])
(override
[on-subwindow-event (lambda (w e)
(and (send e button-down?)
(let-values ([(w h) (get-size)]
[(cw) (send (mred->wx this) get-canvas-width)])
(let-values ([(cw) (send (mred->wx this) get-canvas-width)])
(and ((send e get-x) . >= . (- cw side-combo-width))
(begin
(send menu set-width cw)
(popup-menu menu (- w cw) h)
(on-popup e)
#t)))))])
(private-field
[menu (new popup-menu%)])
(sequence
(for-each (lambda (item) (make-object menu-item% item menu
(lambda (i e)
(focus)
(set-value item)
(let ([e (get-editor)])
(send e set-position 0 (send e last-position))))))
(for-each (lambda (item)
(append item))
choices)
(super-init label parent callback init-value (list* combo-flag 'single style)))))
@ -5891,9 +5903,9 @@
(when (is-a? i labelled-menu-item<%>)
(send i on-demand)))
(send wx get-items)))]
[set-width (lambda (n)
(check-range-integer '(method popup-menu% set-width) n)
(send wx set-width n))])
[set-min-width (lambda (n)
(check-range-integer '(method popup-menu% set-min-width) n)
(send wx set-width n))])
(private-field
[wx #f])
(sequence
@ -8108,7 +8120,7 @@
radio-box%
slider%
text-field%
combo-text-field%
combo-field%
window<%>
area<%>
top-level-window<%>

View File

@ -657,7 +657,7 @@
(let ()
(define co
(make-object combo-text-field% "Greet:" '("Hola" "Ni Hao") ip2 void "hello"))
(make-object combo-field% "Greet:" '("Hola" "Ni Hao") ip2 void "hello"))
(define sh (make-object slider%
(if null-label? #f "H S&lid\uE9r") 0 10 ip2