#
# utils.tk
#
#
# Routines for helping to construct tk windows
#
# Construction routines:
#   build_Toplevel
#   build_Title
#   build_StdFrame
#   build_CmdFrame
#   build_Menubar
#   build_Menu
#   build_Buttonbar
#   build_DismissButtonbar
#   build_Optionslist
#   build_Optionsrow
#   build_Optionscol
#   build_Filename
#   build_Scrollingtext
#   build_Dialog
#   build_PopupMenu
#   build_PopupMenuFixedWidth
#   build_LabelEntryColumnsFixedScroll
#   build_LabelEntryColumnsScroll
#   build_LabelEntryColumns
#   build_Message
#   build_Label
#   build_Radiobutton
#   build_Choicefield
#   build_Choicecols
#   build_Button
#   build_StdListbox
#   build_Listbox
#
#
# Other routines:
#   build_Wname
#   update_Popupmenu
#   scroll(canvas)
#   longest
#   loadfile_into_text
#   bind_LabelEntryColumns
#
# All these procedures use the global variables COLOR and FONT in
# order to configure them.  In particular, they may reference:
#   COLOR(bg)
#   COLOR(abg)
#   COLOR(entry)
#   FONT(button)
#   FONT(label)
#   TITLE
#
# Other global variables used are:
#   main(title)  - for a string to appear in all titlebars made
#                  with build_Title
#   DEBUG        - used for printing some diagnostic errors
#

#
# build_Wname
#
# Converts name to a tk window name by placing a '.' at the beginning
#
# Returns: .name
#
proc build_Wname name {
    return .$name
}

#
# build_Toplevel
#
# Builds a new window using name (which must be unique).
# The name is passed to build_Wname to convert it to a Tk window name
#
# Returns: the tk window name
#
proc build_Toplevel {name} {
    global COLOR

    set wname [build_Wname $name]
    if {![winfo exists $wname]} {
	toplevel $wname -bg $COLOR(bg)
    }
    return $wname
}


#
# build_Title
#
# Set the title of a toplevel window with the string "main(title) $title"
#
proc build_Title {name title} {
    global TITLE
    wm title $name "$TITLE $title"
}

#
# build_StdFrame
#
# Builds a plain frame with specifed name in specified parent
# This widget is not packed.
#
# Returns: the tk frame widget name parent.name
#
proc build_StdFrame {parent name} {
    global COLOR

    set fname $parent.$name
    if {![winfo exists $fname]} {
	frame $fname -bg $COLOR(bg)
    }
    return $fname
}

#
# build_CmdFrame
#
# Builds a raied frame with specifed name in specified parent
# to become an area of a window to put widgets
# This widget is not packed
#
# Returns: the tk frame widget name parent.name
#
proc build_CmdFrame {parent name} {
    global COLOR

    set fname $parent.$name
    if {![winfo exists $fname]} {
	frame $fname -relief raised -bd 1 -bg $COLOR(bg)
    }
    return $fname
}


#
# build_Menubar
#
# Usage:
#       build_menubar parent name { helpmenu stuff } { menu stuff } ...
#
# Builds a menubar as specified.  The first menu specification is
# always placed all the way to the right and is expected to be a help menu.
# The others are placed starting at the left.
#
proc build_Menubar {parent name helpmenu args} {
    global DEBUG COLOR FONT

    # create menubar
    set mbarname [ build_CmdFrame $parent $name ]

    # menubars are not currently rebuilt!
    if [winfo exists $mbarname.b0] {
	if $DEBUG { puts "build_menubar: NOT rebuilding $mbarname"}
	return
    }

    # add help menubutton on right side
    if {[llength $helpmenu] > 1} {
	menubutton $mbarname.help -text [lindex $helpmenu 0] \
	    -menu $mbarname.help.menu -underline 0 \
	    -bg $COLOR(bg) -activebackground $COLOR(abg) \
	    -font $FONT(button)
	eval build_Menu $mbarname.help menu [lrange $helpmenu 1 end]
	pack $mbarname.help -side right
    }

    #add other menubuttons on left side
    set i 0 ; set menubuttons {}
    foreach arg $args {
	if {[llength $arg] >= 1} {
	    menubutton $mbarname.b$i -text [lindex $arg 0] \
		-menu $mbarname.b$i.menu -underline 0 \
		-bg $COLOR(bg) -activebackground $COLOR(abg) \
		-font $FONT(button)
	    eval build_Menu $mbarname.b$i menu [lrange $arg 1 end]
	    lappend menubuttons $mbarname.b$i
	    incr i
	}
    }
    if {[llength $menubuttons] > 0} {
	eval pack $menubuttons -side left -padx 0.1c -pady 0.1c
    }

    # display menubar across the top of the panel
    pack $mbarname -side top -fill x

    return $mbarname
}

#
# build_Menu
#
# Usage:
#	build_Menu parent name {"Load..." load_open} {} {"Exit" tk_exit} ...
#
# Builds a menu with an arbitrary numer of entries and empty ones result
# in separators.
#
proc build_Menu {parent name args} {
    global COLOR FONT

    # create menu
    set mname $parent.$name
    menu $mname -bg $COLOR(bg) -activebackground $COLOR(abg) \
	-font $FONT(label)

    # add commands to menu
    foreach arg $args {
	if {[llength $arg] == 2} {
	    $mname add command -label [lindex $arg 0] -command [lindex $arg 1]
	} else {
	    $mname add separator
	}
    }

    return $mname
}

proc do_Menucommand command {
    eval $command
}


#
# build_Buttonbar
#
# Usage: build_Buttonbar parent name {"Button1" action} ...
#
proc build_Buttonbar {parent name args} {
    global COLOR FONT

    # create buttonbar
    set bbarname [ build_CmdFrame $parent $name ]
    
    # add buttons
    set i 0
    foreach arg $args {
	if {[llength $arg] > 1} {
	    if { [winfo exists $bbarname.b$i] == 0} {
		button $bbarname.b$i -bg $COLOR(bg) \
		    -activebackground $COLOR(abg) \
		    -font $FONT(button)
		pack $bbarname.b$i -side left -padx 2 -pady 2
	    }
	    $bbarname.b$i configure -text [lindex $arg 0] \
		-command [lindex $arg 1]
	    incr i
	}
	while { [winfo exists $bbarname.b$i] == 1} {
	    destroy $bbarname.b$i
	    incr i
	}
    }

    pack $bbarname -fill x

    return $bbarname
}

#
# build_DismissButtonbar
#
# Builds a button bar with a dismiss button on the right hand side
# and the rest lined up on the left.
#
# Usage: build_DismissButtonbar parent name "dismiss command" \
#            {"Button1" "button1 command"} ...
#
proc build_DismissButtonbar {parent name dismiss args} {
    global COLOR FONT

    # create buttonbar
    set bbarname [ build_CmdFrame $parent $name ]

    # add dismiss button on right side
    if {[winfo exists $bbarname.dismiss] == 0} {
	button $bbarname.dismiss -bg $COLOR(bg) -activebackground $COLOR(abg) \
	    -font $FONT(button)
	pack $bbarname.dismiss -in $bbarname -side right -anchor e \
	    -padx 2 -pady 2
    }
    $bbarname.dismiss configure -text Dismiss -command $dismiss

    # add other buttons
    set i 0
    foreach arg $args {
	if {[llength $arg] > 1} {
	    if { [winfo exists $bbarname.b$i] == 0} {
		button $bbarname.b$i \
		    -bg $COLOR(bg) -activebackground $COLOR(abg) \
		    -font $FONT(button)
		pack $bbarname.b$i -side left -padx 2 -pady 2
	    }
	    $bbarname.b$i configure -text [lindex $arg 0] \
		-command [lindex $arg 1]
	    incr i
	}
	while { [winfo exists $bbarname.b$i] == 1} {
	    destroy $bbarname.b$i
	    incr i
	}
    }
    
    pack $bbarname -side bottom -fill x
}

#
# build_Optionslist
#
# Procedure to make a list (column) of option items
#
# Usage: build_Optionslist parent name \
#            {"Switch 1" switch1} {"Switch 2" switch2} ...
#
# The variables switch1,2 are set to 0 or 1 according to whether
# the switch is set or not.
#
proc build_Optionslist {parent name args} {
    global COLOR FONT

    # create options list
    set olistname [ build_StdFrame $parent $name]
    
    # add options
    set i 0
    foreach arg $args {
	if {[llength $arg] > 1} {
	    if { [winfo exists $olistname.b$i] == 0} {
		checkbutton $olistname.b$i -anchor w \
		    -bg $COLOR(bg) -activebackground $COLOR(abg) \
		    -font $FONT(label)
		pack $olistname.b$i -side top -fill x -padx 0.1c -pady 0.1c
	    }
	    $olistname.b$i configure -text [lindex $arg 0] \
		-variable [lindex $arg 1]
	    incr i
	}
	while {[winfo exists $olistname.b$i] == 1} {
	    destroy $olistname.b$i
	    incr i
	}
    }

    pack $olistname -pady 0.1c -anchor w
}

#
# build_Optionsrow
#
# Procedure to make a row of option items, with label
#
# Usage: build_Optionsrow parent name label \
#            {"Switch 1" switch1} {"Switch 2" switch2} ...
#
# The variables switch1,2 are set to 0 or 1 according to whether
# the switch is set or not.
#
proc build_Optionsrow {parent name label args} {
    global COLOR FONT

    set fname [build_StdFrame $parent $name]
    if {[winfo exists $fname.label]} {
        $fname.label configure -text $label
    } {
        label $fname.label -text $label -bg $COLOR(bg) -font $FONT(label)
        pack $fname.label -side left -pady 2 -padx 2
    }

    # create options list
    set olistname [ build_StdFrame $parent $name]
    
    # add options
    set i 0
    foreach arg $args {
	if {[llength $arg] > 1} {
	    if { [winfo exists $olistname.b$i] == 0} {
		checkbutton $olistname.b$i -anchor w \
		    -bg $COLOR(bg) -activebackground $COLOR(abg) \
		    -font $FONT(label)
		pack $olistname.b$i -side left -padx 0.1c -pady 0.1c
	    }
	    $olistname.b$i configure -text [lindex $arg 0] \
		-variable [lindex $arg 1]
	    incr i
	}
	while {[winfo exists $olistname.b$i] == 1} {
	    destroy $olistname.b$i
	    incr i
	}
    }

    pack $olistname -pady 0.1c -anchor w
}

#
# build_Optionscol
#
# Procedure to make a column of option items
#
# Usage: build_Optionscol parent name \
#            {"Switch 1" switch1} {"Switch 2" switch2} ...
#
# The variables switch1,2 are set to 0 or 1 according to whether
# the switch is set or not.
#
proc build_Optionscol {parent name ocmd args} {
    global COLOR FONT

    # create options list
    set olistname [ build_StdFrame $parent $name]
    
    # add options
    set i 0
    foreach arg $args {
	if {[llength $arg] > 1} {
	    if { [winfo exists $olistname.b$i] == 0} {
		checkbutton $olistname.b$i \
			-anchor w \
		    	-bg $COLOR(bg) \
			-activebackground $COLOR(abg) \
		    	-font $FONT(label) 
		pack $olistname.b$i -side top -fill x -padx 0.1c -pady 0
	    }
	    $olistname.b$i configure \
		-text [lindex $arg 0] \
		-variable [lindex $arg 1] \
		-command $ocmd
	    incr i
	}
	while {[winfo exists $olistname.b$i] == 1} {
	    destroy $olistname.b$i
	    incr i
	}
    }

    pack $olistname -pady 0.1c -anchor w
}


#
# build_Filename
#
# Builds fields for inputting a directory and filename
#
#
proc build_Filename {owner name file_var dir_var} {
    global COLOR

    build_LabelEntryColumns $owner $name \
	[list text {} { "Directory:" "Filename:" } ] \
	[list lentry {} [list $dir_var $file_var]]
}

#
# build_Scrollingtext
#
# Builds a widget for text and a scrollbar
#
proc build_Scrollingtext {parent name width height} {
    global COLOR FONT

    # create stext frame
    set stext [ build_StdFrame $parent $name ]

    # add text widget
    if {[winfo exists $stext.text] == 0} {
	text $stext.text -relief sunken -bd 2 \
	    -yscrollcommand "$stext.scroll set" \
	    -bg $COLOR(entry) -font $FONT(label) \
	    -width 1 -height 1
	$stext.text configure -width $width -height $height
	pack $stext.text -side left -fill both -expand 1
    }
    # add scrollbar
    if {[winfo exists $stext.scroll] == 0} {
       scrollbar $stext.scroll -command "$stext.text yview" \
	   -bg $COLOR(bg)
#	   -bg $COLOR(bg) -foreground $COLOR(bg) -activeforeground $COLOR(abg)
	pack $stext.scroll -side right -fill y
    }
    pack $stext -expand 1 -fill both
    return $stext.text
}

#
# build_Dialog
#
# Builds a dialog box for immediate action
#
# Usage: set choice [build_Dialog dialog "Title" "Question ?" \
#			 0 "Choice 0" "Choice 1" ... ]
# where the default choice is specified by the integer which is in this
# example 0.
#
#
proc build_Dialog {name title text default args} {
    global COLOR FONT dialog

    set w .$name

    # create window and top and bottom parts
    toplevel $w -class Dialog -bg $COLOR(bg)
    build_Title $w "$title"
    set top [build_StdFrame $w top]
    set bottom [build_StdFrame $w bottom]
    pack $top -side top -fill both
    pack $bottom -side bottom -fill both

    # put message in top
    message $top.msg -text $text -bg $COLOR(bg) -font $FONT(label) -width 7c
    pack $top.msg -expand 1 -fill both

    # put buttons in bottom
    set i 0
    foreach but $args {
	button $bottom.b$i -text $but -command "set dialog(button) $i" \
	    -bg $COLOR(bg) -activebackground $COLOR(abg) -font $FONT(button)
	if {$i == $default} {
	    frame $bottom.default -relief sunken -bd 1 -bg $COLOR(bg)
	    raise $bottom.b$i
	    pack $bottom.default -side left -expand 1 -padx 3m -pady 2m
	    pack $bottom.b$i -in $bottom.default -side left \
		-padx 2m -pady 2m -ipadx 2m -ipady 1m
	} else {
	    pack $bottom.b$i -side left -expand 1 \
		-padx 3m -pady 3m -ipadx 2m -ipady 1m
	}
	incr i
    }

    # set up bindings etc.
    if {$default >= 0} {
	bind $w <Return> "$bottom.b$default flash; set dialog(button) $default"
    }
    set oldFocus [focus]

    # visibility problem (veran)
    tkwait visibility $w

    grab set $w
    focus $w

    # wait for response
    tkwait variable dialog(button)
    destroy $w
    focus $oldFocus
    return $dialog(button)

}

#
# update_PopupMenu
#
# Utility routine for build_PopupMenu
#
proc update_PopupMenu {name str cmd args} {
    # $name configure -text "$str  ~"
    $name configure -text "$str"
    foreach arg $args {
	uplevel #0 $arg
    }
    eval $cmd
}


#
# build_PopupMenuFixedWidth
#
# Constructs a popup menu with width specified.   If width is <=0,
# then the width will be set to the minimal necessary to get all
# of the entries included, plus a little padding (4 spaces).
#
# Usage: build_PopupMenuFixedWidth parent name width "Algorithm:" \
#            alg_var alg_proc {"Alg 0" "Alg 1" "Alg 2" ...}
# where alg_var is the variable which gives the index of the selected
# algorithm and alg_proc gets called whenever the algorithm is changed.
#
proc build_PopupMenuFixedWidth { parent name width label ivar command items } {
    global COLOR FONT

    set wname [build_StdFrame $parent $name]

    # make label
    if {![winfo exists $wname.label]} {
	label $wname.label -anchor w -bg $COLOR(bg) -font $FONT(label)
    }
    $wname.label configure -text $label

    # if no items then do not create menubar!
    if {![llength $items]} {
	if {[winfo exists $wname.mb]} {destroy $wname.mb}
	pack $wname.label -side left -padx 0.1c
	pack $wname -fill x -pady 0.1c
	return $wname 
    }

    # make menubutton
    if {![winfo exists $wname.mb]} {
	menubutton $wname.mb -menu $wname.mb.m -anchor n -relief raised \
	    -bg $COLOR(bg) -activebackground $COLOR(abg) -font $FONT(label) \
            -indicatoron 1 -fg $COLOR(info)
    }
    upvar #0 $ivar iv
    if {$width <=0} {
        set width [expr [longest $items] + 4]
        }
    #$wname.mb configure -text "[lindex $items $iv]  ~" -width $width
    $wname.mb configure -text "[lindex $items $iv]" -width $width

    # make menu
    if {[winfo exists $wname.mb.m]} {
	destroy $wname.mb.m
    }
    menu $wname.mb.m -bg $COLOR(bg) -activebackground $COLOR(abg) -font $FONT(label)
    set i 0
    foreach item $items {
	$wname.mb.m add command -label $item -command \
	    [list update_PopupMenu $wname.mb $item $command \
		 [list set $ivar $i]]
	incr i
    }

    pack $wname.label $wname.mb -side left -padx 0.1c
    pack $wname -fill x -pady 0.1c

    return $wname
}

#
# build_PopupMenu
#
# builds a popup menu, with default width, by a call to
# build_PopupMenuFixedWidth
#
# Usage: build_PopupMenu parent name "Algorithm:" \
#            alg_var alg_proc {"Alg 0" "Alg 1" "Alg 2" ...}
# where alg_var is the variable which gives the index of the selected
# algorithm and alg_proc gets called whenever the algorithm is changed.
#
proc build_PopupMenu { parent name label ivar command items } {
    global FONT COLOR
 
    build_PopupMenuFixedWidth $parent $name 0 $label $ivar $command $items
 
}
 

#
# create a scrolling label entry columns widget
#
proc scroll(canvas) {parent name width height region args} {
    global COLOR FONT

    #puts ""
    #puts "scroll(canvas)"
    #puts "width: $width"
    #puts "height: $height"
    #puts "region: $region"
    #puts "args: $args"

    if {[winfo exists $parent.$name.canvas]} {
      return $parent.$name.canvas
    }

    set pf [frame $parent.$name -bg $COLOR(bg)]

    canvas $pf.canvas -width $width -height $height \
	-bg $COLOR(bg) \
        -scrollregion $region \
        -yscrollcommand [list $pf.yscroll set]

    scrollbar $pf.yscroll -orient vertical \
        -command [list $pf.canvas yview]

    set cf [frame $pf.canvas.f -bd 0 -bg $COLOR(bg)]
    $pf.canvas create window 0 0 -anchor nw -window $cf

    pack $pf.yscroll -side right -fill y
    pack $pf.canvas -side left -fill both -expand true
    pack $pf -side top -fill both -expand true

    return $pf.canvas
}

proc build_LabelEntryColumnsFixedScroll {parent name height args } {
    global COLOR FONT

    set sc [scroll(canvas) $parent $name 300 $height {0 0 1000 100}]

    pack $parent -fill x
    pack $parent.$name -fill x

    eval [concat [list build_LabelEntryColumns $sc.f le] $args]
     
    tkwait visibility $sc.f
    set dx [winfo width $sc.f]
    set dy [winfo height $sc.f]

    $sc config -scrollregion "0 0 $dx $dy"
    $sc config -width $dx
}

proc build_LabelEntryColumnsScroll {parent name height args } {
    global COLOR FONT

    set arg0     [lindex $args 0]
    set listarg0 [lindex $arg0 2]
    set arglen   [llength $listarg0]

    #puts ""
    #puts "args: $args"
    #puts "arg0: $arg0"
    #puts "list args 0: $listarg0"
    #puts "scroll arg length: $arglen"
    #puts ""

    if {[winfo exists $parent.$name]} {
      destroy $parent.$name
    }

    if { $arglen > 10 } {
      eval [concat [list build_LabelEntryColumnsFixedScroll $parent $name $height] $args]
   
    } else {
      eval [concat [list build_LabelEntryColumns $parent $name] $args]
    }
}


# 
# usage:
#    build_LabelEntryColumns parent name \
#        {text   {} {"Ver Label:"}} \
#        {dentry {} {Print(Ver_Label)}}
#
#    build_LabelEntryColumns parent name \
#             [list text {} [list "Hor Range:" "Ver Range:"]] \
#             [list dentry {} [list Print(HorMin) Print(VerMin)]] \
#             [list dentry {} [list Print(HorMax) Print(VerMax)]]

proc build_LabelEntryColumns {parent name args } {
  global COLOR FONT

    build_StdFrame $parent $name

#    set _tablist {}

    set cn 0
    foreach c $args {
	set _type [lindex $c 0]
	set _code c$cn
	set _head [lindex $c 1]
	set _list [lindex $c 2]
	
	set valid_type 1
	set pady 0
	set nopadx 0
	set col_config {$obj_n configure -textvariable $l}
#	set col_tab {set valid_type}
	if { [string compare $_type "label"] == 0 } {
	    set col_entry {label $obj_n -anchor n -bg $COLOR(bg) -font $FONT(label)}
	    set pady 2
	} elseif { [string compare $_type "dlabel"] == 0 } {
	    set col_entry {label $obj_n -width 23 -relief sunken -anchor w -bg $COLOR(bg) -font $FONT(label) -fg $COLOR(info)}
	    set pady 2
	} elseif { [string compare $_type "ilabel"] == 0 } {
	    set col_entry {label $obj_n -width 10 -relief sunken -anchor w -bg $COLOR(bg) -font $FONT(label) -fg $COLOR(info)}
	    set pady 2
	} elseif { [string compare $_type "text"] == 0 } {
	    set col_entry {label $obj_n -anchor e -bg $COLOR(bg) -font $FONT(label)}
	    set pady 2
	    set col_config {$obj_n configure -text $l}
        } elseif { [string compare $_type "dentry"] == 0 } {
	    set col_entry {entry $obj_n -width 23 -relief sunken -bg $COLOR(entry) -font $FONT(label) -fg $COLOR(info)}
#	    set col_tab { lappend _tablist $obj_n }
        } elseif { [string compare $_type "ientry"] == 0 } {
	    set col_entry {entry $obj_n -width 10 -relief sunken -bg $COLOR(entry) -font $FONT(label) -fg $COLOR(info)}
#	    set col_tab { lappend _tablist $obj_n }
        } elseif { [string compare $_type "lentry"] == 0 } {
	    set col_entry {entry $obj_n -width 40 -relief sunken -bg $COLOR(entry) -font $FONT(label) -fg $COLOR(info)}
#	    set col_tab { lappend _tablist $obj_n }
        } elseif { [string compare $_type "checkbox"] == 0 } {
	    set col_entry {checkbutton $obj_n -anchor w -variable $l \
			       -bg $COLOR(bg) -activebackground $COLOR(abg) -font $FONT(label)}
	    set col_config {$obj_n configure -text ""}
	} elseif { [string compare $_type "bitmapbutton"] == 0} {
	    set col_entry {button $obj_n -image $l -highlightthickness 0} 
	    set nopadx 1
	    set pady 4
	} else {
	    # widget type not recognized
	    set valid_type 0
	    puts "ufo widget: $_type"
	}
	
	if $valid_type {
	    # create column and header
	    set obj $parent.$name.$_code
	    if { ![winfo exists $obj] } {
		frame $obj -bg $COLOR(bg)
		pack $obj -fill x -side left
		# -padx 2 -pady 1
	    }
	    if [string length "$_head"] {
		if { ![winfo exists $obj.head] } {
		    label $obj.head -anchor n -bg $COLOR(bg) -font $FONT(label)
		    pack $obj.head -side top -padx 2 -pady 1
		}
		$obj.head configure -text "$_head"
	    } else {
		if [winfo exists $obj.head] {
		    destroy $obj.head
		}
	    }
	    
	    # add elements to column
	    set _n 0
	    foreach l $_list {
		set obj_n $obj.$_n
		if { ![winfo exists $obj_n] } {
		    eval $col_entry
		    if {$nopadx == 1} {
			pack $obj_n -side top -pady $pady
                    } else {
		        pack $obj_n -side top -padx 0.1c -pady $pady -fill x
		        }
		}
		eval $col_config
#		eval $col_tab
		incr _n
	    }
	    while { [winfo exists $obj.$_n] } {
		destroy $obj.$_n
		incr _n
	    }
	}
	# prepare for next column
	incr cn
    }
    
    while { [winfo exists $parent.$name.c$cn] } {
	destroy $parent.$name.c$cn
	incr cn
    }
    
#    if {[llength $_tablist] > 0} {
#	setTabbing $_tablist $name
#	focus [lindex $_tablist 0]
#    }
    
    pack $parent.$name -fill x -pady 0.1c

    return $parent.$name
    
}

#
# build_Message
#
# Usage: build_Message parent name message
#
proc build_Message {parent name message} {
    global COLOR FONT

    set mname $parent.$name
    if {[winfo exists $mname]} {
	$mname configure -text $message
    } else {
	message $mname -text $message -bg $COLOR(bg) -font $FONT(label) \
	    -justify center -aspect 2000
	pack $mname -expand 1 -fill both
    }

    return $mname
}

#
# build_Label
#
# Usage: build_Label parent name message
#
proc build_Label {parent name message} {
    global COLOR FONT

    set fname [build_StdFrame $parent $name]
    if {[winfo exists $fname.label]} {
        $fname.label configure -text $message
    } {
      label $fname.label -text $message -bg $COLOR(bg) -font $FONT(label)
      pack $fname.label -expand 1 -fill both
    }

    pack $fname -anchor w -padx 0 -pady 0
    return $fname
}

#
# build_Radiobutton
#
# Usage: build_Radiobutton parent name var {choice1 choice2 ...}
#
proc build_Radiobutton {parent name var args} {
    global COLOR FONT

    set fname $parent.$name
    if {[winfo exists $fname] == 0} {
	frame $fname -relief ridge -borderwidth 2 -bg $COLOR(bg)
    }
    set i 0
    foreach arg $args {
	set choice [lindex $arg 0]
	set choiceval [lindex $arg 1]
	if {[winfo exists $fname.c$i]} {
	    $fname.c$i configure -variable $var -value $choiceval
	} else {
	    radiobutton $fname.c$i -text $choice -variable $var -value $choiceval \
		-bg $COLOR(bg) -activebackground $COLOR(abg) -font $FONT(label)
	    pack $fname.c$i -side left -fill x -pady 2 -padx 2
	}
	incr i
    }
    pack $fname -anchor w -padx 2 -pady 2
    return $fname
}

#
# build_Choicefield
#
# Usage: build_Choicefield parent name label var {choice0 choice1 ...}
#
proc build_Choicefield {parent name label var choices} {
    global COLOR FONT

    set fname [build_StdFrame $parent $name]
    if {[winfo exists $fname.label]} {
	$fname.label configure -text $label
    } {
	label $fname.label -text $label -bg $COLOR(bg) -font $FONT(label)
	pack $fname.label -side left -pady 2 -padx 2
    }
    set i 0
    foreach choice $choices {
	if {[winfo exists $fname.c$i]} {
	    $fname.c$i configure -text $choice -variable $var
	} {
	    radiobutton $fname.c$i -text $choice -variable $var -value $i \
		-bg $COLOR(bg) -activebackground $COLOR(abg) -font $FONT(label)
	    pack $fname.c$i -side left -pady 2 -padx 2
	}
	incr i
    }
    while {[winfo exists $fname.c$i]} {
	destroy $fname.c$i
	incr i
    }
    pack $fname -anchor w -padx 2 -pady 2
    return $fname
}

#
# build_Choicecols
#
# Usage: build_Choicecols parent name label var {choice0 choice1 ...}
#
proc build_Choicecols {parent name label var choices} {
    global COLOR FONT

    set fname [build_StdFrame $parent $name]
    if {[winfo exists $fname.label]} {
	$fname.label configure -text $label
    } {
	#label $fname.label -text $label -bg $COLOR(bg) -font $FONT(label)
	#pack $fname.label -side top -pady 0 -padx 2 -anchor w
    }
    set i 0
    foreach choice $choices {
	if {[winfo exists $fname.c$i]} {
	    $fname.c$i configure -text $choice -variable $var
	} {
	    radiobutton $fname.c$i -text $choice -variable $var -value $i \
		-bg $COLOR(bg) -activebackground $COLOR(abg) -font $FONT(label)
	    pack $fname.c$i -side top -pady 0 -padx 0 -anchor w
	}
	incr i
    }
    while {[winfo exists $fname.c$i]} {
	destroy $fname.c$i
	incr i
    }
    pack $fname -anchor w -padx 0 -pady 2
    return $fname
}
#
# build_Button
#
# Usage: build_Button parent name label command
#
proc build_Button {parent name label command} {
    global COLOR FONT

    set bname $parent.$name

    if {[winfo exists $bname]} {
	$bname configure -text $label -command $command
    } else {
	button $bname -bg $COLOR(bg) -activebackground $COLOR(abg) \
	    -font $FONT(button) -text $label -command $command
	pack $bname -anchor w -padx 2 -pady 2
    }
    return $bname
}



# return the length of the longest string in a list
proc longest list {
    set len 0
    foreach l $list {
	set ll [string length $l]
	if {$ll > $len} {set len $ll}
    }
    return $len
}


#
# loads a file into the end of a text widget
#    returns 1 if succesful, else 0
#
proc loadfile_into_text {textw filename} {
    set ok 0
    if [file exists $filename] {
	set f [open $filename]
	while {![eof $f]} {
	    $textw insert end [read $f 1000]
	}
	close $f
	set ok 1
    }
    return $ok
}

#
# binds <Return> to a function for an entry field in a LabelEntryItem
#
proc bind_LabelEntryColumns {widget column key routine} {

    if {[winfo exists $widget.canvas]} {
	set prefix $widget.canvas.f.le.c$column
    } {	
	set prefix $widget.c$column
    }

    set i 0
    while {[winfo exists $prefix.$i]} {
	bind $prefix.$i $key $routine
	incr i
    }
}


#
# build_StdListbox
#
# Builds a listbox widget for text items
#
proc build_StdListbox {parent name width height} {
    global COLOR FONT

    # create lbox frame
    set pf [ build_StdFrame $parent $name ]
    set lf [ build_StdFrame $pf lf ]
    set syf [ build_StdFrame $pf syf ]
    set sxf [ build_StdFrame $pf sxf ]

    # add lbox widget
    if {[winfo exists $lf.lb] == 0} {
        eval {listbox $lf.lb \
                -relief sunken -bd 2 \
                -yscrollcommand [list $syf.sy set] \
                -xscrollcommand [list $sxf.sx set] \
                -bg $COLOR(entry) \
                -font $FONT(label) \
                -width $width \
                -height $height }
        pack $lf.lb \
                -side left \
                -fill both \
                -expand true
    }
    # add scrollbar
    if {[winfo exists $syf.sy] == 0} {
       scrollbar $syf.sy \
		-orient vertical \
                -command [list $lf.lb yview] \
                -bg $COLOR(bg)
        pack $syf.sy \
                -side right \
                -fill both \
                -expand true
    }
    if {[winfo exists $sxf.sx] == 0} {
       scrollbar $sxf.sx \
		-orient horizontal \
                -command [list $lf.lb xview] \
                -bg $COLOR(bg)
        pack $sxf.sx \
                -side bottom \
                -fill both \
                -expand true
    }
    pack $pf -side top -expand true -fill both
    pack $sxf -side bottom -expand false -fill both
    pack $syf -side right -expand false -fill both
    pack $lf -side left -expand true -fill both
    return $lf.lb
}

 
#
# build_Listbox
#
# Builds a listbox (with or without scrollbar, depending upon whether the
# number of entries of the listbox is large enough) which allows the user
# to select two or more entries of the listbox simultaneously.
#
# Usage: build_Listbox parent name label num_to_select items
#   parent is the parent window,
#   name is the name of the new listbox,
#   label is the label for the listbox,
#   num_to_select is the number of entries which should be selected,
#   scrollactivate is the desired height of the listbox.   If there are more
#       entries than this number, a scrollbar is created.
# & items are the entries of the listbox
#
# Note: the listbox created by this routine is not packed, it contains no
# default selection, and will NOT export its selection.   To access the
# selection, use the command "$parent.$name curselection"
#
 
proc build_Listbox { parent name label num_to_select scrollactivate items } {
    global COLOR FONT
 
    if {[winfo exists $parent.$name]} {
        destroy $parent.$name
        }
    set fname [build_StdFrame $parent $name]
    
# Make label
    if {![winfo exists $fname.label]} {
        label $fname.label -anchor nw -bg $COLOR(bg) -font $FONT(label)
        }
    $fname.label configure -text $label 
    pack $fname.label -side left  
 
# Create listbox and scrollbar 
    set wid [expr [longest $items] + 4]
    set hei $scrollactivate
 
    if {[llength $items] > $scrollactivate} {
        if {![winfo exists $fname.lb]} {
            listbox $fname.lb -selectmode $num_to_select -relief ridge \
                -bd 2 -bg $COLOR(entry) -setgrid 1 -width $wid -height $hei \
                -yscrollcommand "$fname.scroll set" -exportselection 0
            pack $fname.lb -side left -fill both -expand 1
            }
        if {![winfo exists $fname.scroll]} {
            scrollbar $fname.scroll -command "$fname.lb yview" \
                -bg $COLOR(bg) 
            pack $fname.scroll -side right -fill y 
            }
    } else {
        if {![winfo exists $fname.lb]} {
            listbox $fname.lb -selectmode $num_to_select -relief ridge \
                -bd 2 -bg $COLOR(entry) -setgrid 1 -width $wid -height $hei  \
                -exportselection 0
            pack $fname.lb -side left -fill both -expand 1
            }
        }
    
  #add options
    foreach item $items {
        $fname.lb insert end $item
        }
 
#change bindings to make the listbox select only the requested number of items
    bind Listbox <1> {
        if [winfo exists %W] {
            myListboxBeginSelect %W [%W index @%x,%y]
            }
        }
    bind Listbox <Control-slash> { myListboxSelectAll %W } 
    bind Listbox <space> { myListboxBeginSelect %W [%W index active] }
    bind Listbox <Select> { myListboxBeginSelect %W [%W index active] }
    bind Listbox <Shift-Control-Home> { myListboxDataExtend %W 0 }
    bind Listbox <Shift-Control-End> { myListboxDataExtend %W end }
 
    return $fname.lb
}
 
 
#
# myListboxBeginSelect 
#
# A modified version of the tkListboxBeginSelect procedure, used for setting
# the selection in a listbox.   This procedure is modified to add to the 
# selection only if we have not passed the required number of entries to 
# select, when the selection mode is not one of the standard ones.  It assumes
# that the option "selectionmode" is set to the number of items we want 
# selected, and should therefore only be used by the procedure build_Listbox 
# above. 
#
# Usage: 
#   myListboxBeginSelect w el num_to_select
#
 
proc myListboxBeginSelect {w el} {
    global tkPriv
    
    set num_to_select [$w cget -selectmode] 
    if {$num_to_select  == "multiple"} {
        if [$w selection includes $el] {
            $w selection clear $el
        } else {
            $w selection set $el
        }
    } elseif {($num_to_select == "browse") || ($num_to_select == "single") || ($num_to_select == "extended")} {
        $w selection clear 0 end
        $w selection set $el
        $w selection anchor $el
        set tkPriv(listboxSelection) {}
        set tkPriv(listboxPrev) $el
    } else {
        if [$w selection includes $el] {
            $w selection clear $el
        } elseif {[llength [$w curselection]] < $num_to_select} {
            $w selection set $el
            } else {
              # too many parameters selected!
                build_Dialog dialog "Aug Param Alert" "Too Many Parameters \
                    selected.  Please deselect one before selecting another." \
                    0 Ok
                }
        }
} 
 
 
# myListboxDataExtend 
# 
# A modified version of the tkListboxDataExtend procedure, used for key-presses
# such as Shift-KEndData.   This procedure is modified to move the active 
# element to el.  It assumes that we have set the option "selectmode" to 
# the maximum number of items we want selected, and should therefore only 
# be used by the procedure build_Listbox above.  
#
# Usage:
#   myListboxDataExtend w el
#
 
proc myListboxDataExtend {w el} {
 
    set mode [$w cget -selectmode]
    if {$mode == "extended"} {
        $w activate $el
        $w see $el
        if [$w selection includes anchor] {
            tkListboxMotion $w $el
        }
    } elseif {($mode != "browse") & ($mode != "single")} {
        $w activate $el
        $w see $el
    } 
}
 
 
# myListboxSelectAll
#
# A modified version of the tkListboxSelectAll procedure, used for the
# "select all" operation.   This procedure is modified to select the active
# element in single or browse mode, and to select everything in the widget
# in multiple or extended mode, but to do nothing in any other mode. 
#
# Usage:
#   myListboxSelectAll w
#
 
proc myListboxSelectAll w {
    set mode [$w cget -selectmode]
    if {($mode == "single") || ($mode == "browse")} {
        $w selection clear 0 end
        $w selection set active
    } elseif {($mode == "extended) || ($mode == "multiple")} {
        $w selection set 0 end
    }
}