#
# support.tcl: support routines for TK programs.
#
# ------------------------------------------------
# Mumit Khan <khan@xraylith.wisc.edu>
# Center for X-ray Lithography
# University of Wisconsin-Madison
# 3731 Schneider Dr., Stoughton, WI, 53589
# ------------------------------------------------
#
# Copyright (c) 1994-1996 Mumit Khan
#
#

#
# PROC DIALOG_TAB_BUTTON: tab through various dialog buttons
#
# the active_frame is the frame around the button that will activate
# when <return> is hit (the default button is packed inside of the 
# active frame).
#
# Arguments:
# 
# dialog_w ...... name of the dialog name
# list .......... list of ALL buttons in the dialog
# active_frame .. name of the frame that packs the current default button
# direction ..... forward/backward, typically done via <Tab>/<Shift-Tab>
#
# to change the current active button:
#
#    find the name of the button inside $active_frame ($w...button$i)
#    find the index of this button in the list of all buttons
#    find the next default button given the direction
#    now re-pack all the buttons, and pack the default in $active_frame
#    re-bind <return> to activate the default_button.
#
proc dialog_tab_button {dialog_w list active_frame {direction forward}} {
    set cur_button_w [pack slaves $active_frame]
    if {$cur_button_w == ""} return

    set current [lsearch -exact $list $cur_button_w]
    set next $current

    switch -glob -- $direction {
	b* {
	    incr next -1
	    if {$next < 0} {
		set next [expr [llength $list] - 1]
	    }
	}
	default {
	    incr next 
	    if {$next >= [llength $list]} {
		set next 0
	    }
	}
    }
    pack unpack $active_frame
    set i 0
    foreach but $list {
	pack unpack $but
	if {$i == $next} {
	    raise $but
	    pack $active_frame -side left -expand 1 -padx 3m -pady 2m
	    pack $but -in $active_frame \
		-side left -padx 2m -pady 2m \
		-ipadx 2m -ipady 2m
	    set default_button $but
	} else {
	    pack $but -side left -expand 1 \
		-padx 3m -pady 3m -ipadx 2m -ipady 2m
	}
	incr i
    }

    #
    # now re-bind <return> key to this new default.
    #
    global g_dialog_button
    bind $dialog_w <Return> "$default_button flash; \
	set g_dialog_button $next"
}

#
# dialog proc from Ousterhout book (Chap 27 Section 1).
#
# note the global g_dialog_button setting.
#
proc dialog {w title text bitmap default args {width 4i}} {
    global g_dialog_button

    toplevel $w -class Dialog
    wm title $w $title
    wm iconname $w Dialog
    frame $w.top -relief raised -bd 1
    pack $w.top -side top -fill both
    frame $w.bot -relief raised -bd 1
    pack $w.bot -side bottom -fill both

    message $w.top.msg -width $width -text $text \
	-font *-New*Century*Schoolbook-Medium-R-*-18-* 
    pack $w.top.msg -side right -expand 1 -fill both -padx 3m -pady 3m
    if {$bitmap != ""} {
	label $w.top.bitmap -bitmap $bitmap
	pack $w.top.bitmap -side left -padx 3m -pady 3m
    }

    #
    # set up the TAB group.
    #
    set tab_group {}


    set i 0
    foreach but $args {
	button $w.bot.button$i -text $but -command "set g_dialog_button $i"
	lappend tab_group $w.bot.button$i
	if {$i == $default} {
	    frame $w.bot.default -relief sunken -bd 1
	    raise $w.bot.button$i
	    pack $w.bot.default -side left -expand 1 -padx 3m -pady 2m
	    pack $w.bot.button$i -in $w.bot.default \
		-side left -padx 2m -pady 2m \
		-ipadx 2m -ipady 2m
	} else {
	    pack $w.bot.button$i -side left -expand 1 \
		-padx 3m -pady 3m -ipadx 2m -ipady 2m
	}
	incr i
    }

    if {$default >= 0} {
	bind $w <Return> "$w.bot.button$default flash; \
	    set g_dialog_button $default"
	#
	# bind the TAB group entries.
	#
	bind $w <Tab>  "dialog_tab_button $w \[list $tab_group\] \
     	    $w.bot.default forward"
	bind $w <Shift-Tab>  "dialog_tab_button $w \[list $tab_group\] \
     	    $w.bot.default backward"
    }

    #
    # now position at the center of root window.
    #

    # 4. Withdraw the window, then update all the geometry information
    # so we know how big it wants to be, then center the window in the
    # display and de-iconify it.

    wm withdraw $w
    update idletasks
    set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
	    - [winfo vrootx [winfo parent $w]]]
    set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
	    - [winfo vrooty [winfo parent $w]]]
    wm geom $w +$x+$y
    wm deiconify $w

    set old_focus [focus]
    catch {grab $w}
    focus $w

    tkwait variable g_dialog_button
    grab release $w
    destroy $w
    catch {focus -force $old_focus}
    return $g_dialog_button
}

# ------------------------------------------------------------------
# METHOD: dialog_num - pop a dialog and get a number
# ------------------------------------------------------------------
proc dialog_num {w title text init} { 
    global g_dialog_button
    set g_dialog_button ""
    catch "destroy $w"
    toplevel $w -class Dialog

    frame ${w}.label -relief raised
    if {$title != ""} {
	label ${w}.label.title -text "$title"
	pack ${w}.label.title -anchor center -padx 5 -pady 5
    }

    label ${w}.msg \
	-text "$text"

    scrollbar ${w}.sb -orient horizontal -command "${w}.entry view"
    entry ${w}.entry -width 50 -relief sunken \
	-xscrollcommand "${w}.sb set"
    ${w}.entry insert 0 $init
    bind ${w}.entry <Return> 	{set g_dialog_button [%W get]}
    bind ${w}.entry <Escape> 	{set g_dialog_button ""}

    frame ${w}.confirm
    button ${w}.confirm.accept -text "Accept" \
	-command "set g_dialog_button \[$w.entry get\]"
    button ${w}.confirm.cancel -text "Cancel" \
	-command "set g_dialog_button {}"
    pack ${w}.confirm.accept -side left -padx 25 -pady 5
    pack ${w}.confirm.cancel -side right -padx 25 -pady 5

    pack ${w}.label -side top -padx 5 -pady 5
    pack ${w}.msg -side top -padx 5 -pady 5 -anchor w
    pack ${w}.entry -side top -padx 5 -pady 5 -fill both
    pack ${w}.sb -side top -padx 5 -pady 5 -fill both
    pack ${w}.confirm -side top -padx 5 -pady 5

    set old_focus [focus]
    catch {grab $w}
    focus $w.entry

    #
    # now position at the center of root window.
    #

    # 4. Withdraw the window, then update all the geometry information
    # so we know how big it wants to be, then center the window in the
    # display and de-iconify it.

    wm withdraw $w
    update idletasks
    set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
	    - [winfo vrootx [winfo parent $w]]]
    set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
	    - [winfo vrooty [winfo parent $w]]]
    wm geom $w +$x+$y
    wm deiconify $w


    tkwait variable g_dialog_button
    grab release $w
    destroy $w
    catch {focus -force $old_focus}
    return [string trim $g_dialog_button]
}

# ------------------------------------------------------------------
# PROC: dialog_str - pop a dialog and get a string
# ------------------------------------------------------------------
proc dialog_str {w title text init} {
    global g_dialog_button
    set g_dialog_button ""
    catch "destroy $w"
    toplevel $w -class Dialog

    frame ${w}.label -relief raised
    if {$title != ""} {
	label ${w}.label.cell -text "$title"
	pack ${w}.label.cell -anchor center -padx 5 -pady 5
    }

    label ${w}.msg \
	-text "$text"

    scrollbar ${w}.sb -orient horizontal -command "${w}.entry view"
    entry ${w}.entry -width 50 -relief sunken \
	-xscrollcommand "${w}.sb set"
    ${w}.entry insert 0 $init
    bind ${w}.entry <Return> 	{set g_dialog_button [%W get]}
    bind ${w}.entry <Escape> 	{set g_dialog_button ""}

    frame ${w}.confirm
    button ${w}.confirm.accept -text "Accept" \
	-command "set g_dialog_button \[$w.entry get\]"
    button ${w}.confirm.cancel -text "Cancel" \
	-command "set g_dialog_button {}"
    pack ${w}.confirm.accept -side left -padx 25 -pady 5
    pack ${w}.confirm.cancel -side right -padx 25 -pady 5

    pack ${w}.label -side top -padx 5 -pady 5
    pack ${w}.msg -side top -padx 5 -pady 5 -anchor w
    pack ${w}.entry -side top -padx 5 -pady 5 -fill both
    pack ${w}.sb -side top -padx 5 -pady 5 -fill both
    pack ${w}.confirm -side top -padx 5 -pady 5

    #
    # now position at the center of root window.
    #

    # 4. Withdraw the window, then update all the geometry information
    # so we know how big it wants to be, then center the window in the
    # display and de-iconify it.

    wm withdraw $w
    update idletasks
    set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
	    - [winfo vrootx [winfo parent $w]]]
    set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
	    - [winfo vrooty [winfo parent $w]]]
    wm geom $w +$x+$y
    wm deiconify $w


    set old_focus [focus]
    catch {grab $w}
    focus $w.entry

    tkwait variable g_dialog_button
    grab release $w
    destroy $w
    catch {focus -force $old_focus}
    return [string trim $g_dialog_button]
}

#
# tab through various dialog entry fields (ideas from JO book 21.2)
#
proc dialog_tab_entry {list {direction forward}} {
    set i [lsearch -exact $list [focus]]
    switch -glob -- $direction {
	b* {
	    incr i -1
	    if {$i < 0} {
		set i [expr [llength $list] - 1]
	    }
	}
	default {
	    incr i
	    if {$i >= [llength $list]} {
		set i 0
	    }
	}
    }
    focus [lindex $list $i]
}


# ------------------------------------------------------------------
# PROC: dialog_2_str - pop a dialog and get two strings.
# ------------------------------------------------------------------
proc dialog_2_str {w title text1 init1 text2 init2 {ifocus 1}} {
    global g_dialog_button
    set g_dialog_button {}
    catch "destroy $w"
    toplevel $w -class Dialog

    frame ${w}.label -relief raised
    if {$title != ""} {
	label ${w}.label.cell -text "$title"
	pack ${w}.label.cell -anchor center -padx 5 -pady 5
    }

    label ${w}.msg1 \
	-text "$text1"

    scrollbar ${w}.sb1 -orient horizontal -command "${w}.entry1 view"
    entry ${w}.entry1 -width 50 -relief sunken \
	-xscrollcommand "${w}.sb1 set"
    ${w}.entry1 insert 0 $init1

    label ${w}.msg2 \
	-text "$text2"

    scrollbar ${w}.sb2 -orient horizontal -command "${w}.entry2 view"
    entry ${w}.entry2 -width 50 -relief sunken \
	-xscrollcommand "${w}.sb2 set"
    ${w}.entry2 insert 0 $init2

    bind ${w}.entry1 <Tab> 	"focus ${w}.entry2"
    bind ${w}.entry2 <Tab> 	"focus ${w}.entry1"
    bind ${w}.entry1 <Return> \
	"set g_dialog_button \[list \[$w.entry1 get\] \[$w.entry2 get\]\]"
    bind ${w}.entry2 <Return> \
	"set g_dialog_button \[list \[$w.entry1 get\] \[$w.entry2 get\]\]"
    bind ${w}.entry1 <Escape> 	{set g_dialog_button ""}
    bind ${w}.entry2 <Escape> 	{set g_dialog_button ""}

    frame ${w}.confirm
    button ${w}.confirm.accept -text "Accept" \
	-command \
	"set g_dialog_button \[list \[$w.entry1 get\] \[$w.entry2 get\]\]"
    button ${w}.confirm.cancel -text "Cancel" \
	-command "set g_dialog_button {}"
    pack ${w}.confirm.accept -side left -padx 25 -pady 5
    pack ${w}.confirm.cancel -side right -padx 25 -pady 5

    pack ${w}.label -side top -padx 5 -pady 5
    pack ${w}.msg1 -side top -padx 5 -pady 5 -anchor w
    pack ${w}.entry1 -side top -padx 5 -pady 5 -fill both
    pack ${w}.sb1 -side top -padx 5 -pady 5 -fill both
    pack ${w}.msg2 -side top -padx 5 -pady 5 -anchor w
    pack ${w}.entry2 -side top -padx 5 -pady 5 -fill both
    pack ${w}.sb2 -side top -padx 5 -pady 5 -fill both
    pack ${w}.confirm -side top -padx 5 -pady 5

    #
    # now position at the center of root window.
    #

    # 4. Withdraw the window, then update all the geometry information
    # so we know how big it wants to be, then center the window in the
    # display and de-iconify it.

    wm withdraw $w
    update idletasks
    set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
	    - [winfo vrootx [winfo parent $w]]]
    set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
	    - [winfo vrooty [winfo parent $w]]]
    wm geom $w +$x+$y
    wm deiconify $w


    set old_focus [focus]
    catch {grab $w}
    focus $w.entry${ifocus}

    tkwait variable g_dialog_button
    grab release $w
    destroy $w
    catch {focus -force $old_focus}
    return [string trim $g_dialog_button]
}

# ------------------------------------------------------------------
# PROC: dialog_2_num - pop a dialog and get OE and SCR numbers
# ------------------------------------------------------------------
proc dialog_2_num {w title text1 init1 text2 init2 {ifocus 1}} {
    global g_dialog_button
    set g_dialog_button {}
    catch "destroy $w"
    toplevel $w -class Dialog

    frame ${w}.label -relief raised
    if {$title != ""} {
	label ${w}.label.cell -text "$title"
	pack ${w}.label.cell -anchor center -padx 5 -pady 5
    }

    label ${w}.msg1 \
	-text "$text1"

    scrollbar ${w}.sb1 -orient horizontal -command "${w}.entry1 view"
    entry ${w}.entry1 -width 50 -relief sunken \
	-xscrollcommand "${w}.sb1 set"
    ${w}.entry1 insert 0 $init1

    label ${w}.msg2 \
	-text "$text2"

    scrollbar ${w}.sb2 -orient horizontal -command "${w}.entry2 view"
    entry ${w}.entry2 -width 50 -relief sunken \
	-xscrollcommand "${w}.sb2 set"
    ${w}.entry2 insert 0 $init2

    bind ${w}.entry1 <Tab> 	"focus ${w}.entry2"
    bind ${w}.entry2 <Tab> 	"focus ${w}.entry1"
    bind ${w}.entry1 <Return> \
	"set g_dialog_button \[list \[$w.entry1 get\] \[$w.entry2 get\]\]"
    bind ${w}.entry2 <Return> \
	"set g_dialog_button \[list \[$w.entry1 get\] \[$w.entry2 get\]\]"
    bind ${w}.entry1 <Escape> 	{set g_dialog_button ""}
    bind ${w}.entry2 <Escape> 	{set g_dialog_button ""}

    frame ${w}.confirm
    button ${w}.confirm.accept -text "Accept" \
	-command \
	"set g_dialog_button \[list \[$w.entry1 get\] \[$w.entry2 get\]\]"
    button ${w}.confirm.cancel -text "Cancel" \
	-command "set g_dialog_button {}"
    pack ${w}.confirm.accept -side left -padx 25 -pady 5
    pack ${w}.confirm.cancel -side right -padx 25 -pady 5

    pack ${w}.label -side top -padx 5 -pady 5
    pack ${w}.msg1 -side top -padx 5 -pady 5 -anchor w
    pack ${w}.entry1 -side top -padx 5 -pady 5 -fill both
    pack ${w}.sb1 -side top -padx 5 -pady 5 -fill both
    pack ${w}.msg2 -side top -padx 5 -pady 5 -anchor w
    pack ${w}.entry2 -side top -padx 5 -pady 5 -fill both
    pack ${w}.sb2 -side top -padx 5 -pady 5 -fill both
    pack ${w}.confirm -side top -padx 5 -pady 5

    #
    # now position at the center of root window.
    #

    # 4. Withdraw the window, then update all the geometry information
    # so we know how big it wants to be, then center the window in the
    # display and de-iconify it.

    wm withdraw $w
    update idletasks
    set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
	    - [winfo vrootx [winfo parent $w]]]
    set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
	    - [winfo vrooty [winfo parent $w]]]
    wm geom $w +$x+$y
    wm deiconify $w


    set old_focus [focus]
    catch {grab $w}
    focus $w.entry${ifocus}

    tkwait variable g_dialog_button
    grab release $w
    destroy $w
    catch {focus -force $old_focus}
    return [string trim $g_dialog_button]
}

# ------------------------------------------------------------------
# PROC: build_msg - builds a string from a collection of strings
# ------------------------------------------------------------------
proc build_msg {args} {
    set msg [join $args " "]
    return $msg
}

proc build_array_string {a {pattern *}} {
    set string ""
    upvar 1 $a array
    if ![array exists array] {
	error "\"$a\" isn't an array"
    }
    set maxl 0
    foreach name [lsort [array names array $pattern]] {
	if {[string length $name] > $maxl} {
	    set maxl [string length $name]
	}
    }
    set maxl [expr {$maxl + 2}]
    foreach name [lsort [array names array $pattern]] {
	append string \
	    [format "%-*s: %s" $maxl $name $array($name)]
	append string "\n"
    }
    return $string
}

# ------------------------------------------------------------------
# PROC: set2 - sets two variables from a list of >=2 elements
# ------------------------------------------------------------------
proc set2 {list var1 var2} {
    upvar $var1 lvar1
    upvar $var2 lvar2
    set lvar1 [lindex $list 0]
    set lvar2 [lindex $list 1]
}

# ------------------------------------------------------------------
# PROC: set3 - sets three variables from a list of >=3 elements
# ------------------------------------------------------------------
proc set3 {list var1 var2 var3} {
    upvar $var1 lvar1
    upvar $var2 lvar2
    upvar $var3 lvar3
    set lvar1 [lindex $list 0]
    set lvar2 [lindex $list 1]
    set lvar3 [lindex $list 2]
}

# ------------------------------------------------------------------
# PROC: setn - sets `n' variables from a list of >=n elements
# ------------------------------------------------------------------
proc setn {list varlist} {
    set cnt 0
    foreach i $varlist {
	upvar $i lvar$cnt
	set lvar$cnt [lindex $list $cnt]
	incr cnt
    }
}

# ------------------------------------------------------------------
# PROC: remove_file - removes/unlinks a filename
#       filename can include wildcard patterns
# ------------------------------------------------------------------
proc remove_file {filepattern} {
    if [catch "glob $filepattern" filenames] {return}

    if {[info command unlink] != ""} {
	set remove_cmd "unlink"
    } else {
	set remove_cmd "exec rm"
    }
    foreach file $filenames {
	catch "eval $remove_cmd $file"
    }
}

# ------------------------------------------------------------------
# PROC: tmpfile - make a temporary filename
#
# Take care to create filename acceptable to both Unix and Win32!
# ------------------------------------------------------------------
proc tmpfile {{dir /tmp} {base ""} {ext ""} {try 20}} {
    global env gvars
    set user $gvars(username)
    set pid [pid]
    if {![file isdir $dir]} {
	error "tmpfile: \"$dir\" is not a directory!"
    } elseif {![file writable $dir]} {
	error "tmpfile: Directory \"$dir\" is not writable!"
    }
    if {[tix platform] != "unix"} {
	set tmpfile $dir/$base$ext
    } else {
	set tmpfile $dir/$base$user$pid$ext
    }
    if [catch "open $tmpfile w" fid] {
	for {set i 1} {$i < $try} {incr i} {
	    if {[tix platform] != "unix"} {
		set tmpfile $dir/$base$i$ext
	    } else {
		set tmpfile $dir/$base$user$pid$i$ext
	    }
	    if ![catch "open $tmpfile w"] break
	}
	set tmpfile ""
    }
    if {$tmpfile != ""} {
	close $fid
	remove_file $tmpfile
    }
    return $tmpfile
}

# ------------------------------------------------------------------
# PROC: fix_platform_filename - fix MSDOS/Unix filename stuff
#
# ------------------------------------------------------------------
proc fix_platform_filename file {
    if {[tix platform] == "unix"} {
        return $file
    } else {
	regsub -all \\\\ $file \/ file
	return $file
    }
}

# ------------------------------------------------------------------
# PROC: cvt_filename_to_platform - Convert to platform filename
#
# ------------------------------------------------------------------
proc cvt_filename_to_platform file {
    if {[tix platform] == "unix"} {
        return $file
    } elseif {[tix platform] == "windows"} {
        regsub -all \/ $file \\\\ file
	return $file
    } else {
        # TODO/FIXME
        return $file
    }
}

# ------------------------------------------------------------------
# PROC: cvt_filename_to_tcl - Convert to Tcl filename
#
# ------------------------------------------------------------------
proc cvt_filename_to_tcl file {
    if {[tix platform] == "unix"} {
        return $file
    } elseif {[tix platform] == "windows"} {
        regsub -all \\\\ $file \/ file
	return $file
    } else {
        # TODO/FIXME:
        return $file
    }
}



# ------------------------------------------------------------------
# PROC: busy_window - show/release busy cursor
# Requires BLT (either 1.x or 2.x) to work. Otherwise a NOOP.
# ------------------------------------------------------------------
proc busy_cursor {state {w .}} {
    global last___cursor
    if {$state == "hold"} {
	set last___cursor [$w cget -cursor]
	$w config -cursor watch
    } else {
	$w config -cursor $last___cursor
    }
}

proc busy_window {state {w .}} {
    global blt_versions
    if {$blt_versions(BLT) >= 2} {
	set blt_busy busy
    } else {
	set blt_busy blt_busy
    }
    if {[llength [info command $blt_busy]] == 0} {
	# set blt_busy busy_cursor
	return
    }

    if {$state == "hold"} {
	$blt_busy hold $w
	update idletasks
    } else {
	$blt_busy release $w
    }
    return
}


