URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tix/] [library/] [Balloon.tcl] - Blame information for rev 1782

Go to most recent revision | Details | Compare with Previous | View Log


# Balloon.tcl --
#
#       The help widget. It provides both "balloon" type of help
#       message and "status bar" type of help message. You can use
#       this widget to indicate the function of the widgets inside
#       your application.
#
# Copyright (c) 1996, Expert Interface Technologies
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
 
 
tixWidgetClass tixBalloon {
    -classname TixBalloon
    -superclass tixShell
    -method {
        bind post unbind
    }
    -flag {
        -installcolormap -initwait -state -statusbar
    }
    -configspec {
        {-installcolormap installColormap InstallColormap false}
        {-initwait initWait InitWait 1000}
        {-state state State both}
        {-statusbar statusBar StatusBar ""}
 
        {-cursor cursor Cursur left_ptr}
    }
    -default {
        {*background                    #ffff60}
        {*foreground                    black}
        {*borderWidth                   0}
        {.borderWidth                   1}
        {.background                    black}
        {*Label.anchor                  w}
        {*Label.justify                 left}
    }
}
 
# Class Record
#
set tixBalloon(bals) ""
 
proc tixBalloon:InitWidgetRec {w} {
    upvar #0 $w data
    global tixBalloon
 
    tixChainMethod $w InitWidgetRec
 
    set data(isActive)    0
    set data(client)    ""
 
    lappend tixBalloon(bals) $w
}
 
proc tixBalloon:ConstructWidget {w} {
    upvar #0 $w data
 
    tixChainMethod $w ConstructWidget
 
    wm overrideredirect $w 1
    wm withdraw $w
 
    # Frame 1 : arrow
    frame $w.f1 -bd 0
    set data(w:label) [label $w.f1.lab -bd 0 -relief flat \
                       -bitmap [tix getbitmap balarrow]]
    pack $data(w:label) -side left -padx 1 -pady 1
 
    # Frame 2 : Message
    frame $w.f2 -bd 0
    set data(w:message) [label $w.f2.message -padx 0 -pady 0 -bd 0]
    pack $data(w:message) -side left -expand yes -fill both -padx 10 -pady 1
 
    # Pack all
    pack $w.f1 -fill both
    pack $w.f2 -fill both
 
    # This is an event tag used by the clients
    #
    bind TixBal$w <Destroy> "tixBalloon:ClientDestroy $w %W"
}
 
proc tixBalloon:Destructor {w} {
    global tixBalloon
 
    set bals ""
    foreach b $tixBalloon(bals) {
        if {$w != $b} {
            lappend bals $b
        }
    }
    set tixBalloon(bals) $bals
 
    tixChainMethod $w Destructor
}
 
#----------------------------------------------------------------------
# Config:
#----------------------------------------------------------------------
proc tixBalloon:config-state {w value} {
    upvar #0 $w data
 
    case $value {
        {none balloon status both} ""
        default {
           error "invalid value $value, must be none, balloon, status, or both"
        }
    }
}
 
#----------------------------------------------------------------------
# "RAW" event bindings:
#----------------------------------------------------------------------
 
bind all <B1-Motion>        "+tixBalloon_XXMotion %X %Y 1"
bind all <B2-Motion>        "+tixBalloon_XXMotion %X %Y 2"
bind all <B3-Motion>        "+tixBalloon_XXMotion %X %Y 3"
bind all <B4-Motion>        "+tixBalloon_XXMotion %X %Y 4"
bind all <B5-Motion>        "+tixBalloon_XXMotion %X %Y 5"
bind all <Any-Motion>       "+tixBalloon_XXMotion %X %Y 0"
bind all <Leave>            "+tixBalloon_XXMotion %X %Y %b"
bind all <Button>           "+tixBalloon_XXButton   %X %Y %b"
bind all <ButtonRelease>    "+tixBalloon_XXButtonUp %X %Y %b"
 
proc tixBalloon_XXMotion {rootX rootY b} {
    global tixBalloon
 
    foreach w $tixBalloon(bals) {
        tixBalloon:XXMotion $w $rootX $rootY $b
    }
}
 
proc tixBalloon_XXButton {rootX rootY b} {
    global tixBalloon
 
    foreach w $tixBalloon(bals) {
        tixBalloon:XXButton $w $rootX $rootY $b
    }
}
 
proc tixBalloon_XXButtonUp {rootX rootY b} {
    global tixBalloon
 
    foreach w $tixBalloon(bals) {
        tixBalloon:XXButtonUp $w $rootX $rootY $b
    }
}
 
 
# return true if d is a descendant of w
#
proc tixIsDescendant {w d} {
    if [string match $w .] {
        return 1
    }
    return [string match $w.* $d]
}
 
# All the button events are fine if the ballooned widget is
# a descendant of the grabbing widget
#
proc tixBalloon:GrabBad {w cw} {
    global tixBalloon
 
    set g [grab current $w]
    if {$g == ""} {
        return 0
    }
    if [info exists tixBalloon(g_ignore,$g)] {
        return 1
    }
    if [info exists tixBalloon(g_ignore,[winfo class $g])] {
        return 1
    }
    if {$g == $cw || [tixIsDescendant $g $cw]} {
        return 0
    }
    return 1
}
 
proc tixBalloon:XXMotion {w rootX rootY b} {
    upvar #0 $w data
 
    if {$data(-state) == "none"} {
        return
    }
 
    if {$b == 0} {
        if [info exists data(b:1)] {unset data(b:1)}
        if [info exists data(b:2)] {unset data(b:2)}
        if [info exists data(b:3)] {unset data(b:3)}
        if [info exists data(b:4)] {unset data(b:4)}
        if [info exists data(b:5)] {unset data(b:5)}
    }
 
 
    if {[array names data b:*] != ""} {
        # Some buttons are down. Do nothing
        #
        return
    }
 
    set cw [winfo containing $rootX $rootY]
    if [tixBalloon:GrabBad $w $cw] {
        return
    }
 
    # Find the a client window that matches
    #
    if {$w == $cw || [string match $w.* $cw]} {
        # Cursor moved over the balloon -- Ignore
        return
    }
 
    while {$cw != ""} {
        if [info exists data(m:$cw)] {
            set client $cw
            break
        } else {
            set cw [winfo parent $cw]
        }
    }
    if {![info exists client]} {
        # The cursor is at a position covered by a non-client
        # Popdown the balloon if it is up
        if {$data(isActive)} {
            tixBalloon:Deactivate $w
        }
        set data(client) ""
        if [info exists data(cancel)] {
            unset data(cancel)
        }
        return
    }
 
    if {$data(client) != $client} {
        if {$data(isActive)} {
            tixBalloon:Deactivate $w
        }
        set data(client) $client
        after $data(-initwait) tixBalloon:SwitchToClient $w $client
    }
}
 
proc tixBalloon:XXButton {w rootX rootY b} {
    upvar #0 $w data
 
    tixBalloon:XXMotion $w $rootX $rootY $b
 
    set data(b:$b) 1
 
    if {$data(isActive)} {
        tixBalloon:Deactivate $w
    } else {
        set data(cancel) 1
    }
}
 
proc tixBalloon:XXButtonUp {w rootX rootY b} {
    upvar #0 $w data
 
    tixBalloon:XXMotion $w $rootX $rootY $b
    if [info exists data(b:$b)] {
        unset data(b:$b)
    }
}
 
#----------------------------------------------------------------------
# "COOKED" event bindings:
#----------------------------------------------------------------------
 
# switch the balloon to a new client
#
proc tixBalloon:SwitchToClient {w client} {
    upvar #0 $w data
 
    if {![winfo exists $w]} {
        return
    }
    if {![winfo exists $client]} {
        return
    }
    if {$client != $data(client)} {
        return
    }
    if [info exists data(cancel)] {
        unset data(cancel)
        return
    }
 
    if [tixBalloon:GrabBad $w $w] {
        return
    }
 
    tixBalloon:Activate $w
}
 
proc tixBalloon:ClientDestroy {w client} {
    if {![winfo exists $w]} {
        return
    }
 
    upvar #0 $w data
 
    if {$data(client) == $client} {
        tixBalloon:Deactivate $w
        set data(client) ""
    }
 
    # Maybe thses have already been unset by the Destroy method
    #
    if [info exists data(m:$client)] {unset data(m:$client)}
    if [info exists data(s:$client)] {unset data(s:$client)}
}
 
#----------------------------------------------------------------------
# Popping up balloon:
#----------------------------------------------------------------------
proc tixBalloon:Activate {w} {
    upvar #0 $w data
 
    if [tixBalloon:GrabBad $w $w] {
        return
    }
    if {[winfo containing [winfo pointerx $w] [winfo pointery $w]] == ""} {
        return
    }
 
    switch $data(-state) {
        "both" {
            tixBalloon:PopUp $w
            tixBalloon:SetStatus $w
        }
        "balloon" {
            tixBalloon:PopUp $w
        }
        "status" {
            tixBalloon:SetStatus $w
        }
    }
 
    set data(isActive) 1
 
    after 200 tixBalloon:Verify $w
}
 
 
# %% Perhaps this is no more needed
#
proc tixBalloon:Verify {w} {
    upvar #0 $w data
 
    if {![winfo exists $w]} {
        return
    }
    if {!$data(isActive)} {
        return
    }
 
    if [tixBalloon:GrabBad $w $w] {
        tixBalloon:Deactivate $w
        return
    }
    if {[winfo containing [winfo pointerx $w] [winfo pointery $w]] == ""} {
        tixBalloon:Deactivate $w
        return
    }
    after 200 tixBalloon:Verify $w
}
 
proc tixBalloon:Deactivate {w} {
    upvar #0 $w data
 
    tixBalloon:PopDown $w
    tixBalloon:ClearStatus $w
    set data(isActive) 0
    if [info exists data(cancel)] {
        unset data(cancel)
    }
}
 
proc tixBalloon:PopUp {w} {
    upvar #0 $w data
 
    if [tixGetBoolean -nocomplain $data(-installcolormap)] {
        wm colormapwindows [winfo toplevel $data(client)] $w
    }
 
    # trick: the following lines allow the balloon window to
    # acquire a stable width and height when it is finally
    # put on the visible screen
    #
    set client $data(client)
    $data(w:message) config -text $data(m:$client)
    wm geometry $w +10000+10000
    wm deiconify $w
    raise $w
    update
 
    # The windows may become destroyed as a result of the "update" command
    #
    if {![winfo exists $w]} {
        return
    }
    if {![winfo exists $client]} {
        return
    }
    # Put it on the visible screen
    #
    set x [expr [winfo rootx $client]+[winfo width  $client]/2]
    set y [expr int([winfo rooty $client]+[winfo height $client]/1.3)]
 
    set width  [winfo reqwidth $w]
    set height [winfo reqheight $w]
    set scrwidth  [winfo vrootwidth  $w]
    set scrheight [winfo vrootheight $w]
 
    # If the balloon is too far right, pull it back to the left
    #
    if {[expr $x + $width] > $scrwidth} {
        set x [expr $scrwidth - $width]
    }
 
    # If the balloon is too far left, pull it back to the right
    #
    if {$x < 0} {
        set x 0
    }
 
    # If the listbox is below bottom of screen, put it upwards
    #
    if {[expr $y + $height] > $scrheight} {
        set y [expr $scrheight-$height]
    }
    if {$y < 0} {
        set y 0
    }
 
    wm geometry $w +$x+$y
}
 
proc tixBalloon:PopDown {w} {
    upvar #0 $w data
 
    # Close the balloon
    #
    wm withdraw $w
 
    # We don't set the data(client) to be zero, so that the balloon
    # will re-appear only if you move out then in the client window
    # set data(client) ""
}
 
proc tixBalloon:SetStatus {w} {
    upvar #0 $w data
 
    if {![winfo exists $data(-statusbar)]} {
        return
    }
    if {![info exists data(s:$data(client))]} {
        return
    }
 
    set vv [$data(-statusbar) cget -textvariable]
    if {$vv == ""} {
        $data(-statusbar) config -text $data(s:$data(client))
    } else {
        uplevel #0 set $vv [list $data(s:$data(client))]
    }
}
 
proc tixBalloon:ClearStatus {w} {
    upvar #0 $w data
 
    if {![winfo exists $data(-statusbar)]} {
        return
    }
 
    # Clear the StatusBar widget
    #
    set vv [$data(-statusbar) cget -textvariable]
    if {$vv == ""} {
        $data(-statusbar) config -text ""
    } else {
        uplevel #0 set $vv [list ""]
    }
}
 
#----------------------------------------------------------------------
# PublicMethods:
#----------------------------------------------------------------------
 
# %% if balloon is already popped-up for this client, change mesage
#
proc tixBalloon:bind {w client args} {
    upvar #0 $w data
 
    if [info exists data(m:$client)] {
        set alreadyBound 1
    } else {
        set alreadyBound 0
    }
 
    set opt(-balloonmsg) ""
    set opt(-statusmsg)  ""
    set opt(-msg)        ""
 
    tixHandleOptions opt {-balloonmsg -msg -statusmsg} $args
 
    if {$opt(-balloonmsg) != ""} {
        set data(m:$client) $opt(-balloonmsg)
    } else {
        set data(m:$client) $opt(-msg)
    }
    if {$opt(-statusmsg) != ""} {
        set data(s:$client) $opt(-statusmsg)
    } else {
        set data(s:$client) $opt(-msg)
    }
 
    tixAppendBindTag $client TixBal$w
}
 
proc tixBalloon:post {w client} {
    upvar #0 $w data
 
    if {![info exists data(m:$client)]} {
        return
    }
    tixBalloon:Enter $w $client
    incr data(fakeEnter)
}
 
proc tixBalloon:unbind {w client} {
    upvar #0 $w data
 
    if [info exists data(m:$client)] {
        if [info exists data(m:$client)] {unset data(m:$client)}
        if [info exists data(s:$client)] {unset data(s:$client)}
 
        if [winfo exists $client] {
            catch {tixDeleteBindTag $client TixBal$w}
        }
    }
}
 
#----------------------------------------------------------------------
#
# Utility function
#
#----------------------------------------------------------------------
#
# $w can be a widget name or a classs name
proc tixBalIgnoreWhenGrabbed {wc} {
    global tixBalloon
    set tixBalloon(g_ignore,$wc) ""
}
 
tixBalIgnoreWhenGrabbed TixComboBox
tixBalIgnoreWhenGrabbed Menu
tixBalIgnoreWhenGrabbed Menubutton

Browse

Tools

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tix/] [library/] [Balloon.tcl] - Blame information for rev 1782

Line No.	Rev	Author	Line
1	578	markom	`# Balloon.tcl --`
2			`#`
3			`# The help widget. It provides both "balloon" type of help`
4			`# message and "status bar" type of help message. You can use`
5			`# this widget to indicate the function of the widgets inside`
6			`# your application.`
7			`#`
8			`# Copyright (c) 1996, Expert Interface Technologies`
9			`#`
10			`# See the file "license.terms" for information on usage and redistribution`
11			`# of this file, and for a DISCLAIMER OF ALL WARRANTIES.`
12			`#`
13
14
15			`tixWidgetClass tixBalloon {`
16			`-classname TixBalloon`
17			`-superclass tixShell`
18			`-method {`
19			`bind post unbind`
20			`}`
21			`-flag {`
22			`-installcolormap -initwait -state -statusbar`
23			`}`
24			`-configspec {`
25			`{-installcolormap installColormap InstallColormap false}`
26			`{-initwait initWait InitWait 1000}`
27			`{-state state State both}`
28			`{-statusbar statusBar StatusBar ""}`
29
30			`{-cursor cursor Cursur left_ptr}`
31			`}`
32			`-default {`
33			`{*background #ffff60}`
34			`{*foreground black}`
35			`{*borderWidth 0}`
36			`{.borderWidth 1}`
37			`{.background black}`
38			`{*Label.anchor w}`
39			`{*Label.justify left}`
40			`}`
41			`}`
42
43			`# Class Record`
44			`#`
45			`set tixBalloon(bals) ""`
46
47			`proc tixBalloon:InitWidgetRec {w} {`
48			`upvar #0 $w data`
49			`global tixBalloon`
50
51			`tixChainMethod $w InitWidgetRec`
52
53			`set data(isActive) 0`
54			`set data(client) ""`
55
56			`lappend tixBalloon(bals) $w`
57			`}`
58
59			`proc tixBalloon:ConstructWidget {w} {`
60			`upvar #0 $w data`
61
62			`tixChainMethod $w ConstructWidget`
63
64			`wm overrideredirect $w 1`
65			`wm withdraw $w`
66
67			`# Frame 1 : arrow`
68			`frame $w.f1 -bd 0`
69			`set data(w:label) [label $w.f1.lab -bd 0 -relief flat \`
70			`-bitmap [tix getbitmap balarrow]]`
71			`pack $data(w:label) -side left -padx 1 -pady 1`
72
73			`# Frame 2 : Message`
74			`frame $w.f2 -bd 0`
75			`set data(w:message) [label $w.f2.message -padx 0 -pady 0 -bd 0]`
76			`pack $data(w:message) -side left -expand yes -fill both -padx 10 -pady 1`
77
78			`# Pack all`
79			`pack $w.f1 -fill both`
80			`pack $w.f2 -fill both`
81
82			`# This is an event tag used by the clients`
83			`#`
84			`bind TixBal$w <Destroy> "tixBalloon:ClientDestroy $w %W"`
85			`}`
86
87			`proc tixBalloon:Destructor {w} {`
88			`global tixBalloon`
89
90			`set bals ""`
91			`foreach b $tixBalloon(bals) {`
92			`if {$w != $b} {`
93			`lappend bals $b`
94			`}`
95			`}`
96			`set tixBalloon(bals) $bals`
97
98			`tixChainMethod $w Destructor`
99			`}`
100
101			`#----------------------------------------------------------------------`
102			`# Config:`
103			`#----------------------------------------------------------------------`
104			`proc tixBalloon:config-state {w value} {`
105			`upvar #0 $w data`
106
107			`case $value {`
108			`{none balloon status both} ""`
109			`default {`
110			`error "invalid value $value, must be none, balloon, status, or both"`
111			`}`
112			`}`
113			`}`
114
115			`#----------------------------------------------------------------------`
116			`# "RAW" event bindings:`
117			`#----------------------------------------------------------------------`
118
119			`bind all <B1-Motion> "+tixBalloon_XXMotion %X %Y 1"`
120			`bind all <B2-Motion> "+tixBalloon_XXMotion %X %Y 2"`
121			`bind all <B3-Motion> "+tixBalloon_XXMotion %X %Y 3"`
122			`bind all <B4-Motion> "+tixBalloon_XXMotion %X %Y 4"`
123			`bind all <B5-Motion> "+tixBalloon_XXMotion %X %Y 5"`
124			`bind all <Any-Motion> "+tixBalloon_XXMotion %X %Y 0"`
125			`bind all <Leave> "+tixBalloon_XXMotion %X %Y %b"`
126			`bind all <Button> "+tixBalloon_XXButton %X %Y %b"`
127			`bind all <ButtonRelease> "+tixBalloon_XXButtonUp %X %Y %b"`
128
129			`proc tixBalloon_XXMotion {rootX rootY b} {`
130			`global tixBalloon`
131
132			`foreach w $tixBalloon(bals) {`
133			`tixBalloon:XXMotion $w $rootX $rootY $b`
134			`}`
135			`}`
136
137			`proc tixBalloon_XXButton {rootX rootY b} {`
138			`global tixBalloon`
139
140			`foreach w $tixBalloon(bals) {`
141			`tixBalloon:XXButton $w $rootX $rootY $b`
142			`}`
143			`}`
144
145			`proc tixBalloon_XXButtonUp {rootX rootY b} {`
146			`global tixBalloon`
147
148			`foreach w $tixBalloon(bals) {`
149			`tixBalloon:XXButtonUp $w $rootX $rootY $b`
150			`}`
151			`}`
152
153
154			`# return true if d is a descendant of w`
155			`#`
156			`proc tixIsDescendant {w d} {`
157			`if [string match $w .] {`
158			`return 1`
159			`}`
160			`return [string match $w.* $d]`
161			`}`
162
163			`# All the button events are fine if the ballooned widget is`
164			`# a descendant of the grabbing widget`
165			`#`
166			`proc tixBalloon:GrabBad {w cw} {`
167			`global tixBalloon`
168
169			`set g [grab current $w]`
170			`if {$g == ""} {`
171			`return 0`
172			`}`
173			`if [info exists tixBalloon(g_ignore,$g)] {`
174			`return 1`
175			`}`
176			`if [info exists tixBalloon(g_ignore,[winfo class $g])] {`
177			`return 1`
178			`}`
179			`if {$g == $cw \|\| [tixIsDescendant $g $cw]} {`
180			`return 0`
181			`}`
182			`return 1`
183			`}`
184
185			`proc tixBalloon:XXMotion {w rootX rootY b} {`
186			`upvar #0 $w data`
187
188			`if {$data(-state) == "none"} {`
189			`return`
190			`}`
191
192			`if {$b == 0} {`
193			`if [info exists data(b:1)] {unset data(b:1)}`
194			`if [info exists data(b:2)] {unset data(b:2)}`
195			`if [info exists data(b:3)] {unset data(b:3)}`
196			`if [info exists data(b:4)] {unset data(b:4)}`
197			`if [info exists data(b:5)] {unset data(b:5)}`
198			`}`
199
200
201			`if {[array names data b:*] != ""} {`
202			`# Some buttons are down. Do nothing`
203			`#`
204			`return`
205			`}`
206
207			`set cw [winfo containing $rootX $rootY]`
208			`if [tixBalloon:GrabBad $w $cw] {`
209			`return`
210			`}`
211
212			`# Find the a client window that matches`
213			`#`
214			`if {$w == $cw \|\| [string match $w.* $cw]} {`
215			`# Cursor moved over the balloon -- Ignore`
216			`return`
217			`}`
218
219			`while {$cw != ""} {`
220			`if [info exists data(m:$cw)] {`
221			`set client $cw`
222			`break`
223			`} else {`
224			`set cw [winfo parent $cw]`
225			`}`
226			`}`
227			`if {![info exists client]} {`
228			`# The cursor is at a position covered by a non-client`
229			`# Popdown the balloon if it is up`
230			`if {$data(isActive)} {`
231			`tixBalloon:Deactivate $w`
232			`}`
233			`set data(client) ""`
234			`if [info exists data(cancel)] {`
235			`unset data(cancel)`
236			`}`
237			`return`
238			`}`
239
240			`if {$data(client) != $client} {`
241			`if {$data(isActive)} {`
242			`tixBalloon:Deactivate $w`
243			`}`
244			`set data(client) $client`
245			`after $data(-initwait) tixBalloon:SwitchToClient $w $client`
246			`}`
247			`}`
248
249			`proc tixBalloon:XXButton {w rootX rootY b} {`
250			`upvar #0 $w data`
251
252			`tixBalloon:XXMotion $w $rootX $rootY $b`
253
254			`set data(b:$b) 1`
255
256			`if {$data(isActive)} {`
257			`tixBalloon:Deactivate $w`
258			`} else {`
259			`set data(cancel) 1`
260			`}`
261			`}`
262
263			`proc tixBalloon:XXButtonUp {w rootX rootY b} {`
264			`upvar #0 $w data`
265
266			`tixBalloon:XXMotion $w $rootX $rootY $b`
267			`if [info exists data(b:$b)] {`
268			`unset data(b:$b)`
269			`}`
270			`}`
271
272			`#----------------------------------------------------------------------`
273			`# "COOKED" event bindings:`
274			`#----------------------------------------------------------------------`
275
276			`# switch the balloon to a new client`
277			`#`
278			`proc tixBalloon:SwitchToClient {w client} {`
279			`upvar #0 $w data`
280
281			`if {![winfo exists $w]} {`
282			`return`
283			`}`
284			`if {![winfo exists $client]} {`
285			`return`
286			`}`
287			`if {$client != $data(client)} {`
288			`return`
289			`}`
290			`if [info exists data(cancel)] {`
291			`unset data(cancel)`
292			`return`
293			`}`
294
295			`if [tixBalloon:GrabBad $w $w] {`
296			`return`
297			`}`
298
299			`tixBalloon:Activate $w`
300			`}`
301
302			`proc tixBalloon:ClientDestroy {w client} {`
303			`if {![winfo exists $w]} {`
304			`return`
305			`}`
306
307			`upvar #0 $w data`
308
309			`if {$data(client) == $client} {`
310			`tixBalloon:Deactivate $w`
311			`set data(client) ""`
312			`}`
313
314			`# Maybe thses have already been unset by the Destroy method`
315			`#`
316			`if [info exists data(m:$client)] {unset data(m:$client)}`
317			`if [info exists data(s:$client)] {unset data(s:$client)}`
318			`}`
319
320			`#----------------------------------------------------------------------`
321			`# Popping up balloon:`
322			`#----------------------------------------------------------------------`
323			`proc tixBalloon:Activate {w} {`
324			`upvar #0 $w data`
325
326			`if [tixBalloon:GrabBad $w $w] {`
327			`return`
328			`}`
329			`if {[winfo containing [winfo pointerx $w] [winfo pointery $w]] == ""} {`
330			`return`
331			`}`
332
333			`switch $data(-state) {`
334			`"both" {`
335			`tixBalloon:PopUp $w`
336			`tixBalloon:SetStatus $w`
337			`}`
338			`"balloon" {`
339			`tixBalloon:PopUp $w`
340			`}`
341			`"status" {`
342			`tixBalloon:SetStatus $w`
343			`}`
344			`}`
345
346			`set data(isActive) 1`
347
348			`after 200 tixBalloon:Verify $w`
349			`}`
350
351
352			`# %% Perhaps this is no more needed`
353			`#`
354			`proc tixBalloon:Verify {w} {`
355			`upvar #0 $w data`
356
357			`if {![winfo exists $w]} {`
358			`return`
359			`}`
360			`if {!$data(isActive)} {`
361			`return`
362			`}`
363
364			`if [tixBalloon:GrabBad $w $w] {`
365			`tixBalloon:Deactivate $w`
366			`return`
367			`}`
368			`if {[winfo containing [winfo pointerx $w] [winfo pointery $w]] == ""} {`
369			`tixBalloon:Deactivate $w`
370			`return`
371			`}`
372			`after 200 tixBalloon:Verify $w`
373			`}`
374
375			`proc tixBalloon:Deactivate {w} {`
376			`upvar #0 $w data`
377
378			`tixBalloon:PopDown $w`
379			`tixBalloon:ClearStatus $w`
380			`set data(isActive) 0`
381			`if [info exists data(cancel)] {`
382			`unset data(cancel)`
383			`}`
384			`}`
385
386			`proc tixBalloon:PopUp {w} {`
387			`upvar #0 $w data`
388
389			`if [tixGetBoolean -nocomplain $data(-installcolormap)] {`
390			`wm colormapwindows [winfo toplevel $data(client)] $w`
391			`}`
392
393			`# trick: the following lines allow the balloon window to`
394			`# acquire a stable width and height when it is finally`
395			`# put on the visible screen`
396			`#`
397			`set client $data(client)`
398			`$data(w:message) config -text $data(m:$client)`
399			`wm geometry $w +10000+10000`
400			`wm deiconify $w`
401			`raise $w`
402			`update`
403
404			`# The windows may become destroyed as a result of the "update" command`
405			`#`
406			`if {![winfo exists $w]} {`
407			`return`
408			`}`
409			`if {![winfo exists $client]} {`
410			`return`
411			`}`
412			`# Put it on the visible screen`
413			`#`
414			`set x [expr [winfo rootx $client]+[winfo width $client]/2]`
415			`set y [expr int([winfo rooty $client]+[winfo height $client]/1.3)]`
416
417			`set width [winfo reqwidth $w]`
418			`set height [winfo reqheight $w]`
419			`set scrwidth [winfo vrootwidth $w]`
420			`set scrheight [winfo vrootheight $w]`
421
422			`# If the balloon is too far right, pull it back to the left`
423			`#`
424			`if {[expr $x + $width] > $scrwidth} {`
425			`set x [expr $scrwidth - $width]`
426			`}`
427
428			`# If the balloon is too far left, pull it back to the right`
429			`#`
430			`if {$x < 0} {`
431			`set x 0`
432			`}`
433
434			`# If the listbox is below bottom of screen, put it upwards`
435			`#`
436			`if {[expr $y + $height] > $scrheight} {`
437			`set y [expr $scrheight-$height]`
438			`}`
439			`if {$y < 0} {`
440			`set y 0`
441			`}`
442
443			`wm geometry $w +$x+$y`
444			`}`
445
446			`proc tixBalloon:PopDown {w} {`
447			`upvar #0 $w data`
448
449			`# Close the balloon`
450			`#`
451			`wm withdraw $w`
452
453			`# We don't set the data(client) to be zero, so that the balloon`
454			`# will re-appear only if you move out then in the client window`
455			`# set data(client) ""`
456			`}`
457
458			`proc tixBalloon:SetStatus {w} {`
459			`upvar #0 $w data`
460
461			`if {![winfo exists $data(-statusbar)]} {`
462			`return`
463			`}`
464			`if {![info exists data(s:$data(client))]} {`
465			`return`
466			`}`
467
468			`set vv [$data(-statusbar) cget -textvariable]`
469			`if {$vv == ""} {`
470			`$data(-statusbar) config -text $data(s:$data(client))`
471			`} else {`
472			`uplevel #0 set $vv [list $data(s:$data(client))]`
473			`}`
474			`}`
475
476			`proc tixBalloon:ClearStatus {w} {`
477			`upvar #0 $w data`
478
479			`if {![winfo exists $data(-statusbar)]} {`
480			`return`
481			`}`
482
483			`# Clear the StatusBar widget`
484			`#`
485			`set vv [$data(-statusbar) cget -textvariable]`
486			`if {$vv == ""} {`
487			`$data(-statusbar) config -text ""`
488			`} else {`
489			`uplevel #0 set $vv [list ""]`
490			`}`
491			`}`
492
493			`#----------------------------------------------------------------------`
494			`# PublicMethods:`
495			`#----------------------------------------------------------------------`
496
497			`# %% if balloon is already popped-up for this client, change mesage`
498			`#`
499			`proc tixBalloon:bind {w client args} {`
500			`upvar #0 $w data`
501
502			`if [info exists data(m:$client)] {`
503			`set alreadyBound 1`
504			`} else {`
505			`set alreadyBound 0`
506			`}`
507
508			`set opt(-balloonmsg) ""`
509			`set opt(-statusmsg) ""`
510			`set opt(-msg) ""`
511
512			`tixHandleOptions opt {-balloonmsg -msg -statusmsg} $args`
513
514			`if {$opt(-balloonmsg) != ""} {`
515			`set data(m:$client) $opt(-balloonmsg)`
516			`} else {`
517			`set data(m:$client) $opt(-msg)`
518			`}`
519			`if {$opt(-statusmsg) != ""} {`
520			`set data(s:$client) $opt(-statusmsg)`
521			`} else {`
522			`set data(s:$client) $opt(-msg)`
523			`}`
524
525			`tixAppendBindTag $client TixBal$w`
526			`}`
527
528			`proc tixBalloon:post {w client} {`
529			`upvar #0 $w data`
530
531			`if {![info exists data(m:$client)]} {`
532			`return`
533			`}`
534			`tixBalloon:Enter $w $client`
535			`incr data(fakeEnter)`
536			`}`
537
538			`proc tixBalloon:unbind {w client} {`
539			`upvar #0 $w data`
540
541			`if [info exists data(m:$client)] {`
542			`if [info exists data(m:$client)] {unset data(m:$client)}`
543			`if [info exists data(s:$client)] {unset data(s:$client)}`
544
545			`if [winfo exists $client] {`
546			`catch {tixDeleteBindTag $client TixBal$w}`
547			`}`
548			`}`
549			`}`
550
551			`#----------------------------------------------------------------------`
552			`#`
553			`# Utility function`
554			`#`
555			`#----------------------------------------------------------------------`
556			`#`
557			`# $w can be a widget name or a classs name`
558			`proc tixBalIgnoreWhenGrabbed {wc} {`
559			`global tixBalloon`
560			`set tixBalloon(g_ignore,$wc) ""`
561			`}`
562
563			`tixBalIgnoreWhenGrabbed TixComboBox`
564			`tixBalIgnoreWhenGrabbed Menu`
565			`tixBalIgnoreWhenGrabbed Menubutton`