golden hour

/usr/lib64/tcl8.5/Tix8.4.3

File/Folder	Size	Actions
Balloon.tcl	12.97 KB
BtnBox.tcl	2.61 KB
CObjView.tcl	7.56 KB
ChkList.tcl	4.97 KB
ComboBox.tcl	35.42 KB
Compat.tcl	870 B
Console.tcl	14.95 KB
Control.tcl	12.11 KB
DefSchm.tcl	2.94 KB
DialogS.tcl	4.2 KB
DirBox.tcl	5.3 KB
DirDlg.tcl	2.15 KB
DirList.tcl	6.9 KB
DirTree.tcl	8.76 KB
DragDrop.tcl	3.93 KB
DtlList.tcl	1002 B
EFileBox.tcl	11.12 KB
EFileDlg.tcl	1.68 KB
Event.tcl	5.11 KB
FileBox.tcl	14 KB
FileCbx.tcl	2.42 KB
FileDlg.tcl	2.13 KB
FileEnt.tcl	7.15 KB
FloatEnt.tcl	3.1 KB
Grid.tcl	21.16 KB
HList.tcl	17.72 KB
HListDD.tcl	4.39 KB
IconView.tcl	5.97 KB
Init.tcl	6.05 KB
LabEntry.tcl	2.09 KB
LabFrame.tcl	1.15 KB
LabWidg.tcl	3.86 KB
ListNBk.tcl	3.5 KB
Meter.tcl	3.04 KB
MultView.tcl	3.62 KB
NoteBook.tcl	6.02 KB
OldUtil.tcl	2.98 KB
OptMenu.tcl	9.17 KB
PanedWin.tcl	27.68 KB
PopMenu.tcl	5.37 KB
Primitiv.tcl	10.28 KB
README.txt	987 B
ResizeH.tcl	12.94 KB
SGrid.tcl	5.8 KB
SHList.tcl	3.7 KB
SListBox.tcl	6.97 KB
STList.tcl	2.37 KB
SText.tcl	3.09 KB
SWidget.tcl	9.52 KB
SWindow.tcl	6.75 KB
Select.tcl	7.04 KB
Shell.tcl	1.06 KB
SimpDlg.tcl	1.13 KB
StackWin.tcl	1.95 KB
StatBar.tcl	1.31 KB
StdBBox.tcl	1.62 KB
StdShell.tcl	1.15 KB
TList.tcl	17.59 KB
Tix.tcl	9.51 KB
Tree.tcl	4.57 KB
Utils.tcl	10.54 KB
VResize.tcl	4.95 KB
VStack.tcl	9.42 KB
VTree.tcl	4.31 KB
Variable.tcl	2.5 KB
WInfo.tcl	965 B
bitmaps	-
fs.tcl	3.9 KB
html	-
libTix.so	320.71 KB
license.terms	2.76 KB
pkgIndex.tcl	122 B
pref	-

Edit: Balloon.tcl

# -*- 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