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=8c5e0c921bda0c32f673221aafa18f64aa1de37b;hb=4af7e789e3afd4b9a7afb81a6cde31c37386e5c4;hpb=a94a9976cce1ff47d1ab38fcccc3099bab8e49d6 diff --git a/example b/example index 8c5e0c9..bd05b17 100755 --- a/example +++ b/example @@ -1,16 +1,20 @@ #!/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 } -.m1 add command -command { msel; puts hi } -label hi -.m3 add command -command { msel; puts boo } -label boo +.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 @@ -20,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 [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" - } - } +proc cmdline {id orientation} { + global argv + return [concat $argv $id] } -setupinnerwindow 40 +applet::setup-subproc cmdline