# core/implementation/Tree.tcl

    @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
        }
    }