From 8bb8186db142691bfb06753a00f2fb0ddc199e29 Mon Sep 17 00:00:00 2001 From: Ian Jackson Date: Sat, 9 Jun 2012 21:03:06 +0100 Subject: [PATCH] wip subproc --- applet.tcl | 123 +++++++++++++++++++++++++++++++++++++++++++++-------- example | 71 ++----------------------------- 2 files changed, 108 insertions(+), 86 deletions(-) diff --git a/applet.tcl b/applet.tcl index 4cf6e11..e225f8d 100644 --- a/applet.tcl +++ b/applet.tcl @@ -29,6 +29,17 @@ package require tktray # Caller should call # applet::tooltip-set TEXT-MAYBE-MULTILINE # whenever they like. +# +# Button presses +# +# Caller may bind .i.i +# +# Alternatively caller may call applet::setup-button-menu $b +# which will generate a menu .m$b which the user can configure +# and which will automatically be posted and unposted etc. +# In this case the caller should arrange that all of their +# menus, when an item is selected, call +# applet::msel # # Icon: # @@ -36,15 +47,22 @@ package require tktray # applet::setimage IMAGE # as necessary. # -# Alternatively, instead of icon, it may arrange to run (repeatedly -# if necessary) a subprocess. +# Alternatively, instead of icon, it may make other arrangements +# to use the provided subwindow # # Caller that needs access to inner window should call # applet::setup-subwindow WIDTH ON-DESTROYING ON-READY # Then the main code will call ON-DESTROYING just before # destroying the inner window and recreating it, and ON-READY -# just after. Afterwards, theh inner window is called -# . +# just after. In ON-READY the inner window is called .i.i. +# +# The user of the subwindow machinery may call +# applet::subwindow-need-recreate +# if for any reason the inner window should be destroyed and recreated. +# +# Alternatively, +# to run (repeatedly +# if necessary) a subprocess. # # proc innerwindow {} { ... } # and run @@ -52,23 +70,14 @@ package require tktray # This will create # .i.i.b frame to contain container # .i.i.b.c actual container -# -# Button presses -# -# Caller may bind .i.i -# -# Alternatively caller may call applet::setup-button-menu $b -# which will generate a menu .m$b which the user can configure -# and which will automatically be posted and unposted etc. -# In this case the caller should arrange that all of their -# menus, when an item is selected, call -# applet::msel wm withdraw . tktray::icon .i -class example .i configure -docked 1 +fconfigure stdout -buffering line + namespace eval applet { @@ -186,9 +195,9 @@ proc setimage {image} { variable subwindow_on_destroying variable subwindow_on_ready -proc innerwindow-resetup-required {why} { +proc subwindow-need-recreate {} { variable innerwindow_after -puts "IW-EVENT $why" +puts "IW-EVENT" if {[info exists innerwindow_after]} return set innerwindow_after [after idle applet::innerwindow-resetup] } @@ -242,7 +251,85 @@ proc setup-subwindow {w on_destroying on_ready} { destroy [frame .i.make-exist] destroy [frame .i.i.make-exist] bind .i <> { - applet::innerwindow-resetup-required IconConfigure + applet::subwindow-need-recreate + } +} + +#----- subprocess ----- + +variable subproc none +variable ratelimit {} + +proc setup-subproc {w get_cmdline} { + variable subproc_get_cmdline $get_cmdline + setup-subwindow $w applet::subproc-destroying applet::subproc-ready +} + +proc subproc-destroying {} { + variable subproc + puts "DESTROYING $subproc" + switch -exact $subproc { + none { } + old { } + default { kill $subproc; set subproc old } + } +} + +proc subproc-ready {} { + variable subproc + puts "READY $subproc" + switch -exact $subproc { + none { + run-child + } + old { + # wait for it to die + } + default { + error "unexpected state $subproc" + } + } + puts "READY-done $subproc" +} + +proc run-child {} { + variable subproc + variable ratelimit + variable subproc_get_cmdline + + set id [winfo id .i.i.b.c] + set cmd [uplevel #0 [concat [list $subproc_get_cmdline] $id]] + + puts "RUN-CHILD $subproc" + 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 subproc none + set subproc [subproc::fork applet::child-died { + execl [lindex $cmd 0] [lrange $cmd 1 end] + }] + puts "FORKED $subproc" +} + +proc child-died {how how2} { + puts "DIED $how $how2" + variable subproc + switch -exact $subproc { + old { + set subproc none + run-child + } + default { + set subproc none + subwindow-need-recreate + } } } diff --git a/example b/example index b1a9c86..b9f1c64 100755 --- a/example +++ b/example @@ -21,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 destroying {} { - global status - puts "DESTROYING $status" - switch -exact $status { - none { } - old { } - default { kill $status; set status old } - } -} - -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" -} - -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" -} - -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} { + return [list xacpi-simple -into $id] } -applet::setup-subwindow 40 destroying ready +applet::setup-subproc 40 cmdline -- 2.30.2