chiark / gitweb /
reorg widgets wip
[chiark-tcl-applet.git] / applet.tcl
index e660bce..04d5813 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,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 <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 {
 
@@ -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 <<IconConfigure>> { innerwindow-resetup-required IconConfigure }
+    bind .i <<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"
+
+    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
+       }
+    }
+}
+
 }