X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?p=chiark-tcl-applet.git;a=blobdiff_plain;f=example;h=bd05b1787c97e1eac55a04fbd26b9e3586f40613;hp=588f3cade9975d1b6061d804a25e57348408eaf7;hb=a145c2fb3db811efb0167b468d5a0026ba6716b8;hpb=3d991e2f5239084df480b19ad9566a5abbe4b621 diff --git a/example b/example index 588f3ca..bd05b17 100755 --- a/example +++ b/example @@ -1,10 +1,13 @@ #!/usr/bin/wish8.4 -f # -*- Tcl -*- +# usage: +# xbatmon-simple-tray + source applet.tcl source subproc.tcl -#----- menu ----- +applet::setup-debug puts foreach b {1 3} { applet::setup-button-menu $b @@ -21,73 +24,9 @@ foreach b {1 3} { 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" - } - } +proc cmdline {id orientation} { + global argv + return [concat $argv $id] } -setupinnerwindow 40 +applet::setup-subproc cmdline