cocoa and gtk: fix combo% `on-popup' method
This commit is contained in:
parent
c6710b8938
commit
39596efef5
|
@ -101,20 +101,30 @@
|
|||
parent callback init-value
|
||||
style #f
|
||||
font))
|
||||
(private
|
||||
[prep-popup
|
||||
(lambda ()
|
||||
(send menu on-demand)
|
||||
(let ([items (send menu get-items)]
|
||||
[wx (mred->wx this)])
|
||||
(send wx clear-combo-items)
|
||||
(for-each
|
||||
(lambda (item)
|
||||
(unless (item . is-a? . separator-menu-item%)
|
||||
(send wx append-combo-item
|
||||
(send item get-plain-label)
|
||||
(lambda ()
|
||||
(send item command
|
||||
(make-object wx:control-event% 'menu-popdown))))))
|
||||
items)))])
|
||||
(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)))]
|
||||
[on-popup (lambda (e) (void))]
|
||||
[get-menu (lambda () menu)]
|
||||
[append (lambda (item)
|
||||
(check-label-string '(method combo-field% append) item)
|
||||
(unless (send (mred->wx this) append-combo-item item
|
||||
(lambda () (handle-selected item)))
|
||||
(make-object menu-item% item menu
|
||||
(lambda (i e)
|
||||
(handle-selected item)))))])
|
||||
(make-object menu-item% item menu
|
||||
(lambda (i e)
|
||||
(handle-selected item))))])
|
||||
(private
|
||||
[handle-selected (lambda (item)
|
||||
(focus)
|
||||
|
@ -128,5 +138,10 @@
|
|||
[menu (new popup-menu% [font font])])
|
||||
(sequence
|
||||
(super-init label parent callback init-value (list* combo-flag 'single style))
|
||||
(send (mred->wx this)
|
||||
set-on-popup
|
||||
(lambda ()
|
||||
(on-popup (make-object wx:control-event% 'menu-popdown))
|
||||
(prep-popup)))
|
||||
(for-each (lambda (item) (append item))
|
||||
choices)))))
|
||||
|
|
|
@ -601,6 +601,8 @@
|
|||
(scroller-page scroller)
|
||||
1)]))
|
||||
|
||||
(define/public (clear-combo-items)
|
||||
(tellv content-cocoa removeAllItems))
|
||||
(define/public (append-combo-item str)
|
||||
(tellv content-cocoa addItemWithObjectValue: #:type _NSString str)
|
||||
#t)
|
||||
|
@ -698,10 +700,15 @@
|
|||
(get-client-size xb yb)
|
||||
((send e get-x) . > . (- (unbox xb) 22))))
|
||||
|
||||
(define/public (on-popup) (void))
|
||||
|
||||
(define/public (starting-combo)
|
||||
(set! in-menu-click? #t)
|
||||
(tellv content-cocoa setStringValue: #:type _NSString current-text))
|
||||
|
||||
(tellv content-cocoa setStringValue: #:type _NSString current-text)
|
||||
(constrained-reply (get-eventspace)
|
||||
(lambda () (on-popup))
|
||||
(void)))
|
||||
|
||||
(define/public (ending-combo)
|
||||
(set! in-menu-click? #f)
|
||||
(let ([pos (tell #:type _NSInteger content-cocoa indexOfSelectedItem)])
|
||||
|
|
|
@ -40,6 +40,7 @@
|
|||
|
||||
(define-gtk gtk_combo_box_entry_new_text (_fun -> _GtkWidget))
|
||||
(define-gtk gtk_combo_box_append_text (_fun _GtkWidget _string -> _void))
|
||||
(define-gtk gtk_combo_box_remove_text (_fun _GtkWidget _int -> _void))
|
||||
|
||||
(define-gtk gtk_widget_queue_draw (_fun _GtkWidget -> _void))
|
||||
|
||||
|
@ -190,7 +191,8 @@
|
|||
set-auto-size
|
||||
adjust-client-delta infer-client-delta
|
||||
is-auto-scroll? get-virtual-width get-virtual-height
|
||||
refresh-for-autoscroll)
|
||||
refresh-for-autoscroll
|
||||
get-eventspace)
|
||||
|
||||
(define is-combo? (memq 'combo style))
|
||||
(define has-border? (or (memq 'border style)
|
||||
|
@ -341,6 +343,12 @@
|
|||
(define/override (get-client-gtk) client-gtk)
|
||||
(define/override (handles-events? gtk) (not (ptr-equal? gtk combo-button-gtk)))
|
||||
|
||||
(define/override (internal-pre-on-event gtk e)
|
||||
(when (and (ptr-equal? gtk combo-button-gtk)
|
||||
(send e button-down?))
|
||||
(on-popup))
|
||||
#f)
|
||||
|
||||
(define/override (get-client-delta)
|
||||
(values margin margin))
|
||||
|
||||
|
@ -535,8 +543,20 @@
|
|||
(when is-combo?
|
||||
(connect-changed client-gtk))
|
||||
|
||||
(define combo-count 0)
|
||||
(define/public (clear-combo-items)
|
||||
(atomically
|
||||
(for ([n (in-range combo-count)])
|
||||
(gtk_combo_box_remove_text gtk 0))
|
||||
(set! combo-count 0)))
|
||||
(define/public (append-combo-item str)
|
||||
(gtk_combo_box_append_text gtk str))
|
||||
(atomically
|
||||
(set! combo-count (add1 combo-count))
|
||||
(gtk_combo_box_append_text gtk str)))
|
||||
|
||||
(when is-combo? (append-combo-item "..."))
|
||||
|
||||
(define/public (on-popup) (void))
|
||||
|
||||
(define/public (combo-maybe-clicked)
|
||||
(let ([i (gtk_combo_box_get_active gtk)])
|
||||
|
|
|
@ -346,7 +346,8 @@
|
|||
(send wx dispatch-on-event m #f)))
|
||||
#t)
|
||||
(constrained-reply (send wx get-eventspace)
|
||||
(lambda () (send wx dispatch-on-event m #t))
|
||||
(lambda () (or (send wx dispatch-on-event m #t)
|
||||
(send wx internal-pre-on-event gtk m)))
|
||||
#t))))))))
|
||||
|
||||
;; ----------------------------------------
|
||||
|
@ -590,6 +591,8 @@
|
|||
[just-pre? #f]
|
||||
[else (when enabled? (on-event e)) #t]))
|
||||
|
||||
(define/public (internal-pre-on-event gtk e) #f)
|
||||
|
||||
(define/public (call-pre-on-event w e)
|
||||
(or (send parent call-pre-on-event w e)
|
||||
(pre-on-event w e)))
|
||||
|
|
|
@ -453,6 +453,10 @@
|
|||
(define/public (set-combo-text s) (void))
|
||||
(define/public (append-combo-item s)
|
||||
(SendMessageW/str combo-hwnd CB_ADDSTRING 0 s))
|
||||
(define/public (clear-combo-items)
|
||||
(void))
|
||||
|
||||
(define/public (on-popup) (void))
|
||||
|
||||
(define/override (is-command? cmd)
|
||||
(= cmd CBN_SELENDOK))
|
||||
|
|
|
@ -23,14 +23,16 @@
|
|||
[do-on-scroll (lambda (e) (super on-scroll e))]
|
||||
[do-on-paint (lambda () (super on-paint))])
|
||||
(private-field
|
||||
[tabable? default-tabable?])
|
||||
[tabable? default-tabable?]
|
||||
[on-popup-callback void])
|
||||
(public
|
||||
[get-tab-focus (lambda () tabable?)]
|
||||
[set-tab-focus (lambda (v) (set! tabable? v))]
|
||||
[on-tab-in (lambda ()
|
||||
(let ([mred (wx->mred this)])
|
||||
(when mred
|
||||
(send mred on-tab-in))))])
|
||||
(send mred on-tab-in))))]
|
||||
[set-on-popup (lambda (proc) (set! on-popup-callback proc))])
|
||||
(override
|
||||
[gets-focus? (lambda () tabable?)]
|
||||
[handles-key-code
|
||||
|
@ -68,7 +70,9 @@
|
|||
(let ([mred (get-mred)])
|
||||
(if mred
|
||||
(as-exit (lambda () (clear-and-on-paint mred)))
|
||||
(as-exit (lambda () (clear-margins) (super on-paint)))))))])
|
||||
(as-exit (lambda () (clear-margins) (super on-paint)))))))]
|
||||
;; for 'combo canvases:
|
||||
[on-popup (lambda () (on-popup-callback))])
|
||||
(sequence (apply super-init mred proxy args))))
|
||||
|
||||
(define wx-canvas%
|
||||
|
|
|
@ -167,7 +167,9 @@
|
|||
(make-object wx-message% #f proxy p label -1 -1 null font))]
|
||||
[c (make-object (class wx-text-editor-canvas%
|
||||
(define/override (on-combo-select i)
|
||||
((list-ref callbacks (- (length callbacks) i 1))))
|
||||
(let ([len (length callbacks)])
|
||||
(when (< -1 i len)
|
||||
((list-ref callbacks (- len i 1))))))
|
||||
(super-new))
|
||||
#f proxy this p
|
||||
(append
|
||||
|
@ -182,6 +184,8 @@
|
|||
'(hide-vscroll hide-hscroll))))]
|
||||
[callbacks null])
|
||||
(public
|
||||
[set-on-popup (lambda (proc) (send c set-on-popup proc))]
|
||||
[clear-combo-items (lambda () (set! callbacks null) (send c clear-combo-items))]
|
||||
[append-combo-item (lambda (s cb)
|
||||
(and (send c append-combo-item s)
|
||||
(set! callbacks (cons cb callbacks))
|
||||
|
|
|
@ -5,8 +5,8 @@
|
|||
|
||||
A @scheme[combo-field%] object is a @scheme[text-field%]
|
||||
object that also resembles a @scheme[choice%] object, because it
|
||||
has a small popup button to the right of the text field. By default,
|
||||
clicking the button pops up a menu, and selecting a menu item copies
|
||||
has a small popup button to the right of the text field. Clicking
|
||||
the button pops up a menu, and selecting a menu item typically copies
|
||||
the item into the text field.
|
||||
|
||||
|
||||
|
@ -40,9 +40,8 @@ The @scheme[choices] list specifies the initial list of items for the
|
|||
combo's popup menu. The
|
||||
@method[combo-field% append] method adds a new item to the menu with a callback to install the
|
||||
appended item into the combo's text field. The
|
||||
@method[combo-field% get-menu] method returns the combo's menu to allow arbitrary other operations.
|
||||
This menu might not be used at all if
|
||||
@method[combo-field% on-popup] is overridden.
|
||||
@method[combo-field% get-menu] method returns a menu that can be changed to
|
||||
adjust the content and actions of the combo's menu.
|
||||
|
||||
The @scheme[callback] procedure is called when the user changes the text
|
||||
in the combo or presses the Enter key (and Enter is not handled by
|
||||
|
@ -75,11 +74,10 @@ Adds a new item to the combo's popup menu. The given label is used for
|
|||
|
||||
@defmethod[(get-menu)
|
||||
(is-a?/c popup-menu%)]{
|
||||
Returns the @scheme[popup-menu%] that is used by the default
|
||||
@method[combo-field% on-popup] method. This menu is initialized with the @scheme[labels] argument when
|
||||
the @scheme[combo-field%] is created, and the
|
||||
@method[combo-field% append] method adds a new item to the menu.
|
||||
|
||||
Returns a @scheme[popup-menu%] that is effectively copied into the
|
||||
combo's popup menu when the combo is clicked. Only the labels can
|
||||
callbacks of the menu's items are used; the enable state, submenus,
|
||||
or separators are ignored.
|
||||
}
|
||||
|
||||
|
||||
|
@ -88,14 +86,13 @@ Returns the @scheme[popup-menu%] that is used by the default
|
|||
|
||||
@methspec{
|
||||
|
||||
Called when the user clicks the combo's popup button.
|
||||
Called when the user clicks the combo's popup button. Override this method
|
||||
to adjust the content of the combo menu on demand.
|
||||
|
||||
}
|
||||
@methimpl{
|
||||
|
||||
Gets a menu from
|
||||
@method[combo-field% get-menu], sets its minimum width to match the combo control's width, and
|
||||
then pops up the menu.
|
||||
Does nothing.
|
||||
|
||||
}}
|
||||
|
||||
|
|
12
collects/tests/gracket/combo-steps.txt
Normal file
12
collects/tests/gracket/combo-steps.txt
Normal file
|
@ -0,0 +1,12 @@
|
|||
Set Up, Callbacks, Appending
|
||||
----------------------------
|
||||
|
||||
The choice/list should contain "Apple" and "Banana" for
|
||||
starters.
|
||||
|
||||
Watch for "Popup!" printed to stdout when you click the choice item.
|
||||
|
||||
When you use "Reset", the content should change to "Alpha", "Beta",
|
||||
and "Gamma", and selecting them should install the word plus
|
||||
"for Reset" into the text field.
|
||||
|
|
@ -1565,6 +1565,79 @@
|
|||
(instructions p "choice-list-steps.txt")
|
||||
(send f show #t))
|
||||
|
||||
(define (combo-frame empty?)
|
||||
(define f (make-frame frame% "Combo Test"))
|
||||
(define p f)
|
||||
(define actual-content '("Apple" "Banana"))
|
||||
(define (callback c e) (void))
|
||||
(define c (make-object (class combo-field%
|
||||
(define/override (on-popup e)
|
||||
(printf "Popup!\n"))
|
||||
(super-new))
|
||||
"Tester" actual-content p callback))
|
||||
(define counter 0)
|
||||
(define append-with-user-data? #f)
|
||||
(define ab (make-object button%
|
||||
"Append" p
|
||||
(lambda (b e)
|
||||
(set! counter (add1 counter))
|
||||
(let ([naya (format "~aExtra ~a"
|
||||
(if (= counter 10)
|
||||
(string-append
|
||||
"This is a Really Long Named Item That Would Have Used the Short Name, Yes "
|
||||
"This is a Really Long Named Item That Would Have Used the Short Name ")
|
||||
"")
|
||||
counter)]
|
||||
[naya-data (box 0)])
|
||||
(set! actual-content (append actual-content (list naya)))
|
||||
(send c append naya)))))
|
||||
(define asb (make-object button%
|
||||
"Append Separator" p
|
||||
(lambda (b e)
|
||||
(set! counter (add1 counter))
|
||||
(new separator-menu-item% [parent (send c get-menu)]))))
|
||||
(define cdp (make-object horizontal-panel% p))
|
||||
(define (clear)
|
||||
(for ([i (send (send c get-menu) get-items)])
|
||||
(send i delete)))
|
||||
(define rb (make-object button% "Clear" cdp
|
||||
(lambda (b e) (clear))))
|
||||
(define (gone l n)
|
||||
(if (zero? n)
|
||||
(cdr l)
|
||||
(cons (car l) (gone (cdr l) (sub1 n)))))
|
||||
(define (delete p)
|
||||
(send (list-ref (send (send c get-menu) get-items) p) delete)
|
||||
(when (<= 0 p (sub1 (length actual-content)))
|
||||
(set! actual-content (gone actual-content p))))
|
||||
(define db (make-object button%
|
||||
"Delete First" cdp
|
||||
(lambda (b e)
|
||||
(unless (null? actual-content)
|
||||
(delete 0)))))
|
||||
(define dbe (make-object button%
|
||||
"Delete Last" cdp
|
||||
(lambda (b e)
|
||||
(unless (null? actual-content)
|
||||
(delete (sub1 (length actual-content)))))))
|
||||
(define setb (make-object button%
|
||||
"Reset" cdp
|
||||
(lambda (b e)
|
||||
(clear)
|
||||
(let ([m (send c get-menu)])
|
||||
(for ([i '("Alpha" "Beta" "Gamma")])
|
||||
(new menu-item% [parent m] [label i]
|
||||
[callback (lambda (itm e)
|
||||
(send c set-value
|
||||
(format "~a from Reset" i)))]))))))
|
||||
(define tb (make-object button%
|
||||
"Check" p
|
||||
(lambda (b e)
|
||||
(void))))
|
||||
(send c stretchable-width #t)
|
||||
(instructions p "combo-steps.txt")
|
||||
(send f show #t))
|
||||
|
||||
(define (slider-frame style)
|
||||
(define f (make-frame frame% "Slider Test"))
|
||||
(define p (make-object vertical-panel% f))
|
||||
|
@ -2163,6 +2236,7 @@
|
|||
(send cp stretchable-width #f)
|
||||
(make-object button% "Make Choice Frame" cp (lambda (b e) (choice-or-list-frame #f null #f)))
|
||||
(make-object button% "Make Empty Choice Frame" cp (lambda (b e) (choice-or-list-frame #f null #t)))
|
||||
(make-object button% "Make Combo Frame" cp (lambda (b e) (combo-frame #f)))
|
||||
(define lp (make-object horizontal-pane% ap))
|
||||
(send lp stretchable-width #f)
|
||||
(make-object button% "Make List Frame" lp (lambda (b e) (choice-or-list-frame #t '(single) #f)))
|
||||
|
|
|
@ -93,8 +93,8 @@ backward-compatibile. Methods like `get-translation',
|
|||
`set-translation', `scale', etc. help hide the reundancy.
|
||||
|
||||
|
||||
Others Drawing-Context Changes
|
||||
------------------------------
|
||||
Other Drawing-Context Changes
|
||||
-----------------------------
|
||||
|
||||
The alpha value of a `dc<%>' (as set by `set-alpha') is used for all
|
||||
drawing operations, including drawing a bitmap.
|
||||
|
@ -122,6 +122,15 @@ background for the selected region, and it should draw the foreground
|
|||
in the color specified by `get-highlight-text-color', if any.
|
||||
|
||||
|
||||
Other GUI Changes
|
||||
-----------------
|
||||
|
||||
The `on-popup' method of `combo-field%' can be used to adjust the
|
||||
content of the combo-box popup menu, but the default implementation no
|
||||
longer triggers the popup menu; instead, the popup behavior is built
|
||||
into the control.
|
||||
|
||||
|
||||
Removed Functions
|
||||
-----------------
|
||||
|
||||
|
|
Loading…
Reference in New Issue
Block a user