Csaba, the inventor of the tablelist widget, contacted me a couple of days ago to tell me that he had found several bugs and some misfeatures in my code. By that time I had found the decisive bug myself but since his version is definitively faster than mine it is this faster version that you will find below. (And the basic parts of it may appear in tablelist itself in the future, who knows.)
I wanted to use a tablelist as a treeview to display infos about the internals of a microprocessor: its perpiherals, registers, etc. Not having used tablelist before it was the usual fighting with a new tool, but after some time I was done - or so I thought: During development I had been using a single peripheral, but when I fed my program the information of the processor as a whole
I then turned to using a ttk::treeview (which worked) but this problem kept nagging me.
Below I provide a link to the "problem data" so you can judge for yourself.
Saving tablelist's content to a file is easy but when you re-load it all the "tree information" is lost. But then I had an idea: How about 'on demand' expanding?
The following is the solution I came up with plus a demo for you to try it out immediately.
First you should save the file below as - say speedup.tcl. You will need it for the demos below.
package require Tk
package require tooltip
package require tablelist_tile
package require scrollutil_tile
foreach ch [winfo children .] {destroy $ch}
#
# Some convenience functions
#
proc contentOf {name} {
set res [read [set f [open $name]]]
close $f
return $res
}
proc string2File {str name} {
set outF [open $name w]
puts $outF $str
close $outF
}
#
# A node is to be expanded. Fill it with its /direct/ children
#
proc expandCmd {tree row} {
if {[$tree childcount $row] != 0} {
return
}
# get the column and the corresponding element
set colIdx [expr {[$tree depth $row] - 1}]
set name [$tree cellcget $row,$colIdx -text]
# build the list of ancestor names, in the order top-level, ..., parent
set ancNameLst {}
set idx $row
for {set col [expr {$colIdx - 1}]} {$col >= 0} {incr col -1} {
set parentKey [$tree parentkey $idx]
set parentName [$tree cellcget $parentKey,$col -text]
set ancNameLst [linsert $ancNameLst 0 $parentName]
set idx $parentKey
}
variable gui
set lst [dict get $gui lst]
# find the list index that corresponds to 'name'
set stIdx 0
set col 0
foreach ancName $ancNameLst {
set lstIdx [lsearch -start $stIdx -index $col -exact $lst $ancName]
set stIdx [expr {$lstIdx + 1}]
incr col
}
set lstIdx [lsearch -start $stIdx -index $col -exact $lst $name]
# ... and find its next sibling
set stIdx [expr {$lstIdx + 1}]
set nxtIdx [lsearch -start $stIdx -index $colIdx -regexp $lst {.+}]
# build a sublist using these two list indices as exclusive range limits
if {$nxtIdx < 0} {
set subLst [lrange $lst $stIdx end]
} else {
set subLst [lrange $lst $stIdx [incr nxtIdx -1]]
}
# now find all /direct/ children: every line which has the /next/ column set
set idxLst [lsearch -index [incr colIdx] -all -regexp $subLst {.+}]
# insert the new elements
foreach idx $idxLst {
set newIdx [$tree insertchild $row end [lindex $subLst $idx]]
# check whether the new item is expandable
set nxtItem [lindex $subLst [incr idx]]
if {[lsearch -regexp $nxtItem {.+}] == $colIdx + 1} {
# the new item is expandable -- mark it as collapsed
$tree collapse $newIdx
}
}
}
#
# A cell of tablelist displays [lindex ... 0] of the text while a tooltip
# displays [lindex ... 1].
#
proc getText {txt} {
return [lindex $txt 0]
}
proc tooltipAddCmd {t row col} {
if {! [catch {$t cellcget $row,$col -text} txt]} {
tooltip::tooltip $t $[lindex $txt 1]
}
}
#
# Get the tree's data from 'fName'. Only create the top level nodes.
#
proc fillFromFile {fName} {
variable gui
set lst [split [contentOf $fName] "\n"]
# remove a potentially empty element
if {[lindex $lst end] eq ""} {
set lst [lrange $lst 0 end-1]
}
set tree [dict get $gui tree]
# find all 'first level' entries
set idxLst [lsearch -all -index 0 -regexp $lst {.+}]
foreach idx $idxLst {
# insert each one into 'tree'
set id [$tree insertchild root end [lindex $lst $idx]]
# mark the item as collapsed
$tree collapse $id
}
# save the data of tree
dict set gui lst $lst
# enable the 'on demand' expansion
$tree configure -expandcommand expandCmd
}
#
# Save the tree to 'fName'. This proc should be called /once/ when the tree has been
# initially constructed.
#
proc saveTreeData {fName} {
variable gui
set tree [dict get $gui tree]
set lst [set [$tree itemlistvar]]
foreach line $lst {
lappend newLst [lrange $line 0 end-1]
}
string2File [join $newLst "\n"] $fName
}
#
# Create a tablelist as a child of 'parent'.
#
proc mkTree {parent} {
variable gui
set sa [scrollutil::scrollarea $parent.sa]
set tree [tablelist::tablelist $sa.t -columns {0 "Peripherals" left
0 "Registers" left 0 "Bit fields" left 0 "Enums" left} -stretch all \
-tooltipaddcommand tooltipAddCmd \
-tooltipdelcommand "tooltip::tooltip clear"]
$sa setwidget $tree
for {set idx 0} {$idx < [$tree columncount]} {incr idx} {
$tree columnconfigure $idx -labelalign center
$tree columnconfigure $idx -formatcommand getText
}
pack $sa -expand 1 -fill both
# save 'tree'
dict set gui tree $tree
return $tree
}Below you find the sample demo mentioned above.
#
# Fill the tree with 'numPeriphs' (pseudo) peripherals
#
proc mkPeriphs {numPeriphs fName} {
variable gui
set limit 8
set tree [dict get $gui tree]
for {set i 1} {$i <= $numPeriphs} {incr i} {
set id [$tree insertchild root end periph$i]
for {set j 1} {$j <= $limit} {incr j} {
set id1 [$tree insertchild $id end [list "" [list p$i-reg$j p$i-reg$j]]]
for {set k 1} {$k <= $limit} {incr k} {
set id2 [$tree insertchild $id1 end [list "" "" [list p$i-r$j-f$k p$i-r$j-f$k]]]
# for testing purposes we want some entries to not have children
if {$k in {3 6}} {continue}
for {set l 1} {$l <= $limit} {incr l} {
set id3 [$tree insertchild $id2 end [list "" "" "" [list p$i-r$j-f$k-e$l p$i-r$j-f$k-e$l]]]
}
}
}
}
$tree collapseall
saveTreeData $fName
}
#
# Create a tree, fill it with 'numPeriphs' (pseudo) peripherals and save
# the resulting tree's 'itemlistvar' to 'fName'.
#
proc start {numPeriphs fName} {
set f [ttk::frame .f]
mkTree $f
set btn [button $f.btn -text "Restart" -command "restart $fName"]
pack $btn -pady 20
pack $f -expand 1 -fill both
update
mkPeriphs $numPeriphs $fName
}
#
# Start from a clean sheet and fill the tree with the content of 'fName'
#
proc restart {fName} {
# destroy everything
foreach ch [winfo children .] {destroy $ch}
# now comes the real thing
mkTree ""
fillFromFile $fName
}
set fName ex.data
if {$argc == 0} {
set numPeriphs 10
} else {
set numPeriphs [lindex $argv 0]
}
start $numPeriphs $fName
Ok, this is not very impressive, but then this was not problematic data. From https://www.dropbox.com/s/jsozid6hsn6u3lf/mxrt1062.zip?dl=0 download mxrt1062.zip and unzip it.
If your are interested to see the original performance without the 'expandCmd' from above: The following script uses a "normal" tablelist and feeds it the complete content - this evidently takes some time. You have some minutes to spare? Try it out!
Csaba Nemethi: The reason for the poor performance of the navigation with the 'up' and 'down' keys is that the vast majority (over 34,000) of the lines of the underlying text widget are elided, due to the tablelst widget's collapseall subcommand. The tablelist bindings for the 'up' and 'down' keys invoke the text widget's see subcommand, which under these circumstances is extremely slow. I will file a bug report on this, and will also examine whether the revised text implementation behaves better in this respect.
Update: I have repeated the test with Tk built from the revised_text branch. With this version, the navigation with the 'up' and 'down' keys works quite smoothly, due to a speed-up of the text widget's see subcommand by many orders of magnitude. Unfortunately, this Tk version still has some stability problems (I experienced several segmentation faults with it).
Csaba Nemethi 2021-09-07: Tablelist 6.15 (released today) contains a workaround for the above-mentioned problem regarding the performance of the text widget's see subcommand in Tk 8.6 and 8.7, with the result that the navigation with the 'up' and 'down' keys has become incomparably smoother.
package require Tk
package require tooltip
package require tablelist_tile
package require scrollutil_tile
foreach ch [winfo children .] {destroy $ch}
#
# Fill a tablelist widget with the complete tree data
#
proc fillAllFromFile {fName} {
variable gui
set lst [split [contentOf $fName] "\n"]
# remove a potentially empty element
if {[lindex $lst end] eq ""} {
set lst [lrange $lst 0 end-1]
}
set tree [dict get $gui tree]
set cnt [$tree columncount]
# 'masterLst' will hold the lastly inserted node per column
for {set col 0} {$col < $cnt} {incr col} {
lappend masterLst {}
}
foreach line $lst {
# find the first non-empty column
for {set col 0} {$col < $cnt} {incr col} {
if {[lindex $line $col] ne ""} {
break
}
}
if {$col == 0} {
# a top level node always gets inserted at 'root'
set id [$tree insertchild root end $line]
# ... hence its 'id' goes into column 0
lset masterLst 0 $id
} else {
# each new node is the child of a node in the column /before/
set insCol [expr {$col - 1}]
# ... but may be the parent of a child to come: hence its 'id' goes
# into the /current/ column
set id [$tree insertchild [lindex $masterLst $insCol] end $line]
lset masterLst $col $id
}
}
}
# on my machine this needs some 20 sec
set fName mxrt1062.data ;# [lindex $argv 0]
set tree [mkTree ""]
set start [clock seconds]
fillAllFromFile $fName
$tree collapseall
set stop [clock seconds]
puts "Excution of 'fillAllFromFile' took [expr {$stop - $start}] sec."Csaba Nemethi: I have added the missing close-brace to the first if statement above. Actually, this if statement (and the identical one in the fillFromFile proc) can be removed if you modify the contentOf proc to invoke read -nonewline rather than a plain read.
Ok, ok - I cannnot deliver a proof in the mathematical sense, but I think I can present a pretty good argument: In the following script a tree is created from my "problem file", it is expanded via 'expandall', saved as compare1.data and then this file is compared with the original. The result is '1' (equal). Now a skeptic might argue like so:
"Hm, in the beginning the tree only holds the lines of the 'top level' nodes. 'expandall' now takes each one of these and inserts all lines from the file belonging to this particular node into the tree - except the first one. This means it basically inserts all lines in the file one by one, one after the other into the tree. Therefore it is not really a surprise that the 2 files match. I wonder what happens if the nodes are expanded in random order?"
That's an argument.
Therefore I devised the proc 'reverseExpand': While 'expandall' takes any unexpanded (top level) node and expands it fully (quasi 'breadth first'), 'reverseExpand' works kind of 'depth first': It takes all top level nodes and expands them just for their direct children (see the use of the '-partly' option), then gets all the newly created nodes and does the same with them etc. - and it works bottom up. This means that via 'reverseExpand' all nodes are expanded in a totally different order.
For a tree of this size and complexity to give with both expand methods the same result is for me a strong indication of their correctness.
#
# Here we do somewhat the opposite of '$tree expandall': While 'expandall'
# takes all 'top level' nodes and expands them fully one after the other
# (quasi 'breadth first') this function expands them one level at time
# (quasi 'depth first') - and this in reverse order.
#
proc reverseExpand {} {
variable gui
set tree [dict get $gui tree]
set lst [dict get $gui lst]
# we look at each column up to the next to last one
for {set col 0} {$col < ([$tree columncount] - 1)} {incr col} {
# get the current content of 'tree'
set lst [set [$tree itemlist]]
# we work 'bottom up'
set lst [lreverse $lst]
foreach line $lst {
if {[lindex $line $col] ne ""} {
set itemKey [lindex $line end]
$tree expand $itemKey -partly
}
}
}
}
#
# Check if 2 files have basically the same content modulo leading or trailing white space
#
proc compare {fName1 fName2} {
foreach fN [list $fName1 $fName2] txt {txt1 txt2} {
set $txt [string trim [contentOf $fN]]
}
return [string equal $txt1 $txt2]
}
set fName mxrt1062.data
set tree [mkTree ""]
fillFromFile $fName
update
set start [clock seconds]
# this call takes some 30 sec
$tree expandall
set stop [clock seconds]
puts "Excution of 'expandall' took [expr {$stop - $start}] sec."
# now check
saveTreeData compare1.data
puts "Equal content ? [compare $fName compare1.data]"
# repeat: re-load
$tree delete 0 end
fillFromFile $fName
update
set start [clock seconds]
# this call takes more than twice that long - sorry, but it is only ever used once or twice
reverseExpand
set stop [clock seconds]
puts "Excution of 'reverseExpand' took [expr {$stop - $start}] sec."
# and check again
saveTreeData compare2.data
puts "Equal content ? [compare $fName compare2.data]"For me in any case. Without this change tablelist - with the data I had - was plainly unusable while with it the performance is immediate. Why it is that with my data tablelist performed badly while in the above demo it is as fast as one can want I don't know. I can only speculate that it has to do with the enormous difference in size among my 'real' peripherals: From one with 4 registers with 7 (bitfields + enums) to one with 479 register with >7100 (bitfields + enums) - but that's only speculation.
As implemented 'expandCmd' works only for - let's call them 'normalized' trees: A 'normalized' tree is a tree which when fully expanded holds in every row exactly one element. In the following examples the first tree is 'normalized' while the second is not.
parent
child 1
grandchild 1
child 2
grandchild 2 parent
child 1 child 2
grandchild 1
grandchild 2In the second example the two grandchildren will probably be assigned to 'child 1' - this would need to be adapted.
Csaba Nemethi 2021-09-07: Tablelist 6.15 (released today) provides the new subcommands dumptofile and loadfromfile, which are not restricted to any particular tablelist type.
While this solution is good if you have a 'stable' tree - one that once created never changes - you will have some work to do if you want to save added items to the tree:
Oh, and don't attempt to save tablelist's data more than once. First of all you don't need to if you had called 'saveTreeData' as recommended above. If you do you are very likely to lose (potentially a lot of) data: It is the feature of 'expandCmd' that it populates tablelist's 'itemlistvar' only with expanded nodes - and if you then save the data you will lose all the data of the unexpanded ones.
In any case: Have fun with 'expandCmd' and friends.