# 
#  Copyright (c) 1994-1998 A & A Custom Software.
#  All rights reserved.
# 
#  Redistribution and use in source and binary forms, with or without
#  modification, are permitted provided that the following conditions
#  are met:
#  1. Redistributions of source code must retain the above copyright
#     notice, this list of conditions and the following disclaimer.
#  2. Redistributions in binary form must reproduce the above copyright
#     notice, this list of conditions and the following disclaimer in the
#     documentation and/or other materials provided with the distribution.
#  3. All advertising materials mentioning features or use of this software
#     must display the following acknowledgement:
#       This product includes software developed by A & A Custom Software 
#       and its contributors.
#  4. Neither the name of A & A Custom Software nor the names of its 
#     contributors may be used to endorse or promote products derived from this 
#     software without specific prior written permission.
# 
#  THIS SOFTWARE IS PROVIDED BY A & A CUSTOM SOFTWARE AND CONTRIBUTORS ``AS IS''
#  AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
#  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
#  ARE DISCLAIMED.  IN NO EVENT SHALL A & A CUSTOM SOFTWARE OR CONTRIBUTORS BE 
#  LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
#  CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF 
#  SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS 
#  INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN 
#  CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 
#  ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 
#  POSSIBILITY OF SUCH DAMAGE.
# 
# $Id: mkWidgets.t,v 1.1.1.1 1998/01/04 22:47:29 abm Exp $

#
# Make a frame.
#
# Arguments:
#   parent: The parent window path of the child widget that will be made.
#   child : The window name of the child to be made. 
#   class : The class name to associate with the child.
#   where : The pack commands for the child window.
#   args  : Additional configuration options for the child window.
#

proc mkFrame { parent child {where {-side top -fill both -expand true}} args } {

    # Toplevel parent?
    if {$parent == "."} {
        set f .$child
    } else {
        set f $parent.$child
    }
    # Create frame 
    eval {frame $f -relief raised -borderwidth 1} $args
    eval pack $f $where
    return $f
} 


proc mkToplevel { top title {class Tkhylafax} args } {

    catch {destroy $top}
    set t [toplevel $top -class $class]
    wm title $t $title
    wm group $t .
    return $t
}

#
# Make a label.
#
# Arguments:
#   parent: The parent window path of the label widget that will be made.
#   name  : The window name of the label to be made. 
#   where : The pack commands for the label window.
#   args  : Additional configuration options for the label window.
#

proc mkLabel { parent {name label} {where {-side left}} args } {

    # Toplevel parent?
    if {$parent == "."} {
        set l .$name
    } else {
        set l $parent.$name
    }
    eval {label $l} $args
    eval pack $l $where
    return $l
}

#
# Make a entry.
#
# Arguments:
#   parent: The parent window path of the entry widget that will be made.
#   name  : The window name of the entry to be made. 
#   where : The pack commands for the entry window.
#   args  : Additional configuration options for the entry window.
#

proc mkEntry { parent {name entry} {where {-side left -fill x}} args } {


    # Toplevel parent?
    if {$parent == "."} {
        set e .$name
    } else {
        set e $parent.$name
    }
    eval {entry $e} $args
    eval pack $e $where
    return $e
}

#
# Make a labeled entry.
#
# Arguments:
#   parent  : The frame window path that will contain the labeled entry.
#   text    : The text for the label. 
#   textvar : The textvariable to associate with the entry.
#   width   : The width (in characters) of the entry window.
#

proc mkLabeledEntry { parent frame text textvar {ewidth {}} {lwidth {}} } {

    global Th_Info
    frame $parent.$frame
    pack $parent.$frame -fill x -expand true

    if {$lwidth == ""} {
        set lwidth $Th_Info(lwidth)
    }
    mkLabel $parent.$frame label {-side left} -anchor w -text $text \
	   -width $lwidth

    if {$ewidth == ""} {
        set ewidth $Th_Info(ewidth)
    }
    mkEntry $parent.$frame entry {-side left -fill x} -width $ewidth \
	   -textvariable $textvar -borderwidth 1

    return $parent.$frame
}


#
# Make a button.
#
# Arguments:
#   parent: The parent window path of the button widget that will be made.
#   name  : The window name of the button to be made. 
#   where : The pack commands for the button window.
#   args  : Additional configuration options for the label window.
#

proc mkButton { parent {name button} {where {-side left}} args } {

    # Toplevel parent?
    if {$parent == "."} {
        set b .$name
    } else {
        set b $parent.$name
    }
    eval {button $b} $args
    eval pack $b $where
    return $b
}

#
# Make a button.
#
# Arguments:
#   parent: The parent window path of the button widget that will be made.
#   name  : The window name of the button to be made. 
#   where : The pack commands for the button window.
#   args  : Additional configuration options for the label window.
#

proc mkRepeatButton { parent {name button} {where {-side left}} args } {

    # Toplevel parent?
    if {$parent == "."} {
        set b .$name
    } else {
        set b $parent.$name
    }
    eval {button $b} $args
    eval pack $b $where
    bindtags $b "RepeatButton [bindtags $b]"
    return $b
}

#
# Make a radiobutton
#
# Arguments:
#   parent: The parent window path of the button widget that will be made.
#   name  : The window name of the button to be made. 
#   where : The pack commands for the button window.
#   args  : Additional configuration options for the label window.
#

proc mkRadioButton { parent {name button} {where {-side left}} args } {


    # Toplevel parent?
    if {$parent == "."} {
        set b .$name
    } else {
        set b $parent.$name
    }
    eval {radiobutton $b} $args
    eval pack $b $where
    return $b
}

proc mkLabeledRadioButtons { parent frame text var lwidth args } {

    frame $parent.$frame
    pack $parent.$frame -fill x -expand true
    mkLabel $parent.$frame label {-side left} -anchor w -text $text \
	   -width $lwidth 
    foreach {name value} $args {
        mkRadioButton $parent.$frame [string tolower $name] \
	   {-side left -fill x} -variable $var -text $name -value $value
    }
    return $parent.$frame
}

#
# Make a menubutton
#
# Arguments
#   parent: The parent window path of the button widget that will be made.
#   button: The window name of the button to be made.
#   text  : The text string for the button.
#   where : The pack commands for the button window.
#

proc mkMenuButton { parent button text {under 0} {where {-side left -fill x}}} {

    # Toplevel parent?
    if {$parent == "."} {
        set b .$button
    } else {
        set b $parent.$button
    }
    menubutton $b -text $text -menu $b.menu -under $under
    menu $b.menu
    eval pack $b $where
    return $b.menu
}


#
# Make an option menubutton
#
# Arguments
#   parent: The parent window path of the button widget that will be made.
#   frame : The frame that will be made to hold the label and button.
#   label : The text string for the label.
#   textvar : The textvariable to associate with the menubutton.
#   where : The pack commands for the button window.
#   lw    : The label width.
#   bw    : The button width.
#

proc mkOptMenuButton { parent frame label textvar where {lw {}} {bw {}} } {

    global Th_Info
    frame $parent.$frame
    pack $parent.$frame -fill x -expand true
    set mb $parent.$frame.mb ;# menubutton to be created

    if {$lw == ""} {
        set lw $Th_Info(lwidth)
    }

    mkLabel $parent.$frame label {-side left} -anchor w -text $label -width $lw

    if {$bw == ""} {
        set bw $Th_Info(ewidth)
    }
    menubutton $mb -textvariable $textvar -menu $mb.menu \
        -indicatoron 1 -takefocus 1 -highlightthickness 2 -relief raised \
        -borderwidth 2 -anchor w -width $bw

    menu $mb.menu -tearoff 0
    eval pack $mb $where 
    return $mb.menu
}

#
# Add a menu item
#
# Arguments
#   menu   : The parent menubutton path of the menu item that will be made.
#   label  : The text string for the button.
#   command: The command to invoke when the menu item is selected.
#   under  : The character to underline as an accelerator.
#   accel  : The key strokes to use as an accelerator.
#

proc mkMenuItem { menu label command {under 0} {accel NONE} } {

    $menu add command -label $label -command $command -under $under
    if {$accel != "NONE"} {
        $menu entryconfigure $label -accelerator $accel
    }
}

proc mkOptMenuItem { menu label command } {

    $menu add command -label $label -command $command
}

#
# Add a menu item separator
#

proc mkMenuSeparator { menu } {

    $menu add separator
}


#
# Add a radio button menu item
#
# Arguments
#   menu     : The parent menubutton path of the menu item that will be made.
#   label    : The text string for the button.
#   variable : The single variable associated with the radio button set. 
#   command  : The command to invoke when the menu item is selected.
#   value    : The value to associate with the variable for this radio button.
#

proc mkRadioMenuItem { menu label variable {value {}} {command {}} } {

    $menu add radio -label $label -variable $variable -value $value \
        -command $command
}

#
# Add a checkbutton menu item
#
# Arguments
#   menu     : The parent menubutton path of the menu item that will be made.
#   label    : The text string for the button.
#   variable : The single variable associated with the radio button set. 
#   command  : The command to invoke when the menu item is selected.
#   on       : The "on" string to associate with a selected checkbutton. 
#   off      : The "off" string to associate with a deselected checkbutton. 
#

proc mkCheckMenuItem { menu label variable {on {}} {off {}} {command {}} } {

    $menu add checkbutton -label $label -variable $variable \
        -onvalue $on -offvalue $off -command $command
}

#
# Make a listbox with scrollbar
#
# Arguments:
#   parent: The parent window path of the listbox widget that will be made.
#

proc mkListbox { parent args } {

    # Toplevel parent?
    if {$parent == "."} {
        set lb .listbox
        set sb .scrollbar
    } else {
        set lb $parent.listbox
        set sb $parent.scrollbar
    }

    scrollbar $sb -command "$lb yview" -relief sunken
    eval {listbox $lb -export true -relief sunken -yscroll "$sb set"} $args

    pack $sb -side right -fill y
    pack $lb -side left -expand true -fill both
    return $lb
}

#
# Make a listbox with a header label for each column 
#
# Arguments
#   parent  : The frame window path that will contain the labeled listbox.
#   text    : The text for the column header label. 
#

proc mkLabeledListbox { parent text args } {

    # Toplevel parent?
    if {$parent == "."} {
        set lb .listbox
        set sb .scrollbar
    } else {
        set lb $parent.listbox
        set sb $parent.scrollbar
    }

    mkLabel $parent hdr {-side top -fill x} -text $text -font fixed 
    scrollbar $sb -command "$lb yview" -relief sunken
    eval {listbox $lb -export true -relief sunken -yscroll "$sb set" \
        -font fixed} $args

    pack $sb -side right -fill y
    pack $lb -side left -expand true -fill both
    return $lb
}


#
# Read file contents that are in tag=value format. 
#

proc ro { PathName DataBufArr {DataList {}} } {

    set in [open $PathName]
    upvar $DataBufArr z 

    if {[llength $DataList] > 0} {
        foreach DataElem [lrange $DataList 0 end] {
	  set tag [format "%s=*" $DataElem]	
	  #set tags [format "%s=%%s" $DataElem]	
	  seek $in 0 start
	  while {[gets $in ln] >= 0} {
	      #find DataList tag 
	      if {[string match $tag $ln]} {
		#scan $ln $tags x
		set x [lindex [split $ln "="] 1]
		if {![info exists x]} {
		   set "z($DataElem)" {} 
		} else {
		   set "z($DataElem)" [string trim $x]
		}
		break
	     }
	  }
        }
    } else {
        while {[gets $in ln] >= 0} {
	  # Ignore anything but tag=value entries.
	  if {![string match *=* $ln]} {
	      continue
	  }
	  set pair [split $ln "="]
	  set tag [lindex $pair 0]
	  set val [lindex $pair 1]
	  set "z($tag)" [string trim $val] 
        }
    }

    close $in
    return 1
}

#
# Bindings and support procedures for repeat button. 
#
bind RepeatButton <Any-Leave> {
     catch {unset repeat(%W)}
}

bind RepeatButton <Any-ButtonRelease> {
     catch {unset repeat(%W)}
}

bind RepeatButton <Any-ButtonPress-1> {
     if {![info exists repeat(%W)]} {
	set repeat(%W) on ; repeatbutton %W
     }
}

proc repeatbutton {w} {
    global repeat

    if {[info exists repeat($w)]} { 
        $w invoke
        after 100 [list repeatbutton $w]
    } else {
        after cancel repeatbutton
        return
    }
}
