ttk::treeview mixins
Introduction
DDG 2020-04-06: If you write mega widgets your widgets become fast to specialized. You add features and behaviours to your widget and some time later you observe that you have to create a similar widget and you are extracting those specializations from your previous widgets. After reading Designing SNIT widgets as mixins, I decided to do a few sample implementations for the ttk::treeview widget to check the concept. The widget adaptors are just adding a small set of functionality and can be added by nesting at object creation to the ttk::treeview widget. Here an hypothetical example which creates a filebrowser with letter search facility and automatic banding stripes added after each insert:
set filebrowser [filebrowser [filtersearch [bandtable [ttk::treeview .tv]]] -directory .]
The nice thing is, that you can use the bandtable or filtersearch widget adaptors for any other treeview widget. Mixins are an additional concept to inheritance and delegation which allow you to add behaviour on the fly to existing objects. I know that tclOO has support for mixins but I have not seen a mega widget written using tclOO using this concept.
Implementation Examples
Below a few sample mixins for the ttk::treeview widget.
- dgw::tvband - traces insert commands and adds stripes to the widget
- dgw::tvfilebrowser - simple file browser widget
- dgw::tvksearch - adds forward search in the first column by typing starting letters
- dgw::tvtooltip - adds <<RowEnter>> and <<RowLeave>> events for displaying tooltips on widgets which support the -textvariable option
- dgw::tvsortable - adds sorting facilities to ttk::treeview widgets
TODO's:
- inplace edits using code from Inplace edit in ttk::treeview
- tvbook with book images version closing/oping, images should be changed as well to opening and closing folders
- sort filenames, folders mode (done, see dgw::tvmixins package)
- more columns for the filebrowser as in normal file manager, configurable
- tooltips as balloons
- banding after sorting (done)
- banding colors as options (done, see dgw::tvmixins package)
package require Tk
package require snit
namespace eval dgw {}
package provide dgw::tvmixins 0.2
# widget adaptor which does a banding of the ttk::treeview
# widget automatically after each insert command
snit::widgetadaptor ::dgw::tvband {
delegate option * to hull
delegate method * to hull
# problem:
# can't avoid delegating insert as if it is
# overerwritten parent insert can't be called
# solved using trace
constructor {args} {
installhull $win
$win tag configure band0 -background #FFFFFF
$win tag configure band1 -background #DDEEFF
bind $win <<SortEnd>> [mymethod band]
trace add execution $win leave [mymethod wintrace]
$self configurelist $args
}
method band {} {
set i 0
foreach item [$win children {}] {
set t [expr { [incr i] % 2 }]
$win tag remove band0 $item
$win tag remove band1 $item
$win tag add band$t $item
}
}
method wintrace {args} {
set path [lindex [lindex $args 0] 0]
set meth [lindex [lindex $args 0] 1]
if {$meth eq "insert"} {
set parent [lindex [lindex $args 0] 2]
set index [lindex [lindex $args 0] 3]
set item [lindex [$path children $parent] $index]
if {$index eq "end"} {
set i [llength [$path children $parent]]
} else {
set i $index
}
set t [expr { $i % 2 }]
$path tag remove band0 $item
$path tag remove band1 $item
$path tag add band$t $item
}
}
}
# widget adaptor which allows forward searching in a ttk::treeview
# with typing beginning letters of entries matching first column text
# further has bindings of Home and End key
snit::widgetadaptor ::dgw::tvksearch {
delegate option * to hull
delegate method * to hull
variable LastKeyTime [clock seconds]
variable LastKey ""
constructor {args} {
installhull $win
bind $win <Key-Home> [mymethod setSelection 0]
bind $win <Key-End> [mymethod setSelection end]
bind $win <Any-Key> [mymethod ListMatch %A]
$self configurelist $args
}
method setSelection {index} {
$self focus [lindex [$self children {}] $index]
$self selection set [lindex [$self children {}] $index]
focus -force $self
$self see [lindex [$self selection] 0]
}
method ListMatch {key} {
if [regexp {[-A-Za-z0-9]} $key] {
set ActualTime [clock seconds]
if {[expr {$ActualTime-$LastKeyTime}] < 3} {
set ActualKey "$LastKey$key"
} else {
set ActualKey $key
}
set n 0
foreach i [$win children {}] {
set name [lindex [$win item $i -value] 0]
if [string match $ActualKey* $name] {
$win selection remove [$win selection]
$win focus $i
$win selection set $i
focus -force $win
$win see $i
set LastKeyTime [clock seconds]
set LastKey $ActualKey
break
} else {
incr n
}
}
}
}
}
# a file browser widget as widget adaptor
# could may be better a snit::widget
# as it is already quite specialized
# however writing it as a adaptor allows nesting
# so banding widget adaptor can go intern
# this is required as within the constructor
# $self browseDir is called
# the banding must be installed before this is called
snit::widgetadaptor ::dgw::tvfilebrowser {
option -dummy ""
option -filepattern ".+"
option -directory "."
option -browsecmd ""
option -fileimage fileImg
delegate option * to hull
delegate method * to hull except browseDir
variable LastKeyTime [clock seconds]
variable LastKey ""
constructor {args} {
ttk::style configure Treeview.Item -padding {1 1 1 1}
installhull $win ;# using ttk::treeview
$win configure -columns [list Name Size] -show [list tree headings]
$win heading Name -text Name
$win heading Size -text Size
$win column Name -width 60
$win column Size -width 30
$win column #0 -width 35 -anchor w -stretch false
bind $win <Double-1> [mymethod fbOnClick %W %x %y]
bind $win <Return> [mymethod fbReturn %W]
bind $win <Key-BackSpace> [mymethod browseDir ..]
$win tag configure hilight -foreground blue
$self configurelist $args
$self browseDir $options(-directory)
}
typeconstructor {
image create photo movie -data {
R0lGODlhEAAQAIIAAPwCBARCRAQCBASChATCxATCBASCBAAAACH5BAEAAAAA
LAAAAAAQABAAAANHCLrc/izISauYI5NduvlXMIjEQBSnUYCYxnmsSJrouhqh
6J4wLo0mWuqWy5heN58seBrGdEdeMgQsNW0ggXbL7Qog4HDDnwAAIf5oQ3Jl
YXRlZCBieSBCTVBUb0dJRiBQcm8gdmVyc2lvbiAyLjUNCqkgRGV2ZWxDb3Ig
MTk5NywxOTk4LiBBbGwgcmlnaHRzIHJlc2VydmVkLg0KaHR0cDovL3d3dy5k
ZXZlbGNvci5jb20AOw==
}
image create photo fileImg -data {
R0lGODlhEAAOAPcAAAAAADVJYzZKZJOit5WkuZalupqpvpyrwJ6uw6OyyKSzyae2zKm5z6u70a6+
1K+/1bLC2LrF1L3K4cTP5MnT5svV59HZ6tPb69Xd7Njf7drh7tzj79/l8OHn8ePp8ubr9Ont9evv
9u7x9/Dz+PL1+fX3+vf4+/n6/Pv8/fz9/v7+/v///wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAP8ALAAAAAAQAA4A
AAh7AP/9g0CwoAMGCgQqFAhhhcOHKw4IWCjwAcSHBCJMXNjgosMBAkIuXOBxBYoBIBcm8KiiBIgB
ARYi8HhCRAeYCw1cTEHigwacCgtcNBGCwwWgAgdARDHCQ4YKSP8pddgSxAYLE6JOXVGzAwYKErSi
HEs2aoCzaNOeFRgQADs=}
image create photo clsdFolderImg -data {
R0lGODlhEAAOAPcAAAAAAJycAM7OY//OnP//nP//zvf39wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAP8ALAAAAAAQAA4A
AAhjAP8JHEiw4MAACBECMHjQQIECBAgEWGgwgICLGAUkTCgwwMOPIB8SELDQY8STKAkMIPnPZEqV
MFm6fDlApUyIKGvqHFkSZ06YK3ue3KkzaMsCRIEOMGoxo1OMFAFInUqV6r+AADs=}
}
method fbReturn {w} {
set row [$win selection]
$win tag remove hilight
$win tag add hilight $row
set fname [lindex [$win item $row -values] 0]
if {[file isdirectory $fname]} {
$self browseDir $fname
} else {
if {$options(-browsecmd) ne ""} {
$options(-browsecmd) $fname
}
}
}
method fbOnClick {w x y} {
set row [$win identify item $x $y]
$win tag remove hilight
$win tag add hilight $row
set fname [lindex [$win item $row -values] 0]
if {[file isdirectory $fname]} {
$self browseDir $fname
} else {
if {$options(-browsecmd) ne ""} {
$options(-browsecmd) $fname
}
}
}
onconfigure -directory value {
$self browseDir $value
set options(-directory) $value
}
method browseDir {{dir "."}} {
if {[llength [$win children {}]] > 0} {
$win delete [$win children {}]
}
if {$dir ne "."} {
cd $dir
set options(-directory) [pwd]
}
$win insert {} end -values [list ".." " "] -image clsdFolderImg
foreach dir [lsort [glob -types d -nocomplain [file join $options(-directory) *]]] {
$win insert {} end -values [list [file tail $dir] " "] -image clsdFolderImg
}
foreach file [lsort [glob -types f -nocomplain [file join $options(-directory) *]]] {
if {[regexp $options(-filepattern) $file]} {
$win insert {} end -values [list [file tail $file] \
[format "%3.1fMb" [expr {([file size $file] /1024.0)/1024.0}]]] \
-image $options(-fileimage)
}
}
$win focus [lindex [$win children {}] 0]
$win selection set [lindex [$win children {}] 0]
focus -force $win
}
}You can now nest the widget adaptors:
# Example usage code
set fb [dgw::tvksearch [dgw::tvfilebrowser [dgw::tvband [ttk::treeview .fp]] -directory . -fileimage fileImg]]
pack $fb -side top -fill both -expand yes
# less specialized but still a file browser
set fb2 [dgw::tvfilebrowser [ttk::treeview .fp2] -directory . \
-fileimage movie -filepattern {\.(3gp|mp4|avi|mkv|mp3|ogg)$}]
pack $fb2 -side top -fill both -expand yesSee below for a screenshot:
If the nested call looks to complicated to you, you can wrap this piped command calls as well in a new widget or even just a simple proc:
proc fbrowse {path args} {
set fb [dgw::tvksearch [dgw::tvfilebrowser [dgw::tvband [ttk::treeview $path]] {*}$args]]
return $fb
}Now, to get your filebrowser widget you can simple execute:
set fb2 [fbrowse .fp2] pack $fb2 -side top -fill both -expand yes
DDG 2020-06-07: Here is another example which wraps the code on Treeview Tooltips:
snit::widgetadaptor dgw::tvtooltip {
delegate option * to hull
delegate method * to hull
variable LAST
variable AFTERS
constructor {args} {
installhull $win
$self configurelist $args
array set LAST [list $win ""]
array set AFTERS [list $win ""]
bind $win <Motion> [mymethod OnMotion %W %x %y %X %Y]
}
method OnMotion {W x y rootX rootY} {
set id [$W identify row $x $y]
set lastId $LAST($W)
set LAST($W) $id
if {$id ne $lastId} {
after cancel $AFTERS($W)
if {$lastId ne ""} {
event generate $W <<RowLeave>> \
-data $lastId -x $x -y $y -rootx $rootX -rooty $rootY
}
if {$id ne ""} {
set AFTERS($W) \
[after 300 event generate $W <<RowEnter>> \
-data $id -x $x -y $y -rootx $rootX -rooty $rootY]
}
}
}
}We can now as well add tooltip hints for a widget which provides a -textvariable option such as a ttk::label:
proc fbrowse {path args} {
set fb [dgw::tvtooltip [dgw::tvksearch [dgw::tvfilebrowser \
[dgw::tvband [ttk::treeview $path]] {*}$args]]]
return $fb
}
if {[info exists argv0] && $argv0 eq [info script] && [regexp {tvfilebrowser} $argv0]} {
# Example code
set fb2 [fbrowse .fp2]
pack $fb2 -side top -fill both -expand yes
pack [::ttk::label .msg -font "Times 12 bold" -textvariable ::msg -width 20 \
-background salmon -borderwidth 2 -relief ridge] -side top -fill x \
-expand false -ipadx 5 -ipady 4
bind $fb2 <<RowEnter>> { set ::msg " Entering row %d" }
bind $fb2 <<RowLeave>> { set ::msg " Leaving row %d" }
}See below for an image of the application:
DDG - 2020-04-08: Here another mixin which adds sorting to ttk::treeview widgets. Might be not yet used for the dgw::tvfilebrowser as it mixes still folders and files.
snit::widgetadaptor ::dgw::tvsortable {
delegate option * to hull except -sorttypes
delegate method * to hull
# -filename column-id to always sort directories before columns
option -filename ""
option -sorttypes [list]
variable sortOpt
constructor {args} {
installhull $win
$self configurelist $args
array set sortOpt $options(-sorttypes)
set headers [$win cget -columns]
set x 0
foreach col $headers {
$win heading $col -image arrowBlank \
-command [mymethod SortBy $col 0]
}
}
typeconstructor {
image create photo arrow(1) -data {
R0lGODlhEAAQAIIAAAT+BPwCBAQCBAQC/FxaXAAAAAAAAAAAACH5BAEAAAAA
LAAAAAAQABAAAAM5CBDM+uKp8KiMsmaAs82dtnGeCHnNp4TjNQ4jq8CbDNOr
oIe3ROyEx2A4vOgkOBzgFxQ6Xa0owJ8AACH+aENyZWF0ZWQgYnkgQk1QVG9H
SUYgUHJvIHZlcnNpb24gMi41DQqpIERldmVsQ29yIDE5OTcsMTk5OC4gQWxs
IHJpZ2h0cyByZXNlcnZlZC4NCmh0dHA6Ly93d3cuZGV2ZWxjb3IuY29tADs=
}
image create photo arrow(0) -data {
R0lGODlhEAAQAIIAAAT+BAQC/AQCBPwCBFxaXAAAAAAAAAAAACH5BAEAAAAA
LAAAAAAQABAAAAM4CAqxLm61CGBs81FMrQxgpnhKJlaXFJHUGg0w7DrDUmvt
PQo8qyuEHoHW6hEVv+DQFvuhWtCFPwEAIf5oQ3JlYXRlZCBieSBCTVBUb0dJ
RiBQcm8gdmVyc2lvbiAyLjUNCqkgRGV2ZWxDb3IgMTk5NywxOTk4LiBBbGwg
cmlnaHRzIHJlc2VydmVkLg0KaHR0cDovL3d3dy5kZXZlbGNvci5jb20AOw==
}
image create bitmap arrow(2) -data {
#define arrowUp_width 7
#define arrowUp_height 4
static char arrowUp_bits[] = {
0x08, 0x1c, 0x3e, 0x7f
};
}
image create bitmap arrow(3) -data {
#define arrowDown_width 7
#define arrowDown_height 4
static char arrowDown_bits[] = {
0x7f, 0x3e, 0x1c, 0x08
};
}
image create bitmap arrowBlank -data {
#define arrowBlank_width 7
#define arrowBlank_height 4
static char arrowBlank_bits[] = {
0x00, 0x00, 0x00, 0x00
};
}
}
# not working yet for file browser as files and folders get mixed
method SortBy {col direction} {
set ncol [lsearch -exact [$win cget -columns] $col]
if {![info exists sortOpt($col)]} {
set stype real
} else {
set stype $sortOpt($col)
}
set dir [expr {$direction ? "-decreasing" : "-increasing"}]
set l [list]
foreach child [$win children {}] {
lappend l [list [lindex [$win item $child -values] $ncol] $child]
}
set idx [lsort -$stype -indices -index 0 $dir $l]
set l [lsort -$stype -index 0 $dir $l]
for {set i 0} {$i < [llength $l]} {incr i 1} {
set item [lindex [lindex $l $i] 1]
$win move $item {} $i
}
set idx -1
foreach ccol [$win cget -columns] {
incr idx
set img arrowBlank
if {$ccol == $col} {
set img arrow($direction)
}
$win heading $idx -image $img
}
set cmd [mymethod SortBy $col [expr {!$direction}]]
$win heading $col -command $cmd
# new event if the sorting is finished
event generate $win <<SortEnd>> -data $item
}
}
Here an example for usage:
set headers {Year Games AB Runs Code}
set data {
{1939 149 565 131 A1}
{1940 144 561 134 B2}
{1941 143 456 135 Z2}
{1942 150 522 141 K3}
{1946 150 514 142 D4}
{1947 156 528 125 AA}
{1948 137 509 124 BB}
{1949 155 566 150 CB}
{1950 89 334 82 D3}
{1951 148 531 109 K4}
{1952 6 10 2 XY}
{1953 37 91 17 P1}
{1954 117 386 93 L3}
{1955 98 320 77 ZZ}
{1956 136 400 71 XX}
{1957 132 420 96 K5}
{1958 129 411 81 C6}
{1959 103 272 32 A7}
{1960 113 310 56 HJ}
}
pack [dgw::tvsortable \
[ttk::treeview .tv3 -columns $headers -show headings] \
-sorttypes [list Code dictionary]] -side top -fill both -expand yes
foreach col $headers {
.tv3 heading $col -text $col
.tv3 column $col -width 100
}
foreach row $data {
.tv3 insert {} end -values $row
}Below an image of the sorting application. To keep a possible banding we would need probably a VirtualEvent like <<TreeViewSorted>>. Might be added later as well as adding sorttype -directory
DDG - 2020-04-11: Instead of those nested addition of widget properties in one command call, it is also possible to add step by step new adaptors. Here an example:
proc dgw::mixin {pathName mixinWidget args} {
return [$mixinWidget $pathName {*}$args]
}
# standard treeview widget
set tv [ttk::treeview .tv -columns "A B C" -show headings]
$tv heading A -text A
$tv heading B -text B
$tv heading C -text C
pack $tv -side top fill both -expand true
# add sorting after object creation using the mixin command
dgw::mixin $tv dgw::tvsortable
# fill the widget
for {set i 0} {$i < 20} {incr i} {
$tv insert {} end -values [list [expr {rand()*4}] \
[expr {rand()*10}] [expr {rand()*20}]]
}
# add another widget adaptor
dgw::mixin $tv dgw::tvband
# use this new method band of the dgw::tvband widget adaptor
$tv bandThis approach nicely simpliyfies experimenting and developing new adaptors.
Changes
- DDG - 2020-04-06: adding first treeview adaptors
- DDG - 2020-04-07: adding dgw::tvtooltip adaptor
- DDG - 2020-04-08: adding dgw::tvsortable adaptor
- DDG - 2020-04-09: adding <<SortEnd>> to tvsortable event after finishing sorting, allows for actions like banding stripes afterwards
- DDG - 2020-04-10: creating package and releasing it, see dgw::tvmixins for downloads, example and manual
- DDG - 2020-04-11: adding dgw::mixin procedure for stepwise adding widget adaptors
Discussion
Please discuss here.