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
|
# ts_exec.tcl
proc ExecCmd {cmd} {
global params gparams
if {$params(pid) > 0} {
Warning $params(dlg_geom) \
"Foreground process is still running.\nWait or kill it."
return
}
if {!$gparams(showout)} {
catch {grid forget .term}
grid .term -row 2 -column 0 -sticky ew
}
set params(pipe) [open "|/bin/sh -c \"$cmd\" 2>@stdout" r+]
debug "Pipe: $params(pipe)"
set params(pid) [pid $params(pipe)]
lappend params(processlist) [list $params(pid) $cmd]
fconfigure $params(pipe) -buffering none -blocking 0
fileevent $params(pipe) readable "CmdOut"
}
proc ExecBg {cmd} {
global params
set pipe [open "|/bin/sh -c \"$cmd\" 2>@stdout" r]
set pid [pid $pipe]
lappend params(processlist) [list $pid $cmd]
fconfigure $pipe -buffering none -blocking 0
fileevent $pipe readable "BgOut $pipe $pid"
}
proc ExecTerm {cmd} {
global params
eval exec xterm -geometry $params(dlg_geom) -e $cmd
}
proc ExecTermBg {cmd} {
global params
eval exec xterm -geometry $params(dlg_geom) -e $cmd &
}
proc CmdOut {} {
global params gparams sigchld
set r1 [catch {eof $params(pipe)} res]
if {$r1 || $res} {
debug "End of $params(pipe)"
catch {close $params(pipe)} err
set sigchld 1
debug "Close pipe: $err"
set i [lsearch $params(processlist) "$params(pid) *"]
if {$i >= 0} {
set params(processlist) [lreplace $params(processlist) $i $i]
}
set params(pid) -1
if {!$gparams(showout)} {
grid forget .term
}
return
}
set line [read $params(pipe)]
.term insert end $line
.term mark set insert end
.term see end
}
proc BgOut {pipe pid} {
global params
if [eof $pipe] {
debug "End of $pid $pipe"
catch {close $pipe} err
set i [lsearch $params(processlist) "$pid *"]
if {$i >= 0} {
set params(processlist) [lreplace $params(processlist) $i $i]
}
debug $err
return
}
set line [read $pipe]
.term insert end $line
.term mark set insert end
.term see end
}
proc Out {w line} {
$w insert end $line\n
$w mark set insert end
$w see end
}
proc CreateTerm {} {
global termline params
set termline ""
bind .term <Return> {
catch {
puts $params(pipe) $termline
}
set termline ""
}
bind .term <Control-Any-d> {
catch {
flush $params(pipe)
close $params(pipe)
}
CmdOut
}
# bind .term <Control-Any-Key> {
# puts ":%A:[format %d %A]:%k:%K"
# catch {
# puts -nonewline $params(pipe) $termline
# set termline ""
# puts -nonewline $params(pipe) %A
# flush $params(pipe)
# }
# }
bind .term <BackSpace> {
set termline [string range $termline 0 \
[expr [string length $termline]-2]]
}
bind .term <Any-Key> {
append termline %A
}
}
proc Kill {} {
global params
set procs {}
foreach l $params(processlist) {
lappend procs [format "%5d %s" [lindex $l 0] [lindex $l 1]]
}
if {[set i [ListDlg .ldlg $params(dlg_geom) "Kill Process:" $procs]] \
>= 0} {
set pid [lindex [lindex $params(processlist) $i] 0]
catch {exec kill $pid} err
OutMsg "Process $pid killed: $err"
set params(processlist) [lreplace $params(processlist) $i $i]
set params(pid) 0
}
}
|
