#!/usr/bin/wish8.4 -f # -*- Tcl -*- source applet.tcl source subproc.tcl #----- menu ----- foreach b {1 3} { applet::setup-button-menu $b } .m1 add command -command { applet::msel; puts hi } -label hi .m3 add command -command { applet::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 { 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 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 [subproc::fork 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