Make categories in the language dialog expand/collapse on a single
click, requires extending hierlists with `on-click-always' svn: r10691
This commit is contained in:
parent
91fb6ffce0
commit
a71a5bcf45
|
@ -345,19 +345,18 @@
|
|||
(if (and i (is-a? i hieritem-language<%>))
|
||||
(something-selected i)
|
||||
(nothing-selected)))
|
||||
;; this is not used, since all lists are selectable
|
||||
;; (define/override (on-click i)
|
||||
;; (when (and i (is-a? i hierarchical-list-compound-item<%>))
|
||||
;; (send i toggle-open/closed)))
|
||||
;; use this instead
|
||||
;; this is used only because we set `on-click-always'
|
||||
(define/override (on-click i)
|
||||
(when (and i (is-a? i hierarchical-list-compound-item<%>))
|
||||
(send i toggle-open/closed)))
|
||||
;; double-click selects a language
|
||||
(define/override (on-double-select i)
|
||||
(when i
|
||||
(cond [(is-a? i hierarchical-list-compound-item<%>)
|
||||
(send i toggle-open/closed)]
|
||||
[(is-a? i hieritem-language<%>)
|
||||
(something-selected i)
|
||||
(ok-handler 'execute)])))
|
||||
(super-instantiate (parent))))
|
||||
(when (and i (is-a? i hieritem-language<%>))
|
||||
(something-selected i)
|
||||
(ok-handler 'execute)))
|
||||
(super-instantiate (parent))
|
||||
;; do this so we can expand/collapse languages on a single click
|
||||
(send this on-click-always #t)))
|
||||
|
||||
(define outermost-panel (make-object horizontal-pane% parent))
|
||||
(define languages-hier-list (make-object selectable-hierlist% outermost-panel))
|
||||
|
@ -568,7 +567,7 @@
|
|||
(send editor change-style section-style-delta
|
||||
(+ pos 1) (send editor last-position)))
|
||||
x)
|
||||
(let* ([new-list (send hier-list new-list
|
||||
(let* ([new-list (send hier-list new-list
|
||||
(if second-number
|
||||
(compose second-number-mixin number-mixin)
|
||||
number-mixin))]
|
||||
|
@ -623,7 +622,7 @@
|
|||
(super-instantiate ())))
|
||||
|
||||
;; second-number-mixin : (extends object%) -> (extends object%)
|
||||
;; adds the get/set-number methods to this class
|
||||
;; adds the get/set-second-number methods to this class
|
||||
(define (second-number-mixin %)
|
||||
(class* % (second-number<%>)
|
||||
(field (second-number 0))
|
||||
|
|
|
@ -306,10 +306,11 @@
|
|||
(send dc set-pen p)
|
||||
(send dc set-brush b))))])
|
||||
(private
|
||||
;; need to use top-select anyway, because it might want to react to
|
||||
;; all clicks
|
||||
[do-select (lambda (on? clicked?)
|
||||
(unless (eq? (not selected?)
|
||||
(not on?))
|
||||
(top-select (if on? item #f) snip clicked?)))])
|
||||
(top-select (if on? item #f) snip clicked?
|
||||
(not (eq? (not selected?) (not on?)))))])
|
||||
(public
|
||||
[select (lambda (on?) (do-select on? #f))]
|
||||
[click-select (lambda (on?) (do-select on? #t))]
|
||||
|
@ -804,21 +805,32 @@
|
|||
[selectable? #t]
|
||||
[show-focus? #f]
|
||||
[on-select-always? #t]
|
||||
[on-click-always? #f]
|
||||
[allow-deselect? #f])
|
||||
(public
|
||||
[on-select-always
|
||||
(case-lambda
|
||||
[() on-select-always?]
|
||||
[(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
|
||||
(case-lambda
|
||||
[() allow-deselect?]
|
||||
[(v) (set! allow-deselect? (and v #t))])])
|
||||
(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
|
||||
[(not selected?)
|
||||
;; this wasn't really a selection, only useful if
|
||||
;; on-click-always? made us do an on-click above
|
||||
(void)]
|
||||
[(and selectable?
|
||||
item
|
||||
item
|
||||
(send item get-allow-selection?))
|
||||
(unless (eq? item selected-item)
|
||||
(when selected (send selected show-select #f))
|
||||
|
@ -827,9 +839,9 @@
|
|||
(when selected (send selected show-select #t))
|
||||
(when (or clicked? on-select-always?)
|
||||
(on-select item)))]
|
||||
[(and item
|
||||
clicked?)
|
||||
(on-click item)]
|
||||
[(and item clicked?)
|
||||
(unless on-click-always? ; already called above
|
||||
(on-click item))]
|
||||
[allow-deselect?
|
||||
(when selected-item
|
||||
(send selected show-select #f)
|
||||
|
@ -838,7 +850,7 @@
|
|||
(when (or clicked? on-select-always?)
|
||||
(on-select #f))]))])
|
||||
(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-item #f])
|
||||
(sequence
|
||||
|
|
Loading…
Reference in New Issue
Block a user