X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?p=chiark-tcl-applet.git;a=blobdiff_plain;f=example;h=0321c6babae35b53ff2af8b6d7d7a17cdd6e46c2;hp=8c5e0c921bda0c32f673221aafa18f64aa1de37b;hb=3d95f708f3791786019a008fc4b98744aa398e6b;hpb=a94a9976cce1ff47d1ab38fcccc3099bab8e49d6 diff --git a/example b/example index 8c5e0c9..0321c6b 100755 --- a/example +++ b/example @@ -2,15 +2,16 @@ # -*- Tcl -*- 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 +21,8 @@ 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} { + return [list xacpi-simple -into $id] } -setupinnerwindow 40 +applet::setup-subproc 40 40 horizontal darkblue 1 cmdline