example

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