Displaying Tree Hierarchy with Incremental Node Numbering

WJG (17/05/17) I was recently supplied with a list of concept headings which were tagged with incremental node strings. Getting the gnocl::tree widget to list the hierarchy of the nodes was a simple task of counting up the separators and modifying the point of table insertion.

#!/bin/sh
# the next line restarts using tclsh \
exec tclsh "$0" "$@"

package require Gnocl

namespace eval pkg {}

#---------------
# Set Markup based upon level of node elements
#---------------
# Arguments:
#        n        level 
# Returns:
#        list of tag on and off values
#
proc pkg::markup { n } {
        if { $n == 1 } { set res [list <b> </b>] }
        if { $n == 2 } { set res [list "<span foreground='red'>" </span>] }
        if { $n == 3 } { set res [list "<span foreground='blue'>" </span>] }
        if { $n >= 4 } { set res [list "" ""] }
        
        return $res
}

#---------------
# Covert tree path to node
#---------------
# Arguments:
#        path                path 
#        separator        default = .
# Returns:
#        node
#
proc pkg::path2node { path {separator .}} {

        foreach n [split [lindex $path 0]] {
                if { [incr n] < 10 } {set pad 0}
                append res "$pad$n$separator"
        }
        
        return [string range $res 0 end-1]

}


#---------------
# Create tree displaying heirarchy based upon nodes
#---------------
# Arguments:
#        data                list of data to display
#        separator        node level separator, default = .
# Returns:
#        widget-id of completed tree
#
proc pkg::create { {data HTC.tcl} {separator .} } {


        set wid [gnocl::tree \
                -types [list markup markup ] \
                -titles [list Level Description ] \
                -headersClickable 0 \
                -treeLines 1 \
                -ruleHint 1 \
                -onSelectionChanged { puts [pkg::path2node %p] } ]
        
        $wid columnConfigure 0 -width 150
        
        source $data
        
        foreach {ref cat} $htc {
                
                set n [split $ref $separator]
                
                set len [ llength $n ]

                lassign [pkg::markup $len] tagOn tagOff

                set ref $tagOn$ref$tagOff ; set cat $tagOn$cat$tagOff

                if { $len == 1} {
                        set row [$wid add "" [list [list $ref $cat]] ]
                } else {
                        set end [expr $len -2]
                        set row [$wid addEnd [lrange [lindex $row 0] 0 $end] [list [list $ref $cat]] ] 
                }

        }
        
        
        return $wid
}


#---------------
# Script Main Function
#---------------
# Arguments:
#        args
# Returns:
#        none
#
proc main { args } {

        gnocl::window -child [pkg::create HTC_.tcl] -setSize 0.5 -title "Hierachy Numbering"

}


main

Here’s a representative node list, file HTC_.tcl.

set htc {
01 {England}
01.01 {London}
01.01.01 {Westminster}
01.01.02 {Kensington}
01.01.03 {Hampstead}
01.02 {West Midlands}
01.02.01 {Birmingham}
01.02.02 {Coventry}
01.02.03 {Wolverhampton}
01.02.03.01 {Pendeford}
01.02.03.02 {Oxley}
01.02.03.03 {Fordhouses}
01.02.03.04 {Penn}
01.02.03.05 {Wightwick}
01.02.03.06 {Finchfield}
01.02.03.07 {Bilston}
01.02.03.08 {Wednesfield}
01.02.03.09 {Tettenhall}
01.02.03.10 {Bushbury}
01.02.03.11 {Compton}
01.02.03.12 {Graisely Hill}
01.02.03.13 {Merridale}
01.02.03.14 {Blackenhall}

01.02.04 {Walsall}
01.02.05 {Solihull}
01.02.06 {Sandwell}
01.02.07 {Dudley}
01.03 {Manchester}

02 {Wales}
02.01 {Cardif}
02.01 {Swansea}

03 {Scotland}
03.01 {Edinburgh}
03.02 {Glasgow}

04 {Northern Ireland}
04.01 {Belfast}
}

And this is what it looks like...

WikiDBImage Node-Number-Tree.png