gui/implementation/TreeBox.tcl


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

}