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
|
#!../src/bltwish
package require BLT
source scripts/demo.tcl
source scripts/globe.tcl
option add *HighlightThickness 0
set program wish
set command [list $program scripts/bgtest.tcl]
array set animate {
index -1
interval 200
colors "#ff8813 #ffaa13 #ffcc13 #ffff13 #ffcc13 #ffaa13 #ff8813"
numBitmaps 30
prefix globe
}
proc Animate {} {
global animate
if { [info commands .logo] != ".logo" } {
set animate(index) 0
return
}
if { $animate(index) >= 0 } {
.logo configure -bitmap $animate(prefix).$animate(index)
incr animate(index)
if { $animate(index) >= $animate(numBitmaps) } {
set animate(index) 0
}
after $animate(interval) Animate
}
}
proc InsertText { string tag } {
.text insert end "$tag: " "" $string $tag
set textlen [expr int([.text index end])]
scan [.vscroll get] "%s %s %s %s" total window first last
if { $textlen > $total } {
.text yview [expr $textlen-$window]
}
update idletasks
}
proc DisplayOutput { name1 name2 how } {
upvar #0 $name1 arr
InsertText "$arr($name2)\n" stdout
set arr($name2) {}
}
proc DisplayErrors { name1 name2 how } {
upvar #0 $name1 arr
InsertText "$arr($name2)\n" stderr
set arr($name2) {}
}
option add *text.yScrollCommand { .vscroll set }
option add *text.relief sunken
option add *text.width 20
option add *text.height 10
option add *text.height 10
option add *text.borderWidth 2
option add *vscroll.command { .text yview }
option add *vscroll.minSlider 4p
option add *stop.command { set results {} }
option add *stop.text { stop }
option add *logo.padX 4
option add *title.text "Catching stdout and stderr"
option add *title.font -*-Helvetica-Bold-R-*-*-14-*-*-*-*-*-*-*
set visual [winfo screenvisual .]
if { [string match *color $visual] } {
option add *text.background white
option add *text.foreground blue
option add *stop.background yellow
option add *stop.activeBackground yellow2
option add *stop.foreground navyblue
option add *start.activeBackground green2
option add *start.background green
option add *start.foreground navyblue
option add *logo.background beige
option add *logo.foreground brown
option add *logo.foreground green4
option add *title.background lightblue
option add *logo.background lightblue
}
. configure -bg lightblue
trace variable results(stdout) w DisplayOutput
trace variable results(stderr) w DisplayErrors
proc Start { command } {
global results animate
.text delete 1.0 end
if { $animate(index) < 0 } {
set results(status) {}
eval "blt::bgexec results(status) -lasterror results(stderr) \
-lastoutput results(stdout) $command &"
set animate(index) 0
Animate
}
}
proc Stop { } {
global results animate
set results(status) {}
set animate(index) -1
}
# Create widgets
text .text
.text tag configure stdout -font -*-Helvetica-Bold-R-*-*-18-*-*-*-*-*-*-* \
-foreground green2
.text tag configure stderr -font -*-Helvetica-Medium-O-*-*-18-*-*-*-*-*-*-* \
-foreground red2
scrollbar .vscroll
button .start -text "Start" -command [list Start $command]
button .stop -text "Stop" -command Stop
label .logo -bitmap globe.0
label .title
# Layout widgets in table
blt::table . \
.title 0,0 -columnspan 4 \
.text 1,0 -columnspan 3 \
.vscroll 1,3 -fill y \
.logo 2,0 -anchor w -padx 10 -reqheight .6i -pady 4 \
.start 2,1 \
.stop 2,2
set buttonWidth 1i
blt::table configure . c1 c2 -width 1i
blt::table configure . c3 r0 r2 -resize none
blt::table configure . .start .stop -reqwidth $buttonWidth -anchor e
blt::table configure . .title .text -fill both
wm min . 0 0
|
