TkTableはdllで配布されていますが、ヘルプに説明のあるデフォルトのバインディングはlib/Tktable2.9/tkTable.tclに書かれているようです。
このファイルは特にデモアプリなどで使われているわけではなく、単にカスタマイズする人のために内部の実装を見えるようにしたものだと思われます。
TkTableはオプションで-selectmode extendedを指定することでドラッグによる範囲選択ができるようになるのですが、セル領域とタイトルセル領域にまたがってドラッグした場合、選択領域がばらばらになってしまうという問題がありました。
最新の2.10に添付されたtkTable.tclも全く変わってなかったので、修正してみました。ただ、過去の選択部分だけをクリアするような処理を、全域クリアに変えてしまったので、パフォーマンス的には問題ありの可能性もあります。ためしに3000行×50列とかでやってみたところでは全く問題ありませんでした。
--- C:/Tcl/lib/Tktable2.9/tkTable.tcl Tue Aug 25 20:01:59 2009
+++ C:/devel/tcl/tktable/tkTable.tcl Fri Aug 28 18:59:51 2009
@@ -433,26 +433,54 @@
if {[catch {$w index anchor}]} { return }
scan $Priv(tablePrev) %d,%d r c
scan $el %d,%d elr elc
- if {[$w tag includes title $el]} {
- if {$r < [$w cget -titlerows]+[$w cget -roworigin]} {
- ## We're in a column header
- if {$c < [$w cget -titlecols]+[$w cget -colorigin]} {
- ## We're in the topleft title area
- $w selection clear anchor end
- } else {
- $w selection clear anchor [$w index end row],$c
- }
- $w selection set anchor [$w index end row],$elc
- } else {
- ## We're in a row header
- $w selection clear anchor $r,[$w index end col]
- $w selection set anchor $elr,[$w index end col]
+
+ set titlerowend [expr {[$w cget -titlerows]+[$w cget -roworigin]}]
+ set titlecolend [expr {[$w cget -titlecols]+[$w cget -colorigin]}]
+ if {$r != $elr} {
+ if {$r < $titlerowend} {
+ if {$elr >= $titlerowend && $r >= $titlerowend} {
+ set elr $r; # turn aside while selecting title row area
+ }
+ } else {
+ if {$elr < $titlerowend && $r < $titlerowend && $elc >= $titlecolend} {
+ set elr $r; # turn aside while selecting non-title row area
+ }
+ }
}
+ if {$c != $elc} {
+ if {$c < $titlecolend} {
+ if {$elc >= $titlecolend && $c >= $titlecolend} {
+ set elc $c; # turn aside while selecting title col area
+ }
+ } else {
+ if {$elc < $titlecolend && $c < $titlecolend && $elr >= $titlerowend} {
+ set elc $c; # turn aside while selecting non-title col area
+ }
+ }
+ }
+ $w selection clear all
+ if {[$w tag includes title $r,$c]} {
+ if {$r < $titlerowend} {
+ if {$c < $titlecolend} {
+ ## We're in the topleft title area
+ if {$elc >= $titlecolend} {
+ $w selection set anchor [$w index end row],$elc
+ } else {
+ $w selection set anchor $elr,[$w index end col]
+ }
+ } else {
+ ## We're in a column header
+ $w selection set anchor [$w index end row],$elc
+ }
+ } else {
+ ## We're in a row header
+ $w selection set anchor $elr,[$w index end col]
+ }
+ set Priv(tablePrev) $elr,$elc
} else {
- $w selection clear anchor $Priv(tablePrev)
- $w selection set anchor $el
+ $w selection set anchor $el
+ set Priv(tablePrev) $r,$c
}
- set Priv(tablePrev) $el
}
}
}