chiark / gitweb /
wip subproc
authorIan Jackson <ijackson@chiark.greenend.org.uk>
Sat, 9 Jun 2012 20:03:06 +0000 (21:03 +0100)
committerIan Jackson <ijackson@chiark.greenend.org.uk>
Sat, 9 Jun 2012 20:03:06 +0000 (21:03 +0100)
applet.tcl
example

index 4cf6e11..e225f8d 100644 (file)
@@ -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
+       }
     }
 }
 
diff --git a/example b/example
index b1a9c86..b9f1c64 100755 (executable)
--- 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