From 20901497e27bff2a6ac88c519fd938b61b083f07 Mon Sep 17 00:00:00 2001 From: Ian Jackson Date: Sat, 9 Jun 2012 19:22:46 +0100 Subject: [PATCH] namespaces etc. --- applet.tcl | 106 ++++++++++++++++++++++++++++++----------------------- example | 12 ++++-- 2 files changed, 69 insertions(+), 49 deletions(-) diff --git a/applet.tcl b/applet.tcl index 8440092..ce25507 100644 --- a/applet.tcl +++ b/applet.tcl @@ -1,3 +1,15 @@ +# 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 ----- @@ -5,7 +17,8 @@ # # tk::tktray widget is called .i # -# Inner window: +# Inner window subprocess: +# # Caller that needs access to inner window should define # proc innerwindow {} { ... } # and run @@ -15,36 +28,31 @@ # .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 +# +# 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 { 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 @@ -61,19 +69,21 @@ proc menubuttonpressed {b x y} { } 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 @@ -89,7 +99,6 @@ 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 { pressed %b %X %Y } # global inner_lastw inner_lasth #set w [winfo width .i.i] @@ -117,17 +126,19 @@ proc setupinnerwindow {w} { bind .i <> { innerwindow-resetup-required IconConfigure } } -bind .i { 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 @@ -135,42 +146,47 @@ proc tooltip_cancel {} { 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 { tooltip_enter %s %X %Y } - bind .i { tooltip_leave } - bind .i { tooltip_cancel; tooltip_starttimer %s %X %Y } - bind .i { tooltip_starttimer %s %X %Y } +proc setup-tooltip {} { + bind .i { applet::tooltip-enter %s %X %Y } + bind .i { applet::tooltip-leave } + bind .i { + applet::tooltip-cancel + applet::tooltip-starttimer %s %X %Y + } + bind .i { 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 } diff --git a/example b/example index 3b45d0b..67977a9 100755 --- a/example +++ b/example @@ -3,18 +3,22 @@ source applet.tcl -#----- specifics ----- +#----- menu ----- + +foreach b {1 3} { + applet::setup-button-menu $b +} .m1 add command -command { msel; puts hi } -label hi .m3 add command -command { msel; puts boo } -label boo -image create bitmap ims -file gs_s.xbm +#image create bitmap ims -file gs_s.xbm #image create bitmap ims -file /usr/share/ghostscript/8.71/lib/gs_s.xbm #setimage ims #setimage ims -setuptooltip -settooltip "line\nanother" +applet::setup-tooltip +applet::tooltip-set "line\nanother" fconfigure stdout -buffering line -- 2.30.2