@implementation TreeBox { - init {} { $super@ Tree init $super@ CanvasBox init set defaults(font) [$label cget -font] set defaults(status) closed set defaults(type) child set defaults(fill) #a0a0a0 set bg [[entry $path._e] cget -selectbackground] set defaults(selectionBackground) $bg destroy $path._e set icons(empty) [@imageCopy empty] set icons(plus) [@imageCopy plus] $icons(plus) configure -background [$canvas cget -bg] set icons(minus) [@imageCopy minus] $icons(minus) configure -background [$canvas cget -bg] set icons(child) [@imageCopy white_sphere] set icons(opened) [@imageCopy sphere] set icons(closed) [@imageCopy sphere] set buildData(lastY) 0 set buildData(selectionItem) {} $self property: status of: $root to: $defaults(status) $self draw: $root set callbacks(Selection) {} } - root: rootNode { $super@ Tree root: $rootNode $self redraw } - toggle: aNode { set aNode [$self format: $aNode] if [$self contains: $aNode] { if [string length [$self childsOf: $aNode]] { if {"[$self property: status of: $aNode]" == "opened"} { $self property: status of: $aNode to: closed } else { $self property: status of: $aNode to: opened } $self redraw } } } - open: aNode { set aNode [$self format: $aNode] if [$self contains: $aNode] { $self property: status of: $aNode to: opened $self redraw } } - close: aNode { set aNode [$self format: $aNode] if [$self contains: $aNode] { $self property: status of: $aNode to: closed $self redraw } } - add: aNode { set aNode [$self format: $aNode] $super add: $aNode $self property: status of: $aNode to: opened $self redraw } - addWithoutUpdate: aNode { set aNode [$self format: $aNode] $super add: $aNode $self property: status of: $aNode to: opened } - remove: aNode { set aNode [$self format: $aNode] $super remove: $aNode foreach field [array names icons $aNode,*] { unset icons($field) } $self redraw } - redraw {} { #- clearing current canvas content foreach item [$canvas find all] { if [string length [set c [bind $item]]] { @debug "$c" } $canvas delete $item } set buildData(lastY) 0 $self draw: [$self root] $canvas configure -scrollregion [$canvas bbox all] if [string length $selection] { $self updateSelection } $self zoomSync } - draw: aNode { if {"$aNode" == "[$self root]"} { $canvas create image 0 0 -image $icons(empty) } if [$self contains: $aNode] { #- setting x,y for the drawing set x0 [expr ([$self levelOf: $aNode] * 20) + 40] set y0 $buildData(lastY) set x1 $x0 set y1 [expr $y0 + 20] set x2 [expr $x0 + 20] set y2 $y1 set x3 [expr $x2 + 10] set y3 $y2 #- expanding branch if previous node of the same level is opened if {"$aNode" != "[$self root]"} { set childrenOfParent [$self childsOf: [$self parentOf: $aNode]] set i [childrenOfParent indexOf: $aNode] if {$i > 0} { incr i -1 set previousNode [lindex $childrenOfParent $i] if {"[$self property: status of: $previousNode]" == "opened"} { #- getting Y set item [$canvas find withtag "node:$previousNode"] set y [expr round([lindex [$canvas coord $item] end])] $canvas lower [$canvas create line \ $x0 $y $x0 $buildData(lastY) -fill $defaults(fill)] } } } #- setting icon following the current type and status of the node set _childs [$self childsOf: $aNode] set parent [$self parentOf: $aNode] if {![string length $_childs]} { if [info exists icons($aNode,child)] { set icon $icons($aNode,child) } else { set icon $icons(child) } set expandIcon $icons(empty) } elseif {"[$self property: status of: $aNode]" == "opened"} { if [info exists icons($aNode,opened)] { set icon $icons($aNode,opened) } else { set icon $icons(opened) } if [string length $_childs] { set expandIcon $icons(minus) } else { set expandIcon $icons(empty) } } else { if [info exists icons($aNode,closed)] { set icon icons($aNode,closed) } else { set icon $icons(closed) } if [string length $_childs] { set expandIcon $icons(plus) } else { set expandIcon $icons(empty) } } set item1 [$canvas create poly $x0 $y0 $x1 $y1 $x2 $y2 $x1 $y1 \ -outline $defaults(fill)] set item2 [$canvas create image $x1 $y2 -image $expandIcon \ -tag [list icon "expandIconOf:$aNode"]] set item3 [$canvas create image $x2 $y2 -image $icon \ -tag "iconOf:$aNode" \ -anchor c] set item4 [$canvas create text $x3 $y3 \ -text [$self nodeNameOf: $aNode] -font $defaults(font) \ -anchor w -tag [list parent:$parent node:$aNode]] $canvas bind $item4 <Double-1> "$self toggle: \"$aNode\"" $canvas bind $item4 <ButtonPress-1> "$self selection: \"$aNode\"" if {[string length $_childs]} { foreach i {1 2 3} { $canvas bind [set item$i] <ButtonPress-1> "$self toggle: \"$aNode\"" } } $canvas lower $item1 $canvas raise $item2 $canvas raise $item3 set buildData(lastY) [expr $buildData(lastY) + 20] if {[string length $_childs] \ && "[$self property: status of: $aNode]" == "opened"} { foreach child $_childs { $self draw: $child } } } } - clear {} { foreach item [$canvas find all] { $canvas delete $item } $self selection: {} $self clear } - selection: aNode { set aNode [$self format: $aNode] #- removing root name if in the path if [regexp [join [list [$self root] (.*)] [$self separator]] $aNode -> node] { if {![string length $node]} { set aNode $node } } if {"$selection" == "$aNode"} { $self selection: {} ; return $self } if {[string length $aNode] && ![$self contains: $aNode]} { return [error "$self doesn't contain \"$aNode\""] } #- clearing current selection if [string length [set i $buildData(selectionItem)]] { $canvas delete $i set buildData(selectionItem) {} } set previousSelectionNode $selection set selection {} if {![string length $aNode]} { return $self } set selection $aNode $self updateSelection $self selectionChange } - updateSelection {} { if {![string length $selection]} { return $self } set bbox [$canvas bbox [$canvas find withtag node:$selection]] if {[llength $bbox] == 4} { foreach {x1 y1 x2 y2} $bbox { set i [$canvas create rectangle $x1 $y1 $x2 $y2 \ -fill $defaults(selectionBackground) \ -outline $defaults(selectionBackground)] #set i [$canvas create rectangle $x1 $y1 $x2 $y2 \ # -fill $defaults(selectionBackground) \ # -outline black] $canvas lower $i set buildData(selectionItem) $i } } } - selection {} { return $selection } - onSelection: aCallback { set callbacks(Selection) $aCallback } - onSelection {} { return $callbacks(Selection) } - selectionChange {} { catch {eval $callbacks(Selection)} } - itemOfNode: aNode { set aNode [$self format: $aNode] return [$canvas find withtag node:$aNode] } - openedIcon: aBitmap { set aNode [$self format: $aNode] set icons(opened) $aBitmap $self redraw } - closedIcon: aBitmap { set icons(closed) $aBitmap $self redraw } - childIcon: aBitmap { set icons(child) $aBitmap $self redraw } - openedIcon {} { return $icons(opened) } - closedIcon {} { return $icons(closed) } - childIcon {} { return $icons(child) } - openedIconOfNode:to: {aNode aBitmap} { set aNode [$self format: $aNode] set icons($aNode,opened) $aBitmap $self redraw } - closedIconOfNode:to: {aNode aBitmap} { set aNode [$self format: $aNode] set icons($aNode,closed) $aBitmap $self redraw } - childIconOfNode:to: {aNode aBitmap} { set aNode [$self format: $aNode] set icons($aNode,child) $aBitmap $self redraw } - iconOfNode:to: {aNode aBitmap} { set aNode [$self format: $aNode] set icons($aNode,opened) $aBitmap set icons($aNode,closed) $aBitmap set icons($aNode,child) $aBitmap $self redraw } - openedIconOfNode: aNode { set aNode [$self format: $aNode] if [info exists icons($aNode,opened)] { return $icons($aNode,opened) } else { return $icons(opened) } } - closedIconOfNode: aNode { set aNode [$self format: $aNode] if [info exists icons($aNode,closed)] { return $icons($aNode,closed) } else { return $icons(closed) } } - childIconOfNode: aNode { set aNode [$self format: $aNode] if [info exists icons($aNode,child)] { return $icons($aNode,child) } else { return $icons(child) } } - saveToFile: aFile { set f [open $aFile w] foreach node [lsort [$self allChilds]] { puts $f "$node" } close $f } - onLeftClick: aCallback { bind $canvas <ButtonRelease-1> "$self doLeftClick" set callbacks(LeftClick) $aCallback } - doLeftClick {} { catch {eval $callbacks(LeftClick)} } - onMiddleClick: aCallback { bind $canvas <ButtonRelease-2> "$self doMiddleClick" set callbacks(MiddleClick) $aCallback } - doMiddleClick {} { catch {eval $callbacks(MiddleClick)} } - onRightClick: aCallback { bind $canvas <ButtonRelease-3> "$self doRightClick" set callbacks(RightClick) $aCallback } - doRightClick {} { catch {eval $callbacks(RightClick)} } - add: aNode { set aNode [$self format: $aNode] $super add: $aNode $self property: status of: $aNode to: opened $self redraw } - seeEnd {} { $canvas yview moveto [lindex [$canvas yview] end] $canvas xview moveto [lindex [$canvas xview] end] } - forwardInvocation: anInvocation { if [$self respondsTo: [@selector $anInvocation]] { if [catch {set result [eval $self $anInvocation]} err] { return [error $err] } $self redraw if {"$result" != "$self"} { return $result } } else { return [eval $super $anInvocation] } } - dealloc {} { $self release return [$super dealloc] } - loadFromFile: aFile { $super@ Tree loadFromFile: $aFile foreach child [$self allChilds] { $self property: status of: $child to: closed } $self redraw } - loadFromDirectory: aDirectory { $super@ Tree loadFromDirectory: $aDirectory foreach child [$self allChilds] { $self property: status of: $child to: opened } $self redraw } - canvasBackground: aColor { $canvas configure -background $aColor $icons(plus) configure -background $aColor $icons(minus) configure -background $aColor } }