summaryrefslogtreecommitdiff
path: root/support/xtexshell/exec.tcl
blob: d799467816cd2e3a63e55f26d4f16569b8b9fe0f (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
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
        }
}