# copyright (C) 1997-2006 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: tktable.tcl,v 1.6 2006/01/28 19:16:59 jfontain Exp $

# utilities for the tkTable widget


namespace eval ::tk::table {                                                   ;# already exists as tkTable package should be loaded

    class rightColumnTipper {        ;# displays a widget tip with cell content when rightmost column data is not completely visible

        proc rightColumnTipper {this path} {
            set bindings [new bindings $path end]
            bindings::set $bindings <Enter> "::tk::table::rightColumnTipper::enter $this %x %y"
            bindings::set $bindings <Leave> "::tk::table::rightColumnTipper::leave $this"
            set ($this,bindings) $bindings
            set ($this,path) $path
        }

        proc ~rightColumnTipper {this} {
            delete $($this,bindings)
            if {![catch {classof $($this,tip)}]} {delete $($this,tip)}                              ;# delete tip is it still exists
        }

        proc enter {this x y} {
            bindings::set $($this,bindings) <Motion> "::tk::table::rightColumnTipper::motion $this %x %y"
            set ($this,cell) [$($this,path) index @$x,$y]
            in $this $($this,cell)
        }

        proc leave {this} {
            bindings::set $($this,bindings) <Motion> {}
            catch {unset ($this,cell)}                                            ;# should not need to be caught but better be safe
        }

        proc motion {this x y} {
            set cell [$($this,path) index @$x,$y]
            if {![info exists ($this,cell)]} {set ($this,cell) cell}                       ;# should never happen but better be safe
            if {[string equal $cell [$($this,path) index end]]} {
                # lower right corner cell which tktable code thinks extends all the way down to the bottom limit of the table
                foreach {left top width height} [$($this,path) bbox $cell] {}
                if {$y > ($top + $height)} {set cell -1,-1}              ;# actually out of the cell: simulate position in void cell
            }
            if {[string equal $cell $($this,cell)]} return                                                              ;# no change
            in $this [set ($this,cell) $cell]
        }

        proc in {this cell} {
            scan $cell %d,%d row column
            if {($row < 0) || ($column < 0)} return                                                            ;# ignore title areas
            if {$column != [$($this,path) index end col]} return                                         ;# not the rightmost column
            set path $($this,path)
            set data [$path cget -variable]
            if {[string length $data] == 0} return                       ;# just in case there is no data associated with this table
            set text [set ${data}($cell)]
            set label [label $path.temporary -font [$path cget -font] -text $text]                     ;# note: tag font not handled
            set required [winfo reqwidth $label]                                     ;# required display width for cell textual data
            destroy $label
            foreach {left top width height} [$path bbox $cell] {}
            if {![info exists width] || ($width >= $required)} return                     ;# void cell or no clipping: nothing to do
            if {![catch {classof $($this,tip)}]} {delete $($this,tip)}   ;# ephemeral tip has a good chance of being deleted already
            set ($this,tip) [new widgetTip\
                -path $path -rectangle [list $left $top [expr {$left + $width}] [expr {$top + $height}]] -text $text -ephemeral 1\
            ]
        }

    }

}

proc adjustTableColumns {table} {                               ;# automatically set column widths according to column cells content
    upvar #0 [$table cget -variable] data

    if {[array size data] == 0} return
    update idletasks                                                 ;# make sure table and its labels is completely drawn and sized
    set label [label .temporary]        ;# use a temporary label for precise measurements, instead of using the font measure command
    set firstRow [$table cget -roworigin]
    set lastRow [expr {$firstRow + [$table cget -rows]}]
    set column [$table cget -colorigin]
    set lastColumn [expr {$column + [$table cget -cols]}]
    set defaultFont [$table cget -font]
    for {} {$column < $lastColumn} {incr column} {
        set maximum 0
        for {set row $firstRow} {$row < $lastRow} {incr row} {
            if {[string length [$table hidden $row,$column]] > 0} continue                         ;# take hidden cell width as null
            if {[catch {set window [$table window cget $row,$column -window]}]} {
                set font $defaultFont
                if {[$table tag includes title $row,$column] && ([string length [$table tag cget title -font]] > 0)} {
                    set font [$table tag cget title -font]
                }
                set text {}; catch {set text $data($row,$column)}                                              ;# data may not exist
                $label configure -font $font -text $text
                set width [expr {[winfo reqwidth $label] + (2 * [$table cget -padx])}]
            } else {
                set width [expr {[winfo reqwidth $window] + (2 * [$table window cget $row,$column -padx])}]
            }
            if {$width > $maximum} {
                set maximum $width
            }
        }
        $table width $column -$maximum
    }
    destroy $label
}


proc drawTableLimits {path lastColumn {embeddedWindowsCommand {}}} {
    set previous [$path tag row lastrow]
    if {[llength $previous] > 0} {                            ;# eventually reset last row aspect in case number of rows has changed
        $path tag row {} $previous
        if {[string length $embeddedWindowsCommand] > 0} {
            uplevel #0 $embeddedWindowsCommand $previous {{1 0 1 0}}
        }
    }
    catch {$path tag cell {} [$path tag cell lastcell]}      ;# eventually reset last cell aspect in case number of rows has changed
    set row [$path index end row]
    if {$row < 0} {                                                                                                  ;# no data rows
        $path configure -borderwidth {1 0 1 1}                             ;# so that title row bottom is delimited by a thin border
        $path window configure -1,$lastColumn -borderwidth 1
    } else {
        $path configure -borderwidth {1 0 1 0}                            ;# only draw a thin dark line on top and left of each cell
        $path window configure -1,$lastColumn -borderwidth {1 1 1 0}         ;# so that the right side is delimited by a thin border
        $path tag row lastrow $row                                               ;# so that the bottom is delimited by a thin border
        $path tag cell lastcell [$path index end]
        if {[string length $embeddedWindowsCommand] > 0} {
            uplevel #0 $embeddedWindowsCommand $row {{1 0 1 1}}
        }
    }
}
