#******************************************************************************
#***
#*** This file is part of XTeXShell; see file xtexsh for details
#*** Version 0.91 (21.2.94)
#***
#******************************************************************************

#******************************************************************************
#*** Execute Programs in a TCL window *****************************************
#******************************************************************************

proc ExecProg {command} {

#***
#*** Execute command. Command may include the symbol :fname, which
#*** will be replaced by the filname of the file loaded in the editor
#*** or, if specified, by the main filename. :fnamewoext will be replaced
#*** by filename without extension. 
#*** If fname == "", use mainname or editfname without extension
#*** Before executing, change to directory of fname
#***

        global editfname editwin
        global mainflag mainname
        global readchild readchierr writechild
        global childpid 
        global boldl_font
        global chisaveflag chireloadflag
	global critsect

#*** Is there another programm running ?

	if {![info exist critsect]} {set critsect 0}

        if {[childstat] || $critsect} {
                DisplayInfo "Sorry:\nThere is another program running\n\nKill other program first" "$boldl_font"
                return
        }
	set critsect 1

#*** Determine fname as explained above
        
	set fname ""
        if {[info exists editfname]} {
                set fname $editfname
        }
        if {$mainflag} {set fname $mainname}

#*** Replace macros :save :reload :fname :fnamewoext
        
        set chisaveflag false
        set chireloadflag false
	set filenameneeded 0

        while {1} {
                set pos [string first ":" "$command"]
                if {$pos==-1} {break}

                set sstr [expr {$pos ? [crange "$command" 0 "$pos-1" ] : ""}]
                set estr [crange "$command" "$pos+1" end]
                set mstr [string tolower [ctoken estr " .,:"]]

                if {[cequal "$mstr" "fnamewoext"]} {
                        set mstr [strip_extension $fname] 
			set filenameneeded 1
                }
                if {[cequal "$mstr" "fname"]} {
                        set mstr $fname
			set filenameneeded 1
                }
                if {[cequal "$mstr" "save"]} {
                        set mstr ""
                        set chisaveflag true
                }
                if {[cequal "$mstr" "reload"]} {
                        set mstr ""
                        set chireloadflag true
                }
                set command [format "%s%s%s" "$sstr" "$mstr" "$estr"]
        }

#*** Does the command need a file name? If yes, check if we have a valid filename

        if {$filenameneeded && [cequal "" $fname]} {
                if {[info exists editwin] && [winfo exists $editwin]} {
                        DisplayInfo "Please save your file before executing this command.\n I don't know the name of your file yet" $boldl_font
                } else {
                        DisplayInfo "No File has been specified so far.\nCannot execute command!\nPlease load a file in the editor or specify a main file!" $boldl_font
                }
		set critsect 0
                return
        }
        
#*** Create window if it doesn't exist

        global  exec_win    execwin_name    execwin_geo
     
        set     exec_win    $execwin_name
        set     c           $execwin_name.c

        if {[cequal "" [CreateTopWin execwin ""]]} {
                wm withdraw  $exec_win
                wm deiconify $exec_win
        } else {
                wm title    $exec_win "$command"
                wm iconname $exec_win "$command"

                frame       $exec_win.but        -relief raised -borderwidth 1 -width 80c -height 10c
                pack        $exec_win.but        -side bottom -fill x

                button      $exec_win.but.kill   -text "Kill Program"  -command {childkill}
                button      $exec_win.but.done   -text "Done"  -command {childkill; destroy $exec_win}
                button      $exec_win.but.clear  -text "Clear" -command {$exec_win.c delete 0.0 end}
                pack        $exec_win.but.kill   $exec_win.but.clear  -side left -anchor s -fill x -padx 3m -pady 1m -ipadx 0.6m
                pack        $exec_win.but.done   -side right -anchor s -fill x -padx 3m -pady 1m -ipadx 0.6m

                scrollbar   $exec_win.ys         -command "$c yview" -relief sunken
                pack        $exec_win.ys         -side right -fill y

                text        $c                   -relief raised -bd 2 -yscrollcommand "$exec_win.ys set"
                pack        $c                   -side left -fill both -expand yes  

                $c tag configure error           -foreground red
                $c tag configure message         -foreground blue 
 
                bind        $c <Any-Return>      { %W insert insert "\n"
                                                   puts $writechild ""
                                                   %W yview -pickplace insert
                                                 }
                bind        $c <Any-KeyPress>    { if {[childstat]} {
                                                        %W insert insert %A
                                                        puts -nonewline $writechild "%A"
                                                        %W yview -pickplace insert
                                                   }            
                                                 }
                bind        $c <1>               { focus %W}
                bind        $c <2>               {%W scan mark -%y}
                bind        $c <B2-Motion>       {%W scan dragto -%y}
        }


#*** Save text ?

        global editor
        if {$chisaveflag} {
                if {[cequal "$editor" "xtex"] && [Qmodflag]} {SaveFile ""}
        }

#*** Compose Command, program-name should go to prog, parameters to command

        eval  set command \"$command\"
        set   progname [lvarpop command 0]

        set   childpath [string range $fname 0 [string last "/" $fname]]

#*** Create pipes to enable communication with child

        pipe  readchild   writepar;                     #*** Child --> Parent
        fcntl $readchild  NONBLOCK 1
        fcntl $readchild  NOBUF    1

        pipe  readchierr  writeparerr;                  #*** Child stderr --> Parent
        fcntl $readchierr NONBLOCK 1
        fcntl $readchierr NOBUF    1

        pipe  readpar     writechild;                   #*** Parent --> Child
        fcntl $writechild NOBUF    1

#*** Now fork and start program

        InsertWithTags $c "Executing: $progname $command\n\n" message
        focus  $c
        update

        if {[set childpid [fork]] == 0} {
                dup $readpar stdin;                     #*** Child process, set IO to pipes
                close $readpar
                dup $writepar stdout
                close $writepar
                dup $writeparerr stderr
                close $writeparerr

                pushd $childpath;                       #*** Change to data file directory
                execl $progname $command

                puts stderr "*** Sorry: Programm could not be started"
                kill [id process]
                exit 255
        }

#*** Disable buffering and install driver to update window 5x per second

	set critsect 0
        after  250 {childIO $childpid}
}

proc    childkill {} {

#*** Kill the child process

        global childpid
        if {[childstat]} {
                kill 9 $childpid
        }
}


proc    childstat {} {

#*** Get status of child. (0 = child does not exist)
#*** If child exists: Read stdout and stderr from child and append to the
#*** variables chistdout and chistderr.
#*** Then check status of child with the wait function and write return value
#*** to chistatus. Return 0 if wait returns end of process condition.

        global childpid chireloadflag
        global childpid readchild readchierr writechild
        global exec_win

        if {![info exists childpid]} {set childpid 0; return 0}
        if {!$childpid} {return 0}

#*** Read Standard-Error and Standard-Output from child and write it on exec-window

        set pmode [lindex [select [list $readchierr $readchild] {} {} 0] 0]

        if {[winfo exists $exec_win.c]} {
                if {[string first $readchierr $pmode] >=0 } {
                        InsertWithTags $exec_win.c [read $readchierr] error
                        $exec_win.c yview -pickplace insert
                }
                if {[string first $readchild $pmode] >=0 } {
                        InsertWithTags $exec_win.c [read $readchild] ""
                        $exec_win.c yview -pickplace insert
                }
        }

#*** Check Status of child

        set chistatus [wait -nohang $childpid]

        if {$childpid != [lindex $chistatus 0]} {
                return 1
        } else {

#*** Process has terminated. Tell user

                close $readchild
                close $readchierr
		close $writechild

                if {[cequal "EXIT" [lindex $chistatus 1]]} {
                        set msg [format "\nProgram terminated, ERC: %d" [lindex $chistatus 2]]
                } else {
                        set msg [format "\n\nProgram was killed by signal: %s" [lindex $chistatus 2]]
                }

                if {[winfo exists $exec_win.c]} {
                        InsertWithTags $exec_win.c "$msg\n" message
                        InsertWithTags $exec_win.c "----------------------------------------------------------------------------\n" ""
                        $exec_win.c yview -pickplace insert
                }

                global editor
                if {$chireloadflag} {
                        if {[cequal $editor "xtex"]} { ReLoadFile }
                }

                set childpid 0
        }
}


proc    childIO {reqchipid} {

#*** This process runs in background during execution of a unix command
#*** It calls childstat which updates the exec window and restarts itself
#*** after a delay of 200ms

        global childpid

        if {[childstat]==1 && $reqchipid==$childpid} {
                after 200 childIO $reqchipid
        }
}