From: Ian Jackson <ijackson@chiark.greenend.org.uk>
Date: Sat, 9 Jun 2012 17:10:09 +0000 (+0100)
Subject: wip
X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?p=chiark-tcl-applet.git;a=commitdiff_plain;h=4a30ace4afa266ebcda72e88c96c611ad33feaae

wip
---

diff --git a/applet.tcl b/applet.tcl
index 5c6ad29..1a75f14 100644
--- a/applet.tcl
+++ b/applet.tcl
@@ -1,6 +1,27 @@
 
 #----- general machinery -----
 
+# Interface:
+#
+#  tk::tktray widget is called .i
+#
+# Inner window:
+#  Caller that needs access to inner window should define
+#     proc innerwindow {} { ... }
+#  and run
+#     innerwindow
+#  This will create
+#     .i.i.b      frame to contain container
+#     .i.i.b.c    actual container
+# 
+#  Button presses
+#    Caller should provide
+#       proc pressed {b x y} { ... }
+#    which should examine b and do something appropriate.
+#    
+
+
+
 package require tktray
 #load /home/ian/things/Systray/tktray-1.3.8/libtktray1.3.8.so
 
@@ -16,7 +37,7 @@ foreach b {1 3} {
     menu .m$b -tearoff 0
 }
 
-proc pressed {b x y} {
+proc menubuttonpressed {b x y} {
     global posted
     tooltip_cancel
     if {$posted == $b} {
@@ -39,27 +60,54 @@ proc msel {} {
     set posted 0
 }
 
-proc setupinnerwindow {} {
-    global innerwindow_after innerwindow
-    catch { after cancel $innerwindow_after }
-    catch { unset innerwindow_after }
-    if {[info exists innerwindow]} return
-    set children {}
-    foreach child [winfo children .i] {
-	if {![winfo exists $child]} continue
-	lappend children $child
-    }
-    if {[llength $children]==1} {
-	set innerwindow [lindex $children 0]
-	bind $innerwindow <Destroy> {
-	    innerwindow-unavailable
-	    catch { unset innerwindow }
-	    after idle setupinnerwindow
-	}
-	innerwindow-available
-    } else {
-	after 5000 setupinnerwindow
-    }
+proc innerwindow-event {why} {
+    global innerwindow_after
+puts "IW-EVENT $why"
+    if {[info exists innerwindow_after]} return
+    set innerwindow_after [after idle innerwindow-resetup]
+}
+
+proc innerwindow-resetup {} {
+    global innerwindow_after
+    unset innerwindow_after
+
+puts RESETUP
+
+    catch { destroy .i.i.c }
+    if {![winfo exists .i.i]} return
+    destroy [frame .i.i.make-exist]
+    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
+    bind .i.i <ButtonPress> { pressed %b %X %Y }
+#
+    global inner_lastw inner_lasth
+    #set w [winfo width .i.i]
+#    set w [winfo width .i.i]
+#    set h [winfo height .i.i]
+
+#    if {$w != $inner_lastw || $h != $inner_lasth} {
+#	set inner_lastw $w
+#	set inner_lasth $h
+#	innerwindow-ph-dummy configure -width $w -height 2
+	innerwindow [winfo id .i.i.b.c]
+#    }
+}
+
+proc setupinnerwindow {w} {
+    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
+
+    destroy [frame .i.make-exist]
+    destroy [frame .i.i.make-exist]
+    bind .i <<IconConfigure>> { innerwindow-event "%w" }
 }
 
 bind .i <ButtonPress> { pressed %b %X %Y }
diff --git a/example b/example
index bdb3955..4a6a16a 100755
--- a/example
+++ b/example
@@ -11,88 +11,18 @@ source applet.tcl
 image create bitmap ims -file gs_s.xbm   
 #image create bitmap ims -file /usr/share/ghostscript/8.71/lib/gs_s.xbm   
 #setimage ims
-
-image create photo ph-dummy ;# -width 40 -height 23
-.i configure -image ph-dummy
 #setimage ims
 
 setuptooltip
 settooltip "line\nanother"
 
-destroy [frame .i.make-exist]
-destroy [frame .i.i.make-exist]
-
-proc innerwindow {} {
-    puts "INNER"
-    catch { destroy .i.i.c }
-    if {![winfo exists .i.i]} return
-    destroy [frame .i.i.make-exist]
-#    if {[catch {
-#	.i.i configure -width [winfo width .i.i] -height [winfo height .i.i]
-#    } emsg]} {
-#	puts stderr $emsg...
-#	return
-#    }
-    frame .i.i.b -background darkblue -bd 1
-    pack .i.i.b -fill both -side left -expand 1
-    frame .i.i.b.c -container 1 -background orange ;# -width 35 -height 15
-    pack .i.i.b.c -fill both -side left -expand 1
-    puts "ID [winfo id .i.i.b.c]"
-#    bind .i.i.b.c <Configure> iiconfigure
-iiconfigure
-}
-
-proc iiconfigure {} {
+proc innerwindow {id} {
     puts IICONFIG
-    puts "IC [winfo id .i.i]"
-    set w [winfo width .i.i]
-    set h [winfo height .i.i]
-    puts "W $w H $h"
-set w 40
-    ph-dummy configure -width $w -height 2 ;#$h
-#    if {![string length [info command .i.i]]} {
-#	puts NO
-#	return
-#    }
-#    .i.i.b.c configure -width $w -height $h -background blue
+    puts "IC $id"
 
+    .i.i.b configure -background darkblue -bd 1
 exec /home/ian/things/Chiark-utils/chiark-utils.git/cprogs/xacpi-simple \
-	-into [winfo id .i.i.b.c] &
+	-into $id &
 }
 
-##bind all <<IconCreate>> { puts sponge }
-##bind all <<Sping>> { puts sping%W }
-
-#bind .i <<IconConfigure>> innerwindow
-innerwindow
-
-#foreach w {. .i .i.i} {
-    bind all <<IconCreate>> { puts "create %W" }
-    bind all <<IconConfigure>> { puts "config %W" }
-#}
-
-puts gening
-
-#foreach ev {MapRequest ResizeRequest ConfigureRequest Create  Gravity
-# Reparent Circulate
-#Configure Visibility
-#} {
-#	bind .i <$ev> { puts "$ev => [winfo children .i]" }
-#}
-
-#proc report {} {
-#	after 1000 report
-#	puts "children: [winfo children .i]"
-#}
-
-#report
-
-#after idle {
-#      winfo children .i
-#      frame .i.inner.c -container 1 -background yellow
-#      pack .i.inner.c
-
-#      after idle {
-#      	    puts [winfo id .i.c]
-#    }
-#}
+setupinnerwindow 40