X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?a=blobdiff_plain;f=example;h=2d07e86d135c6cb5a952452febc8c9f1af4c86e0;hb=refs%2Fheads%2Fmaster;hp=67977a9dbcf132e829219e255447360bbbe91dca;hpb=20901497e27bff2a6ac88c519fd938b61b083f07;p=chiark-tcl-applet.git diff --git a/example b/example deleted file mode 100755 index 67977a9..0000000 --- a/example +++ /dev/null @@ -1,92 +0,0 @@ -#!/usr/bin/wish8.4 -f -# -*- Tcl -*- - -source applet.tcl - -#----- 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 /usr/share/ghostscript/8.71/lib/gs_s.xbm -#setimage ims -#setimage ims - -applet::setup-tooltip -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 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" -} - -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