@implementation Tree { - init {} { $super init set separator / set root / } - root: rootName { #- changing existing child info if {[string length $rootName] && ("$rootName" != "$root")} { if [string length [set oldroot $root]] { foreach field [array names properties ${root},*] { set f [join [lreplace [split $field ,] 0 0] ,] set properties($rootName,$f) [set properties($field)] unset properties($field) } } set root $rootName } } - root {} { return $root } - separator: aCharacter { if {"$separator" != "$aCharacter"} { #- changing existing info foreach array {nodes childs} { foreach field [array names $array] { if {[llength [split $field $separator]] > 1} { set ${array}([join [split $field $separator] $aCharacter]) [set ${array}($field)] unset ${array}($field) } } } foreach field [array names properties] { set propertyName [lindex [split $field ,] end] set aPath [join [lreplace [split $field ,] end end] ,] if {[llength [split $aPath $separator]] > 1 && "$aPath" != "$aCharacter" && "$aPath" != "$separator"} { set ${array}([join [split $aPath $separator] $aCharacter],$propertyName) \ [set properties($field)] unset properties($field) } } set separator $aCharacter } } - separator {} { return $separator } - add: aNode { set aNode [$self format: $aNode] if {[$self contains: $aNode]} { return [error "([info level 0]) \"$aNode\" already exist"] } set nodeName [$self nodeNameOf: $aNode] set parent [$self parentOf: $aNode] #- checking parent existence if {"$parent" == "$root"} { lappend rootChilds $nodeName } else { if {![$self contains: $parent]} { return [error "([info level 0]) \"$parent\" doesn't exist"] } else { lappend childs($parent) $nodeName } } set nodes($aNode) $nodeName } - addFull: aNode { set aNode [$self format: $aNode] set parent $aNode set parents {} while 1 { set parent \ [join [lreplace [split $parent $separator] end end] $separator] if {![string length $parent]} { break } set parents [linsert $parents 0 $parent] } foreach parent $parents { if {![$self contains: $parent]} { $self add: $parent } } if {![$self contains: $aNode]} { $self add: $aNode } } - remove: aNode { set aNode [$self format: $aNode] if {"$aNode" == "$root"} { $self clear ; $self root: / ; return $self } #- already gone ? if {![$self contains: $aNode]} { return [error "([info level 0]) \"$aNode\" doesn't exist"] } set nodeName [$self nodeNameOf: $aNode] set parent [$self parentOf: $aNode] #- removing node link from parent childs list if {"$parent" != "$root"} { if [string length $parent] { childs($parent) remove: $nodeName } } else { rootChilds remove: $nodeName } #- removing node unset nodes($aNode) #- removing childs if [info exists childs($aNode)] { foreach node $childs($aNode) { $self remove: [join [list $aNode $node] $separator] } unset childs($aNode) } #- removing properties foreach field [array names properties $aNode,*] { unset properties($field) } } - parentOf: aNode { set aNode [$self format: $aNode] if {"$aNode" == "$root"} { return } set parent [join [lreplace [split $aNode $separator] end end] $separator] if {![string length $parent]} { return $root } else { return $parent } } - childsOf: aNode { set aNode [$self format: $aNode] if {"$aNode" == "$root"} { return $rootChilds } if {![$self contains: $aNode]} { return [error "([info level 0]) \"$aNode\" doesn't exist"] } set childsOfNode {} if [info exists childs($aNode)] { foreach node $childs($aNode) { lappend childsOfNode [join [list $aNode $node] $separator] } } return $childsOfNode } - allChilds {} { return [array names nodes] } - allChildsOf: aNode { set aNode [$self format: $aNode] if {"$aNode" == "$root"} { return [array names nodes] } if [$self contains: $aNode] { if {"$aNode" != "$separator"} { return [array names nodes [join [list ${aNode} *] $separator]] } else { return [array names nodes ${aNode}?*] } } return } - contains: aNode { set aNode [$self format: $aNode] if {"$aNode" == "$root"} { return 1 } if [info exists nodes($aNode)] { return 1 } else { return 0 } } - loadFromTree: aTree { $self clear $self root: [$aTree root] $self separator: [$aTree separator] foreach child [$aTree allChilds] { $self add: $child } } - loadFromFile: aFile { set f [open $aFile r] while {![eof $f]} { set line [string trim [gets $f]] if [string length $line] { $self add: $line } } close $f } - saveToFile: aFile { set f [open $aFile w] foreach node [lsort [$self allChildsOf: $root]] { puts $f $node } close $f } - clear {} { foreach array {nodes childs properties} { foreach field [array names $array] { unset ${array}($field) } } $self root: $root } - nodeNameOf: aNode { set aNode [$self format: $aNode] if {"$aNode" == "$separator" && "$aNode" == "$root"} { return $aNode } return [lindex [split $aNode $separator] end] } - levelOf: aNode { set aNode [$self format: $aNode] if {"$aNode" == "$root"} { return 0 } set nodeLevel [llength [split $aNode $separator]] #incr nodeLevel 1 return $nodeLevel } - property:of: {propertyName aNode} { set aNode [$self format: $aNode] if [info exists properties($aNode,$propertyName)] { return $properties($aNode,$propertyName) } else { return [error "([info level 0]) \"$aNode\" doesn't have any \"$propertyName\" property"] } } - property:of:to: {propertyName aNode aValue} { set aNode [$self format: $aNode] set properties($aNode,$propertyName) $aValue } - loadFromDirectory: aDirectory { if {![$self contains: $aDirectory]} { $self addFull: $aDirectory } foreach child [glob -nocomplain $aDirectory/*] { $self loadFromDirectory: $child } } - format: aNode { if {"$aNode" != "/"} { if [regexp [join [list $root (.*)] $separator] $aNode -> node] { if [string length $node] { set aNode $node } } set aNode [string trimleft $aNode /] } return $aNode } }