#! /bin/sh
# \
exec /usr/local/bin/tclsh8.5 "$0" ${1+"$@"}

#
# TkNib - GUI Netinfo browser
#
# Stuart Cassoff
# Winter 2009
#
# Version 0.1
#
# Fall 2009
# Version 0.2
# Adjusted for addition of 'ether' database
#
# Summer 2012
# Version 0.3
# Updated about window to show more info.
#


[namespace eval tknib {


#
#
#
proc gui {} {
	variable cfg
	variable gui

	set ns $cfg(NS):

	set w [set gui(w) {}]
	set W [set gui(W) $w.]

	grid [set gui(mainBook) [ttk::notebook $w.n0]] -sticky nsew -row 0 -column 0
	grid rowconfigure $W 0 -weight 1
	grid columnconfigure $W 0 -weight 1

	foreach t [netinfoDatabases] {
		if {![file exists [${t}DataFilename]]} { continue }
		load[string totitle $t]Data
		set fields {}; set headings {}
		foreach fld [${t}Fields] {
			set fld [string range $fld 1 end]
			lappend fields $fld
			lappend headings [string totitle $fld]
		}

		set f [ttk::frame $gui(mainBook).f$t]
		grid [set gui($t) [ttk::treeview $f.v0 -selectmode browse -height 20 -show headings -columns $fields -xscrollcommand [list $f.s1 set] -yscrollcommand [list $f.s0 set]]] -sticky nsew -row 0 -column 0
		grid [ttk::scrollbar $f.s0 -command [list $f.v0 yview]] -sticky ns -row 0 -column 1
		grid [ttk::scrollbar $f.s1 -orient horizontal -command [list $f.v0 xview]] -sticky ew -row 1 -column 0
		grid rowconfigure $f 0 -weight 1
		grid columnconfigure $f 0 -weight 1
		$gui(mainBook) add $f -text $t -sticky nsew

		foreach fld $fields hdg $headings {
			$gui($t) heading $fld -command [list $ns:SortBy $gui($t) $fld 0] -text $hdg
			set lens($fld) [string length $hdg]; incr lens($fld) 4
		}
		foreach q [$t -name *] {
			$gui($t) insert {} end -values $q
			foreach fld $fields val $q {
				if {[set len [string length $val]] > $lens($fld)} { set lens($fld) [incr len 2] }
			}
		}
		set font [ttk::style lookup [$gui($t) cget -style] -font]
		foreach fld $fields { $gui($t) column $fld -width [font measure $font [string repeat x $lens($fld)]] }
	}

	set M [menu $w.mMain -tearoff 0]
	foreach {menu mi} {file 0 help 0} items {{Exit 1} {About 0}} commands [list [list exit] [list $ns:about]] {
		$M add cascade -label [string totitle $menu] -underline $mi -menu [set mm [menu $M.$menu -tearoff 0]]
		foreach {item ii} $items command $commands { $mm add command -label $item -underline $ii -command $command }
	}

	bind $W <Control-q> exit; bind $W <Control-Q> exit

	$W configure -menu $M

	wm title $W $cfg(name)\ $cfg(ver)

	if {[llength [$gui(mainBook) tabs]] == 0} {
		$gui(mainBook) configure -width 200
	}
}
###



#
# From the Tk widget demo "A multi-column list of countries"
# Code to do the sorting of the tree contents when clicked on
#
proc SortBy {tree col direction} {
	# Build something we can sort
	set data {}
	foreach row [$tree children {}] {
		lappend data [list [$tree set $row $col] $row]
	}

	set dir [expr {$direction ? "-decreasing" : "-increasing"}]
	set r -1

	# Now reshuffle the rows into the sorted order
	foreach info [lsort -dictionary -index 0 $dir $data] {
		$tree move [lindex $info 1] {} [incr r]
	}

	# Switch the heading so that it will sort in the opposite direction
	$tree heading $col -command [list [namespace current]::SortBy $tree $col [expr {!$direction}]]
}
###



#
#
#
proc about {} {
	variable cfg

	set w .aboot
	catch {destroy $w}
	wm group [toplevel $w] .

	set i -1
	foreach t [list \
			$cfg(title) \
			$cfg(author) \
			$cfg(when) \
	] {
		grid [ttk::label $w.l[incr i] -text $t]

	}
	grid [ttk::separator $w.s -orient horizontal] -sticky ew
	foreach t [list \
			$cfg(name)\ $cfg(ver) \
			Netinfo\ [package provide netinfo] \
	] {
		grid [ttk::label $w.l[incr i] -text $t]
	}
	grid [set ok [ttk::button $w.b -command [list destroy $w] -text Ok]]
	foreach k {Q q} { bind $w <Control-$k> [list $ok invoke] }
	wm title $w $cfg(name)\ $cfg(ver)\ -\ About
	::tk::PlaceWindow $w widget .
	focus $ok
}
###



#
#
#
proc setup {} {
	variable cfg

	set cfg(NS)		[namespace current]

	set cfg(name)		TkNib
	set cfg(title)		"Netinfo Browser"
	set cfg(ver)		0.3
	set cfg(author)		"Stuart Cassoff"
	set cfg(when)		"Summer 2012"
}
###



#
#
#
proc go {} {
	package require Tk
	package require netinfo 
	namespace import ::netinfo::*
	setup
	gui
}
###



namespace current}]::go


# EOF
