X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?p=chiark-tcl-applet.git;a=blobdiff_plain;f=applet.tcl;h=e225f8d5d842d0ecaaa3018f3e88c265c709b934;hp=4cf6e119545be2ea6783199e7316e6e2eebd6ee5;hb=8bb8186db142691bfb06753a00f2fb0ddc199e29;hpb=dab74bc8b4245e9808a256d4c0e38b9c055078e4

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 <ButtonPress-$b>
+#
+#    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 <ButtonPress-$b>
-#
-#    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 <<IconConfigure>> { 
-	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
+	}
     }
 }