Version 21 of ttk::treeview mixins

Updated 2020-04-11 07:41:39 by DDG

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 yes

See below for a screenshot:

treeview-mixin-image

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:

treeview-mixin-image-02

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

treeview-mixin-image-03

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 band

This 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.