applet.tcl

   1 # General purpose code for being a tray applet
   2
   3 proc manyset {list args} {
   4     foreach val $list var $args {
   5         upvar 1 $var my
   6         set my $val
   7     }
   8 }
   9
  10
  11 package require Tclx
  12 package require tktray
  13
  14 #----- general machinery -----
  15
  16 # Interface:
  17 #
  18 #  tk::tktray widget is called .i
  19 #
  20 # Tooltip:
  21 #
  22 #   Caller may call
  23 #      applet::setup-tooltip ON-VISIBLE ON-INVISIBLE
  24 #   to make applet have a tooltip.
  25 #
  26 #   ON-VISIBLE and ON-INVISIBLE will be globally eval'd
  27 #   when the tooltip becomes visible and invisible.
  28 #
  29 #   Caller should call
  30 #      applet::tooltip-set TEXT-MAYBE-MULTILINE
  31 #   whenever they like.
  32 #
  33 # Icon:
  34 #
  35 #  Caller should call:
  36 #      applet::setimage IMAGE
  37 #  as necessary.
  38 #
  39 # Alternatively, instead of icon, it may arrange to run (repeatedly
  40 # if necessary) a subprocess.
  41 #
  42 #  Caller that needs access to inner window should call
  43 #      applet::setup-subwindow WIDTH ON-DESTROYING ON-READY
  44 #  Then the main code will call ON-DESTROYING just before
  45 #  destroying the inner window and recreating it, and ON-READY
  46 #  just after.  Afterwards, theh inner window is called
  47 #      .
  48 #
  49 #     proc innerwindow {} { ... }
  50 #  and run
  51 #     innerwindow
  52 #  This will create
  53 #     .i.i.b      frame to contain container
  54 #     .i.i.b.c    actual container
  55 #
  56 #  Button presses
  57 #
  58 #    Caller may bind .i.i <ButtonPress-$b>
  59 #
  60 #    Alternatively caller may call  applet::setup-button-menu $b
  61 #    which will generate a menu .m$b which the user can configure
  62 #    and which will automatically be posted and unposted etc.
  63 #    In this case the caller should arrange that all of their
  64 #    menus, when an item is selected, call
  65 #      applet::msel
  66
  67 wm withdraw .
  68
  69 tktray::icon .i -class example
  70 .i configure -docked 1
  71
  72
  73 namespace eval applet {
  74
  75
  76 # used by both menus and tooltips
  77 variable posted 0
  78
  79 #----- menus -----
  80
  81 proc setup-button-menu {b} {
  82     bind .i.i <ButtonPress> { applet::menubuttonpressed %b %X %Y }
  83     menu .m$b -tearoff 0
  84 }
  85
  86 proc menubuttonpressed {b x y} {
  87     variable posted
  88     tooltip-cancel
  89     if {$posted == $b} {
  90         puts "unpost $posted toggle"
  91         .m$posted unpost
  92         set posted 0
  93     } elseif {[winfo exists .m$b]} {
  94         if {$posted} {
  95             .m$posted unpost
  96             puts "unpost $posted other"
  97         }
  98         puts "post $b"
  99         set posted $b
 100         .m$b post $x $y
 101     }
 102 }
 103
 104 proc msel {} {
 105     variable posted
 106     set posted 0
 107 }
 108
 109 #----- tooltips -----
 110
 111 variable tooltip_on_vis {}
 112 variable tooltip_on_invis {}
 113
 114 proc tooltip-starttimer {state x y} {
 115     variable tooltip_after
 116     variable posted
 117     variable tooltip_inwindow
 118     if {$state || $posted || !$tooltip_inwindow} { tooltip-cancel; return }
 119     catch { after cancel $tooltip_after }
 120     set tooltip_after [after 500 applet::tooltip-show $x $y]
 121 }
 122
 123 proc tooltip-cancel {} {
 124     variable tooltip_after
 125     variable tooltip_on_invis
 126     catch { after cancel $tooltip_after }
 127     catch { unset $tooltip_after }
 128     wm withdraw .tt
 129     uplevel #0 $tooltip_on_invis
 130 }
 131
 132 set tooltip_inwindow 0
 133
 134 proc tooltip-enter {state x y} {
 135     variable tooltip_inwindow
 136     set tooltip_inwindow 1
 137     tooltip-starttimer $state $x $y
 138 }
 139
 140 proc tooltip-leave {} {
 141     variable tooltip_inwindow
 142     set tooltip_inwindow 0
 143     tooltip-cancel
 144 }
 145
 146 proc setup-tooltip {on_vis on_invis} {
 147     foreach v {vis invis} {
 148         variable tooltip_on_$v [set on_$v]
 149     }
 150     bind .i <Enter> { applet::tooltip-enter %s %X %Y }
 151     bind .i <Leave> { applet::tooltip-leave }
 152     bind .i <ButtonRelease> {
 153         applet::tooltip-cancel
 154         applet::tooltip-starttimer %s %X %Y
 155     }
 156     bind .i <Motion> { applet::tooltip-starttimer %s %X %Y }
 157     toplevel .tt -background black
 158     wm withdraw .tt
 159     wm overrideredirect .tt 1
 160     label .tt.t -justify left -background {#EEE1B3}
 161     pack .tt.t -padx 1 -pady 1
 162     tooltip-set {}
 163 }
 164
 165 proc tooltip-set {s} {
 166     .tt.t configure -text $s
 167 }
 168
 169 proc tooltip-show {x y} {
 170     variable tooltip_on_vis
 171     incr x 9
 172     incr y 9
 173     wm geometry .tt +$x+$y
 174     wm deiconify .tt
 175     uplevel #0 $tooltip_on_vis
 176 }
 177
 178 #----- simple images -----
 179
 180 proc setimage {image} {
 181     .i configure -image $image
 182 }
 183
 184 #----- subwindow -----
 185
 186 variable subwindow_on_destroying
 187 variable subwindow_on_ready
 188
 189 proc innerwindow-resetup-required {why} {
 190     variable innerwindow_after
 191 puts "IW-EVENT $why"
 192     if {[info exists innerwindow_after]} return
 193     set innerwindow_after [after idle applet::innerwindow-resetup]
 194 }
 195
 196 proc innerwindow-resetup {} {
 197     variable innerwindow_after
 198     variable subwindow_on_destroying
 199     variable subwindow_on_ready
 200     unset innerwindow_after
 201
 202 puts RESETUP
 203
 204     uplevel #0 $subwindow_on_destroying
 205
 206     catch { destroy .i.i.c }
 207     if {![winfo exists .i.i]} return
 208     destroy [frame .i.i.make-exist]
 209     catch { destroy .i.i.b.c }
 210     catch { destroy .i.i.b }
 211     frame .i.i.b
 212     pack .i.i.b -fill both -side left -expand 1
 213     frame .i.i.b.c -container 1 -background orange
 214     pack .i.i.b.c -fill both -side left -expand 1
 215 #
 216     global inner_lastw inner_lasth
 217     #set w [winfo width .i.i]
 218 #    set w [winfo width .i.i]
 219 #    set h [winfo height .i.i]
 220
 221 #    if {$w != $inner_lastw || $h != $inner_lasth} {
 222 #       set inner_lastw $w
 223 #       set inner_lasth $h
 224 #       innerwindow-ph-dummy configure -width $w -height 2
 225
 226     uplevel #0 $subwindow_on_ready
 227 #    }
 228 }
 229
 230 proc setup-subwindow {w on_destroying on_ready} {
 231     foreach v {destroying ready} {
 232         variable subwindow_on_$v [set on_$v]
 233     }
 234
 235     global inner_lastw inner_lasth
 236     set inner_lastw -2
 237     set inner_lasth -2
 238
 239     image create photo applet::innerwindow-ph-dummy -width $w -height 2
 240     .i configure -image applet::innerwindow-ph-dummy
 241
 242     destroy [frame .i.make-exist]
 243     destroy [frame .i.i.make-exist]
 244     bind .i <<IconConfigure>> {
 245         applet::innerwindow-resetup-required IconConfigure
 246     }
 247 }
 248
 249 }