# Utilities Library
#	    requires topgetopt.tcl by Kennard White & Phil Lapsley
# $Header: /usr2/people/raines/src/tk/tkmail/utils.tk,v 1.11 94/01/25 09:32:34 raines Exp $
global ut_fs ut_getok ut_getstr


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

# Arguments:
#   -okcmd	a procedure that accepts as its first argument
#		a filename and that returns 1 for success and 0
#		for failure
#   -okargs	additional arguments to pass to okcmd after filename
#   -cancelcmd	a procedure to call when cancel pressed that
#		return 1 to actually cancel, 0 to abort
#   -cancelargs arguments to pass to cancelcmd
#   -purpose	a text string to prompt with
#   -stayup	whether the file selector should stayup after a
#		successful call of cmd
#   -grab	whether to grab focus or not
#   -callback   possible command to eval before event loop
#		which will be given the fileselector toplevel
#		as a first argument
#   -cbargs	arguments to callback in addition to toplevel
#   -master	name of toplevel to be transient to
#   -title	title for fileselector toplevel
#   -dir	startup directory
#   -hidden	whether to show hidden directories

proc ut_fsbox { args } {
    global env ut_fs

    set okcmd ""
    set okargs ""
    set cancelcmd ""
    set cancelargs ""
    set purpose "File: "
    set stayup 0
    set grab 1
    set callback ""
    set cbargs ""
    set master ""
    set title "Select File"
    set dir [pwd]
    set hidden 1
    topgetopt { okcmd okargs cancelcmd cancelargs purpose \
        stayup grab callback cbargs master title dir \
	hidden } $args

    set cnt 0
    while {[winfo exists .utfsbox$cnt]} {incr cnt}
  
    set w .utfsbox$cnt
    toplevel $w
    if {$master != ""} { 
	wm transient $w $master
	set xpos [expr [winfo rootx $master]+[winfo width $master]/3]
	set ypos [expr [winfo rooty $master]+[winfo height $master]/3]
	wm geometry $w +${xpos}+${ypos}
    }
    wm title $w $title
    if {$grab != 0} {after 20 grab $w}

    set entry $w.file.eframe.entry
    set fslist $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

    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
    frame $w.file.bframe
    label $w.file.dirlabel -width 32 -anchor w -text $dir 

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

    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
 
    global hidden_$w
    set hidden_$w $hidden
    checkbutton $w.file.bframe.hide -text "Hidden" -variable hidden_$w \
	-relief raised -command "global hidden_$w ; \
		  ut_fsfill $fslist \[pwd\] \${hidden_$w}"

    button $w.file.bframe.home -text Home -relief raised \
        -command "global hidden_$w ; ut_fsgo $env(HOME) $w $entry \
		  $dirlabel $fslist \{$okcmd\} $stayup $grab \
		  \${hidden_$w} $okargs"

    pack append $w.file.bframe $w.file.bframe.home {left expand fillx} \
                          $w.file.bframe.hide {left expand fillx}

    button $w.bframe.ok -text OK -relief raised  -width 10 \
        -command "global hidden_$w ; ut_fsokcmd $w $entry \
		  $dirlabel $fslist \{$okcmd\} $stayup $grab \
		  \${hidden_$w} $okargs"

    button $w.bframe.cancel -text Cancel -relief raised -width 10 \
        -command "ut_fscancelcmd $w \{$cancelcmd\} $grab $cancelargs"

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

   # 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 $fslist <Button-1> "ut_fsselect %W %y $entry"

    bind $fslist <Key> "ut_fsselect %W %y $entry"

    bind $fslist <B1-Motion> " "

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

    bind $fslist <Return> "ut_fsselect %W %y $entry; eval $ok invoke"

    ut_fsfill $fslist [pwd] $hidden
    if {$callback != ""} {eval "$callback $w $cbargs"}
    focus $w.file.eframe.entry
}

proc ut_fsgo {dir w entry args} {
    $entry delete 0 end
    $entry insert 0 "$dir/"
    eval "ut_fsokcmd $w $entry $args"
}

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

proc ut_fsokcmd {w entry dirlabel fslist cmd stayup grab hidden args} {

    set selected [$entry get]
    set ndx [expr [string length $selected]-1]
    if {[string index $selected $ndx] == "/"} {
        set selected [string range $selected 0 [expr $ndx-1]]
    }
    $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" ""]
	    }
	}
	$dirlabel configure -text $dir
	ut_fsfill $fslist [pwd] $hidden
	return
    }
    if {$grab != 0} {grab release $w}
    if {$cmd != ""} {
        if {[string first [string index $selected 0] {~/}] == -1} { 
	    set res [eval $cmd [linsert $args 0 [pwd]/$selected]]
	} else {
	    set res [eval $cmd [linsert $args 0 $selected]]
	}
    } else {
	set res 1
    }
    if {$stayup || $res == 0} {
       if {$grab != 0} {grab $w}
    } else {
       destroy $w
    }

}

proc ut_fscancelcmd {w cmd grab args} {

    if {$grab != 0} {grab release $w}
    if {$cmd != ""} {
	set res [eval "$cmd $args" ]
    } else {
	set res 1
    }
    if {$res == 0} {
       if {$grab != 0}  {grab $w}
    } else {
       destroy $w
    }

}

proc ut_fsfill { fslist dir { hidden 1 } } {

    if {$hidden} { 
        set opt "-a"
	set dirlist ""
    } else { 
        set opt "" 
	set dirlist ".."
    }
    $fslist delete 0 end
    foreach i [split [exec ls $opt $dir] \n] {
	if {[string compare $i "."] != 0} {
	    if {[file isdirectory $i]} {
	        set dirlist [linsert $dirlist 0 $i]
	    } else {
	        $fslist insert end $i
	    }
	}
    }
    foreach i $dirlist {
        $fslist insert 0 "$i/"
    }
}

###############################################
# BEGINNING OF TKGETOKAY PACKAGE
#   hacked from code by Jay Sekora
#
# Arguments:
#  -prompt	text of message to display for confirmation
#  -master	name of toplevel to be transient to
#  -oklabel	label for ok button
#  -nolabel	label for cancel button
#  -showno	whether to show the Cancel button
proc ut_getok { args } {

    global ut_getok
    set ut_getok(res) 0

    set master ""
    set oklabel "OK"
    set nolabel "Cancel"
    set prompt "Confirm?"
    set showno 1
    topgetopt { prompt master oklabel nolabel showno} $args

    set cnt 0
    while {[winfo exists .ut_getok$cnt]} {incr cnt}
  
    set w .ut_getok$cnt
    toplevel $w
    wm title $w "Attention!"
    if {$master != ""} { 
	wm transient $w $master
	set xpos [expr [winfo rootx $master]+[winfo width $master]/3]
	set ypos [expr [winfo rooty $master]+[winfo height $master]/3]
	wm geometry $w +${xpos}+${ypos}
    }

    message $w.prompt -width 300 -anchor w -text $prompt
    frame $w.b
    button $w.b.ok -text $oklabel -bd 4 -width 8 \
	-command "ut_getokdone 1 $w"
    pack append $w.b $w.b.ok {left padx 10 pady 10}
    if {$showno} {
	button $w.b.cancel -text $nolabel -bd 4 -width 8 \
	    -command "ut_getokdone 0 $w"
	pack append $w.b $w.b.cancel {left padx 10 pady 10}
    }
    pack append $w \
	$w.prompt {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 $ut_getok(res)
}

proc ut_getokdone { val w} {

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

###############################################
# BEGINNING OF ut_getstr PACKAGE
#   hacked from code by Jay Sekora
#
# Arguments:
#   -prompt	text to prompt user with
#   -defstr	default string to place in entry
#   -callback   possible command to eval before event loop
#		which will be given the created toplevel
#		as a first argument
#   -cbargs	arguments to callback in addition to toplevel
#   -master	name of toplevel to be transient to
#   -oklabel	label for ok button
#   -nolabel	label for cancel button
proc ut_getstr { args } {

    global ut_getstr
    set ut_getstr(res) ""

    set master ""
    set prompt "Confirm?"
    set defstr ""
    set callback ""
    set cbargs ""
    set oklabel "OK"
    set nolabel "Cancel"
    topgetopt { prompt master defstr callback cbargs oklabel nolabel} $args

    set cnt 0
    while {[winfo exists .ut_getstr$cnt]} {incr cnt}
  
    set w .ut_getstr$cnt
    toplevel $w
    wm title $w " "
    if {$master != ""} { 
	wm transient $w $master
	set xpos [expr [winfo rootx $master]+[winfo width $master]/3]
	set ypos [expr [winfo rooty $master]+[winfo height $master]/3]
	wm geometry $w +${xpos}+${ypos}
    }

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

    frame $w.b
    button $w.b.ok -text $oklabel -bd 4 -width 8 \
	-command "ut_getstrdone 1 $w"
    button $w.b.cancel -text $nolabel -bd 4 -width 8 \
	-command "ut_getstrdone 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.prompt {top fill expand padx 10} \
	$w.ent {top fill expand padx 100} \
	$w.b {bottom fillx}

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

    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 $ut_getstr(res)
}

proc ut_getstrdone { val w} {

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


###############################################
# BEGINNING OF ut_simpletext PACKAGE
#
# Arguments:
#   -name	name of window to use for toplevel
#   -title	text to put in window title
#   -defstr	default string to place in text widget
#   -master	name of toplevel to be transient to
#   -focus	name of widget to return keyboard focus to
#   -grab	whether to grab the focus while mapped
#   -callback   possible command to eval before event loop
#		which will be given the created toplevel
#		as a first argument
#   -cbargs	arguments to callback in addition to toplevel
#   -leftscroll whether scroll bar should be on left or right
#   -buttons    a list of button definitions where the definitions
#		have the form of a variable length list. The mapping
#		of this list by slot is:
#		   1) Label string for button
#		   2) a command (no arguments) to run when button
#		      is pressed (default none). It must return
#		      a 0 to keep the window from being withdraw
#		   3+) all arguments from the third on are taken
#		       as additional arguments to the command
#		       specified in the second slot
#		Only the label string is required.
#		Example: { {Apply apply_it $env(HOME) $file} \
#			   {Cancel} } 
#	        If no buttons are specified, { {Close} } is assumed.
#
# The callback, cbargs, leftscroll, and buttons arguments can
# only be specified the first time ut_simpletext is called for 
# a named window.  Calling ut_simpletext for a particular name window
# after the first call will remap the window.  The caller must 
# explicity destroy the window itself if desired.
#

proc ut_simpletext { args } {

    global ut_stext

    set name {}
    set title {}
    set master {}
    set defstr {}
    set callback {}
    set cbargs {}
    set grab 0
    set leftscroll 1
    set focus {}
    set buttons {}
    topgetopt { name title grab master defstr callback buttons \
	      cbargs oklabel nolabel leftscroll focus } $args

    if {$name == {}} {
        error "No name given to ut_simpletext"
    }
    set w $name

    set ut_stext($w,focus) $focus
    set ut_stext($w,grab) $grab

    if {![winfo exists $w]} {

	toplevel $w
	if {$master != {}} {
	  wm transient $w $master
	  set xpos [expr [winfo rootx $master]+10]
	  set ypos [expr [winfo rooty $master]+[winfo height $master]/3]
	  wm geometry $w +${xpos}+${ypos}
        }

	scrollbar $w.scr -command "$w.txt yview" -relief raised
	text $w.txt -cursor left_ptr -relief sunken -wrap word \
	    -yscroll "$w.scr set"
	$w.txt insert 1.0 $defstr

	frame $w.bb
	set bcnt 0
	if {$buttons == {}} {set buttons { {Close} } }
	foreach bdef $buttons {
	  set bargs {}
	  set blen [llength $bdef]
	  if {$blen < 1} continue
	  if {$blen > 1} { set bargs [lrange $bdef 1 end]}
	  button $w.bb.btn$bcnt -text [lindex $bdef 0] -command "ut_stextcmd $w $bargs"
	  pack append $w.bb $w.bb.btn$bcnt { left expand fillx }
	  incr bcnt
        }
	if {$bcnt < 1} {error "Invalid buttons specification to ut_simpletext"}

	if {$leftscroll} {
	    pack append $w $w.bb {bottom expand fillx} $w.scr {left filly} \
		$w.txt {left expand fill}
	} else {
	    pack append $w $w.bb {bottom expand fillx} $w.txt {left expand fill} \
		$w.scr {left filly}
	}

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

    } else {
	if {$master != {}} {
	  wm transient $w $master
	  set xpos [expr [winfo rootx $master]+10]
	  set ypos [expr [winfo rooty $master]+[winfo height $master]/3]
	  wm geometry $w +${xpos}+${ypos}
        }
	if {[string length $defstr]} {
	    $w.txt delete 1.0 end
	    $w.txt insert 1.0 $defstr
	}
	if {[string length $buttons] || [string length $callback]} {
	   error "Window $w already exists. Cannot change buttons or run callback"
	}
        wm deiconify $w
    }
    if {[string length $title]} {wm title $w $title}
    if {$grab != 0} {after 20 grab $w}
    focus $w.txt
}


proc ut_stextcmd {w args} {
    global ut_stext

    if {$ut_stext($w,grab) != 0} {grab release $w}
    if {$args != {}} {
        set cmd [lindex $args 0]
	set cmdargs {}
	if {[llength $args] > 1} {set cmdargs [lrange $args 1 end]}
	set res [eval $cmd $w $cmdargs]
    } else {
	set res 1
    }
    if {$res == 0} {
       if {$ut_stext($w,grab) != 0} {grab $w}
    } else {
       wm withdraw $w
       if {[winfo exists $ut_stext($w,focus)]} {focus $ut_stext($w,focus)}
    }

}


###################################################################
#  Create an empty file if filename does not exist and create any
#  directories needed with user confirmation

proc ut_askcreate { filename args} {

    set master ""
    set askf 1
    set askd 1
    set askovrw 0
    set errproc error
    topgetopt {master askf askd askovrw errproc} $args

    if {[file exists $filename]} {
        if {![file writable $filename]} {
	    $errproc "ut_askcreate: File $filename not writable"
	    return 0
	}
	if {$askovrw && ![ut_getok -master $master \
		  -prompt "Append to existing file ($filename)?"]} {
	    return 0
	}
	return 1
    }

    set dlist ""
    set fname [file tail $filename]
    set cdir [file dirname $filename]
    while {$cdir != "." && $cdir != "/" && ![file exists $cdir]} {
        set dlist [linsert $dlist 0 [file tail $cdir]]
        set cdir [file dirname $cdir]
    }

    if {[string length $cdir]} {set cdir $cdir/}
    foreach dname $dlist {
	if {$askd && ![ut_getok -prompt "Create new directory ${cdir}$dname?" \
	       -master $master]} {return 0}
	if {[catch "exec mkdir ${cdir}$dname" res]} {
	    $errproc "ut_askcreate: cannot create ${cdir}$dname"
	}
	set cdir ${cdir}${dname}/
    }

    if {$askf} {
	if {![ut_getok -prompt "Create new file ${cdir}$fname?" \
	       -master $master]} {return 0}
	if {[catch "exec touch ${cdir}$fname" res]} {
	    $errproc "ut_askcreate: cannot create ${cdir}$fname"
	}
    }

    return 1
}
