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

Make categories in the language dialog expand/collapse on a single

Browse Source 
click, requires extending hierlists with `on-click-always'

svn: r10691

original commit: a71a5bcf45df13d310a35f1c077614ad26e0d1ad
This commit is contained in:
Eli Barzilay 2008-07-09 09:47:24 +00:00
parent 2fabbcf66d
commit ee8be7c733
1 changed files with 21 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
collects/mrlib/hierlist/hierlist-unit.ss
View File

@ -306,10 +306,11 @@
(send dc set-pen p) (send dc set-pen p)
(send dc set-brush b))))]) (send dc set-brush b))))])
(private (private
;; need to use top-select anyway, because it might want to react to
;; all clicks
[do-select (lambda (on? clicked?) [do-select (lambda (on? clicked?)
(unless (eq? (not selected?) (top-select (if on? item #f) snip clicked?
(not on?)) (not (eq? (not selected?) (not on?)))))])
(top-select (if on? item #f) snip clicked?)))])
(public (public
[select (lambda (on?) (do-select on? #f))] [select (lambda (on?) (do-select on? #f))]
[click-select (lambda (on?) (do-select on? #t))] [click-select (lambda (on?) (do-select on? #t))]
@ -804,21 +805,32 @@
[selectable? #t] [selectable? #t]
[show-focus? #f] [show-focus? #f]
[on-select-always? #t] [on-select-always? #t]
[on-click-always? #f]
[allow-deselect? #f]) [allow-deselect? #f])
(public (public
[on-select-always [on-select-always
(case-lambda (case-lambda
[() on-select-always?] [() on-select-always?]
[(v) (set! on-select-always? (and v #t))])] [(v) (set! on-select-always? (and v #t))])]
[on-click-always
(case-lambda
[() on-click-always?]
[(v) (set! on-click-always? (and v #t))])]
[allow-deselect [allow-deselect
(case-lambda (case-lambda
[() allow-deselect?] [() allow-deselect?]
[(v) (set! allow-deselect? (and v #t))])]) [(v) (set! allow-deselect? (and v #t))])])
(private (private
[do-select (lambda (item s clicked?) [do-select (lambda (item s clicked? selected?)
(when (and item clicked? on-click-always?)
(on-click item))
(cond (cond
[(not selected?)
;; this wasn't really a selection, only useful if
;; on-click-always? made us do an on-click above
(void)]
[(and selectable? [(and selectable?
item item
(send item get-allow-selection?)) (send item get-allow-selection?))
(unless (eq? item selected-item) (unless (eq? item selected-item)
(when selected (send selected show-select #f)) (when selected (send selected show-select #f))
@ -827,9 +839,9 @@
(when selected (send selected show-select #t)) (when selected (send selected show-select #t))
(when (or clicked? on-select-always?) (when (or clicked? on-select-always?)
(on-select item)))] (on-select item)))]
[(and item [(and item clicked?)
clicked?) (unless on-click-always? ; already called above
(on-click item)] (on-click item))]
[allow-deselect? [allow-deselect?
(when selected-item (when selected-item
(send selected show-select #f) (send selected show-select #f)
@ -838,7 +850,7 @@
(when (or clicked? on-select-always?) (when (or clicked? on-select-always?)
(on-select #f))]))]) (on-select #f))]))])
(private-field (private-field
[top-buffer (make-object hierarchical-list-text% this (lambda (i s c?) (do-select i s c?)) 0 #f)] [top-buffer (make-object hierarchical-list-text% this (lambda (i s c? s?) (do-select i s c? s?)) 0 #f)]
[selected #f] [selected #f]
[selected-item #f]) [selected-item #f])
(sequence (sequence