#$@%#$%!

Ngiler SH3LL 360
: / lib64 / tcl8.6 / Tix8.4.3 /

Information Server
MySQL : OFF Perl : OFF CURL : ON WGET : OFF PKEXEC : OFF

Directive	Local Value
IP Address	162.0.209.101
System	Linux premium169.web-hosting.com 4.18.0-553.50.1.lve.el8.x86_64 #1 SMP Thu Apr 17 19:10:24 UTC 2025 x86_64
User	luxeelil
PHP Version	8.0.30
Software	LiteSpeed
Doc root	Writable

Edit File : Balloon.tcl \| Size : 12.97 KB
# -- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -- # # $Id: Balloon.tcl,v 1.7 2008/02/27 22:17:28 hobbs Exp $ # # 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) 1993-1999 Ioi Kim Lam. # Copyright (c) 2000-2001 Tix Project Group. # Copyright (c) 2004 ActiveState # # 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 -cursor } -configspec { {-installcolormap installColormap InstallColormap false} {-initwait initWait InitWait 1000} {-state state State both} {-statusbar statusBar StatusBar ""} {-cursor cursor Cursor {}} } -default { {background #ffff60} {foreground black} {borderWidth 0} {.borderWidth 1} {.background black} {Label.anchor w} {Label.justify left} } } # static seem to be -installcolormap -initwait -statusbar -cursor # Class Record # global tixBalloon 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 if {[tk windowingsystem] eq "aqua"} { ::tk::unsupported::MacWindowStyle style $w help none } else { wm overrideredirect $w 1 } catch {wm attributes $w -topmost 1} wm positionfrom $w program 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> [list 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 set re {^(none\|balloon\|status\|both)$} if {![regexp -- $re $value]} { 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" # Should %b be 0? %b is illegal bind all <Leave> "+tixBalloon_XXMotion %X %Y 0" 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} { return [expr {$w eq "." \|\| [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 {![info exists data(-state)]} { # puts "tixBalloon:XXMotion called without a state\n$w" set data(state) none return } if {$data(-state) eq "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 {[llength [array names data b:]]} { # Some buttons are down. Do nothing # return } set cw [winfo containing -displayof $w $rootX $rootY] if {[tixBalloon:GrabBad $w $cw]} { return } # Find the a client window that matches # if {$w eq $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) ne $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 ne $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) eq $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 -displayof $w \ [winfo pointerx $w] [winfo pointery $w]] == ""} { return } if {![info exists data(-state)]} { # puts "tixBalloon:Activate called without a state\n$w" set data(state) none return } if {$data(-state) eq "none"} { return } switch -exact -- $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 -displayof $w \ [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 {[string is true -strict $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) if {$data(m:$client) == ""} {return ""} $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 {($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 {($y + $height) > $scrheight} { set y [expr {$scrheight-$height}] } if {$y < 0} { set y 0 } wm geometry $w +$x+$y after idle raise $w } 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)] \|\| ![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 set alreadyBound [info exists data(m:$client)] 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)] \|\| $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 Back

Edit File : Balloon.tcl | Size : 12.97 KB

# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
#	$Id: Balloon.tcl,v 1.7 2008/02/27 22:17:28 hobbs Exp $
#
# 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) 1993-1999 Ioi Kim Lam.
# Copyright (c) 2000-2001 Tix Project Group.
# Copyright (c) 2004 ActiveState
#
# 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 -cursor
    }
    -configspec {
	{-installcolormap installColormap InstallColormap false}
	{-initwait initWait InitWait 1000}
	{-state state State both}
	{-statusbar statusBar StatusBar ""}
 	{-cursor cursor Cursor {}}
    }
    -default {
	{*background 			#ffff60}
	{*foreground 			black}
	{*borderWidth 			0}
	{.borderWidth 			1}
	{.background 			black}
	{*Label.anchor			w}
	{*Label.justify			left}
    }
}
# static seem to be -installcolormap -initwait -statusbar -cursor

# Class Record
#
global tixBalloon
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

if {[tk windowingsystem] eq "aqua"} {
	::tk::unsupported::MacWindowStyle style $w help none
    } else {
	wm overrideredirect $w 1
    }
    catch {wm attributes $w -topmost 1}
    wm positionfrom $w program
    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> [list 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

set re {^(none|balloon|status|both)$}
    if {![regexp -- $re $value]} {
	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"
# Should %b be 0? %b is illegal
bind all <Leave>      	    "+tixBalloon_XXMotion %X %Y 0"
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} {
    return [expr {$w eq "." || [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 {![info exists data(-state)]} {
	# puts "tixBalloon:XXMotion called without a state\n$w"
	set data(state) none
	return
    }
    if {$data(-state) eq "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 {[llength [array names data b:*]]} {
	# Some buttons are down. Do nothing
	#
	return
    }

set cw [winfo containing -displayof $w $rootX $rootY]
    if {[tixBalloon:GrabBad $w $cw]} {
	return
    }

# Find the a client window that matches
    #
    if {$w eq $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) ne $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 ne $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) eq $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 -displayof $w \
	    [winfo pointerx $w] [winfo pointery $w]] == ""} {
	return
    }

if {![info exists data(-state)]} {
	# puts "tixBalloon:Activate called without a state\n$w"
	set data(state) none
	return
    }
    if {$data(-state) eq "none"} {
	return
    }

switch -exact -- $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 -displayof $w \
	    [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 {[string is true -strict $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)
    if {$data(m:$client) == ""} {return ""}

$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 {($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 {($y + $height) > $scrheight} {
	set y [expr {$scrheight-$height}]
    }
    if {$y < 0} {
	set y 0
    }

wm geometry $w +$x+$y
    after idle raise $w
}

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)]
	|| ![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

set alreadyBound [info exists data(m:$client)]

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)] || $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

Back