#
# Miscellaneous widgets for SSA tools
#
# $Id: tkextra.tcl,v 1.2 1994/08/08 23:10:15 weibel Exp $
#
# mkOkSave	Make OK and save buttons 
#
# arguments
#	w	name of parent window
#	app	name of application using theses widgets
#	okcmd	The action to be invoked when OK button is pressed
#	SaveAstitle	Title for the Save As... dialog
#
proc mkOkSave {w app okcmd SaveAsTitle {SaveAsCmd default} {SaveCmd {}}} {
    global env

    frame $w
    button $w.ok -relief groove -bd 6 -text OK -command "$okcmd ; $w.sa configure -state normal"
    if {$SaveCmd == {}} {set SaveCmd "
	if \[info exists ${app}(outpath)\] \
		then {save $app.out $${app}(outpath)} \
		else {$w.sa invoke} 
	"
    }
    if {$SaveAsCmd == "default"} {set SaveAsCmd "
	if !\[info exists ${app}(savdir)\] {set ${app}(savdir) [pwd]}
	if !\[info exists ${app}(outpath)\] {set ${app}(outpath) $app.out}
	if {\[set tmp \[FD -access w -dir $${app}(savdir) \
		-file $${app}(outpath) -title {$SaveAsTitle}\]\] != {} } then {
		    set ${app}(outpath) \$tmp
		    set ${app}(savdir) \$FDvars(directory)
		    save $app.out $${app}(outpath)
        }
	"
    }
    append SaveAsCmd " ; $w.s configure -state normal"

    button $w.s -text "Save" -state disabled -command $SaveCmd
    button $w.sa -text "Save As ..." -state disabled -command $SaveAsCmd
    if {$w == ""} {set w .}
    pack append $w $w.ok {top fill padx 10} \
	$w.s {top fill padx 10} $w.sa {top fill padx 10}
    return $w
}


#
#
# mkRadioPanel -  Make a panel of radio buttons
#
# Arguments
#
#	w	Pathname to this window.  All the radiobuttons are children of
#		this frame
#	label	Main title for this window
#	args	each argument is a list of {text variable value}
#
# Return value
#	The pathname of the panel widget
# 
# Arguments/Options not yet implemented
# 
# -origin <origin>  Pack buttons starting from the top|bottom|left|right
#

proc mkRadioPanel {w label args} {
    frame $w
    set n 0
    pack [label $w.la -text $label] -in $w -side top -pady 1m -anchor w
    foreach b $args {
	pack [radiobutton $w.b$n -text [lindex $b 0] -variable [lindex $b 1] \
	      -relief flat -value [lindex $b 2]] -in $w -side top -pady 1 -anchor w
	incr n 1
    }
    return $w
}



#
# scalentry -  Produce a compound widget from a scale and an entry box
#
# Arguments
#	w	parent widget.  A frame containing the scale and entry widgets.
#	args	options which are passed directly to the scale
#
#       -variable  create a global variable, which will be the textvariable of
#                  the entry box.
#
# The user can then control a variable via the slider, or by typing in the entry box. 
# A global variable is created, with either the name w with _'s substituted for .'s, 
# or the name chosen by the -variable option.
# The user can also modify the scale bounds by double-clicking in the widget.
# Return the pathname of the parent, which is a frame widget.
# Other arguments can be any options that are accepted by the "scale" command.
# A procedure is created which substitutes for the analogous scale widget 
# command.
#
proc scalentry {w args} {
	if [set index [expr [lsearch $args -variable] + 1]] {
	    set variable [lindex $args $index]
	    set args [lreplace $args [expr $index - 1] $index]
	} else {
	    regsub -all \\. $w _ variable
	}
	upvar $variable v
	trace variable v w [set todo "$w.s set \$$variable \; drain"]

	frame $w
	eval scale $w.s -orient horizontal -showvalue 0 -length 200 \
		[list -command "set $variable"] $args
	entry $w.e -textvariable $variable -relief sunken -width 6
	pack append $w $w.e {right frame se} $w.s fill

	proc $w {args} "eval $w.s \$args"

	bind $w.e <Double-Button-1> "widgetPreference $w.s {Scale Bounds} from to"
	bind $w.s <Double-Button-1> "widgetPreference $w.s {Scale Bounds} from to"
	bind $w.e <Left>  "$w.e icursor \[expr \[$w.e index insert\]-1\]"
	bind $w.e <Right> "$w.e icursor \[expr \[$w.e index insert\]+1\]"
	bind $w <Destroy> [list trace vdelete $variable w $todo]
	return $w
}


#
# set preferences for a widget
#
proc widgetPreference { w title args } {
	set t $w.t
	toplevel $t
	wm title $t $title
	set okcmd "$w configure "
# intialize each entry box
	foreach option $args {
		pack append $t [frame $t.$option] {top fill}
		pack append $t.$option \
			[label $t.$option.l -text $option] {left frame w} \
			[entry $t.$option.e -relief sunken] {fill}
		bind $t.$option.e <Return> \
			"$w configure -$option \[$t.$option.e get\]"
		set okcmd "$okcmd -$option \[$t.$option.e get\]"
		set value [$w configure -$option]
		$t.$option.e insert 0 [lindex $value [expr [llength $value]-1]]
	}
	set okcmd "$okcmd ; destroy $t"
	pack append $t [frame $t.bot] {bottom fill}
	eval pack \
		[button $t.bot.cancel -text Cancel -command "destroy $t"] \
		[button $t.bot.ok -text OK -command $okcmd] \
		-side left -expand 1 -ipadx 3m -ipady 1m
}

#
# toggle  - toggle the state of a widget
#
proc toggle {w} {
    set oldstate [lindex [$w configure -state] 4]
    if {$oldstate == "normal"} {$w configure -state disabled}
    if {$oldstate == "disabled"} {$w configure -state normal}
}

#
# A drain for needless arguments
#
proc drain {args} {}