diff options
author | Norbert Preining <norbert@preining.info> | 2019-09-02 13:46:59 +0900 |
---|---|---|
committer | Norbert Preining <norbert@preining.info> | 2019-09-02 13:46:59 +0900 |
commit | e0c6872cf40896c7be36b11dcc744620f10adf1d (patch) | |
tree | 60335e10d2f4354b0674ec22d7b53f0f8abee672 /support/xtexshell/exec.tcl |
Initial commit
Diffstat (limited to 'support/xtexshell/exec.tcl')
-rw-r--r-- | support/xtexshell/exec.tcl | 289 |
1 files changed, 289 insertions, 0 deletions
diff --git a/support/xtexshell/exec.tcl b/support/xtexshell/exec.tcl new file mode 100644 index 0000000000..d799467816 --- /dev/null +++ b/support/xtexshell/exec.tcl @@ -0,0 +1,289 @@ +#****************************************************************************** +#*** +#*** 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 + } +} + + + + |