#!/usr/bin/env tclsh ############################################################################## # # Created By : Dr. Detlef Groth # Created : Sun Apr 5 17:37:39 2020 # Last Modified : <201221.0758> # # Description # # Notes # # History # ############################################################################## # # Copyright (c) 2020 Dr. Detlef Groth. # ############################################################################## #' --- #' documentclass: scrartcl #' title: dgw::tvmixins __PKGVERSION__ #' author: Detlef Groth, Schwielowsee, Germany #' --- #' #' ## NAME #' #' **dgw::tvmixins** - implementations of extensions for the *ttk::treeview* #' widget which can be added dynamically using chaining of commands #' at widget creation or using the *dgw::mixin* command after widget #' creation. #' #' ## TABLE OF CONTENTS #' #' - [SYNOPSIS](#synopsis) #' - [DESCRIPTION](#description) #' - [WIDGET COMMANDS](#commands) #' - [dgw::mixin](#mixin) #' - [dgw::tvband](#tvband) #' - [dgw::tvedit](#tvedit) #' - [dgw::tvfilebrowser](#tvfilebrowser) #' - [dgw::tvksearch](#tvksearch) #' - [dgw::tvsortable](#tvsortable) #' - [dgw::tvtooltip](#tvtooltip) #' - [dgw::tvtree](#tvtree) #' - [EXAMPLE](#example) #' - [INSTALLATION](#install) #' - [DEMO](#demo) #' - [DOCUMENTATION](#docu) #' - [SEE ALSO](#see) #' - [CHANGES](#changes) #' - [TODO](#todo) #' - [AUTHORS](#authors) #' - [COPYRIGHT](#copyright) #' - [LICENSE](#license) #' #' ## SYNOPSIS #' #' ``` #' package require Tk #' package require snit #' package require dgw::tvmixins #' ::dgw::mixin pathName widgetAdaptor ?options? #' ::dgw::tvband [ttk::treeview pathName ?options?] ?options? #' ::dgw::tvedit [ttk::treeview pathName ?options?] ?options? #' ::dgw::tvfilebrowser [ttk::treeview pathName ?options?] ?options? #' ::dgw::tvksearch [ttk::treeview pathName ?options?] ?options? #' ::dgw::tvsortable [ttk::treeview pathName ?options?] ?options? #' ::dgw::tvtooltip [ttk::treeview pathName ?options?] ?options? #' ::dgw::tvtree [ttk::treeview pathName ?options?] ?options? #' ::dgw::tvfilebrowser [dgw::tvband [dgw::tvsortable [dgw::tvsearch \ #' [ttk::treeview pathName ?options?] ?options?] ?options?] ?options?] #' set tv [ttk::treeview pathName ?options?] #' dgw::mixin $tv dgw::tvband ?options? #' ``` #' #' ## DESCRIPTION #' #' The package **dgw::tvmixins** implements several *snit::widgetadaptor*s which #' extend the standard *ttk::treeview* widget with different functionalities. #' Different adaptors can be chained together to add the required functionalities. #' Furthermore at any later time point using the *dgw::mixin* command other adaptors can be installed on the widget. #' #' ## WIDGET COMMANDS #' package require Tk package require snit namespace eval ::dgw {} package provide dgw::tvmixins 0.3 #' #' **dgw::mixin** *pathName mixinWidget ?-option value ...?* #' #' Adds the properties and methods of a snit::widgetadaptor specified with *mixinWidget* #' to the exising widget created before with the given *pathName* and configures the widget #' using the given *options*. #' #' Example: #' #' > ``` #' # demo: mixin #' # 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 #' # configure the new options of this adaptor at a later point #' $tv configure -bandcolors [list white ivory] #' > ``` proc ::dgw::mixin {pathName mixinWidget args} { return [$mixinWidget $pathName {*}$args] } #' #' **dgw::tvband** *[ttk::treeview pathName] ?-option value ...?* #' #' Creates and configures the *dgw::tvband* widget using the Tk window id _pathName_ and the given *options*. #' Please note that this adaptor might have performace issues and that the #' *ttk::treeview* widget of Tk 8.7 #' probably will have a configure option *-striped* and *-stripedbackgroundcolor* which can replace this adaptor. #' #' The following option is available: #' #' > - *-bandcolors* *list* - list of the two colors to be displayed alternatively. #' #' Example: #' #' > ``` #' # demo: tvband #' dgw::tvband [ttk::treeview .fb -columns [list A B C] -show headings] #' foreach col [list A B C] { .fb heading $col -text $col } #' for {set i 0} {$i < 20} {incr i 1} { #' .fb insert {} end -values [list [expr {int(rand()*100)}] \ #' [expr {int(rand()*1000)}] [expr {int(rand()*1000)}]] #' } #' pack .fb -side top -fill both -expand yes #' > ``` # 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 option -bandcolors [list #FFFFFF #DDEEFF] # problem: # can't avoid delegating insert as if it is # overwritten parent insert can't be called # solved by adding trace executation # might slow down the widget constructor {args} { installhull $win $self configurelist $args $win tag configure band0 -background [lindex $options(-bandcolors) 0] $win tag configure band1 -background [lindex $options(-bandcolors) 1] trace add execution $win leave [mymethod wintrace] # new line bind $win <> [mymethod band] $self band #bind $win <> { puts Dummy } } # new method 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 } } onconfigure -bandcolors value { set options(-bandcolors) $value $win tag configure band0 -background [lindex $options(-bandcolors) 0] $win tag configure band1 -background [lindex $options(-bandcolors) 1] } 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 } } } #' #' **dgw::tvedit** *[ttk::treeview pathName] ?-option value ...?* #' #' Creates and configures the *dgw::tvedit* widget using the Tk window id _pathName_ and the given *options*. #' This widget adaptor allows to do in place edits of the text within the ttk::treeview widget. The code is largly based on the wiki code in [Inplace edit in ttk::treeview](https://wiki.tcl-lang.org/page/Inplace+edit+in+ttk%3A%3Atreeview). Note: Currently only tabular, non hierarchical *ttk::treeview* widget's can be edited. #' #' The following options are available: #' #' > - *-edittypes* *list* - list of key values pairs where the key is the colummn name and #' the values are pssible data types or lists of available values. The following data types are available #' 1. *bool* provides a boolean value selection of true and false using a check box #' 1. *int* a integer range of values must be given as: *int [list start end]* #' 1. *list* list of possible values must be given with the values such as: *list [list A B C D E]* #' 1. the default if no type is provided for a column name is a text entry with free text edition available #' #' > - *-editdefault* *type* the default edit is a entry text field, if you set this to an empty string only columns listed in the *-edittypes* options can be edited. #' #' > - *-editendcmd* *commandName* the command to be executed after the value was changed. #' The widget path, the data type, the row id, the old and the new value are added as command arguments. This method can be used to validate the input as well and to perform some actions after the entry was edited. #' #' The widget provides the follwing events: #' #' > - <<*TreeviewEditEnd*\>> which is fired if a entry in the *ttk::treeview* widget #' is changed. The following event symbols are available: *%d* a list of the row index and the column name which was changed, *%W* (widget). #' #' Bindings: #' #' > - ** - edit current row entries #' - ** - cancel edits #' - ** - save edit and end current edits #' - ** - switch to the next edit field #' - ** - switch to the previous edit field #' #' Example: #' #' > ``` #' # demo: tvedit #' proc editDone {args} { #' puts "done: $args" #' } #' pack [dgw::tvedit [ttk::treeview .tv -columns {bool int list} -show {headings} \ #' -selectmode extended -yscrollcommand {.sb set}] \ #' -edittypes [list bool bool int [list int 0 100]] \ #' -editdefault "" -editendcmd editDone] -fill both -expand true -side left #' pack [ttk::scrollbar .sb -orient v -command ".tv yview"] -fill y -side left #' .tv insert {} end -values {true 15 {Letter B}} #' .tv insert {} end -values {true 35 {Letter D}} #' for {set i 0} {$i<20} {incr i} { #' .tv insert {} end -values [list true $i {Letter B}] #' } #' dgw::mixin .tv dgw::tvband #' > ``` snit::widgetadaptor ::dgw::tvedit { delegate option * to hull delegate method * to hull option -edittypes [list] option -editdefault entry option -editendcmd "" variable edittypes variable curfocus constructor {args} { installhull $win $self configurelist $args # intercept all the events changing focus #bind $win <> +[mymethod checkFocus %W] bind $win +[mymethod checkFocus %W %x %y] #bind $win +[mymethod checkFocus %W] bind $win +[list after idle [mymethod updateWnds %W]] bind $win +[list after idle [mymethod updateWnds %W]] bind $win +[list after idle [mymethod updateWnds %W]] bind $win +[list if {$ttk::treeview::State(pressMode)=="resize"} { [mymethod updateWnds %W] }] bind $win +[list after idle [mymethod updateWnds %W]] bind all +[mymethod _clear $win %d] #bind all +[mymethod _clear $win %d] bind $win <> [mymethod InplaceEdit %d %v] array set edittypes $options(-edittypes) } method InplaceEdit {d v} { if {[$win children [lindex $d 1]]==""} { set col [lindex $d 0] if {$col eq "#0"} { $win _inplaceEntry $win {*}$d } elseif {[info exists edittypes($col)]} { if {$edittypes($col) eq "bool"} { $win _inplaceCheckbutton $win {*}$d true false } elseif {[lindex $edittypes($col) 0] eq "int"} { $win _inplaceSpinbox $win {*}$d [lindex $edittypes($col) 1] [lindex $edittypes($col) 2] 1 } elseif {[lindex $edittypes($col) 0] eq "list"} { $win _inplaceList $win {*}$d [lrange $edittypes($col) 1 end] } else { $win _inplaceEntry $win {*}$d } } else { if {$options(-editdefault) eq "entry"} { $win _inplaceEntry $win {*}$d } } } elseif {[lindex $d 0]=="list"} { # did not work yet $win _inplaceEntryButton $win {*}$d [list set %$v "tree: $win, column,item=$d"] } } # check, if focus has changed method checkFocus {w {X {}} {Y {}} } { if {![info exists curfocus($w)]} { set changed 1 } elseif {$curfocus($w)!=[$w focus]} { $self _clear $w $curfocus($w) set changed 1 } else { set changed 0 } set newfocus [$w focus] if {$changed} { if {$newfocus!=""} { $self _focus $w $newfocus if {$X!=""} { set col [$w identify column $X $Y] if {$col!=""} { if {$col!="#0"} { set col [$w column $col -id] } } catch {focus $w.$col} } } set curfocus($w) $newfocus $self updateWnds $w } } # update inplace edit widgets positions method updateWnds {w} { if {![info exists curfocus($w)]} { return } set item $curfocus($w) if {$item==""} { return } foreach col [concat [$w cget -columns] #0] { set wnd $w.$col if {[winfo exists $wnd]} { set bbox [$w bbox $item $col] if {$bbox==""} { place forget $wnd } else { place $wnd -x [lindex $bbox 0] -y [lindex $bbox 1] -width [lindex $bbox 2] -height [lindex $bbox 3] } } } } # remove all inplace edit widgets method _clear {w {item ""}} { foreach col [concat [$w cget -columns] #0] { set wnd $w.$col if {[winfo exists $wnd]} { destroy $wnd } } } # called when focus item has changed method _focus {w item} { set cols [$w cget -displaycolumns] if {$cols=="#all"} { set cols [concat #0 [$w cget -columns]] } foreach col $cols { event generate $w <> -data [list $col $item] if {[winfo exists $w.$col]} { bind $w.$col {focus [tk_focusNext %W]} bind $w.$col {focus [tk_focusPrev %W]} } } } # helper functions for inplace edit method _get_value {w column item} { if {$column=="#0"} { return [$w item $item -text] } else { return [$w set $item $column] } } method _set_value {w column item value} { if {$column=="#0"} { $w item $item -text $value } else { $w set $item $column $value } } method _cancel_value {w column item} { set value [$self _get_value $w $column $item] set curfocus($w,$column) $value $self _clear $w focus -force $w } method _update_value {w column item} { set value [$self _get_value $w $column $item] set newvalue $curfocus($w,$column) if {$value!=$newvalue} { $self _set_value $w $column $item $newvalue } if {$options(-editendcmd) ne ""} { $options(-editendcmd) $w $column $item $value $newvalue } focus -force $w event generate $w <> -data [list $item $column] } # these functions create widgets for in-place edit, use them in your in-place edit handler method _inplaceEntry {w column item} { set wnd $w.$column ttk::entry $wnd -textvariable [myvar ::curfocus($w,$column)] -width 3 set curfocus($w,$column) [$self _get_value $w $column $item] bind $wnd [mymethod _update_value $w $column $item] bind $wnd [mymethod _cancel_value $w $column $item] } method _inplaceEntryButton {w column item script} { set wnd $w.$column ttk::frame $wnd pack [ttk::entry $wnd.e -width 3 -textvariable [myvar curfocus($w,$column)]] -side left -fill x -expand true pack [ttk::button $wnd.b -style Toolbutton -text "..." -command [string map [list %v [myvar curfocus($w,$column)]] $script]] -side left -fill x set curfocus($w,$column) [$self _get_value $w $column $item] bind $wnd [mymethod _update_value $w $column $item] bind $wnd [mymethod _cancel_value $w $column $item] } method _inplaceCheckbutton {w column item {onvalue 1} {offvalue 0} } { set wnd $w.$column ttk::checkbutton $wnd -variable [myvar ::curfocus($w,$column)] -onvalue $onvalue -offvalue $offvalue set curfocus($w,$column) [$self _get_value $w $column $item] bind $wnd [mymethod _update_value $w $column $item] bind $wnd [mymethod _cancel_value $w $column $item] } method _inplaceList {w column item values} { set wnd $w.$column ttk::combobox $wnd -textvariable [myvar curfocus($w,$column)] -values $values -state readonly set curfocus($w,$column) [$self _get_value $w $column $item] bind $wnd [mymethod _update_value $w $column $item] bind $wnd [mymethod _cancel_value $w $column $item] } method _inplaceSpinbox {w column item min max step} { set wnd $w.$column spinbox $wnd -textvariable [myvar curfocus($w,$column)] -from $min -to $max -increment $step set curfocus($w,$column) [$self _get_value $w $column $item] bind $wnd [mymethod _update_value $w $column $item] bind $wnd [mymethod _cancel_value $w $column $item] } } #' #' **dgw::tvfilebrowser** *[ttk::treeview pathName] ?-option value ...?* #' #' Creates and configures the *dgw::tvfilebrowser* widget using the Tk window id _pathName_ and the given *options*. #' #' The following option is available: #' #' > - *-directory dirName* - starting directory for the filebrowser, default current directory. #' - *-browsecmd cmdName* - command to be executed if the users double clicks on a row item or presses the Return key. The widgets *pathName* and the actual row index are appended to the *cmdName* as arguments, default to empty string. #' - *-fileimage imgName* - image to be displayed as filename image left of the filename, default is standard file icon. #' - *-filepattern pattern* - the filter for the files to be displayed in the widget, default to ".+" i.e. all files #' #' The following method(s) is(are) available: #' #' > - *browseDir dirName* - the directory to be loaded into the *dgw::tvfilebrowser* widget. #' #' Example: #' #' > ``` #' # demo: tvfilebrowser #' dgw::tvfilebrowser [dgw::tvsortable [dgw::tvksearch [dgw::tvband \ #' [ttk::treeview .fb]]] \ #' -sorttypes [list Name directory Size real Modified dictionary]] #' pack .fb -side top -fill both -expand yes #' > ``` # a file browser widget as widget adaptor # could be may be better be 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 in the constructor already # browseDir is called snit::widgetadaptor ::dgw::tvfilebrowser { option -filepattern ".+" option -directory "." option -browsecmd "" option -fileimage fileImg delegate option * to hull delegate method * to hull except browseDir variable LastKeyTime 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 Modified] -show [list tree headings] $win heading Name -text Name -anchor w $win heading Size -text Size -anchor center $win heading Modified -text Modified -anchor w $win column Name -width 60 $win column Size -width 40 $win column Size -width 40 $win column #0 -width 35 -anchor w -stretch false bind $win [mymethod fbOnClick %W %x %y] bind $win [mymethod fbReturn %W] bind $win [mymethod browseDir ..] $win tag configure hilight -foreground blue $self configurelist $args set LastKeyTime [clock seconds] $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=} image create bitmap arrowBlank -data { #define arrowBlank_width 7 #define arrowBlank_height 4 static char arrowBlank_bits[] = { 0x00, 0x00, 0x00, 0x00 }; } } 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 ".." " " [clock format [file mtime ..] -format "%Y-%m-%d %H:%M"]] -image clsdFolderImg foreach dir [lsort -dictionary [glob -types d -nocomplain [file join $options(-directory) *]]] { $win insert {} end -values [list [file tail $dir] " " \ [clock format [file mtime [file tail $dir]] -format "%Y-%m-%d %H:%M"]] -image clsdFolderImg } foreach file [lsort -dictionary [glob -types f -nocomplain [file join $options(-directory) *]]] { if {[regexp $options(-filepattern) $file]} { $win insert {} end -values [list [file tail $file] \ [format "%3.2fMb" [expr {([file size $file] /1024.0)/1024.0}]] \ [clock format [file mtime [file tail $file]] -format "%Y-%m-%d %H:%M"]] \ -image $options(-fileimage) } } $win focus [lindex [$win children {}] 0] $win selection set [lindex [$win children {}] 0] focus -force $win foreach header [$win cget -columns] { $win heading $header -image arrowBlank } } } #' #' **dgw::tvksearch** *[ttk::treeview pathName] ?-option value ...?* #' #' Creates and configures the *dgw::tvksearch* widget using the Tk window id _pathName_ and the given *options*. #' With this widget you can use the Home and End keys for navigation and further letter #' typing starts searching in the first column shifting focus and display to the current matching entry. #' #' There are currently no options or methods available for this widget. #' #' Example: #' #' > ``` #' # demo: tvksearch #' dgw::tvfilebrowser [dgw::tvksearch [ttk::treeview .fb]] #' pack .fb -side top -fill both -expand yes #' > ``` # widget adaptor which allows forward searching in a ttk::treeview # using the starting letters matchinf entries in column 1 # with typing beginning letters # further has bindings of Home and End key snit::widgetadaptor ::dgw::tvksearch { delegate option * to hull delegate method * to hull variable LastKeyTime "" variable LastKey "" constructor {args} { installhull $win bind $win [mymethod setSelection 0] bind $win [mymethod setSelection end] bind $win [mymethod ListMatch %A] set LastKeyTime [clock seconds] $self configurelist $args } method setSelection {index} { $self focus [lindex [$self children {}] $index] $self selection set [lindex [$self children {}] $index] focus -force $win $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 } } } } } #' #' **dgw::tvsortable** *[ttk::treeview pathName] ?-option value ...?* #' #' Creates and configures the *dgw::tvsortable* widget using the Tk window id _pathName_ and the given *options*. #' #' The following option is available: #' #' > - *-sorttypes* the options for the *lsort* command for each of the columns, #' such as dictionary, ascii, real etc. Default: autocheck for dictionary or real. #' The values are given as a list of key-value pairs where the key is #' the column name. In addition to the standard *lsort* options as well #' the option *directory* can be given if the widget contains results of a #' directory listening with filenames and directory names. #' In this case the directories are always sorted above the filenames. #' #' The following methods are available: #' #' > - *sortBy* *colId decreasing* - sort widget by column with the given *colId* and in decreasing order if true or *increasing* if false. #' - *reSort* redo the last sorting again, useful if the data in the widget where changed either interactively for instance using the *tvedit* adaptor or programmatically. #' #' The widget further provides the following event: #' #' - <<*SortEnd*\>> - with the following symbols *%W* (widget path) and *%d* (column id) #' #' Example: #' #' > ``` #' # demo: tvsortable #' dgw::tvsortable [dgw::tvband [ttk::treeview .fb -columns [list A B C] \ #' -show headings]] -sorttypes [list A real B real C integer] #' foreach col [list A B C] { .fb heading $col -text $col } #' for {set i 0} {$i < 20} {incr i 1} { #' .fb insert {} end -values [list [expr {int(rand()*100)}] \ #' [expr {int(rand()*1000)}] [expr {int(rand()*1000)}]] #' } #' pack .fb -side top -fill both -expand yes #' > ``` # snit::widgetadaptor ::dgw::tvsortable { delegate option * to hull except -sorttypes delegate method * to hull # -filename column-id to always sort directories before columns option -sorttypes [list] variable sortOpt variable lastCol "" variable lastDir "" 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 method sortBy {col direction} { set lastCol $col set lastDir $direction #set mtimer [Timer %AUTO%] set ncol [lsearch -exact [$win cget -columns] $col] if {![info exists sortOpt($col)]} { set fchild [lindex [$win children ""] 0] set fvalues [$win item $fchild -values] set i 0 foreach heading [$win cget -columns] { if {[$win heading $heading -text] eq "$col"} { set val [lindex $fvalues $i] break } incr i } if {[string is double $val]} { set stype real } else { set stype dictionary } } else { set stype $sortOpt($col) } set dir [expr {$direction ? "-decreasing" : "-increasing"}] if {[lsearch [array get sortOpt] directory] > -1} { set hasDir true foreach key [array names sortOpt] { if {$sortOpt($key) eq "directory"} { set cname $key set i 0 foreach heading [$win cget -columns] { if {[$win heading $heading -text] eq "$cname"} { set didx $i break } incr i } break } } } else { set hasDir false } set l [list] foreach child [$win children {}] { set val [lindex [$win item $child -values] $ncol] if {$stype eq "directory"} { # ensure that .. is always on top # and thereafter sorted directories # and only then sorted files if {$val eq ".." && $direction} { set val "Z$val" } elseif {$val eq ".."} { set val "A$val" } elseif {[file isdirectory $val] && $direction} { set val "O$val" } elseif {[file isdirectory $val]} { set val "D$val" } else { set val "F$val" } lappend l [list $val $child] } elseif {$hasDir} { set val [lindex [$win item $child -values] $ncol] set fname [lindex [$win item $child -values] $didx] if {$fname eq ".."} { set letter A } elseif {[file isdirectory $fname]} { set letter D } else { set letter F } lappend l [list $val $child $letter] } else { lappend l [list $val $child] } } if {$hasDir && ($stype eq "real" || $stype eq "integer")} { set l [lmap x $l { list [regsub -all {[^0-9\.]} [lindex $x 0] "0"] [lindex $x 1] [lindex $x 2] }] } elseif {$stype eq "real" && $stype eq "integer"} { set l [lmap x $l { list [regsub -all {[^0-9]} [lindex $x 0] ""] [lindex $x 1] }] } #set idx [lsort -$stype -indices -index 0 $dir $l] if {$stype eq "directory"} { set l [lsort -dictionary -index 0 $dir $l] } elseif {$hasDir} { #puts $l set l [lsort -dictionary -index 2 -increasing [lsort -$stype -index 0 $dir $l]] #puts $l } else { 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 event generate $win <> -data $col } method reSort {} { if {$lastCol ne ""} { $self sortBy $lastCol $lastDir } } } #' #' **dgw::tvtooltip** *[ttk::treeview pathName] ?-option value ...?* #' #' Creates and configures the *dgw::tvtooltip* widget using the Tk window id _pathName_ and the given *options*. #' #' There are currently no options available. #' #' The widget provides the following events: #' #' - <> with the following symbols: %d the row index, and the standards %W (widget), %x (widgetX), %y (widgetY), %X (rootx), %Y (rootY) #' - <> with the following symbols: %d the row index, and the standards %W (widget), %x (widgetX), %y (widgetY), %X (rootx), %Y (rootY) #' #' Example: #' #' > ``` #' # demo: tvtooltip #' set fb [dgw::tvtooltip [dgw::tvfilebrowser [ttk::treeview .fp2] \ #' -directory . -fileimage movie \ #' -filepattern {\.(3gp|mp4|avi|mkv|mp3|ogg)$}]] #' pack $fb -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 $fb <> { set ::msg " Entering row %d"} #' bind $fb <> { set ::msg " Leaving row %d"} #' > ``` #' # https://wiki.tcl-lang.org/page/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 [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 <> \ -data $lastId -x $x -y $y -rootx $rootX -rooty $rootY } if {$id ne ""} { set AFTERS($W) \ [after 300 event generate $W <> \ -data $id -x $x -y $y -rootx $rootX -rooty $rootY] } } } } #' #' **dgw::tvtree** *[ttk::treeview pathName] ?-option value ...?* #' #' Creates and configures the *dgw::tvtree* widget using the Tk window id _pathName_ and the given *options*. #' #' There is(are) currently the following option(s) available: #' #' - *-icon* - the icon type, which can be currently either book or folder. To provide your own icons you must create two image icons \open16 and \close16. Support for icons of size 22 will be added later. #' #' The widget provides the following event: #' #' - <> which is fired if a item is inserted into the *tvtree* widget, there are the following event symbols available: _%d_ the row index, and the standard _%W_ (widget pathname). #' #' Example: #' #' > ``` #' # demo: tvtree #' set tree [dgw::tvtree [ttk::treeview .tree \ #' -height 15 -show tree -selectmode browse] \ #' -icon folder] #' foreach txt {first second third} { #' set id [$tree insert {} end -text " $txt item" -open 1] #' for {set i [expr {1+int(rand()*5)}]} {$i > 0} {incr i -1} { #' set child [$tree insert $id 0 -text " child $i"] #' for {set j [expr {int(rand()*3)}]} {$j > 0} {incr j -1} { #' $tree insert $child 0 -text " grandchild $i" #' } #' } #' } #' pack $tree -side top -fill both -expand true #' > ``` #' snit::widgetadaptor ::dgw::tvtree { delegate option * to hull delegate method * to hull option -icon book constructor {args} { installhull $win $self configurelist $args trace add execution $win leave [mymethod wintrace] bind $win <> [mymethod TreeviewUpdateImages true] bind $win <> [mymethod TreeviewUpdateImages false] bind $win <> [mymethod InsertItem %d] } typeconstructor { image create photo bookclose16 -data { R0lGODlhEAAQAIQAAPwCBAQCBDyKhDSChGSinFSWlEySjCx+fHSqrGSipESO jCR6dKTGxISytIy6vFSalBxydAQeHHyurAxubARmZCR+fBx2dDyKjPz+/MzK zLTS1IyOjAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAVkICCOZGmK QXCWqTCoa0oUxnDAZIrsSaEMCxwgwGggHI3E47eA4AKRogQxcy0mFFhgEW3M CoOKBZsdUrhFxSUMyT7P3bAlhcnk4BoHvb4RBuABGHwpJn+BGX1CLAGJKzmK jpF+IQAh/mhDcmVhdGVkIGJ5IEJNUFRvR0lGIFBybyB2ZXJzaW9uIDIuNQ0K qSBEZXZlbENvciAxOTk3LDE5OTguIEFsbCByaWdodHMgcmVzZXJ2ZWQuDQpo dHRwOi8vd3d3LmRldmVsY29yLmNvbQA7 } image create photo bookopen16 -data { R0lGODlhEAAQAIUAAPwCBAQCBExCNGSenHRmVCwqJPTq1GxeTHRqXPz+/Dwy JPTq3Ny+lOzexPzy5HRuVFSWlNzClPTexIR2ZOzevPz29AxqbPz6/IR+ZDyK jPTy5IyCZPz27ESOjJySfDSGhPTm1PTizJSKdDSChNzWxMS2nIR6ZKyijNzO rOzWtIx+bLSifNTGrMy6lIx+ZCRWRAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAae QEAAQCwWBYJiYEAoGAFIw0E5QCScAIVikUgQqNargtFwdB9KSDhxiEjMiUlg HlB3E48IpdKdLCxzEAQJFxUTblwJGH9zGQgVGhUbbhxdG4wBHQQaCwaTb10e mB8EBiAhInp8CSKYIw8kDRSfDiUmJ4xCIxMoKSoRJRMrJyy5uhMtLisTLCQk C8bHGBMj1daARgEjLyN03kPZc09FfkEAIf5oQ3JlYXRlZCBieSBCTVBUb0dJ RiBQcm8gdmVyc2lvbiAyLjUNCqkgRGV2ZWxDb3IgMTk5NywxOTk4LiBBbGwg cmlnaHRzIHJlc2VydmVkLg0KaHR0cDovL3d3dy5kZXZlbGNvci5jb20AOw== } image create photo folderclose16 -data { R0lGODlhEAAQAIMAAPwCBNSeBJxmBPz+nMzOZPz+zPzSBPz2nPzqnAAAAAAA AAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAARFEMhJ6wwYC3uH 98FmBURpElkmBUXrvsVgbOxw3F8+A+zt/7ddDwgUFohFWgGB9BmZzcMTASUK DdisNisSeL9gMGdMJvsjACH+aENyZWF0ZWQgYnkgQk1QVG9HSUYgUHJvIHZl cnNpb24gMi41DQqpIERldmVsQ29yIDE5OTcsMTk5OC4gQWxsIHJpZ2h0cyBy ZXNlcnZlZC4NCmh0dHA6Ly93d3cuZGV2ZWxjb3IuY29tADs= } image create photo folderopen16 -data { R0lGODlhEAAQAIMAAPwCBJxmBPz+nNSeBPz6nPz2nPzqnPzunPzynPzmnPzi nAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAROEMhJKw0Y2yt6 DxswEJ43nOc0FGTpgiLbup+I3nc9GMdRsK6BALTjIWQlISzAOxwLwWUi0XvO BjBAINE8zoaTgIJr/LWy2oxaHWq7Lf4IACH+aENyZWF0ZWQgYnkgQk1QVG9H SUYgUHJvIHZlcnNpb24gMi41DQqpIERldmVsQ29yIDE5OTcsMTk5OC4gQWxs IHJpZ2h0cyByZXNlcnZlZC4NCmh0dHA6Ly93d3cuZGV2ZWxjb3IuY29tADs= } image create photo file16 -data { R0lGODlhEAAQAIUAAPwCBFxaXNze3Ly2rJyanPz+/Ozq7GxqbPz6/GxubNTK xDQyNIyKhHRydERCROTi3PT29Pz29Pzy7PTq3My2pPzu5PTi1NS+rPTq5PTe zMyynPTm1Pz69OzWvMyqjPTu5PTm3OzOtOzGrMSehNTCtNS+tAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAZ/ QAAgQCwWhUhhQMBkDgKEQFIpKFgLhgMiOl1eC4iEYrtIer+MxsFRRgYe3wLk MWC0qXE5/T6sfiMSExR8Z1YRFRMWF4RwYIcYFhkahH6AGBuRk2YCCBwSFZgd HR6UgB8gkR0hpJsSGCAZoiEiI4QKtyQlFBQeHrVmC8HCw21+QQAh/mhDcmVh dGVkIGJ5IEJNUFRvR0lGIFBybyB2ZXJzaW9uIDIuNQ0KqSBEZXZlbENvciAx OTk3LDE5OTguIEFsbCByaWdodHMgcmVzZXJ2ZWQuDQpodHRwOi8vd3d3LmRl dmVsY29yLmNvbQA7 } image create photo bookclose22 -data { R0lGODlhFgAWAIUAAPwCBAQCBDyGhCyCfFSWlESOjDyKjDSGhCx+fGSinGSe nFyanEySjHSqpHSqrGympEySlBx2dISytHyyrCR6dKTGxHyurHSurHyytGSi pCR6fARmZFSalEyWlBRubAxubBRydDyKhDSChLSytPz+/MzKzIyOjAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAWABYAAAbF QIBwSCwaj8ikMhBQIpmCQdM5ZBIKhgNiugwkFAsCI7pNMhuOxkNBgBgEiAi3 GkBLJpJHYgEpaClyREwVFhcSEhgOGQoMfgMaERtcARQBFRMYExZ6HB0FUYAe kkIBHxqWFmlrC1haESAfG6MBGx+VFRgKYH0hInGRklO0ppYXCwwMWQiQHkwj grWnFRdYZHIBJCTP0LaWGAcDW9jZ2nMAw9IWTOQkJSZMRsOV49nu8E+19Pbm R7TY+1TovONH5V7Ag0QMBAEAIf5oQ3JlYXRlZCBieSBCTVBUb0dJRiBQcm8g dmVyc2lvbiAyLjUNCqkgRGV2ZWxDb3IgMTk5NywxOTk4LiBBbGwgcmlnaHRz IHJlc2VydmVkLg0KaHR0cDovL3d3dy5kZXZlbGNvci5jb20AOw== } image create photo bookopen22 -data { R0lGODlhFgAWAIYAAAQCBAQ2NPwCBHSurIS2tBx2dBweHPz+/Ozm1GxiTGyq pPz6/Pz69GSqpOzaxPzy5HxuVLSmlOTazPz27PT29NzClPTexHxuXLSmjAxq bFSinPTy9KyehNy+lPTy5Pz29HxyXNzWxKSahOzexPzy7IR2ZOTWtESenPTy 7KSWfIyCbKyijAQGBDyalPTu3KSSdDSOjJyOdCSGhPzu3OzizJSGdPTq1PTq 3JySdMy6lAyKhOzWtOzi1OTOrJyKbMS2nJySfMS+rAwCBNzOrNTCpNzKpJSG ZKyafLSifLyylIx+ZHx6ZDSChAQuLAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAIA LAAAAAAWABYAAAf/gAABAoSFhoeHAAMAiI2IAAQFjI6EAAaJkQeTjwAICYkK BQcLm5WdBwyfhgChB66bp64HCQC1lQ2irqQCAA4PowsLEBESE4wAuLIHFAAV Fr+uDBcYxRm1GrmuGxwdFh4Mrh8gGCET1gDYyhsiFSMkDAsMDCUYJhvnJ9kH KCnODwwfPlBQsULCPRYAWogK9sHFiwoOPEyQh0JFPXO1YBSYwBEFghjdHkwQ OYGgwQwIZRR44GHGDBogabhAsYEEihrUMAIoUMCEDRs3HODIYQHFA6MPcJA7 KICFjgw7eIzo4cOfiwc/gKwIUm2SkKdDdlDt4AABDaU/iIRwwbTSUyJFOow4 S3Hkx9oNDDZgXPU0h1wcSIgEGUw4ibVET5WoWMKksePHpdxmyKADAEIWly9H JtQkQJMmlAgZCAQAIf5oQ3JlYXRlZCBieSBCTVBUb0dJRiBQcm8gdmVyc2lv biAyLjUNCqkgRGV2ZWxDb3IgMTk5NywxOTk4LiBBbGwgcmlnaHRzIHJlc2Vy dmVkLg0KaHR0cDovL3d3dy5kZXZlbGNvci5jb20AOw== } image create photo filenew22 -data { R0lGODlhFgAWAIUAAPwCBExOTERCRDw6PCwuLBwaHAwODAQCBOze1NTW1OTi 5Nze3MTGxLS2tJyanPz+/Ozu7OTi3BQSFCwqLDw+PDQyNFRSVPTu7MzKxLyy rIR+fCQmJPz6/NTOxPz69Pzy7PTu5Pz29Pzu5PTq5PTm1My6pBQWFPTq3PTm 3NS+rAwKDPTi1PTezOzWxMy2pPz27PTazOzSvMyynOzaxOzOtPTaxOzKrMyq jOzGpMymhPTizOTCpNzSzNTGvMymjMSihCH5BAEAAAAALAAAAAAWABYAAAbo QIBwSCwaiYGAYEAgFAqGg/Q4DCASCsTiymgcHAcqQLB4mM+QiIQBppLPcMjk wQ4bB2X4maKgt4sVCHpnFhQTElNFE3mDDxcYGRp2RBuMgxwIHX9EBZZwHh8g CBmTQ52NISEiIyQlpUImng8hHyInKAgprwAqgnC0IKwrLLpGB4wctLYkwy0u uwd9Z8AnJywsLcVFx2YcL7UnJCwwLTEy0GXJoSgrCCwzNDTnxgjeH9UrKzXw NDY36LRGhEOwLx4NHDmgJbh3QoeOgv127EhojEeHDj16pEhRQoZHHzl+QJNC sqTJSXaCAAAh/mhDcmVhdGVkIGJ5IEJNUFRvR0lGIFBybyB2ZXJzaW9uIDIu NQ0KqSBEZXZlbENvciAxOTk3LDE5OTguIEFsbCByaWdodHMgcmVzZXJ2ZWQu DQpodHRwOi8vd3d3LmRldmVsY29yLmNvbQA7 } } 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] event generate $win <> -data $item } } method InsertItem {item} { set parent [$win parent $item] $win item $item -image file16 if {$parent eq {}} { $win item $item -image file16 } else { if {[$win item $parent -open]} { $win item $parent -image $options(-icon)open16 } else { $win item $parent -image $options(-icon)close16 } } } method TreeviewUpdateImages {open} { # event fires before # the children are indeed displayed or hided set item [$win focus] if {$open} { if {[llength [$win children $item]] > 0} { $win item $item -image $options(-icon)open16 } } else { if {[llength [$win children $item]] > 0} { $win item $item -image $options(-icon)close16 } } } } namespace eval dgw { namespace export mixin tvband tvedit tvfilebrowser tvksearch \ tvsortable tvtooltip tvtree } if {[info exists argv0] && $argv0 eq [info script] && [regexp {tvmixins} $argv0]} { # dgwutils is only required for doucmentation and script execution package require dgw::dgwutils set dpath dgw set pfile [file rootname [file tail [info script]]] if {[llength $argv] == 1 && [lindex $argv 0] eq "--version"} { puts [dgw::getVersion [info script]] destroy . } elseif {[llength $argv] >= 1 && [lindex $argv 0] eq "--demo"} { if {[llength $argv] == 1} { dgw::runExample [info script] true } else { dgw::runExample [info script] true [lindex $argv 1] } } elseif {[llength $argv] == 1 && [lindex $argv 0] eq "--code"} { puts [dgw::runExample [info script] false] #destroy . } elseif {[llength $argv] == 1 && [lindex $argv 0] eq "--example"} { puts [dgw::runExample [info script] false] destroy . } elseif {[llength $argv] == 1 && [lindex $argv 0] eq "--test"} { package require tcltest set argv [list] tcltest::test dummy-1.1 { Calling my proc should always return a list of at least length 3 } -body { set result 1 } -result {1} tcltest::cleanupTests destroy . } elseif {[llength $argv] == 1 && ([lindex $argv 0] eq "--license" || [lindex $argv 0] eq "--man" || [lindex $argv 0] eq "--html" || [lindex $argv 0] eq "--markdown")} { dgw::manual [lindex $argv 0] [info script] } elseif {[llength $argv] == 1 && [lindex $argv 0] eq "--install"} { dgw::install [info script] } else { destroy . puts "\n -------------------------------------" puts " The ${dpath}::$pfile package for Tcl" puts " -------------------------------------\n" puts "Copyright (c) 2020 Dr. Detlef Groth, E-mail: detlef(at)dgroth(dot)de\n" puts "License: MIT - License see manual page" puts "\nThe ${dpath}::$pfile package provides a text editor widget with syntax hilighting facilities and and toolbar" puts "" puts "Usage: [info nameofexe] [info script] option\n" puts " Valid options are:\n" puts " --help : printing out this help page" puts " --demo : runs a small demo application." puts " --code : shows the demo code." puts " --test : running some test code" puts " --license : printing the license to the terminal" puts " --install : install ${dpath}::$pfile as Tcl module" puts " --man : printing the man page in pandoc markdown to the terminal" puts " --markdown: printing the man page in simple markdown to the terminal" puts " --html : printing the man page in html code to the terminal" puts " if the Markdown package from tcllib is available" puts "" } return proc fbrowse {path args} { set fb [dgw::tvtooltip [dgw::tvksearch [dgw::tvfilebrowser [dgw::tvband [ttk::treeview $path]] {*}$args]]] return $fb } # Example code set fb [dgw::tvsortable [dgw::tvksearch [dgw::tvfilebrowser [dgw::tvband [ttk::treeview .fp]] -directory . -fileimage fileImg]] -sorttypes [list Name directory Size dictionary Modified dictionary]] pack $fb -side top -fill both -expand yes #set fb2 [dgw::tvfilebrowser [ttk::treeview .fp2] -directory . -fileimage movie -filepattern {\.(3gp|mp4|avi|mkv|mp3|ogg)$}] 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 <> { set ::msg " Entering row %d"} bind $fb2 <> { set ::msg " Leaving row %d"} 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 \ [dgw::tvband \ [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 } } #' ## EXAMPLE #' #' In the examples below we create first a filebrowser widget using all the widget #' adaptors for demonstration purposes. Therafter comes a tooltip demonstration, a tree demonstration and #' finally a demonstration on how to use the *dgw::mixin* command which simplifies the addition of #' new behaviors to our *ttk::treewidget* in a stepwise manner. The latter approach is as well nice to extend existing widgets in a more controlled manner avoiding restarts of applications during developing the widget. #' #' ``` #' # wrapper function #' proc fbrowse {path args} { #' set fb [dgw::tvtooltip [dgw::tvsortable [dgw::tvksearch \ #' [dgw::tvfilebrowser [dgw::tvband \ #' [ttk::treeview $path]] {*}$args]] \ #' -sorttypes [list Name directory Size real Modified dictionary]]] #' return $fb #' } #' set pw [ttk::panedwindow .pw -orient horizontal] #' set f0 [ttk::frame $pw.f] #' set f1 [ttk::frame $f0.f] #' set fb [fbrowse $f1.fb] #' pack $fb -side left -fill both -expand yes #' pack [ttk::scrollbar $f1.yscroll -command [list $fb yview]] \ #' -side left -fill y -expand false #' $fb configure -yscrollcommand [list $f1.yscroll set] #' pack $f1 -side top -fill both -expand true #' # demo tvtooltip #' pack [::ttk::label $f0.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 $fb <> { set ::msg " Entering row %d"} #' bind $fb <> { set ::msg " Leaving row %d"} #' #' $pw add $f0 #' set tree [dgw::tvtree [ttk::treeview $pw.tree -height 15 -show tree -selectmode browse] -icon folder] #' foreach txt {first second third} { #' set id [$tree insert {} end -text " $txt item" -open 1] #' for {set i [expr {1+int(rand()*5)}]} {$i > 0} {incr i -1} { #' set child [$tree insert $id 0 -text " child $i"] #' for {set j [expr {int(rand()*3)}]} {$j > 0} {incr j -1} { #' $tree insert $child 0 -text " grandchild $i" #' } #' } #' } #' $pw add $tree #' # another example using mixin syntax #' set tv [ttk::treeview $pw.tv -columns "A B C" -show headings] #' dgw::mixin $tv dgw::tvsortable #' #' $tv heading A -text A #' $tv heading B -text B #' $tv heading C -text C #' $pw add $tv #' for {set i 0} {$i < 20} {incr i} { #' $tv insert {} end -values [list [expr {rand()*4}] \ #' [expr {rand()*10}] [expr {rand()*20}]] #' } #' dgw::mixin $tv dgw::tvband #' $tv configure -bandcolors [list white ivory] #' pack $pw -side top -fill both -expand true #' ``` #' #' ## INSTALLATION #' #' Installation is easy you can install and use the **__PKGNAME__** package if you have a working install of: #' #' - the snit package which can be found in [tcllib - https://core.tcl-lang.org/tcllib](https://core.tcl-lang.org/tcllib) #' #' For installation you copy the complete *dgw* folder into a path #' of your *auto_path* list of Tcl or you append the *auto_path* list with the parent dir of the *dgw* directory. #' Alternatively you can install the package as a Tcl module by creating a file dgw/__BASENAME__-__PKGVERSION__.tm in your Tcl module path. #' #' Only if you you like to extract the HTML documentation and run the examples, #' you need the complete dgw package and for the HTML generation the tcllib Markdown package. #' #' ## DEMO #' #' Example code for this package in the *EXAMPLE* section can be executed by running this file using the following command line: #' #' ``` #' $ wish __BASENAME__.tcl --demo #' ``` #' #' Specific code examples outside of the EXAMPLE section can be executed using the string after the *demo:* prefix string in the code block for the individual code adaptors such as: #' #' #' ``` #' $ wish __BASENAME__.tcl --demo tvband #' ``` #' #' The example code used for the demo in the EXAMPLE section can be seen in the terminal by using the following command line: #' #' ``` #' $ tclsh __BASENAME__.tcl --code #' ``` #' #include "documentation.md" #' #' ## SEE ALSO #' #' - [dgw package homepage](https://chiselapp.com/user/dgroth/repository/tclcode/index) - various useful widgets #' - [ttk::treeview widget manual](https://www.tcl.tk/man/tcl8.6/TkCmd/ttk_treeview.htm) standard manual page for the ttk::treeview widget #' #' #' ## CHANGES #' #' * 2020-04-10 - version 0.2 released with adaptors: *tvband*, *tvfilebrowser*, *tvksearch*, *tvsortable*, *tvtooltip* #' * 2020-04-14 - version 0.3 released with adaptor *tvtree*, *tvedit' and command *dgw::mixin* #' #' ## TODO #' #' * tests #' * github url #' #' ## AUTHORS #' #' The **__PKGNAME__** widget was written by Detlef Groth, Schwielowsee, Germany. #' #' ## Copyright #' #' Copyright (c) 2020 Dr. Detlef Groth, E-mail: detlef(at)dgroth(dot)de #' # LICENSE START # #' #include "license.md" # # LICENSE END