# -*- Tcl -*-
source applet.tcl
+source subproc.tcl
-#----- specifics -----
+#----- menu -----
-.m1 add command -command { msel; puts hi } -label hi
-.m3 add command -command { msel; puts boo } -label boo
+foreach b {1 3} {
+ applet::setup-button-menu $b
+}
+
+.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
-
-image create photo ph-dummy ;# -width 40 -height 23
-.i configure -image ph-dummy
#setimage ims
-setuptooltip
-settooltip "line\nanother"
-
-destroy [frame .i.make-exist]
-destroy [frame .i.i.make-exist]
-
-proc innerwindow {} {
- puts "INNER"
- catch { destroy .i.i.c }
- if {![winfo exists .i.i]} return
- destroy [frame .i.i.make-exist]
-# if {[catch {
-# .i.i configure -width [winfo width .i.i] -height [winfo height .i.i]
-# } emsg]} {
-# puts stderr $emsg...
-# return
-# }
- frame .i.i.b -background darkblue -bd 1
- pack .i.i.b -fill both -side left -expand 1
- frame .i.i.b.c -container 1 -background orange ;# -width 35 -height 15
- pack .i.i.b.c -fill both -side left -expand 1
- puts "ID [winfo id .i.i.b.c]"
-# bind .i.i.b.c <Configure> iiconfigure
-iiconfigure
-}
-
-proc iiconfigure {} {
- puts IICONFIG
- puts "IC [winfo id .i.i]"
- set w [winfo width .i.i]
- set h [winfo height .i.i]
- puts "W $w H $h"
-set w 40
- ph-dummy configure -width $w -height 2 ;#$h
-# if {![string length [info command .i.i]]} {
-# puts NO
-# return
-# }
-# .i.i.b.c configure -width $w -height $h -background blue
-
-exec /home/ian/things/Chiark-utils/chiark-utils.git/cprogs/xacpi-simple \
- -into [winfo id .i.i.b.c] &
-}
-
-##bind all <<IconCreate>> { puts sponge }
-##bind all <<Sping>> { puts sping%W }
-
-#bind .i <<IconConfigure>> innerwindow
-innerwindow
+applet::setup-tooltip { puts VIS } { puts INVIS }
+applet::tooltip-set "line\nanother"
-#foreach w {. .i .i.i} {
- bind all <<IconCreate>> { puts "create %W" }
- bind all <<IconConfigure>> { puts "config %W" }
-#}
+fconfigure stdout -buffering line
-puts gening
+set status none
-#foreach ev {MapRequest ResizeRequest ConfigureRequest Create Gravity
-# Reparent Circulate
-#Configure Visibility
-#} {
-# bind .i <$ev> { puts "$ev => [winfo children .i]" }
-#}
+proc destroying {} {
+ global status
+ puts "DESTROYING $status"
+ switch -exact $status {
+ none { }
+ old { }
+ default { kill $status; set status old }
+ }
+}
-#proc report {} {
-# after 1000 report
-# puts "children: [winfo children .i]"
-#}
+proc 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"
+}
-#report
+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 [subproc::fork child-died {
+ execl xacpi-simple [list -into [winfo id .i.i.b.c]]
+ }]
+ puts "FORKED $status"
+}
-#after idle {
-# winfo children .i
-# frame .i.inner.c -container 1 -background yellow
-# pack .i.inner.c
+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"
+ }
+ }
+}
-# after idle {
-# puts [winfo id .i.c]
-# }
-#}
+applet::setup-subwindow 40 destroying ready