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: Primitiv.tcl

# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
#	$Id: Primitiv.tcl,v 1.7 2004/03/28 02:44:57 hobbs Exp $
#
# Primitiv.tcl --
#
#	This is the primitive widget. It is just a frame with proper
#	inheritance wrapping. All new Tix widgets will be derived from
#	this widget
#
# Copyright (c) 1993-1999 Ioi Kim Lam.
# Copyright (c) 2000-2001 Tix Project Group.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

# No superclass, so the superclass switch is not used
#
#
tixWidgetClass tixPrimitive {
    -virtual true
    -superclass {}
    -classname  TixPrimitive
    -method {
	cget configure subwidget subwidgets
    }
    -flag {
	-background -borderwidth -cursor
	-height -highlightbackground -highlightcolor -highlightthickness
	-options -relief -takefocus -width -bd -bg
    }
    -static {
	-options
    }
    -configspec {
	{-background background Background #d9d9d9}
	{-borderwidth borderWidth BorderWidth 0}
	{-cursor cursor Cursor ""}
	{-height height Height 0}
	{-highlightbackground highlightBackground HighlightBackground #c3c3c3}
	{-highlightcolor highlightColor HighlightColor black}
	{-highlightthickness highlightThickness HighlightThickness 0}
	{-options options Options ""}
	{-relief relief Relief flat}
	{-takefocus takeFocus TakeFocus 0 tixVerifyBoolean}
	{-width width Width 0}
    }
    -alias {
	{-bd -borderwidth}
	{-bg -background}
    }
}

#----------------------------------------------------------------------
# ClassInitialization:
#----------------------------------------------------------------------

# not used
# Implemented in C
#
# Override: never
proc tixPrimitive:Constructor {w args} {

upvar #0 $w data
    upvar #0 $data(className) classRec

# Set up some minimal items in the class record.
    #
    set data(w:root)  $w
    set data(rootCmd) $w:root

# We need to create the root widget in order to parse the options
    # database
    tixCallMethod $w CreateRootWidget

# Parse the default options from the options database
    #
    tixPrimitive:ParseDefaultOptions $w

# Parse the options supplied by the user
    #
    tixPrimitive:ParseUserOptions $w $args

# Rename the widget command so that it can be use to access
    # the methods of this class

tixPrimitive:MkWidgetCmd $w

# Inistalize the Widget Record
    #
    tixCallMethod $w InitWidgetRec

# Construct the compound widget
    #
    tixCallMethod $w ConstructWidget

# Do the bindings
    #
    tixCallMethod $w SetBindings

# Call the configuration methods for all "force call" options
    #
    foreach option $classRec(forceCall) {
	tixInt_ChangeOptions $w $option $data($option)
    }
}

# Create only the root widget. We need the root widget to query the option
# database.
#
# Override: seldom. (unless you want to use a toplevel as root widget)
# Chain   : never.

proc tixPrimitive:CreateRootWidget {w args} {
    upvar #0 $w data
    upvar #0 $data(className) classRec

frame $w -class $data(ClassName)
}

proc tixPrimitive:ParseDefaultOptions {w} {
    upvar #0 $w data
    upvar #0 $data(className) classRec

# SET UP THE INSTANCE RECORD ACCORDING TO DEFAULT VALUES IN
    # THE OPTIONS DATABASE
    #
    foreach option $classRec(options) {
	set spec [tixInt_GetOptionSpec $data(className) $option]

if {[lindex $spec 0] eq "="} {
	    continue
	}

set o_name    [lindex $spec 1]
	set o_class   [lindex $spec 2]
	set o_default [lindex $spec 3]

if {![catch {option get $w $o_name $o_class} db_default]} {
	    if {$db_default ne ""} {
		set data($option) $db_default
	    } else {
		set data($option) $o_default
	    }
	} else {
	    set data($option) $o_default
	}
    }
}

proc tixPrimitive:ParseUserOptions {w arglist} {
    upvar #0 $w data
    upvar #0 $data(className) classRec

# SET UP THE INSTANCE RECORD ACCORDING TO COMMAND ARGUMENTS FROM
    # THE USER OF THE TIX LIBRARY (i.e. Application programmer:)
    #
    foreach {option arg} $arglist {
	if {[lsearch $classRec(options) $option] != "-1"} {
	    set spec [tixInt_GetOptionSpec $data(className) $option]

if {[lindex $spec 0] ne "="} {
		set data($option) $arg
	    } else {
		set realOption [lindex $spec 1]
		set data($realOption) $arg
	    }
	} else {
	    error "unknown option $option. Should be: [tixInt_ListOptions $w]"
	}
    }
}

#----------------------------------------------------------------------
# Initialize the widget record
# 
#
# Override: always
# Chain   : always, before
proc tixPrimitive:InitWidgetRec {w} {
    # default: do nothing
}

#----------------------------------------------------------------------
# SetBindings
# 
#
# Override: sometimes
# Chain   : sometimes, before
#
bind TixDestroyHandler <Destroy> {
    [tixGetMethod %W [set %W(className)] Destructor] %W
}

proc tixPrimitive:SetBindings {w} {
    upvar #0 $w data

if {[winfo toplevel $w] eq $w} {
	bindtags $w [concat TixDestroyHandler [bindtags $w]]
    } else {
	bind $data(w:root) <Destroy> \
	    "[tixGetMethod $w $data(className) Destructor] $w"
    }
}

#----------------------------------------------------------------------
# PrivateMethod: ConstructWidget
# 
# Construct and set up the compound widget
#
# Override: sometimes
# Chain   : sometimes, before
#
proc tixPrimitive:ConstructWidget {w} {
    upvar #0 $w data

$data(rootCmd) config \
	-background  $data(-background) \
	-borderwidth $data(-borderwidth) \
	-cursor      $data(-cursor) \
	-relief      $data(-relief)

if {$data(-width) != 0} {
	$data(rootCmd) config -width $data(-width)
    }
    if {$data(-height) != 0} {
	$data(rootCmd) config -height $data(-height)
    }

set rootname *[string range $w 1 end]

foreach {spec value} $data(-options) {
	option add $rootname*$spec $value 100
    }
}

#----------------------------------------------------------------------
# PrivateMethod: MkWidgetCmd
# 
# Construct and set up the compound widget
#
# Override: sometimes
# Chain   : sometimes, before
#
proc tixPrimitive:MkWidgetCmd {w} {
    upvar #0 $w data

rename $w $data(rootCmd)
    tixInt_MkInstanceCmd $w
}

#----------------------------------------------------------------------
# ConfigOptions:
#----------------------------------------------------------------------

#----------------------------------------------------------------------
# ConfigMethod: config
#
# Configure one option.
# 
# Override: always
# Chain   : automatic.
#
# Note the hack of [winfo width] in this procedure
#
# The hack is necessary because of the bad interaction between TK's geometry
# manager (the packer) and the frame widget. The packer determines the size
# of the root widget of the ComboBox (a frame widget) according to the
# requirement of the slaves inside the frame widget, NOT the -width
# option of the frame widget.
#
# However, everytime the frame widget is
# configured, it sends a geometry request to the packer according to its
# -width and -height options and the packer will temporarily resize
# the frame widget according to the requested size! The packer then realizes
# something is wrong and revert to the size determined by the slaves. This
# cause a flash on the screen.
#
foreach opt {-height -width -background -borderwidth -cursor
        -highlightbackground -highlightcolor -relief -takefocus -bd -bg} {

set tixPrimOpt($opt) 1
}

proc tixPrimitive:config {w option value} {
    global tixPrimOpt
    upvar #0 $w data

if {[info exists tixPrimOpt($option)]} {
	$data(rootCmd) config $option $value
    }
}

#----------------------------------------------------------------------
# PublicMethods:
#----------------------------------------------------------------------

#----------------------------------------------------------------------
# This method is used to implement the "subwidgets" widget command.
# Will be re-written in C. It can't be used as a public method because
# of the lame substring comparison routines used in tixClass.c
#
#
proc tixPrimitive:subwidgets {w type args} {
    upvar #0 $w data

case $type {
	-class {
	    set name [lindex $args 0]
	    set args [lrange $args 1 end]
	    # access subwidgets of a particular class
	    #
	    # note: if $name=="Frame", will *not return the root widget as well
	    #
	    set sub ""
	    foreach des [tixDescendants $w] {
		if {[winfo class $des] eq $name} {
		    lappend sub $des
		}
	    }

# Note: if the there is no subwidget of this class, does not
	    # cause any error.
	    #
	    if {$args eq ""} {
		return $sub
	    } else {
		foreach des $sub {
		    eval [linsert $args 0 $des]
		}
		return ""
	    }
	}
	-group {
	    set name [lindex $args 0]
	    set args [lrange $args 1 end]
	    # access subwidgets of a particular group
	    #
	    if {[info exists data(g:$name)]} {
		if {$args eq ""} {
		    set ret ""
		    foreach item $data(g:$name) {
			lappend ret $w.$item
		    }
		    return $ret
		} else {
		    foreach item $data(g:$name) {
			eval [linsert $args 0 $w.$item]
		    }
		    return ""
		}
	    } else {
		error "no such subwidget group $name"
	    }
	}
	-all {
	    set sub [tixDescendants $w]

if {$args eq ""} {
		return $sub
	    } else {
		foreach des $sub {
		    eval [linsert $args 0 $des]
		}
		return ""
	    }
	}
	default {
	    error "unknown flag $type, should be -all, -class or -group"
	}
    }
}

#----------------------------------------------------------------------
# PublicMethod: subwidget
#
# Access a subwidget withe a particular name 
#
# Override: never
# Chain   : never
#
# This is implemented in native C code in tixClass.c
#
proc tixPrimitive:subwidget {w name args} {
    upvar #0 $w data

if {[info exists data(w:$name)]} {
	if {$args eq ""} {
	    return $data(w:$name)
	} else {
	    return [eval [linsert $args 0 $data(w:$name)]]
	}
    } else {
	error "no such subwidget $name"
    }
}

#----------------------------------------------------------------------
# PrivateMethods:
#----------------------------------------------------------------------

# delete the widget record and remove the command
#
proc tixPrimitive:Destructor {w} {
    upvar #0 $w data

if {![info exists data(w:root)]} {
	return
    }

if {[llength [info commands $w]]} {
	# remove the command
	rename $w ""
    }

if {[llength [info commands $data(rootCmd)]]} {
	# remove the command of the root widget
	rename $data(rootCmd) ""
    }

# delete the widget record
    catch {unset data}
}