#  Postilion software and its included text and images
#  Copyright (C) 1998, 1999, 2000 Nic Bernstein
#
#  The full text of the legal notices is contained in the file called
#  COPYING, included with this distribution.
#
#  This program is free software; you can redistribute it and/or
#  modify it under the terms of the GNU General Public License
#  as published by the Free Software Foundation; either version 2
#  of the License, or (at your option) any later version.
# 
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#
#  You should have received a copy of the GNU General Public License
#  along with this program; if not, write to the Free Software
#  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.

# BuildHierarcyWindow
#
# a dynamic hierarchical listbox for selection/creation/manipulation
# 3/7/97 Nic Bernstein
#
# Arguments:
# type     - the type of information

proc BuildHierarchyWindow {win} {
    global option t app
    upvar #0 $win id
    set type $id(type)
    upvar #0 $type htype

    set mypad $id(mypad)
    set num_lbs $htype(num_lbs)
    set htype(path_begin) {}

    # Create label box
    frame $win.labbox
    pack $win.labbox -fill x -padx $mypad

    # Create listboxes box
    frame $win.fLBs
    pack $win.fLBs -fill both -expand yes -padx $mypad
    set j 0

    # Populate labelbox and listboxbox
    for {set i 0} {$i < $num_lbs} {incr i} {
	CreateHierLB $win $j $type
	CreateLabel $win $j $type
	incr j
    }
}


# CreateHierLB --
#
# Create a frame with a scrollbar and listbox, and a seperate
# frame with an Icon and text for use in a hierarchical
# browser widget
#
# Arguments:
# Parent - the toplevel window of the widget
# j      - the number designation in the hierarchy
# Type - the type of hierarchy we're dealing with

proc CreateHierLB {parent j type} {
    global option
    upvar #0 $type htype

    set bg [lindex $option(color_set) 0]
    set fg [lindex $option(color_set) 1]
    set lbname $parent.fLBs.$j
    
    frame $lbname -relief sunken -bd 2
    scrollbar $lbname.sb -command "$lbname.lb yview" -relief flat
    listbox $lbname.lb -relief flat -selectbackground $fg \
	-selectforeground $bg -yscrollcommand "$lbname.sb set" \
	-exportselection false

    # Scroll mouse support added by Stephen Ryan 14 Oct 1999
    bind $lbname.lb <5> [list $lbname.lb yview scroll 5 units]
    bind $lbname.lb <4> [list $lbname.lb yview scroll -5 units]
    bind $lbname.lb <Shift-5> [list $lbname.lb yview scroll 1 units]
    bind $lbname.lb <Shift-4> [list $lbname.lb yview scroll -1 units]
    bind $lbname.lb <Control-5> [list $lbname.lb yview scroll 1 pages]
    bind $lbname.lb <Control-4> [list $lbname.lb yview scroll -1 pages]

    if [info exists $htype(lbwidth)] {
	$lbname.lb configure -width $htype(lbwidth)
    }

    pack $lbname.sb -side left -fill y -expand no
    pack $lbname.lb -side left -fill both -expand yes
    pack $lbname -side left -fill both -padx 2 -pady 2 -expand yes

    bindtags $lbname.lb [list Listbox $lbname.lb . all]
    set htype(highlbnum) $j
    update idletasks 
}

# Create Listbox Labels
#
# Create an label representing the selected item in the accompanying
# listbox.
#
# Aguments:
# parent       - parent window for label
# j                - number of label
# Type          - the type of hierarchy we're dealing with

proc CreateLabel { parent j type } {
    global option defaultFontWidth 
    upvar #0 $type htype

    update idletasks
    set lblabel $parent.labbox.$j
    set sbw [expr [$parent.fLBs.$j.sb cget -width] / $defaultFontWidth]
    set lbw [expr [$parent.fLBs.$j.lb cget -width] / $defaultFontWidth]
    set font $htype(head_font)

    if [info exists $htype(lbwidth)] {
	set width [ expr $sbw + $htype(lbwidth) ]
    } else {
	set width [ expr $sbw + $lbw]
    }

    frame $lblabel -relief sunken -bd 2 -bg gray50
    label $lblabel.text -relief flat -width $width -fg white \
	-bg gray50 -font $font
    pack $lblabel.text -side left -expand yes -fill x
    pack $lblabel -side left -fill x -padx 2 -pady 2 -expand yes
}

