# Utilities Library
# $Header: /a/juno/u1/ra/raines/src/tk/tkmail/utils.tk,v 1.6 1993/09/02 20:31:05 raines Exp $

###############################################
# BEGINNING OF FILESELECTOR PACKAGES
#   hacked from code by Mario J. Silva

# Arguments:
#   cmd		a procedure that accepts as its first argument
#		a filename and that returns 1 for success and 0
#		for failure
#   purpose	a text string to prompt with
#   stayupQ	whether it file selector should stayup after a
#		successful call of cmd
#   callback    possible command to eval before event loop
#   top		name of toplevel to be transient to
#   args	additional arguments to cmd after filename

proc fileselect {cmd purpose stayupQ callback top args } {
  
  set w .tkfileselect
  catch {destroy $w}

#    set FS_cmd $cmd
#    set FS_args $args

    toplevel $w
    wm transient $w $top
    wm title $w "Select File"
    after 20 grab $w

    set entry $w.file.eframe.entry
    set FS_list $w.file.sframe.list
    set scroll $w.file.sframe.scroll
    set ok $w.bframe.ok
    set cancel $w.bframe.cancel
    set dirlabel $w.file.dirlabel

    set dir [pwd]
    if {[string length $dir] > 32} {
	set dir [join "... $dir" ""]
	while {[string length $dir] > 32} {
	    set dir [string range $dir 4 end]
	    set dir [string range $dir [string first "/" $dir] end]
	    set dir [join "... $dir" ""]
	}
    }

    # widgets
    frame $w.file -bd 10 
    frame $w.bframe -bd 10
    pack append $w \
        $w.file {top expand fill} \
        $w.bframe {top}

    frame $w.file.eframe
    frame $w.file.sframe
    label $w.file.dirlabel -width 32 -anchor w -text $dir 

    pack append $w.file \
	$w.file.dirlabel {top fillx} \
        $w.file.eframe {top fillx} \
	$w.file.sframe {top expand fill}


    label $w.file.eframe.label -text "$purpose"
    entry $w.file.eframe.entry -relief sunken \
	-exportselection 0 

    pack append $w.file.eframe \
		$w.file.eframe.label {left } \
                $w.file.eframe.entry {left pady 10 fillx}


    scrollbar $w.file.sframe.yscroll -relief sunken \
	 -command "$w.file.sframe.list yview"

    listbox $w.file.sframe.list -relief sunken \
        -geometry "25x10" \
	-yscroll "$w.file.sframe.yscroll set" \
	-exportselection 0

    pack append $w.file.sframe \
        $w.file.sframe.yscroll {left filly} \
 	$w.file.sframe.list {expand fill} 

    # buttons
 
    button $w.bframe.ok -text OK -relief raised  -width 10 \
        -command "ok.cmd $w $entry $dirlabel $FS_list $cmd $stayupQ $args"
    button $w.bframe.cancel -text Cancel -relief raised \
        -command "grab release $w; destroy $w" -width 10

    pack append $w.bframe $w.bframe.ok {left padx 15} \
                          $w.bframe.cancel {left padx 15}

    # Fill the listbox with a list of all the files in the directory (run
    # the "ls" command to get that information).
 
    foreach i [exec ls -a [pwd]] {
        if {[string compare $i "."] != 0} {
            $FS_list insert end $i
        }
    }

   # Set up bindings for the browser.
    bind $entry <Return> "eval $ok invoke"
    bind $entry <Control-c> "eval $cancel invoke"

    bind $w <Control-c> "eval $cancel invoke"
    bind $w <Return> "eval $ok invoke"


    bind $FS_list <Button-1> "FS_select %W %y $entry"

    bind $FS_list <Key> "FS_select %W %y $entry"

    bind $FS_list <B1-Motion> " "

    bind $FS_list <Double-Button-1> "eval $ok invoke"

    bind $FS_list <Return> "FS_select %W %y $entry; eval $ok invoke"

    proc FS_select {W y B_entry} {
	$W select from [$W nearest $y]
	$W select to [$W nearest $y]
	eval $B_entry delete 0 end
	eval $B_entry insert 0 [$W get [$W nearest $y]]
    }


    # button procedures

    proc ok.cmd {w entry dirlabel FS_list cmd stayupQ args} {

        set selected [$entry get]
	$entry delete 0 end
	if {![llength $selected]} {return}

        if {[file isdirectory $selected] != 0} {
            cd $selected
            set dir [pwd]
	    if {[string length $dir] > 32} {
		set dir [join "... $dir" ""]
		while {[string length $dir] > 32} {
		    set dir [string range $dir 4 end]
		    set dir [string range $dir [string first "/" $dir] end]
		    set dir [join "... $dir" ""]
		}
	    }
	    eval $dirlabel configure -text $dir
            $FS_list delete 0 end
	    foreach i [exec ls -a [pwd]] {
	        if {[string compare $i "."] != 0} {
	            eval $FS_list insert end $i
	        }
	    }
	    return
	}
	grab release $w
	set res [eval $cmd [linsert $args 0 "[pwd]/$selected"]]
	if {$stayupQ || !$res} {
	    grab $w
	} else {
	    destroy $w
	}
    
    }

    if {$callback != ""} {eval $callback $w}
    focus $w.file.eframe.entry
}

###############################################
# BEGINNING OF TKGETOKAY PACKAGE
#   hacked from code by Jay Sekora
proc tkgetokay { msg top {xpos -1} {ypos -1}} {

    global tkgetokay
    set tkgetokay(res) 0

    toplevel .tkgetokay
    set w .tkgetokay
    wm transient $w $top
    wm title $w "Attention!"
    if {$xpos!=-1 && $ypos!=-1} {
	wm geometry $w +${xpos}+${ypos}
    }

    message $w.msg -width 300 -anchor w -text $msg
    frame $w.b
    button $w.b.ok -text OK -bd 4 -width 8 \
	-command "tkgetokaydone 1 $w"
    button $w.b.cancel -text Cancel -bd 4 -width 8 \
	-command "tkgetokaydone 0 $w"
    pack append $w.b \
	$w.b.ok {left padx 10 pady 10} \
	$w.b.cancel {left padx 10 pady 10}
    pack append $w \
	$w.msg {top fill expand padx 10} \
	$w.b {bottom fillx}

    focus $w
    after 200 grab $w
    bind $w <Key-Return> "$w.b.ok invoke"
    tkwait window $w

    return $tkgetokay(res)
}

proc tkgetokaydone { val w} {

    global tkgetokay
    set tkgetokay(res) $val
    grab release $w
    destroy $w
}    

###############################################
# BEGINNING OF TKGETSTRING PACKAGE
#   hacked from code by Jay Sekora
proc tkgetstring { msg top {defstr ""} {xpos -1} {ypos -1} {callback {}}} {

    global tkgetstring
    set tkgetstring(res) ""

    toplevel .tkgetstring
    set w .tkgetstring
    wm transient $w $top
    wm title $w " "
    if {$xpos!=-1 && $ypos!=-1} {
	wm geometry $w +${xpos}+${ypos}
    }

    message $w.msg -width 300 -anchor w -text $msg
    entry $w.ent -relief sunken
    $w.ent delete 0 end
    $w.ent insert 0 $defstr

    frame $w.b
    button $w.b.ok -text OK -bd 4 -width 8 \
	-command "tkgetstringdone 1 $w"
    button $w.b.cancel -text Cancel -bd 4 -width 8 \
	-command "tkgetstringdone 0 $w"
    pack append $w.b \
	$w.b.ok {left padx 10 pady 10} \
	$w.b.cancel {left padx 10 pady 10}
    pack append $w \
	$w.msg {top fill expand padx 10} \
	$w.ent {top fill expand padx 100} \
	$w.b {bottom fillx}

    if {$callback != ""} {eval $callback $w}

    focus $w.ent
    after 200 grab $w
    bind $w <Key-Return> "$w.b.ok invoke"
    bind $w.ent <Key-Return> "$w.b.ok invoke"
    tkwait window $w

    return $tkgetstring(res)
}

proc tkgetstringdone { val w} {

    global tkgetstring
    if {$val} {set tkgetstring(res) [$w.ent get]}
    grab release $w
    destroy $w
}    

##################################################
