#******************************************************************************
#***
#*** 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
       }
}

You are viewing proxied material from ftp.icm.edu.pl. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.