X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?p=chiark-tcl-applet.git;a=blobdiff_plain;f=applet.tcl;h=04d5813bebc6042d481fb2b3941333a0e766119a;hp=e660bce7acbba766981b75cf9a68ab5052ee2c6c;hb=3b3dad48b2bd8f43a76cf3633e0bf2ca6e6ef14d;hpb=e83279661ca71a95d236df97655761f6d77b4fd8 diff --git a/applet.tcl b/applet.tcl index e660bce..04d5813 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,32 +47,37 @@ package require tktray # applet::setimage IMAGE # as necessary. # -# Inner window 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. 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. # -# Caller that needs access to inner window should define +# Alternatively, +# to run (repeatedly +# if necessary) a subprocess. +# # proc innerwindow {} { ... } # and run # innerwindow # 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 { @@ -174,33 +190,37 @@ proc setimage {image} { .i configure -image $image } -} +#----- subwindow ----- +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 innerwindow-resetup] + set innerwindow_after [after idle applet::innerwindow-resetup] } proc innerwindow-resetup {} { variable innerwindow_after + variable subwindow_on_destroying + variable subwindow_on_ready unset innerwindow_after puts RESETUP - innerwindow-destroying - catch { destroy .i.i.c } if {![winfo exists .i.i]} return destroy [frame .i.i.make-exist] + + uplevel #0 $subwindow_on_destroying catch { destroy .i.i.b.c } + catch { destroy .i.i.b } + frame .i.i.b pack .i.i.b -fill both -side left -expand 1 - frame .i.i.b.c -container 1 -background orange - pack .i.i.b.c -fill both -side left -expand 1 # global inner_lastw inner_lasth #set w [winfo width .i.i] @@ -211,19 +231,110 @@ puts RESETUP # set inner_lastw $w # set inner_lasth $h # innerwindow-ph-dummy configure -width $w -height 2 - innerwindow-ready + + uplevel #0 $subwindow_on_ready # } } -proc setupinnerwindow {w} { +proc setup-subwindow {w on_destroying on_ready} { + foreach v {destroying ready} { + variable subwindow_on_$v [set on_$v] + } + global inner_lastw inner_lasth set inner_lastw -2 set inner_lasth -2 - image create photo innerwindow-ph-dummy -width $w -height 2 - .i configure -image innerwindow-ph-dummy + image create photo applet::innerwindow-ph-dummy -width $w -height 2 + .i configure -image applet::innerwindow-ph-dummy destroy [frame .i.make-exist] destroy [frame .i.i.make-exist] - bind .i <> { innerwindow-resetup-required IconConfigure } + bind .i <> { + 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" + + frame .i.i.b.c -container 1 -background orange + pack .i.i.b.c -fill both -side left -expand 1 + + 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 + } + } +} + }