# gui/implementation/TableBox.tcl

    @implementation TableBox {
      - init {} {
          $super init
          set counter 1
          set separator {}
          $super hideBorder
          $frame configure -relief sunken -bd 1
          frame $frame.f

          canvas $frame.f.headers -bd 0 -relief flat -width 10 -height 10
          pack $frame.f.headers -fill both -expand 1
          $frame.f.headers create window 0 0 \
            -window [set headers [frame $frame.f.headers.frame -bd 0]] \
            -anchor nw -tag headers
          canvas $frame.f.main -bd 0 -relief flat -width 10 -height 10
          $frame.f.main create window 0 0 \
            -window [set main [frame $frame.f.main.frame -bd 0]] \
            -anchor nw -tag main

          set xscroll [scrollbar $frame.xscroll -orient horizontal \
            -command "$self xview"]
          set yscroll [scrollbar $frame.yscroll -orient vertical \
            -command "$self yview"]

          $frame.f.main configure -xscrollcommand [list $xscroll set]

          grid $frame.f $frame.yscroll -sticky snew -padx 0 -pady 0
          grid $frame.xscroll -sticky snew -padx 0 -pady 0
          grid rowconfigure $frame 0 -weight 1
          grid columnconfigure $frame 0 -weight 1

          grid $frame.f.headers -sticky snew -padx 0 -pady 0
          grid $frame.f.main -sticky snew -padx 0 -pady 0
          grid rowconfigure $frame.f 1 -weight 1
          grid columnconfigure $frame.f 0 -weight 1

          set callbacks(Selection) {}

          $self on: Configure do: {
            set w [eventData get: path]
            if {"$w" == "$frame.f.main.frame"} {
                $frame.f.main configure -scrollregion [set bbox [$frame.f.main bbox all]]
                $frame.f.headers configure -scrollregion $bbox
            } elseif {"$w" == "$frame.f.headers.frame"} {
                $frame.f.headers configure \
                  -height [winfo height $frame.f.headers.frame]
            } elseif {"$w" == "$frame.headers"} {
                $frame.f.headers configure \
                  -height [winfo height $frame.f.headers.frame] \
                  -scrollregion [$frame.f.headers bbox all]
            } elseif {"$w" == "$frame.f.main"} {
                $frame.f.main itemconfigure [$frame.f.main find withtag main] \
                  -height [winfo height $frame.f.main]
                $frame.f.main configure -scrollregion [set bbox [$frame.f.main bbox all]]
                $frame.f.headers configure -scrollregion $bbox
            }
          }

          $self enableEvent: Configure \
                         on: [list $frame.f.main.frame $frame.f.headers.frame \
                                   $frame.f.main $frame.f.headers]

          $self on: ButtonPress-1 do: {
            $self rowOfSelection: [[eventData get: path] nearest [eventData get: y]]
            $self selectionChange
          }
          $self on: B1-Motion do: {
            $self rowOfSelection: [[eventData get: path] nearest [eventData get: y]]
            $self selectionChange
          }
          $self on: Button-4 do: {
            foreach column [pack slaves $main] {
              if {"[eventData get: path]" != "$column"} {
                $column yview scroll -5 units
              }
            }
          }
          $self on: Button-5 do: {
            foreach column [pack slaves $main] {
              if {"[eventData get: path]" != "$column"} {
                $column yview scroll +5 units
              }
            }
          }
        }

      - columns: columns {
          if [string length $separator] {
            foreach column [split $columns $separator] { $self addColumn: $column }
          } else {
            foreach column $columns { $self addColumn: $column }
          }
        }
      - columns {} {
          set columns {}
          foreach column [pack slaves $headers] {
            lappend columns [$column get 0 end]
          }
          if [string length $separator] {
            return [join $columns $separator]
          } else {
            return $columns
          }
        }
      - rowOfSelection: row {
          foreach column [pack slaves $main] {
            $column selection clear 0 end
            if [string length $row] {
              $column select anchor $row
              $column select set anchor $row
              set rowOfSelection $row
            }
          }
        }
      - rowOfSelection {} {
          return $rowOfSelection
        }
      - selection {} {
          return [$self row: $rowOfSelection]
        }
      - row: aRow {
          set result {}
          set columns [pack slaves $main]
          if {[llength $columns] == 0} { return }
          foreach column $columns {
            lappend result [$column get $i]
          }
          if [string length $separator] {
            return [join [string trimright $result \n] $separator]
          } else {
            return [string trimright $result \n]
          }
        }
      - addColumn: column {
          global tcl_platform

          set length [expr [string length $column] + 3]
          pack [listbox $headers.$counter -relief raised -bd 1 -width $length \
            -height 1 -exportselection no \
            -background [$frame.f.headers cget -bg] \
            -selectbackground [$frame.f.headers cget -bg]] \
            -side left -fill y -expand 1 -padx 0 -pady 0
          $headers.$counter insert end $column
          pack [listbox $main.$counter -width $length -height 5 \
            -relief raised -bd 1 \
            -exportselection no -yscrollcommand [list $yscroll set]] \
            -side left -fill y -expand 1 -padx 0 -pady 0

          $headers configure -width [winfo reqwidth [winfo parent $headers]]

          $self enableEvent: {ButtonPress-1 B1-Motion Button-4 Button-5} \
                         on: $main.$counter
          incr counter
        }

      - add: record {
          set columns [pack slaves $main]
          if {[string length $separator]} {
            if {[llength [split $record $separator]] > [llength $columns]} {
              set record [join [lrange [split $record $separator] 0 [expr [llength $columns] -1]] $separator]
            }
            set items [split $record $separator]
          } else {
            if {[llength $record] > [llength $columns]} {
              set record [join [lrange $record 0 [expr [llength $columns] -1]]]
            }
            set items $record
          }

          foreach column $columns item $items {
            if {[set len [expr [string length $item] +3]] \
              > [$column cget -width]} {
              $column configure -width $len
              $headers.[lindex [split $column .] end] configure -width $len
            }
            $column insert end $item
          }
        }
      - insert:atRow: {record row} {
          set columns [pack slaves $main]
          if {[string length $separator]} {
            if {[llength [split $record $separator] > [llength $columns]} {
              set record [join [lrange [split $record $separator] 0 [expr [llength $columns] -1]] $separator]
            }
          } else {
            if {[llength $record] > [llength $columns]} {
              set record [join [lrange $record 0 [expr [llength $columns] -1]]]
            }
          }

          foreach column $columns item [split $record $separator] {
            if {[set len [expr [string length $item] +3]] \
              > [$column cget -width]} {
              $column configure -width $len
              $headers.[lindex [split $column .] end] configure -width $len
            }
            $column insert $row $item
          }
        }
      - deleteRow: row {
          foreach column [pack slaves $main] {
            $column delete $row $row
          }
        }
      - loadFromFile: aFile {
          if [catch {set f [open $aFile r]} err] {
            @error "$self loadFromFile: $aFile ($err)"
            return -1
          }
          gets $f line
          if {[string length $separator]} {
            set len [llength [split $line $separator]]
          } else {
            set len [llength $line]
          }
          if {![string length [$self columns]]} {
            for {set i 1} {$i <= $len} {incr i} {
              $self addColumn: $i
            }
          }

          while {[eof $f] == 0} {
            gets $f line
            if [string length $line] {
              $self add: $line
            }
          }
          close $f
        }
      - content {} {
          set result {}
          set columns [pack slaves $main]
          if {[llength $columns] == 0} { return }
          for {set i 0} {$i < [[lindex $columns 0] size]} {incr i} {
            set line {}
            foreach column $columns {
              append line [$column get $i],
            }
            append result [string trimright $line ,]\n
          }
          return [string trimright $result \n]
        }
      - xview {args} {
          eval [winfo parent $headers] xview $args
          eval [winfo parent $main] xview $args
        }
      - yview {args} {
          foreach l [pack slaves $main] {
            eval $l yview $args
          }
        }
      - onSelection: aCallback {
          set callbacks(Selection) $aCallback
        }
      - onSelection {} {
          return $callbacks(Selection)
        }
      - selectionChange {} {
          catch {eval $callbacks(Selection)}
        }
      - separator {} { return $separator }
      - separator: _separator { set separator $_separator }
      - dealloc {} {
          catch {destroy $main $headers}
          return [$super dealloc]
        }
    }