chiark / gitweb /
c68d6e91de0ea60c6971f91cec1c34880d214b36
[chiark-tcl-applet.git] / 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 # Inner window subprocess:
34 #
35 #  Caller that needs access to inner window should define
36 #     proc innerwindow {} { ... }
37 #  and run
38 #     innerwindow
39 #  This will create
40 #     .i.i.b      frame to contain container
41 #     .i.i.b.c    actual container
42
43 #  Button presses
44 #
45 #    Caller may bind .i.i <ButtonPress-$b>
46 #
47 #    Alternatively caller may call  applet::setup-button-menu $b
48 #    which will generate a menu .m$b which the user can configure
49 #    and which will automatically be posted and unposted etc.
50 #    In this case the caller should arrange that all of their
51 #    menus, when an item is selected, call
52 #      applet::msel
53
54 wm withdraw .
55
56 tktray::icon .i -class example
57 .i configure -docked 1
58
59
60 namespace eval applet {
61
62
63 # used by both menus and tooltips
64 variable posted 0
65
66 #----- menus -----
67
68 proc setup-button-menu {b} {
69     bind .i.i <ButtonPress> { applet::menubuttonpressed %b %X %Y }
70     menu .m$b -tearoff 0
71 }
72
73 proc menubuttonpressed {b x y} {
74     variable posted
75     tooltip-cancel
76     if {$posted == $b} {
77         puts "unpost $posted toggle"
78         .m$posted unpost
79         set posted 0
80     } elseif {[winfo exists .m$b]} {
81         if {$posted} {
82             .m$posted unpost
83             puts "unpost $posted other"
84         }
85         puts "post $b"
86         set posted $b
87         .m$b post $x $y
88     }
89 }
90
91 proc msel {} {
92     variable posted
93     set posted 0
94 }
95
96 #----- tooltips -----
97
98 variable tooltip_on_vis {}
99 variable tooltip_on_invis {}
100
101 proc tooltip-starttimer {state x y} {
102     variable tooltip_after
103     variable posted
104     variable tooltip_inwindow
105     if {$state || $posted || !$tooltip_inwindow} { tooltip-cancel; return }
106     catch { after cancel $tooltip_after }
107     set tooltip_after [after 500 applet::tooltip-show $x $y]
108 }
109
110 proc tooltip-cancel {} {
111     variable tooltip_after
112     variable tooltip_on_invis
113     catch { after cancel $tooltip_after }
114     catch { unset $tooltip_after }
115     wm withdraw .tt
116     uplevel #0 $tooltip_on_invis
117 }
118
119 set tooltip_inwindow 0
120
121 proc tooltip-enter {state x y} {
122     variable tooltip_inwindow
123     set tooltip_inwindow 1
124     tooltip-starttimer $state $x $y
125 }
126
127 proc tooltip-leave {} {
128     variable tooltip_inwindow
129     set tooltip_inwindow 0
130     tooltip-cancel
131 }
132
133 proc setup-tooltip {on_vis on_invis} {
134     foreach v {vis invis} {
135         variable tooltip_on_$v [set on_$v]
136     }
137     bind .i <Enter> { applet::tooltip-enter %s %X %Y }
138     bind .i <Leave> { applet::tooltip-leave }
139     bind .i <ButtonRelease> { 
140         applet::tooltip-cancel
141         applet::tooltip-starttimer %s %X %Y
142     }
143     bind .i <Motion> { applet::tooltip-starttimer %s %X %Y }
144     toplevel .tt -background black
145     wm withdraw .tt
146     wm overrideredirect .tt 1
147     label .tt.t -justify left -background {#EEE1B3}
148     pack .tt.t -padx 1 -pady 1
149     tooltip-set {}
150 }
151
152 proc tooltip-set {s} {
153     .tt.t configure -text $s
154 }
155
156 proc tooltip-show {x y} {
157     variable tooltip_on_vis
158     incr x 9
159     incr y 9
160     wm geometry .tt +$x+$y
161     wm deiconify .tt
162     uplevel #0 $tooltip_on_vis
163 }
164
165 }
166
167
168 proc innerwindow-resetup-required {why} {
169     variable innerwindow_after
170 puts "IW-EVENT $why"
171     if {[info exists innerwindow_after]} return
172     set innerwindow_after [after idle innerwindow-resetup]
173 }
174
175 proc innerwindow-resetup {} {
176     variable innerwindow_after
177     unset innerwindow_after
178
179 puts RESETUP
180
181     innerwindow-destroying
182
183     catch { destroy .i.i.c }
184     if {![winfo exists .i.i]} return
185     destroy [frame .i.i.make-exist]
186     catch { destroy .i.i.b.c }
187     catch { destroy .i.i.b }
188     frame .i.i.b
189     pack .i.i.b -fill both -side left -expand 1
190     frame .i.i.b.c -container 1 -background orange
191     pack .i.i.b.c -fill both -side left -expand 1
192 #
193     global inner_lastw inner_lasth
194     #set w [winfo width .i.i]
195 #    set w [winfo width .i.i]
196 #    set h [winfo height .i.i]
197
198 #    if {$w != $inner_lastw || $h != $inner_lasth} {
199 #       set inner_lastw $w
200 #       set inner_lasth $h
201 #       innerwindow-ph-dummy configure -width $w -height 2
202         innerwindow-ready
203 #    }
204 }
205
206 proc setupinnerwindow {w} {
207     global inner_lastw inner_lasth
208     set inner_lastw -2
209     set inner_lasth -2
210
211     image create photo innerwindow-ph-dummy -width $w -height 2
212     .i configure -image innerwindow-ph-dummy
213
214     destroy [frame .i.make-exist]
215     destroy [frame .i.i.make-exist]
216     bind .i <<IconConfigure>> { innerwindow-resetup-required IconConfigure }
217 }
218
219
220
221 proc setimage {image} {
222     .i configure -image $image
223 }