1  #lang racket/base
 2  
 3  (require mzlib/unit
 4           racket/gui/base
 5           "hierlist/hierlist-sig.rkt"
 6           "hierlist/hierlist-unit.rkt")
 7  
 8  (define-values/invoke-unit/infer hierlist@)
 9  
10  (provide-signature-elements hierlist^)
11  
12  ;; ============================================================
13  
14  (module+ demo
15  (require racket/class)
16  
17  (define f (make-object frame% (format "test ~s" (version))))
18  (define p (make-object horizontal-panel% f))
19  (define c (make-object (class hierarchical-list%
20                           (define/override (on-item-opened i)
21                             (let ([f (send i user-data)])
22                               (when f (f i))))
23                           (define/override (on-select i)
24                             (printf "Selected: ~a\n"
25                                     (if i 
26                                         (send (send i get-editor) get-flattened-text)
27                                         i)))
28                           (define/override (on-double-select s)
29                             (printf "Double-click: ~a\n"
30                                     (send (send s get-editor) get-flattened-text)))
31                           (super-new))
32                         p))
33  
34  (define a (send c new-list))
35  (send (send a get-editor) insert "First Item: List")
36  (send (send (send a new-item) get-editor) insert "Sub1")
37  (send (send (send a new-item) get-editor) insert "Sub2")
38  (define a.1 (send a new-list))
39  (send (send a.1 get-editor) insert "Deeper List")
40  (send (send (send a.1 new-item) get-editor) insert "Way Down")
41  
42  (define b (send c new-item))
43  (send (send b get-editor) insert "Second Item")
44  
45  (define d (send c new-list))
46  (send (send d get-editor) insert "dynamic")
47  (send d user-data (lambda (d)
48  		    (time (let loop ([i 30])
49  			    (unless (zero? i)
50  				    (send (send (send d new-item) get-editor) insert (number->string i))
51  				    (loop (sub1 i)))))))
52  
53  (define x (send c new-list))
54  (send (send x get-editor) insert "x")
55  
56  (define y (send c new-item))
57  (send (send y get-editor) insert "y")
58  
59  (define z (send c new-list))
60  (send (send z get-editor) insert "a multi-line\nlabel")
61  (send (send (send z new-item) get-editor) insert "Sub1")
62  (send (send (send z new-item) get-editor) insert "Sub2")
63  
64  (send f show #t)
65  
66  (yield (make-semaphore))
67  )