X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?a=blobdiff_plain;ds=sidebyside;f=example;h=8c5e0c921bda0c32f673221aafa18f64aa1de37b;hb=a94a9976cce1ff47d1ab38fcccc3099bab8e49d6;hp=4a6a16a2e886bbacfb88d9d6096f6383a97e1d27;hpb=4a30ace4afa266ebcda72e88c96c611ad33feaae;p=chiark-tcl-applet.git diff --git a/example b/example index 4a6a16a..8c5e0c9 100755 --- a/example +++ b/example @@ -3,26 +3,90 @@ source applet.tcl -#----- specifics ----- +#----- menu ----- + +foreach b {1 3} { + applet::setup-button-menu $b +} .m1 add command -command { msel; puts hi } -label hi .m3 add command -command { msel; puts boo } -label boo -image create bitmap ims -file gs_s.xbm +#image create bitmap ims -file gs_s.xbm #image create bitmap ims -file /usr/share/ghostscript/8.71/lib/gs_s.xbm #setimage ims #setimage ims -setuptooltip -settooltip "line\nanother" +applet::setup-tooltip { puts VIS } { puts INVIS } +applet::tooltip-set "line\nanother" + +fconfigure stdout -buffering line + +set status none + +proc innerwindow-destroying {} { + global status + puts "DESTROYING $status" + switch -exact $status { + none { } + old { } + default { kill $status; set status old } + } +} + +proc innerwindow-ready {} { + global status + puts "READY $status" + switch -exact $status { + none { + run-child + } + old { + # wait for it to die + } + default { + error "unexpected state $status" + } + } + puts "READY-done $status" +} + +set ratelimit 0 -proc innerwindow {id} { - puts IICONFIG - puts "IC $id" +proc run-child {} { + global status ratelimit + + puts "RUN-CHILD $status" + set now [clock seconds] + lappend ratelimit $now + while {[lindex $ratelimit 0] < {$now - 10}} { + set ratelimit [lrange $ratelimit 1 end] + } + if {[llength $ratelimit] > 10} { + puts stderr "crashing repeatedly, quitting $ratelimit" + exit 127 + } + + set status none + set status [fork-then child-died { + execl xacpi-simple [list -into [winfo id .i.i.b.c]] + }] + puts "FORKED $status" +} - .i.i.b configure -background darkblue -bd 1 -exec /home/ian/things/Chiark-utils/chiark-utils.git/cprogs/xacpi-simple \ - -into $id & +proc child-died {how how2} { + puts "DIED $how $how2" + global status + switch -exact $status { + old { + set status none + run-child + } + default { + set status none + innerwindow-resetup-required "child died" + } + } } setupinnerwindow 40