#
# mkListBox -	make a vertically and horizontally scrollable listbox
#		with a <Double-Button-1> selection binding
#
# inputs:
#	frame	frame to create for listbox and scrollbars
#	tobind	<Double-Button-1> binding
#
proc mkListBox { frame tobind { geom {20x10}}} {
	frame $frame
	label $frame.t -text ""
	frame $frame.ls
	listbox $frame.ls.l -yscroll "$frame.ls.s set" -relief sunken \
		-setgrid 1 -xscroll "$frame.ls.hs set" \
		-geom $geom
	scrollbar $frame.ls.s -command "$frame.ls.l yview" 
	scrollbar $frame.ls.hs -command "$frame.ls.l xview" -orient hor 
	pack append $frame.ls \
		$frame.ls.hs { bottom fillx } \
		$frame.ls.s { right filly } \
		$frame.ls.l { expand top }
	pack append $frame \
		$frame.t { top fillx } \
		$frame.ls { top fill }
	bind $frame.ls.l <Double-Button-1> "$tobind"
}

#
# FillBox - fill in a list box
#
# inputs:
#	box	listbox
#	tofill	list of elements
#
proc FillBox { box tofill } {
	foreach i $tofill { $box insert end $i }
}

#
# ClearBox - clear a list box
#
# input:
#	box	listbox to clear
#
proc ClearBox box {
	$box delete 0 end
}


#
# Tab - Tab between entries, listboxes, and/or buttons
#
# inputs:
#	args	list of windows to Tab between
#
# action:
#	sets <Tab> bindings for each window
#
proc Tab args {
	set cur [lsearch $args [focus]]
	set next [expr $cur+1]
	if {$next >= [llength $args]} {
		set next 0
	}
	set curw [lindex $args $cur]
	set nextw [lindex $args $next]
	catch { $curw conf -state normal }
	catch { $nextw conf -state active }
	focus $nextw
}

#
# SetTabbing - setup Tabbing for a list of windows
#
# inputs:
#	args	variable list of windows
#
proc SetTabbing { args } {
        foreach w $args {
                bind $w <Tab> "Tab $args"
        }
}



#
# EntryDialog - simple modal entry dialog
#
# inputs:
#	prompt		prompt string for dialog
#	default		default value for entry box
#
# returns:
#	valid entry string or "" if canceled
#
set dialogpad "padx 5m pady 5m"
proc EntryDialog { prompt {default {}} {title Entry} } {
	global EntryDialog dialogpad
	toplevel .ed
	wm title .ed $title
	wm transient .ed
	frame .ed.b
	set okcmd {
		.ed.b.bok conf -state active
		after 100
		set EntryDialog [.ed.le.e get]
		destroy .ed
		}
	set cancelcmd {
		set EntryDialog {}
		destroy .ed
	}
	mkButton .ed.b.bok OK $okcmd default
	mkButton .ed.b.bcancel Cancel $cancelcmd
	pack append .ed.b \
		.ed.b.bok "left $dialogpad" \
		.ed.b.bcancel "left $dialogpad"
	frame .ed.le -relief raised -border 1
	label .ed.le.l -text "$prompt:"
	entry .ed.le.e -relief sunken
	.ed.le.e insert 0 "$default"
	bind .ed.le.e <Return> $okcmd
	pack append .ed.le \
		.ed.le.l "left $dialogpad" \
		.ed.le.e "left $dialogpad"
	pack append .ed \
		.ed.le "top fill" \
		.ed.b "bottom fillx"
	set Tablist {.ed.le.e .ed.b.bok .ed.b.bcancel}
	foreach f $Tablist {
		bind $f <Tab> "Tab $Tablist"
	}
	tkwait visibility .ed
	grab .ed
	focus .ed.le.e
	tkwait window .ed
	return $EntryDialog
}

proc BitmapDir { } {
	global BITMAPDIR
	if [info exists BITMAPDIR] {
		return $BITMAPDIR
	} else {
		return /usr/include/X11/bitmaps
	}
}

proc OldConfirm { msg {default 0} {yes OK} {no Cancel} {title Confirm}} {
	global Confirm dialogpad env
	set bitmap [BitmapDir]/Excl
	toplevel .confirm
	wm title .confirm $title
	frame .confirm.l -bd 2 -relief raised
	if [file exists $bitmap] {
		label .confirm.l.b -bitmap @$bitmap
	} else {
		label .confirm.l.b -text ! -background blue -foreground white
	}
	label .confirm.l.l -text $msg
	pack append .confirm.l \
		.confirm.l.b "left $dialogpad" \
		.confirm.l.l "left $dialogpad"
	frame .confirm.b
	set yesdef ""
	set nodef ""
	case $default in {
		{1 y* o*} {set f 1 ; set yesdef default}
		{0 n* c*} {set f 0 ; set nodef default}
	}

	mkButton .confirm.b.1 $yes {set Confirm 1 ; destroy .confirm} $yesdef
	mkButton .confirm.b.0 $no {set Confirm 0 ; destroy .confirm} $nodef

	pack append .confirm.b \
		.confirm.b.1 "left $dialogpad" \
		.confirm.b.0 "left $dialogpad"
	pack append .confirm \
		.confirm.l { top fill }\
		.confirm.b { top fillx }
	SetTabbing .confirm.b.1 .confirm.b.0
	tkwait visibility .confirm
	focus .confirm.b.$f
	.confirm.b.$f conf -state active
	grab .confirm
	tkwait window .confirm
	return $Confirm
}

#
# TopLevNotice - create a toplevel info box
#
# inputs:
#	window	toplevel name, .$window
#	msg	message for info box
#
# action:
#	builds InfoBox and adds .$window to global "toplevelInfoBoxes"
#	variable
#
proc TopLevNotice { args } {
	global NumTopLevs
	if [catch {ParseArgs {{:bitmap} {:char} {:title} {:msg}} $args} err] {
		error "TopLevelNotice parse error: $err"
	}
	if ![info exists NumTopLevs] {
		set NumTopLevs 0
	} else {
		incr NumTopLevs 1
	}
	set win .toplev$NumTopLevs
	toplevel $win
	wm title $win $title
	frame $win.t -relief raised -bd 2
	if [info exists bitmap] {
		label $win.t.l -bitmap $bitmap
	} else {
		if [info exists char] {
			label $win.t.l -text $char
		} else {
			label $win.t.l -text i
		}
		$win.t.l conf -background blue -foreground white \
			-font "-adobe-courier-bold-r-*-*-*-240-*"
	}
	message $win.t.m -text "\n$msg\n" -aspect 200 -width 300
	pack append $win.t \
		$win.t.l { left padx 30 pady 30 } \
		$win.t.m { left fill }
	mkButton $win.b OK "destroy $win"
	$win.b conf -state active
	pack append $win \
		$win.t {top fill} \
		$win.b {top pady 20 }
	tkwait visibility $win
	focus $win.b
	tkwait window $win
}
#
# DelTopLevs - delete all top level info boxes
#
proc DelTopLevs {} {
	global NumTopLevs
	if ![info exists NumTopLevs] return
	while {$NumTopLevs>0} {
		incr NumTopLevs -1
		catch { destroy .toplev$NumTopLevs }
	}
}

# Various flavors of TopLevBox...

proc NoticeBox { msg } {
	TopLevNotice -msg "$msg" -title Notice -bitmap @[BitmapDir]/Excl -char !
}
proc ErrorBox { msg } {
	TopLevNotice -msg "$msg" -title Error -bitmap @[BitmapDir]/Excl -char !
}
proc InfoBox { msg } {
	TopLevNotice -msg "$msg" -title Info -char i
}
proc HelpBox { msg } {
	global HELPDIR
	if {[string range $msg 0 0] == "@"} {
		if ![info exists HELPDIR] {
			ErrorBox "HELPDIR not defined, can't find help file: $fname"
			return
		}
		set fname $HELPDIR/[string range $msg 1 end]
		if {![file exists $fname] || ![file readable $fname]} {
			ErrorBox "Can't read help file:  $HELPDIR/$fname"
			return
		} else {
			set file [open $fname]
			set msg [read $file]
			close $file
		}
	}
	TopLevNotice -msg "$msg" -title Help -char ?
}

#
# mkButton - make a button with <Return> binding
#
# inputs:
#	w	window
#	text	textbitmap#	cmd	command for <Button-1> and <Return>
#
proc mkButton { w text cmd {default 0} } {
	if {[set l [string length $text]] < 10} {
		set l 10
	}
	incr l 2
        button $w -text "$text" -command "$cmd" -width $l
	if {$default != 0 } {
		$w configure -relief raised -bd 5
	}
        bind $w <Return> "$w flash;$w invoke"
}



#
#
# Calling sequence
#
# AddMenuButtons w {help1 help2 ...} menu1 menu2 ...
#
# where menuI is a list of {buttonname { {cmdlabel1 cmd1 help1} ...}
#
proc mkMenuBar { w helpentries args } {
	frame $w -relief raised -bd 2
	menubutton $w.help -text "Help" -menu $w.help.m
	menu $w.help.m
	set gotanyhelp 0
	if {$helpentries != {}} {
		set gotanyhelp 1
		foreach e $helpentries {
			set h [lindex $e 1]
			$w.help.m add command -label [lindex $e 0] \
 				-command "HelpBox {$h}"
		}
		$w.help.m add separator
	}
	set n 0
	foreach b $args {
		set bn [lindex $b 0]
		set gotsomehelp 0
		menubutton $w.$n -text $bn -menu $w.$n.m
		menu $w.$n.m
		foreach e [lindex $b 1] {
			set en [lindex $e 0]
			set c [lindex $e 1]
			set h [lindex $e 2]
			$w.$n.m add command -label $en -command $c
			if {$h != ""} { set gotsomehelp 1 }
		}
		if $gotsomehelp {
			set gotanyhelp 1
			$w.help.m add cascade -label "$bn Menu..." \
				-menu $w.help.m.$n
			menu $w.help.m.$n
			foreach e [lindex $b 1] {
				set h [lindex $e 2]
				if {$h != {}} {
					set en [lindex $e 0]
					set c [lindex $e 1]
					$w.help.m.$n add command \
						-label $en \
						-command "HelpBox {$h}"
				}
			}
		}
		incr n 1
	}
	for {set i 0} {$i<$n} {incr i 1} {
		pack append $w \
			$w.$i { left padx 10 } 
	}
	if $gotanyhelp { pack append $w $w.help { right padx 10 } }
}


#
# Calling sequence
#
# AddMenuButtons w menu1 menu2 ...
#
# where menuI is a list of {buttonname { {cmdlabel1 cmd1} ...}
#
proc AddMenuButtons { w args } {
	set n 0
	foreach b $args {
		menubutton  $w.a$n -text [lindex $b 0] -menu $w.a$n.m
		menu $w.a$n.m
		foreach e [lindex $b 1] {
			$w.a$n.m add command -label [lindex $e 0] \
				-command [lindex $e 1]
		}
		pack append $w $w.a$n { left padx 10 } 
		incr n 1
	}
}


#
# ExpandTilde - expand ~dir to full path name
#
proc ExpandTilde d {
	case $d in {
		~/	{return [file dirname ~/]}
		default {return [file dirname $d/]}
	}
}

#
# SearchPath -	search for an execuTable in user's default
#		path (or in some supposed default location).
#
# inputs:
#	prog	prog to search for
#	apath	other directories to search, separated by :
#
# returns:
#	location of prog, perhaps adding the location to env(PATH),
#	or "" if not found
#
proc SearchPath { prog {apath {}}} {
        global env
        foreach p [split $env(PATH) :] {
		if [catch {file exists $p}] continue
                if [file exists $p/$prog] {
                        return [ExpandTilde $p]/$prog
               	}
        }
        foreach p [split $apath :] {
		if [catch {file exists $p}] continue
               	if [file exists $p/$prog] {
                       	set env(PATH) $env(PATH):[ExpandTilde $p]
                       	return $p/$prog
		}
        }
        return ""
}



#
# ugly, I know
#
proc GetAPid {} {
	return [exec sh -c {echo $$}]
}

#
# ParseArgs -	parse command line arguments conforming to a simple style
#
# inputs:
#	keys	list of command line keys.  The key foo searches the
#		argument list for -foo and set the variable foo in
#		at the calling procedure's level.  If the key is
#		specified as :foo, searches for -foo and expects
#		an argument to follow
#	cmdargs	argument list
#
# returns:
#	index in cmdargs where options end and operands start or
#	calls error
#
proc ParseArgs {keys cmdargs} {
	foreach key $keys {
		if {[string range $key 0 0] == ":"} {
			set key [string range $key 1 end]
			upvar $key $key
			set boolean($key) 0
		} else {
			upvar $key $key
			set $key 0
			set boolean($key) 1
		}
	}

	set nargs [llength $cmdargs]
	for {set n 0} {$n < $nargs} {incr n 1} {
		set arg [lindex $cmdargs $n]
		if {[string range $arg 0 0] != "-"} break
		set arg [string range $arg 1 end]
		if ![info exists boolean($arg)] {
			error "Parse error:  no such flag: -$arg"
		}
		if $boolean($arg) {
			set $arg 1
			continue
		} else {
			incr n 1
			set nextarg [lindex $cmdargs $n]
			if {$nextarg == {} || [info exists boolean([string range $nextarg 1 end])]} {
				error "Parse error:  missing argument:  should be -$arg $arg"
			}
			set $arg $nextarg
		}
	}
	return $n
}


proc SelectAButton { msg args } {
	global MBReturn
	set MBReturn -1
	toplevel .mb
	wm title .mb Dialog
	set pad {padx 1c pady 1c}
	frame .mb.m -relief raised -bd 1
	label .mb.m.b -bitmap @[BitmapDir]/Excl
	message .mb.m.m -text $msg -aspect 400
	pack append .mb.m \
		.mb.m.b "left $pad" \
		.mb.m.m "left $pad expand frame w"
	frame .mb.b -relief raised -bd 1
	set default 1
	for {set n 0} {$n < [llength $args]} {incr n 1} {
		set but [lindex $args $n]
		set lab [lindex $but 0]
		set val [lindex $but 1]
		if {$val == {}} {set val $n}
		mkButton .mb.b.$n $lab "set MBReturn $val;destroy .mb" $default
		set default 0
		pack append .mb.b .mb.b.$n "left $pad"
		lappend tablist .mb.b.$n
	}
	eval SetTabbing $tablist
	pack append .mb \
		.mb.m "top fill $pad" \
		.mb.b {top fillx}
	tkwait visibility .mb.b.0
	.mb.b.0 conf -state active
	focus .mb.b.0
	grab .mb
	tkwait window .mb
	return $MBReturn
}

proc Confirm { msg {y Yes} {n No} } {
	return [SelectAButton $msg "{$y} 1" "{$n} 0"]
}

proc DumpArray { array } {
	upvar 1 $array a
	foreach n [array names a] {
		lappend r "set ${array}($n) $a($n)"
	}
	return $r
}