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

...

Browse Source 
original commit: 8b372620ae76c9a61067c61192f05fe32877c08a
This commit is contained in:
Robby Findler 2001-10-23 03:44:55 +00:00
parent ca0a970012
commit c071b7efa2
2 changed files with 341 additions and 323 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
collects/framework/private/main.ss
View File

@ -67,7 +67,8 @@
with-syntax with-syntax
module module
let/cc let/ec letcc catch let/cc let/ec letcc catch
let-syntax letrec-syntax syntax-case let-syntax letrec-syntax
syntax-case syntax-case*
let-signature fluid-let let-signature fluid-let
let-struct let-macro let-values let*-values let-struct let-macro let-values let*-values
case when unless match case when unless match

27
collects/hierlist/hierlist-unit.ss
View File

@ -147,18 +147,24 @@
is-selected? is-selected?
select select
user-data user-data
get-allow-selection?
set-allow-selection
get-clickable-snip)) get-clickable-snip))
(define hierarchical-list-item% (define hierarchical-list-item%
(class100* object% (hierarchical-list-item<%>) (snp) (class100* object% (hierarchical-list-item<%>) (snp)
(private-field (private-field
[snip snp] [snip snp]
[data #f]) [data #f]
[allow-selection #t])
(public (public
[get-allow-selection? (lambda () allow-selection)]
[set-allow-selection (lambda (_a) (set! allow-selection _a))]
[get-clickable-snip (lambda () snip)] [get-clickable-snip (lambda () snip)]
[get-editor (lambda () (send snip get-item-buffer))] [get-editor (lambda () (send snip get-item-buffer))]
[is-selected? (lambda () (send (send snip get-editor) is-selected?))] [is-selected? (lambda () (send (send snip get-editor) is-selected?))]
[select (lambda (on?) (send (send snip get-editor) select on?))] [select (lambda (on?) (send snip select on?))]
[scroll-to (lambda () (let* ([admin (send snip get-admin)] [scroll-to (lambda () (let* ([admin (send snip get-admin)]
[dc (send admin get-dc)] [dc (send admin get-dc)]
[h-box (box 0.0)]) [h-box (box 0.0)])
@ -176,6 +182,10 @@
new-list new-list
delete-item delete-item
get-items get-items
open
close
toggle-open/closed
is-open?
get-arrow-snip)) get-arrow-snip))
(define hierarchical-list-compound-item% (define hierarchical-list-compound-item%
@ -270,7 +280,8 @@
(send dc set-brush b))))]) (send dc set-brush b))))])
(public (public
[select (lambda (on?) [select (lambda (on?)
(unless (eq? (not selected?) (not on?)) (unless (eq? (not selected?)
(not on?))
(top-select (if on? item #f) snip)))] (top-select (if on? item #f) snip)))]
[double-select (lambda () (send top on-double-select item))] [double-select (lambda () (send top on-double-select item))]
[select-prev (lambda () (send top select-prev))]) [select-prev (lambda () (send top select-prev))])
@ -557,6 +568,7 @@
[on-item-closed (lambda (i) (void))] [on-item-closed (lambda (i) (void))]
[on-double-select (lambda (i) (void))] [on-double-select (lambda (i) (void))]
[on-select (lambda (i) (void))] [on-select (lambda (i) (void))]
[on-click (lambda (i) (void))]
[new-item (lambda x (send top-buffer new-item . x))] [new-item (lambda x (send top-buffer new-item . x))]
[new-list (lambda x (send top-buffer new-list . x))] [new-list (lambda x (send top-buffer new-list . x))]
[delete-item (lambda (i) (send top-buffer delete-item i))] [delete-item (lambda (i) (send top-buffer delete-item i))]
@ -682,13 +694,18 @@
[show-focus? #f]) [show-focus? #f])
(private (private
[do-select (lambda (item s) [do-select (lambda (item s)
(when selectable? (cond
[(and selectable?
item
(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))
(set! selected (if item s #f)) (set! selected (if item s #f))
(set! selected-item item) (set! selected-item item)
(when selected (send selected show-select #t)) (when selected (send selected show-select #t))
(on-select item))))]) (on-select item))]
[item
(on-click item)]))])
(private-field (private-field
[top-buffer (make-object hierarchical-list-text% this (lambda (i s) (do-select i s)) 0 #f)] [top-buffer (make-object hierarchical-list-text% this (lambda (i s) (do-select i s)) 0 #f)]
[selected #f] [selected #f]