From 1c191f202bc6f8d0e800d055d9421976378fc1a7 Mon Sep 17 00:00:00 2001 From: Ian Jackson Date: Fri, 8 Jun 2012 02:00:12 +0100 Subject: [PATCH] after hacking got it to work, needs tidying up. --- applet.tcl | 25 +++++++++++++++ example | 90 ++++++++++++++++++++++++++++++++++++++++++++++++++++-- huh | 32 +++++++++++++++++++ 3 files changed, 144 insertions(+), 3 deletions(-) create mode 100755 huh diff --git a/applet.tcl b/applet.tcl index 0b0fcf6..5c6ad29 100644 --- a/applet.tcl +++ b/applet.tcl @@ -2,6 +2,8 @@ #----- general machinery ----- package require tktray +#load /home/ian/things/Systray/tktray-1.3.8/libtktray1.3.8.so + wm withdraw . @@ -37,6 +39,29 @@ 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 { + innerwindow-unavailable + catch { unset innerwindow } + after idle setupinnerwindow + } + innerwindow-available + } else { + after 5000 setupinnerwindow + } +} + bind .i { pressed %b %X %Y } proc tooltip_starttimer {state x y} { diff --git a/example b/example index 57e8708..bdb3955 100755 --- a/example +++ b/example @@ -1,4 +1,5 @@ -#!/usr/bin/wish8.4 +#!/usr/bin/wish8.4 -f +# -*- Tcl -*- source applet.tcl @@ -7,8 +8,91 @@ source applet.tcl .m1 add command -command { msel; puts hi } -label hi .m3 add command -command { msel; puts boo } -label boo -image create bitmap ims -file /usr/share/ghostscript/8.71/lib/gs_s.xbm -setimage ims +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 iiconfigure +iiconfigure +} + +proc iiconfigure {} { + 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 + +exec /home/ian/things/Chiark-utils/chiark-utils.git/cprogs/xacpi-simple \ + -into [winfo id .i.i.b.c] & +} + +##bind all <> { puts sponge } +##bind all <> { puts sping%W } + +#bind .i <> innerwindow +innerwindow + +#foreach w {. .i .i.i} { + bind all <> { puts "create %W" } + bind all <> { 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] +# } +#} diff --git a/huh b/huh new file mode 100755 index 0000000..0a035b8 --- /dev/null +++ b/huh @@ -0,0 +1,32 @@ +#!/usr/bin/wish8.4 -f +# -*- Tcl -*- + +destroy [label .make-exist] + +event add <> +bind all <> { puts "y %T %W" } +puts q1: +bind all +puts q2: +bind all <> +event generate . <> -when tail + +#frame .i + +#bind all <> { puts sponge } +#bind all <> { puts sping%W } + +# bind all <> { puts <<%W } +# bind all <> { puts > +#event generate . <> + +#frame .foo +#pack .foo + +#event generate .foo <> + +puts end -- 2.30.2