1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
|
# 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: tktable.tcl,v 1.5 2005/02/13 15:55:51 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}}
}
}
}
|
