1#!/usr/local/bin/bltwish 2 3package require BLT 4# -------------------------------------------------------------------------- 5# Starting with Tcl 8.x, the BLT commands are stored in their own 6# namespace called "blt". The idea is to prevent name clashes with 7# Tcl commands and variables from other packages, such as a "table" 8# command in two different packages. 9# 10# You can access the BLT commands in a couple of ways. You can prefix 11# all the BLT commands with the namespace qualifier "blt::" 12# 13# blt::graph .g 14# blt::table . .g -resize both 15# 16# or you can import all the command into the global namespace. 17# 18# namespace import blt::* 19# graph .g 20# table . .g -resize both 21# 22# -------------------------------------------------------------------------- 23 24if { $tcl_version >= 8.0 } { 25 namespace import blt::* 26 namespace import -force blt::tile::* 27} 28 29source scripts/demo.tcl 30source scripts/globe.tcl 31 32option add *HighlightThickness 0 33 34set program [info nameofexecutable] 35if { [info exists tcl_platform ] } { 36 puts stderr $tcl_platform(platform) 37 if { $tcl_platform(platform) == "windows" } { 38 set shells [glob C:/Program\ Files/Tcl/bin/tclsh8*.exe ] 39 set program [lindex $shells 0] 40 } 41} 42if { ![file executable $program] } { 43 error "Can't execute $program" 44} 45 46set command [list $program scripts/bgtest.tcl] 47 48array set animate { 49 index -1 50 interval 200 51 colors "#ff8813 #ffaa13 #ffcc13 #ffff13 #ffcc13 #ffaa13 #ff8813" 52 numBitmaps 30 53 prefix globe 54} 55 56proc Animate {} { 57 global animate 58 if { [info commands .logo] != ".logo" } { 59 set animate(index) 0 60 return 61 } 62 if { $animate(index) >= 0 } { 63 .logo configure -bitmap $animate(prefix).$animate(index) 64 incr animate(index) 65 if { $animate(index) >= $animate(numBitmaps) } { 66 set animate(index) 0 67 } 68 after $animate(interval) Animate 69 } 70} 71 72proc InsertText { string tag } { 73 .text insert end "$tag: " "" $string $tag 74 set textlen [expr int([.text index end])] 75 scan [.vscroll get] "%s %s %s %s" total window first last 76 if { $textlen > $total } { 77 .text yview [expr $textlen-$window] 78 } 79 update idletasks 80} 81 82proc DisplayOutput { name1 name2 how } { 83 upvar #0 $name1 arr 84 85 InsertText "$arr($name2)\n" stdout 86 set arr($name2) {} 87} 88 89proc DisplayErrors { name1 name2 how } { 90 upvar #0 $name1 arr 91 92 InsertText "$arr($name2)\n" stderr 93 set arr($name2) {} 94} 95 96 97option add *text.yScrollCommand { .vscroll set } 98option add *text.relief sunken 99option add *text.width 20 100option add *text.height 10 101option add *text.height 10 102option add *text.borderWidth 2 103option add *vscroll.command { .text yview } 104option add *vscroll.minSlider 4p 105option add *stop.command { set results {} } 106option add *stop.text { stop } 107option add *logo.padX 4 108option add *title.text "Catching stdout and stderr" 109option add *title.font -*-Helvetica-Bold-R-*-*-14-*-*-*-*-*-*-* 110 111set visual [winfo screenvisual .] 112if { [string match *color $visual] } { 113 option add *text.background white 114 option add *text.foreground blue 115 option add *stop.background yellow 116 option add *stop.activeBackground yellow2 117 option add *stop.foreground navyblue 118 option add *start.activeBackground green2 119 option add *start.background green 120 option add *start.foreground navyblue 121 option add *logo.background beige 122 option add *logo.foreground brown 123 option add *logo.foreground green4 124 option add *title.background lightblue 125 option add *logo.background lightblue 126} 127. configure -bg lightblue 128 129trace variable results(stdout) w DisplayOutput 130trace variable results(stderr) w DisplayErrors 131 132proc Start { command } { 133 global results animate 134 .text delete 1.0 end 135 if { $animate(index) < 0 } { 136 set results(status) {} 137 eval "bgexec results(status) -lasterror results(stderr) \ 138 -lastoutput results(stdout) $command &" 139 set animate(index) 0 140 Animate 141 } 142} 143 144proc Stop { } { 145 global results animate 146 set results(status) {} 147 set animate(index) -1 148} 149 150# Create widgets 151text .text 152.text tag configure stdout -font -*-Helvetica-Bold-R-*-*-18-*-*-*-*-*-*-* \ 153 -foreground green2 154.text tag configure stderr -font -*-Helvetica-Medium-O-*-*-18-*-*-*-*-*-*-* \ 155 -foreground red2 156 157scrollbar .vscroll 158button .start -text "Start" -command [list Start $command] 159button .stop -text "Stop" -command Stop 160label .logo -bitmap globe.0 161label .title 162 163# Layout widgets in table 164table . \ 165 .title 0,0 -columnspan 4 \ 166 .text 1,0 -columnspan 3 \ 167 .vscroll 1,3 -fill y \ 168 .logo 2,0 -anchor w -padx 10 -reqheight .6i -pady 4 \ 169 .start 2,1 \ 170 .stop 2,2 171 172set buttonWidth 1i 173table configure . c1 c2 -width 1i 174table configure . c3 r0 r2 -resize none 175table configure . .start .stop -reqwidth $buttonWidth -anchor e 176table configure . .title .text -fill both 177 178wm min . 0 0 179 180 181