chiark / gitweb /
wip
[chiark-tcl-applet.git] / applet.tcl
1
2 #----- general machinery -----
3
4 # Interface:
5 #
6 #  tk::tktray widget is called .i
7 #
8 # Inner window:
9 #  Caller that needs access to inner window should define
10 #     proc innerwindow {} { ... }
11 #  and run
12 #     innerwindow
13 #  This will create
14 #     .i.i.b      frame to contain container
15 #     .i.i.b.c    actual container
16
17 #  Button presses
18 #    Caller should provide
19 #       proc pressed {b x y} { ... }
20 #    which should examine b and do something appropriate.
21 #    
22
23
24
25 package require tktray
26 #load /home/ian/things/Systray/tktray-1.3.8/libtktray1.3.8.so
27
28
29 wm withdraw .
30
31 tktray::icon .i -class example
32 .i configure -docked 1
33
34 set posted 0
35
36 foreach b {1 3} {
37     menu .m$b -tearoff 0
38 }
39
40 proc menubuttonpressed {b x y} {
41     global posted
42     tooltip_cancel
43     if {$posted == $b} {
44         puts "unpost $posted toggle"
45         .m$posted unpost
46         set posted 0
47     } elseif {[winfo exists .m$b]} {
48         if {$posted} {
49             .m$posted unpost
50             puts "unpost $posted other"
51         }
52         puts "post $b"
53         set posted $b
54         .m$b post $x $y
55     }
56 }
57
58 proc msel {} {
59     global posted
60     set posted 0
61 }
62
63 proc innerwindow-event {why} {
64     global innerwindow_after
65 puts "IW-EVENT $why"
66     if {[info exists innerwindow_after]} return
67     set innerwindow_after [after idle innerwindow-resetup]
68 }
69
70 proc innerwindow-resetup {} {
71     global innerwindow_after
72     unset innerwindow_after
73
74 puts RESETUP
75
76     catch { destroy .i.i.c }
77     if {![winfo exists .i.i]} return
78     destroy [frame .i.i.make-exist]
79     catch { destroy .i.i.b.c }
80     catch { destroy .i.i.b }
81     frame .i.i.b
82     pack .i.i.b -fill both -side left -expand 1
83     frame .i.i.b.c -container 1 -background orange
84     pack .i.i.b.c -fill both -side left -expand 1
85     bind .i.i <ButtonPress> { pressed %b %X %Y }
86 #
87     global inner_lastw inner_lasth
88     #set w [winfo width .i.i]
89 #    set w [winfo width .i.i]
90 #    set h [winfo height .i.i]
91
92 #    if {$w != $inner_lastw || $h != $inner_lasth} {
93 #       set inner_lastw $w
94 #       set inner_lasth $h
95 #       innerwindow-ph-dummy configure -width $w -height 2
96         innerwindow [winfo id .i.i.b.c]
97 #    }
98 }
99
100 proc setupinnerwindow {w} {
101     global inner_lastw inner_lasth
102     set inner_lastw -2
103     set inner_lasth -2
104
105     image create photo innerwindow-ph-dummy -width $w -height 2
106     .i configure -image innerwindow-ph-dummy
107
108     destroy [frame .i.make-exist]
109     destroy [frame .i.i.make-exist]
110     bind .i <<IconConfigure>> { innerwindow-event "%w" }
111 }
112
113 bind .i <ButtonPress> { pressed %b %X %Y }
114
115 proc tooltip_starttimer {state x y} {
116     global tooltip_after posted tooltip_inwindow
117     if {$state || $posted || !$tooltip_inwindow} { tooltip_cancel; return }
118     catch { after cancel $tooltip_after }
119     set tooltip_after [after 500 tooltip_show $x $y]
120 }
121
122 proc tooltip_cancel {} {
123     global tooltip_after
124     catch { after cancel $tooltip_after }
125     catch { unset $tooltip_after }
126     wm withdraw .tt
127 }
128
129 set tooltip_inwindow 0
130
131 proc tooltip_enter {state x y} {
132     global tooltip_inwindow
133     set tooltip_inwindow 1
134     tooltip_starttimer $state $x $y
135 }
136
137 proc tooltip_leave {} {
138     global tooltip_inwindow
139     set tooltip_inwindow 0
140     tooltip_cancel
141 }
142
143 proc setuptooltip {} {
144     bind .i <Enter> { tooltip_enter %s %X %Y }
145     bind .i <Leave> { tooltip_leave }
146     bind .i <ButtonRelease> { tooltip_cancel; tooltip_starttimer %s %X %Y }
147     bind .i <Motion> { tooltip_starttimer %s %X %Y }
148     toplevel .tt -background black
149     wm withdraw .tt
150     wm overrideredirect .tt 1
151     label .tt.t -justify left -background {#EEE1B3}
152     pack .tt.t -padx 1 -pady 1
153     settooltip {}
154 }
155
156 proc settooltip {s} {
157     .tt.t configure -text $s
158 }
159
160 proc tooltip_show {x y} {
161     incr x 9
162     incr y 9
163     wm geometry .tt +$x+$y
164     wm deiconify .tt
165 }
166
167 proc setimage {image} {
168     .i configure -image $image
169 }