# $Id$ # Another Freedesktop systray icon support. # Requires tktray (http://sw4me.com/wiki/Tktray) package ########################################################################## if {![cequal $::interface tk]} return if {[catch { package require tktray }]} return ########################################################################## namespace eval tktray { variable options custom::defvar options(enable) 1 \ [::msgcat::mc "Enable freedesktop system tray icon."] \ -group Systray -type boolean \ -command [namespace code enable_disable] variable s2p foreach {k v} [list available available \ away away \ chat chat \ dnd dnd \ xa xa \ unavailable unavailable \ invisible invisible \ blank blank \ message1 message-server \ message2 message \ message3 message-personal] { set s2p($k) docking/$v } } ########################################################################## proc tktray::enable_disable {args} { variable options set icon .tksi if {$options(enable) && ![winfo exists $icon]} { ifacetk::systray::create $icon \ -createcommand [namespace code create] \ -configurecommand [namespace code configure] \ -destroycommand [namespace code destroy] \ -locationcommand [namespace code location] } elseif {!$options(enable) && [winfo exists $icon]} { ifacetk::systray::destroy $icon } } hook::add finload_hook [namespace current]::tktray::enable_disable ########################################################################## proc tktray::create {icon} { variable s2p tktray::icon $icon -image $s2p(unavailable) -class TkabberIcon set m [ifacetk::systray::popupmenu $icon.menu] bind $icon ifacetk::systray::restore bind $icon ifacetk::systray::withdraw bind $icon [list tk_popup [double% $m] %X %Y] balloon::setup $icon -command [list ifacetk::systray::balloon $icon] } ########################################################################## proc tktray::configure {icon status} { variable s2p if {![cequal $icon ""] && [winfo exists $icon]} { $icon configure -image $s2p($status) } } ########################################################################## proc tktray::destroy {icon} { if {![cequal $icon ""] && [winfo exists $icon]} { ::destroy $icon } } ########################################################################## proc tktray::location {icon} { if {![cequal $icon ""] && [winfo exists $icon]} { return [lrange [$icon bbox] 0 1] } else { return {0 0} } } ##########################################################################