#
# $Source: /home/nlfm/Working/Zircon/Released/plugins/Dcc/RCS/send.tcl,v $
# $Date: 1997/02/20 08:55:46 $
# $Revision: 1.18.1.6 $
#
package provide Dcc 1.18
#
proc acceptSend {net key file usr chan hst port} {
    global zircon
    upvar #0 Offer$net Offer Send$net Send
    set x [lsearch $Offer($usr) "$key *"]
    set v [lindex $Offer($usr) $x]
    close [lindex $v 2]
    if [catch {set fd [open "|[file join $zircon(lib) plugins Dcc dccsend] $file\
      [lindex $v 4] $usr <@$chan 2>@$chan" r]} msg] {
	tellError {} {Prog error} "Cannot run DCC helper program \
dccsend - \"$msg\"
Check your installation"
	close $chan
	return
    }
    catch {fconfigure $fd -buffering line -translation lf}
    fileevent $fd readable "handleInfo $net $fd"
    set v [list $fd $file [lindex $v 3] [lindex $v 4]]
    close $chan
    if ![info exists Send($usr)] {$usr ref}
    lappend Send($usr) $v
    listdel Offer($usr) $x
    switch -- $Offer($usr) {} {unset Offer($usr) ; $usr deref}
    if [winfo exists .@dls$net] { buildDCCList $net }
    dccWindow $fd $usr Send $file
}
#
proc DCCSend {usr file} {
    switch {} $file return
    if [file exists $file] {
	if ![file readable $file] {
	    tellError {} {File error} "Cannot read file \"$file\"."
	    return
	}
	set net [$usr net]
	set file [glob $file]
	set xfile [file tail $file]
	global zircon
	upvar #0 Offer$net Offer
	set ky [newName Scon]
	set sock [socket -server "acceptSend $net $ky $file $usr" 0]
	if [catch {fconfigure $sock -sockname} xx] {
	    error "Cannot get port for server - $xx"
	}
	if ![info exists Offer($usr)] { $usr ref }
	lappend Offer($usr) [list $ky $file $sock [lindex $xx 2] 0 0]
	$net CTCP DCC [$usr name] \
	  "SEND $xfile [ipPack [ipAddress]] [lindex $xx 2] [file size $file]"
	if [winfo exists .@dls$net] { buildDCCList $net }
    } {
	tellError {} {File error} "File \"$file\" does not exist."
    }
}
#
proc handleInfo {net conn} {
    if {[catch {gets $conn} msg] || ([string match {} $msg] && [eof $conn])} {
	catch {close $conn}
    } {
	global ztrans
	upvar #0 Send$net Send Get$net Get
	zIn "! $msg" $net
	regsub -all {[\\{\"}]} $msg {\\&} sp
	switch -- [set who [lindex $sp 5]] {} {error "Bad Info line - {$msg}"}
	set pid [lindex $sp 0]
	set msg [join [lreplace [lrange $sp 1 end] 4 4 [$who name]]]
	switch -glob -- $msg {
	{DCC Get prog*} -
	{DCC Send prog*} {
		catch {dccProgress $conn [lindex $sp 6] [lindex $sp 7] \
		  [lindex $sp 8] [lindex $sp 9]}
		return
	    }
	{DCC Send*} -
	{DCCError Send*} {
		set x [lsearch $Send($who) "$conn *"]
		listdel Send($who) $x
		switch -- $Send($who) {}  {unset Send($who) ; $who deref}
		if [winfo exists .@dls$net] { buildDCCList $net}
		if ![winfo exists .@$conn] {
		    $net inform $msg 
		} {
		catch {destroy .@$conn.meter .@$conn.txt .@$conn.txt2}
		if [winfo exists .@$conn.done] {
		    .@$conn.done configure -text $msg
		} {
		    pack [label .@$conn.done -text $msg] \
		      -before .@$conn.cancel -padx 10 -pady 10
		}
		.@$conn.cancel configure -text $ztrans(dismiss) \
		  -command "destroy .@$conn"
		}
		close $conn
		return
	    }
	{DCCError Get*} -
	{DCC Get*} {
		set x [lsearch $Get($who) "$conn *"]
		listdel Get($who) $x
		switch -- $Get($who) {} {unset Get($who) ; $who deref}
		if [winfo exists .@dls$net] { buildDCCList $net }
		if ![winfo exists .@$conn] {
		    $net inform $msg
		} {
		    catch {destroy .@$conn.meter .@$conn.txt .@$conn.txt2}
		    if [winfo exists .@$conn.done] {
			.@$conn.done configure -text $msg
		    } {
			pack [label .@$conn.done -text $msg] \
			  -before .@$conn.cancel -padx 10 -pady 10
		    }
		    .@$conn.cancel configure -text $ztrans(dismiss) \
		      -command "destroy .@$conn"
		}
		close $conn
		return
	    }
	default {
		set msg "WEIRD ERROR : $msg"
	    }
	}
	mkInfoBox $net DCCINFO .@dcc$conn {DCC Info} $msg
    }
}
#
proc startGet {sk net file usr leng posn} {
    global zircon
    zOut "! dccget $file $usr $leng $posn" $net
    if [catch {open "|[file join $zircon(lib) plugins Dcc dccget] $file \
      00 $usr $leng $posn <@$sk 2>@$sk" r} fd] {
	tellError {} {Prog error} "Cannot run DCC helper program dccget - $fd. Check your installation"
    } {
	upvar #0 Get$net Get
	catch {fconfigure $fd -buffering line -translation {lf lf}}
	set pid [pid $fd]
	fileevent $fd readable "handleInfo $net $fd"
	if ![info exist Get($usr)] {$usr ref}
	lappend Get($usr) [list $fd $file $fd]
	if [winfo exists .@dls$net] { buildDCCList $net }
	dccWindow $fd $usr Get $file
    }
    close $sk
}
#
proc dccAutoDir {net fln} {
    foreach x [$net autogetdir] {
	set dir [lindex $x 0]
	switch {} [set rx [lindex $x 1]] {set rx .*}
	if [regexp $rx $fln] {return $dir}
    }
    return {}
}
#
switch -glob [info tclversion] {
8* -
{7.6} {
#
proc handleSend {net fln usr addr port leng posn auto} {
    global ztrans GetDir zFileTypes
    if $auto {
	switch {} [set fl [dccAutoDir $net $fln]] {} default {
	    doGetDCC $net Get $usr $addr $port $leng $posn \
		[file join $fl $fln]
	    return
	}
    }
    if ![info exists GetDir($net)] {
	switch {} [set GetDir($net) [dccAutoDir $net $fln]] {
	    set GetDir($net) [pwd]
	}
    }
    set dir $GetDir($net)
    set msg "DCC Send request ($fln) from [$usr name]"
    set fl [tk_getSaveFile -initialdir $dir -initialfile $fln -filetypes $zFileTypes]
    set GetDir($net) [file dirname $fl]
    doGetDCC $net Get $usr $addr $port $leng $posn $fl
}
}
default {
proc handleSend {net fln usr addr port leng posn auto} {
    if $auto {
	switch {} [set fl [dccAutoDir $net $fln]] {} default {
	    doGetDCC $net Get $usr $addr $port $leng $posn \
		[file join $fl $fln]
	    return
	}
    }
    global ztrans GetDir
    if ![info exists GetDir($net)] {
	switch {} [set GetDir($net) [dccAutoDir $net $fln]] {
		set GetDir($net) [pwd]
	}
    }
    set msg "DCC Send request ($fln) from [$usr name]"
    tkwait window [mkFileBox {} GetDir($net) .* "DCC Send $fln" $msg $fln \
      "$ztrans(accept) {doGetDCC $net Get $usr $addr $port $leng $posn}" \
      "$ztrans(reject) {}"]
}
}
}
#
proc handleResume {net usr file port posn} {
    upvar #0 Offer$net Offer
    set i 0
    if ![info exists Offer($usr)] {
	warnUser {Resume Error} "Asked to Resume, but no DCC offer to [$usr name] outstanding!"
    } {
	foreach l $Offer($usr) {
	    switch $port [lindex $l 3] {
		set Offer($usr) [lreplace $Offer($usr)\
		  $i $i [lreplace $l 4 4 $posn]]
		$net CTCP DCC [$usr name] "ACCEPT $file $port $posn"
		break
	    }
	    incr i
	}
    }
}
#
proc handleAccept {net usr fln port posn} {
    global Resume
    set i 0
    foreach l $Resume($usr) {
	switch $port [lindex $l 2] {
	    set file [lindex $l 0]
	    set addr [lindex $l 1]
	    set leng [lindex $l 3]
	    set posn [lindex $l 4]
	    doGetDCC $net Get $usr $addr $port $leng $posn $file
	    $usr deref
	    listdel Resume($usr) $i
	    $usr deref
	    switch {} $Resume($usr) {unset Resume($usr)}
	    break
	}
	incr i
    }
}
#
proc dccWindow {conn usr array file} {
    global ztrans
    if [winfo exists [set w .@$conn]] return
    toplevel $w -class Zircon
    switch $array Send {
	wm title $w "DCC send $file to [$usr name]"
    } default {
	wm title $w "DCC get $file from [$usr name]"
    }
    wm protocol $w WM_DELETE_WINDOW {}
    frame $w.meter -relief raised
    scale $w.meter.slide -from 0 -to 100 -tickinterval 20 \
       -state disabled -length 200 -orient horizontal
    pack $w.meter.slide -padx 10 -pady 5 -fill x
    pack $w.meter -fill x 
    frame $w.txt
    pack [label $w.txt.bytes -text {0 bytes transferred}] -padx 10 -side left
    pack [label $w.txt.pcnt -text {0% complete}] -side left -padx 10
    frame $w.txt2
#    pack [label $w.txt2.left -text {}]
    pack $w.txt $w.txt2 -fill x -pady 5
    button $w.cancel -text $ztrans(cancel) \
      -command "killDel $array[$usr net] $usr {$file} ; destroy .@$conn"
    pack $w.cancel -fill x
}
#
proc dccProgress {conn bytes pcnt min sec} {
    set w .@$conn
    $w.txt.bytes configure -text "$bytes bytes transferred."
    $w.txt.pcnt configure -text "$pcnt% complete"
#    $w.txt2.left configure -text "${min}m ${sec}s remaining"
    $w.meter.slide configure -state normal
    $w.meter.slide set $pcnt
    $w.meter.slide configure -state disabled
    update idletasks
}
