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=3b45d0bd19e76c23033e9ccb4fa7a89f1258f95d;hb=4af7e789e3afd4b9a7afb81a6cde31c37386e5c4;hpb=7287ebb84338db042f47bc91b7c2f075ab8a94ed diff --git a/example b/example index 3b45d0b..bd05b17 100755 --- a/example +++ b/example @@ -1,88 +1,32 @@ #!/usr/bin/wish8.4 -f # -*- Tcl -*- +# usage: +# xbatmon-simple-tray + source applet.tcl +source subproc.tcl + +applet::setup-debug puts -#----- specifics ----- +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 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" - -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" -} +applet::setup-tooltip { puts VIS } { puts INVIS } +applet::tooltip-set "line\nanother" -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