#
# $Source: /home/nlfm/Working/Zircon/Released/lib/RCS/Help.tcl,v $
# $Date: 2001/07/10 15:36:11 $
# $Revision: 1.18.1.15 $
#
# ----------------------------------------------------------------------
#   AUTHOR:  Lindsay Marshall <lindsay.marshall@newcastle.ac.uk>
# ----------------------------------------------------------------------
# Copyright 1993-2000 The University of Newcastle upon Tyne (see COPYRIGHT)
# ======================================================================
#
package provide zircon 1.18
#
proc makeHelp {win nm} {
    $win delete 0 end
    global zircon
    if {[catch {set st [glob [file join $zircon(lib) help $nm *]]}]} {
	$win add command -label {Sorry, not yet available.} -command {}
    } {
	$win delete 0 end
	set hc 0
	foreach x $st {
	    set tx [file tail $x]
	    set ntx m[incr hc]
	    if {[file isdirectory $x]} {
		$win add cascade -label $tx -menu $win.$ntx
		if {![winfo exists $win.$ntx]} {
		    menu $win.$ntx -tearoff 0 \
		      -postcommand "makeHelp $win.$ntx [list [file join $nm $tx]]"
		}
	    } { 
		$win add command -label $tx \
		  -command "zHelpWind .@$nm$tx [list $x] {Zircon Help : $nm > $tx}"
	    }
	}
    }
}
#
proc zHelpWind {ctl hfile title} {
    if {[winfo exists $ctl]} { popup $ctl ; return }
    makeToplevel $ctl $title {} {}
    set oFrm $ctl
    grid columnconfigure $ctl 0 -weight 1
    grid rowconfigure $ctl 0 -weight 1
    scrollbar $ctl.vs -command "$ctl.txt yview"
    text $ctl.txt -yscrollcommand "$ctl.vs set" -height 10 -width 40
    $ctl.txt tag configure input -foreground red
    $ctl.txt tag configure output -foreground black
    grid $ctl.vs -row 0 -column 1 -sticky ns
    grid $ctl.txt -row 0 -column 0 -sticky nsew
    grid [button $ctl.close -text [trans dismiss] -command "destroy $ctl"] -
    set desc [open $hfile r]
    while {![eof $desc]} {
	gets $desc buffer
	switch {} $buffer {
	    $ctl.txt insert end "\n\n"
	} default {
	    $ctl.txt insert end "$buffer "
	}
    }
    close $desc
    $ctl.txt configure -state disabled
}