From a71a5bcf45df13d310a35f1c077614ad26e0d1ad Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Wed, 9 Jul 2008 09:47:24 +0000 Subject: [PATCH] Make categories in the language dialog expand/collapse on a single click, requires extending hierlists with `on-click-always' svn: r10691 --- .../private/language-configuration.ss | 27 ++++++++--------- collects/mrlib/hierlist/hierlist-unit.ss | 30 +++++++++++++------ 2 files changed, 34 insertions(+), 23 deletions(-) diff --git a/collects/drscheme/private/language-configuration.ss b/collects/drscheme/private/language-configuration.ss index 2b9ecbb854..21c1778b4f 100644 --- a/collects/drscheme/private/language-configuration.ss +++ b/collects/drscheme/private/language-configuration.ss @@ -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)) diff --git a/collects/mrlib/hierlist/hierlist-unit.ss b/collects/mrlib/hierlist/hierlist-unit.ss index ebf77bb498..6a0b026aff 100644 --- a/collects/mrlib/hierlist/hierlist-unit.ss +++ b/collects/mrlib/hierlist/hierlist-unit.ss @@ -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