package require Tk
package require tooltip
package require tablelist_tile
package require scrollutil_tile

foreach ch [winfo children .] {destroy $ch}

#
# A node is to be expanded. Fill it with its /direct/ children
#
proc expandCmd {tree row} {
    variable gui

    set item [$tree rowcget $row -text]

    # get the column
    set colIdx [expr {[$tree depth $row] - 1}]
    set name [lindex $item $colIdx]

    # get our 'first level' parent's idx (in the tree)
    set parentIdx $row
    for {set i 1} {$i <= $colIdx} {incr i} {
        set parentIdx [$tree parentkey $parentIdx]
    }
    set parentName [$tree cellcget $parentIdx,0 -text]

    # get the subLst for 'parentName': find its list index
    set lst [dict get $gui lst]
    set lstIdx [lsearch -index 0 $lst $parentName]
    # ... and grab all the rest
    set subLst [lrange $lst $lstIdx end]

    # find the next sibling to 'parentName':
    set nxtIdx [lsearch -start 1 -index 0 -regexp $subLst {.+}]
    # ... and remove all lines from 'nxtIdx' on
    if {$nxtIdx == -1} {
        set subLst [lrange $subLst 0 end]
    } else {
        set subLst [lrange $subLst 0 [incr nxtIdx -1]]
    }
    # 'subLst' now contains all entries for the 'first level' 'parentName'

    # find the line which corresponds to 'name'
    set lineIdx [lsearch -index $colIdx $subLst $name]
    # ... and find its next sibling
    set stIdx [expr {$lineIdx + 1}]
    set nxtIdx [lsearch -start $stIdx -index $colIdx -regexp $subLst {.+}]
    # remove all lines from 'nxtIdx' on
    if {$nxtIdx != -1} {
        set subLst [lrange $subLst 0 [incr nxtIdx -1]]
    }

    # delete the dummy
    set 1stCh [lindex [$tree childkeys $row] 0]
    set 1stChTxt [$tree rowcget $1stCh -text]
    if {! [string match "*@*" $1stChTxt]} {
        # our dummy is already gone: this node has already been expanded
        return
    }
    $tree delete $1stCh

    # now find all /direct/ children: every line which has the /next/ column set
    set idxLst [lsearch -index [incr colIdx] -start $stIdx -all -regexp $subLst {.+}]

    # are we inserting into the last column? if so don't add a dummy
    set lastCol [expr {$colIdx == ([$tree columncount] - 1)}]

    # insert the new elements
    set newLst {}
    foreach idx $idxLst {
        set newIdx [$tree insertchild $row end [lindex $subLst $idx]]
        lappend newLst $newIdx
        if {! $lastCol} {
            $tree insertchild $newIdx end {"" "@"}
        }
        $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]]
        # add a dummy
        $tree insertchild $id end {"" "@"}
    }
    $tree collapseall

    # 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]]
    # strip off the item number
    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
}

#
# The following procs are only for the demo
#
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
}

#
# 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 exdata.txt
if {$argc == 0} {
    set numPeriphs 10
} else {
    set numPeriphs [lindex $argv 0]
}
start $numPeriphs $fName

foreach ch [winfo children .] {destroy $ch}
mkTree ""
fillFromFile MXRT1062.data
set t [dict get $gui tree]
update
# this call takes about 3 min on my machine so be prepared
$t expandall
update
# this one is fast: 10 sec
$t collapseall
saveTreeData tst.data

      parent
          child 1
              grandchild 1
          child 2
              grandchild 2

     parent
         child 1    child 2
                        grandchild 1    
                        grandchild 2