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

cocoa and gtk: make combo-field% `on-popup' work better

Browse Source 
original commit: c9e778c54137b1fe1468e9ef46a242245572e9e1
This commit is contained in:
Matthew Flatt 2010-12-16 10:40:11 -07:00
parent 797c6e1c08
commit 30d1312fab
3 changed files with 44 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
collects/mred/private/wx/cocoa/canvas.rkt
View File

@ -382,6 +382,7 @@
(define/override (get-client-size xb yb)
(super get-client-size xb yb)
(when is-combo?
(set-box! xb (max 0 (- (unbox xb) 22)))
(set-box! yb (max 0 (- (unbox yb) 5)))))
(define/override (maybe-register-as-child parent on?)
@ -627,6 +628,8 @@
(tellv content-cocoa addItemWithObjectValue: #:type _NSString str)
#t)
(define/public (on-combo-select i) (void))
(define/public (popup-combo)
(tellv (tell content-cocoa cell) popUp: #f))
(define clear-bg? (and (not (memq 'transparent canvas-style))
(not (memq 'no-autoclear canvas-style))))
@ -718,7 +721,7 @@
(let ([xb (box 0)]
[yb (box 0)])
(get-client-size xb yb)
((send e get-x) . > . (- (unbox xb) 22))))
((send e get-x) . > . (unbox xb))))
(define/public (on-popup) (void))
@ -764,12 +767,10 @@
(void))
(define/public (get-backing-size xb yb)
(get-client-size xb yb)
(when is-combo?
(set-box! xb (- (unbox xb) 22))))
(get-client-size xb yb))
(define/override (get-cursor-width-delta)
(if is-combo? 22 0))
0)
(define/public (is-flipped?)
(tell #:type _BOOL (get-cocoa-content) isFlipped))

18
collects/mred/private/wx/gtk/canvas.rkt
View File

@ -41,6 +41,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_combo_box_popup (_fun _GtkWidget -> _void))
(define-gtk gtk_widget_queue_draw (_fun _GtkWidget -> _void))
@ -344,10 +345,19 @@
(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)
(if (and (ptr-equal? gtk combo-button-gtk)
(send e button-down?))
(begin
(on-popup)
#t)
#f))
(define/public (popup-combo)
;; Unfortunately, the user has to hold the mouse
;; button down when popping up the menu this way,
;; whereas the default handler (that we subvert in
;; `internal-pre-on-event') keeps the menu open if
;; the user release the mouse button right away.
(gtk_combo_box_popup gtk))
(define/override (get-client-delta)
(values margin margin))

25
collects/mred/private/wxtextfield.rkt
View File

@ -221,6 +221,7 @@
(private-field
[l (and label
(make-object wx-message% #f proxy p label -1 -1 null font))]
[combo-callback #f]
[c (make-object (class wx-text-editor-canvas%
(define/override (on-combo-select i)
(let ([len (length callbacks)])
@ -239,8 +240,30 @@
'(hide-hscroll))
'(hide-vscroll hide-hscroll))))]
[callbacks null])
(override
[pre-on-event (lambda (w e)
(or (super pre-on-event w e)
(and combo-callback
(eq? w c)
(send e button-down?)
(let ([w (box 0)]
[h (box 0)])
(send c get-client-size w h)
(not (and (<= 0 (send e get-x) (unbox w))
(<= 0 (send e get-y) (unbox h)))))
(begin
(do-popup-callback)
#t))))])
(private
[do-popup-callback (lambda ()
(wx:queue-callback (lambda ()
(combo-callback)
(send c popup-combo))
wx:middle-queue-key))])
(public
[set-on-popup (lambda (proc) (send c set-on-popup proc))]
[set-on-popup (lambda (proc)
(set! combo-callback proc)
(send c set-on-popup (lambda () (do-popup-callback))))]
[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)