example

   1 #!/usr/bin/wish8.4 -f
   2 # -*- Tcl -*-
   3
   4 source applet.tcl
   5
   6 #----- menu -----
   7
   8 foreach b {1 3} {
   9     applet::setup-button-menu $b
  10 }
  11
  12 .m1 add command -command { msel; puts hi } -label hi
  13 .m3 add command -command { msel; puts boo } -label boo
  14
  15 #image create bitmap ims -file gs_s.xbm
  16 #image create bitmap ims -file /usr/share/ghostscript/8.71/lib/gs_s.xbm
  17 #setimage ims
  18 #setimage ims
  19
  20 applet::setup-tooltip { puts VIS } { puts INVIS }
  21 applet::tooltip-set "line\nanother"
  22
  23 fconfigure stdout -buffering line
  24
  25 set status none
  26
  27 proc innerwindow-destroying {} {
  28     global status
  29     puts "DESTROYING $status"
  30     switch -exact $status {
  31         none { }
  32         old { }
  33         default { kill $status; set status old }
  34     }
  35 }
  36
  37 proc innerwindow-ready {} {
  38     global status
  39     puts "READY $status"
  40     switch -exact $status {
  41         none {
  42             run-child
  43         }
  44         old {
  45             # wait for it to die
  46         }
  47         default {
  48             error "unexpected state $status"
  49         }
  50     }
  51     puts "READY-done $status"
  52 }
  53
  54 set ratelimit 0
  55
  56 proc run-child {} {
  57     global status ratelimit
  58
  59     puts "RUN-CHILD $status"
  60     set now [clock seconds]
  61     lappend ratelimit $now
  62     while {[lindex $ratelimit 0] < {$now - 10}} {
  63         set ratelimit [lrange $ratelimit 1 end]
  64     }
  65     if {[llength $ratelimit] > 10} {
  66         puts stderr "crashing repeatedly, quitting $ratelimit"
  67         exit 127
  68     }
  69
  70     set status none
  71     set status [fork-then child-died {
  72         execl xacpi-simple [list -into [winfo id .i.i.b.c]]
  73     }]
  74     puts "FORKED $status"
  75 }
  76
  77 proc child-died {how how2} {
  78     puts "DIED $how $how2"
  79     global status
  80     switch -exact $status {
  81         old {
  82             set status none
  83             run-child
  84         }
  85         default {
  86             set status none
  87             innerwindow-resetup-required "child died"
  88         }
  89     }
  90 }
  91
  92 setupinnerwindow 40