+# General purpose code for being a tray applet
+
+proc manyset {list args} {
+ foreach val $list var $args {
+ upvar 1 $var my
+ set my $val
+ }
+}
+
+
+package require Tclx
+package require tktray
#----- general machinery -----
#
# tk::tktray widget is called .i
#
-# Inner window:
+# Inner window subprocess:
+#
# Caller that needs access to inner window should define
# proc innerwindow {} { ... }
# and run
# .i.i.b.c actual container
#
# Button presses
-# Caller should provide
-# proc pressed {b x y} { ... }
-# which should examine b and do something appropriate.
-#
-
-proc manyset {list args} {
- foreach val $list var $args {
- upvar 1 $var my
- set my $val
- }
-}
-
-
-package require Tclx
-package require tktray
+#
+# 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.
wm withdraw .
tktray::icon .i -class example
.i configure -docked 1
-set posted 0
-foreach b {1 3} {
+namespace eval applet {
+
+variable posted 0
+
+proc setup-button-menu {b} {
+ bind .i.i <ButtonPress> { applet::menubuttonpressed %b %X %Y }
menu .m$b -tearoff 0
}
proc menubuttonpressed {b x y} {
- global posted
- tooltip_cancel
+ variable posted
+ tooltip-cancel
if {$posted == $b} {
puts "unpost $posted toggle"
.m$posted unpost
}
proc msel {} {
- global posted
+ variable posted
set posted 0
}
+}
+
proc innerwindow-resetup-required {why} {
- global innerwindow_after
+ variable 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
+ variable innerwindow_after
unset innerwindow_after
puts RESETUP
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]
bind .i <<IconConfigure>> { innerwindow-resetup-required IconConfigure }
}
-bind .i <ButtonPress> { pressed %b %X %Y }
+namespace eval applet {
-proc tooltip_starttimer {state x y} {
- global tooltip_after posted tooltip_inwindow
- if {$state || $posted || !$tooltip_inwindow} { tooltip_cancel; return }
+proc tooltip-starttimer {state x y} {
+ variable tooltip_after
+ variable posted
+ variable tooltip_inwindow
+ if {$state || $posted || !$tooltip_inwindow} { tooltip-cancel; return }
catch { after cancel $tooltip_after }
- set tooltip_after [after 500 tooltip_show $x $y]
+ set tooltip_after [after 500 applet::tooltip-show $x $y]
}
-proc tooltip_cancel {} {
- global tooltip_after
+proc tooltip-cancel {} {
+ variable tooltip_after
catch { after cancel $tooltip_after }
catch { unset $tooltip_after }
wm withdraw .tt
set tooltip_inwindow 0
-proc tooltip_enter {state x y} {
- global tooltip_inwindow
+proc tooltip-enter {state x y} {
+ variable tooltip_inwindow
set tooltip_inwindow 1
- tooltip_starttimer $state $x $y
+ tooltip-starttimer $state $x $y
}
-proc tooltip_leave {} {
- global tooltip_inwindow
+proc tooltip-leave {} {
+ variable tooltip_inwindow
set tooltip_inwindow 0
- tooltip_cancel
+ tooltip-cancel
}
-proc setuptooltip {} {
- bind .i <Enter> { tooltip_enter %s %X %Y }
- bind .i <Leave> { tooltip_leave }
- bind .i <ButtonRelease> { tooltip_cancel; tooltip_starttimer %s %X %Y }
- bind .i <Motion> { tooltip_starttimer %s %X %Y }
+proc setup-tooltip {} {
+ bind .i <Enter> { applet::tooltip-enter %s %X %Y }
+ bind .i <Leave> { applet::tooltip-leave }
+ bind .i <ButtonRelease> {
+ applet::tooltip-cancel
+ applet::tooltip-starttimer %s %X %Y
+ }
+ bind .i <Motion> { applet::tooltip-starttimer %s %X %Y }
toplevel .tt -background black
wm withdraw .tt
wm overrideredirect .tt 1
label .tt.t -justify left -background {#EEE1B3}
pack .tt.t -padx 1 -pady 1
- settooltip {}
+ tooltip-set {}
}
-proc settooltip {s} {
+proc tooltip-set {s} {
.tt.t configure -text $s
}
-proc tooltip_show {x y} {
+proc tooltip-show {x y} {
incr x 9
incr y 9
wm geometry .tt +$x+$y
wm deiconify .tt
}
+}
+
proc setimage {image} {
.i configure -image $image
}