#####################################################################
# X-Files Background-Exec v0.9  Date: 31.08.98      (c) Juha Forsten
# ===================================================================
#
# ADDED:
#
# * Error-handling using tmp-file (directory is an option).
#     
# TODO:
#
# - 
# -  
#

package provide BGEXEC 0.8

## List of all open command-pipes
set bg(fileid_list) ""

## Command used in 'bg_kill'
set bg(kill_cmd) "kill -9"

proc bg_exec {command {callback ""} {kill_cb 0} {error_detect 0} {error_dir .}} {
    global bg

    ## Direct all outs to stdout and open command-pipe
    #set comm "$command 2>@stdout"

    ## We need some dirty "kludge" to prevent crating error-files
    ## with same names.. So we use tcl's fileid..
 
    if {$error_detect} {
	set errorid [open "|" RDWR]
	set errorfile "$error_dir/TMP_$errorid.err"
	set fileid [open "|$command 2>$errorfile"]
    } {
	set fileid [open "|$command 2>@stdout" RDWR] 
    }

    ## Add 'fileid' to list
    lappend bg(fileid_list) $fileid

    ## Set variables
    set bg($fileid.buf)       ""
    set bg($fileid.pid)       [pid $fileid]
    set bg($fileid.comm)      $command
    set bg($fileid.closed)    0
    set bg($fileid.killcb)    $kill_cb
    set bg($fileid.callback)  "$callback"
    set bg($fileid.starttime) [clock format [clock seconds]]
    set bg($fileid.error)     0
    set bg($fileid.errormsg)  ""
    
    if {$error_detect} {
	set bg($fileid.errorfile) $errorfile
	set bg($errorid.parent)   $fileid
	set bg($fileid.errorid)   $errorid
    }

    fconfigure $fileid -blocking 0 -buffering line
    fileevent $fileid readable "bg_read $fileid $error_detect"
    
    return $fileid
}

proc bg_read {fileid error_detect} {
    global bg
    
    if {[eof $fileid] == 0} {

	## Read output
	set bg($fileid.line) [read $fileid]
	set bg($fileid.buf) "$bg($fileid.buf)$bg($fileid.line)"
    } { 
	
	## CLOSED !!
	catch {close $fileid}
	
	## eval Callback -function
	catch {eval $bg($fileid.callback) $fileid}

	## Remove 'fileid' from list
	bg_removeid $fileid

	if {($error_detect == 1) && ([file exists $bg($fileid.errorfile)])} { 
	    if {[file size $bg($fileid.errorfile)] > 0} {
		set tmp [open $bg($fileid.errorfile) r]
		while {[eof $tmp] == 0} {
		    set bg($fileid.errormsg) "$bg($fileid.errormsg)[read $tmp]"
		}
		set bg($fileid.error) 1
	    }
	    catch {file delete -force -- $bg($fileid.errorfile)}
	}
	
	
	# Trig 'closed'-variable
	set bg($fileid.closed) 1
    }
}

proc bg_kill {fileid} {
    global bg
    
    # Kill !!
    eval exec $bg(kill_cmd) [pid $fileid]
    update idletasks
    fileevent $fileid readable {}
    
    catch {close $fileid}

    if {$bg($fileid.killcb) == 1} {
	eval $bg($fileid.callback) $fileid
    }

    ## Remove 'fileid' from list
    bg_removeid $fileid

    # Trig 'closed'-variable
    set bg($fileid.closed) 1
}

proc bg_removeid {fileid} {
    global bg

    ## Remove 'fileid' from list
    set index [lsearch -exact $bg(fileid_list) $fileid]
    set bg(fileid_list) [lreplace $bg(fileid_list) $index $index]     
}

proc bg_unset {fileid} {
    global bg
    ## Clean variables!
    foreach i [array names bg $fileid.*] {
	unset bg($i)
    } 
}

## TESTING

#set fid0 [bg_exec "xv" "puts closed"]
#set fid1 [bg_exec "xcalc" "puts closed"]

#button .b -text kill -command {bg_kill $fid0;puts "$bg(fileid_list)"} 
#button .p -text puts -command  {puts "$bg($fid0.buf)"} 
#button .l -text puts -command  {puts "$bg(fileid_list)"} 
#pack .b .p .l





