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