# copyright (C) 1997-2005 Jean-Luc Fontaine (mailto:jfontain@free.fr)
# this program is free software: please read the COPYRIGHT file enclosed in this package or use the Help Copyright menu

# $Id: selectab.tcl,v 1.15 2005/01/02 00:45:07 jfontain Exp $


# a scrollable table with embedded selector using external outlines so that clean and independant selection can be implemented
# important: the underlying tktable widget must not manipulated directly, otherwise options data may be desynchronized

class selectTable {

    proc selectTable {this parentPath args} composite {
        [new scroll table $parentPath\
            -height 200 -yscrollcommand "selectTable::refreshBorders $this; selectTable::refreshSelection $this"\
        ] $args
    } {
        set path $composite::($composite::($this,base),scrolled,path)
        # leave a 1 pixel wide empty border so that selection rectangles can extend a bit outside the table
        $path configure -font $font::(mediumNormal) -colstretchmode last -cursor {} -bordercursor {} -highlightthickness 1\
            -highlightcolor [$path cget -background] -sparsearray 0 -exportselection 0 -rows 0\
            -drawmode single                                                      ;# in single mode, no light shadow lines are drawn
        set ($this,rows) 0  ;# internally maintain number of rows as tktable, for example, return 1 when -rows was actually set to 0
        bindtags $path [list $path all]                                                              ;# remove all existing bindings
        set ($this,left) [frame $path.left -background {} -highlightthickness 1]                                 ;# dark shadow line
        set ($this,right) [frame $path.right -background {} -highlightthickness 1]                             ;# light shadow lines
        set ($this,bottom) [frame $path.bottom -background {} -highlightthickness 1]
        set ($this,limit) [frame $path.limit -background {} -highlightthickness 1]                                ;# last row bottom
        set ($this,tablePath) $path
        bind $path <Configure> "selectTable::refreshBorders $this"                                   ;# needed when table is resized
        # implement single mode selection:
        set ($this,selector) [new objectSelector -selectcommand "selectTable::setRowsState $this"]
        bind $path <ButtonPress-1> "selectTable::select $this \[%W index @0,%y row\]"
        composite::complete $this
    }

    proc ~selectTable {this} {
        variable ${this}frame

        foreach {row frame} [array get ${this}frame] {
            ::delete $frame
        }
        ::delete $($this,selector)
    }

    proc options {this} {
        return [list\
            [list -background $widget::option(label,background)]\
            [list -columns 1]\
            [list -focuscommand {} {}]\
            [list -followfocus 1]\
            [list -roworigin 0 0]\
            [list -selectcommand {} {}]\
            [list -state normal normal]\
            [list -titlerows 0 0]\
            [list -variable {} {}]\
        ]
    }

    proc set-background {this value} {
        $($this,tablePath) configure -background $value
        foreach {dark light} [3DBorders $($this,tablePath) $value] {}
        $($this,left) configure -highlightbackground $dark
        $($this,right) configure -highlightbackground $light
        $($this,bottom) configure -highlightbackground $light
        $($this,limit) configure -highlightbackground $light
    }

    proc set-columns {this value} {                                                                             ;# number of columns
        $($this,tablePath) configure -cols $value
        refreshBorders $this
        ::adjustTableColumns $($this,tablePath)
    }

    proc set-focuscommand {this value} {}

    proc set-followfocus {this value} {
        if {$composite::($this,complete)} {
            error {option -followfocus cannot be set dynamically}
        }
        if {$value} {
            bind $widget::($this,path) <FocusIn> "selectTable::focus $this 1"     ;# in case focus is explicitely set on main widget
            bind $($this,tablePath) <FocusIn> "selectTable::focus $this 1"
            bind $($this,tablePath) <FocusOut> "selectTable::focus $this 0"
        } else {
            bind $widget::($this,path) <FocusIn> {}
            bind $($this,tablePath) <FocusIn> {}
            bind $($this,tablePath) <FocusOut> {}
        }
    }

    proc set-selectcommand {this value} {}     ;# command must return a boolean which will determine if selection should be canceled

    proc set-state {this value} {
        switch $value {
            normal {}
            disabled {
                clear $this
            }
            default {
                error "bad state value \"$value\": must be normal or disabled"
            }
        }
    }

    proc set-roworigin {this value} {
        if {$composite::($this,complete)} {
            error {option -roworigin cannot be set dynamically}
        }
        $($this,tablePath) configure -roworigin $value
    }

    proc set-titlerows {this value} {
        if {$composite::($this,complete)} {
            error {option -titlerows cannot be set dynamically}
        }
        $($this,tablePath) configure -titlerows $value
    }

    proc set-variable {this value} {
        if {$composite::($this,complete)} {
            error {option -variable cannot be set dynamically}
        }
        $($this,tablePath) configure -variable $value
    }

    proc setRowsState {this rows select} {
        variable ${this}frame

        set path $($this,tablePath)
        if {$select} {
            foreach row $rows {
                set ${this}frame($row) [new selectFrame $path $row]
            }
        } else {
            foreach row $rows {
                ::delete [set ${this}frame($row)]
                unset ${this}frame($row)
            }
        }
    }

    # public procedures below:

    # set or get number of rows, not counting title rows (used instead of -rows option as reliable synchronization with table actual
    # number of rows is too difficult to achieve)
    proc rows {this {number {}}} {
        if {[string length $number] == 0} {
            return $($this,rows)
        } else {
            $($this,tablePath) configure -rows [expr {$number + $composite::($this,-titlerows)}]
            # note: user should refresh borders and possibly adjust table columns when new rows are added or rows deleted
            set ($this,rows) $number
        }
    }

    proc select {this row} {
        if {$row < 0} {return 0}                                                                  ;# prevent selection on title line
        if {[string equal $composite::($this,-state) disabled]} {return 0}
        if {[info exists ($this,selected)] && ($row == $($this,selected))} {return 1}                          ;# selection is valid
        if {([string length $composite::($this,-selectcommand)] == 0) || [uplevel #0 $composite::($this,-selectcommand) $row]} {
            # selection may be canceled by user code
            set ($this,selected) $row
            selector::select $($this,selector) $row
            $($this,tablePath) see $row,[$($this,tablePath) index topleft col]                           ;# make sure row is visible
            return 1                                                                                           ;# selection is valid
        } else {
            return 0                                                                                         ;# selection is invalid
        }
    }

    proc refreshSelection {this first last} {
        variable ${this}frame

        set path $($this,tablePath)
        foreach {row frame} [array get ${this}frame] {
            ::delete $frame
            set ${this}frame($row) [new selectFrame $path $row]
        }
    }

    proc refreshBorders {this} {
        foreach {x y width height} [$($this,tablePath) bbox bottomright] {}
        if {![info exists x]} return                                                                                  ;# not visible
        incr y -1
        incr height $y
        place $($this,limit) -y $height -relwidth 1 -height 1
        place $($this,left) -width 1 -relheight 1 -height 1
        place $($this,right) -relx 1 -x -1 -y 1 -width 1 -relheight 1
        place $($this,bottom) -rely 1 -relwidth 1 -height 1
    }

    proc selected {this} {
        set list {}
        catch {lappend list $($this,selected)}
        return $list
    }

    proc clear {this} {                                                                                                 ;# selection
        selector::clear $($this,selector)
        catch {unset ($this,selected)}
    }

    proc focus {this in} {
        variable ${this}frame

        if {![info exists ($this,selected)]} return                                        ;# nothing to do if there is no selection
        if {$in} {
            selectFrame::refresh [set ${this}frame($($this,selected))] 0
        } else {
            selectFrame::refresh [set ${this}frame($($this,selected))] 1
        }
        if {[string length $composite::($this,-focuscommand)] > 0} {
            uplevel #0 $composite::($this,-focuscommand) $($this,selected) $in
        }
    }

    proc delete {this rows} {                                                    ;# any row deletion must be done here, not directly
        set path $($this,tablePath)
        foreach row $rows {$path delete rows $row}
        incr ($this,rows) -[llength $rows]
    }

    proc windows {this} {
        set path $($this,tablePath)
        set list {}
        foreach cell [$path window names] {
            lappend list [$path window cget $cell -window]
        }
        return $list
    }

    proc windowConfigure {this cell args} {
        return [eval $($this,tablePath) window configure $cell $args]
    }

    proc window {this cell} {
        return [$($this,tablePath) window cget $cell -window]
    }

    proc see {this cell} {
        $($this,tablePath) see $cell
    }

    proc spans {this args} {
        return [eval $($this,tablePath) spans $args]
    }

    proc tag {this option args} {
        return [eval $($this,tablePath) tag $option $args]
    }

    proc height {this args} {
        return [eval $($this,tablePath) height $args]
    }

    proc adjustTableColumns {this} {
        ::adjustTableColumns $($this,tablePath)
    }

}


class selectTable {

    class selectFrame {

        proc selectFrame {this table row} {                                           ;# use 4 border frames to make selector hollow
            foreach side {left top right bottom} {
                lappend ($this,frames) [new frame $table -background {} -highlightthickness 1 -highlightbackground black]
            }
            set ($this,table) $table
            set ($this,row) $row
            refresh $this 0
        }

        proc ~selectFrame {this} {
            eval delete $($this,frames)
        }

        proc refresh {this hide} {
            set table $($this,table)
            foreach {x y width height}\
                [$table bbox $($this,row),[$table index topleft col] $($this,row),[$table index bottomright col]] {}
            if {![info exists x]} return                                                                          ;# row not visible
            if {$hide} {
                foreach frame $($this,frames) {
                    place forget $widget::($frame,path)
                }
            } else {                                ;# draw a rectangle that horizontally extends beyond the table limits by 1 pixel
                foreach {left top right bottom} $($this,frames) {}
                incr y -1
                place $widget::($left,path) -x -1 -y $y -width 1 -height $height
                place $widget::($top,path) -x -1 -y $y -relwidth 1 -width 1 -height 1
                place $widget::($right,path) -relx 1 -x 0 -y $y -width 1 -height [expr {$height + 1}]
                place $widget::($bottom,path) -x -1 -y [expr {$y + $height}] -relwidth 1 -width 1 -height 1
            }
        }

    }

}