ag/cpython-bin-deps
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Import build of Tcl/Tk 8.6.10

Browse Source
This commit is contained in:
Steve Dower
2020-09-24 23:32:28 +01:00
parent 86027ce3ed
commit c0c00d5551
498 changed files with 65344 additions and 64042 deletions
Download Patch File Download Diff File Expand all files Collapse all files

8
amd64/lib/dde1.4/pkgIndex.tcl
View File

@@ -1,7 +1,7 @@
if {([info commands ::tcl::pkgconfig] eq "")
|| ([info sharedlibextension] ne ".dll")} return
if {![package vsatisfies [package provide Tcl] 8.5]} return
if {[info sharedlibextension] != ".dll"} return
if {[::tcl::pkgconfig get debug]} {
package ifneeded dde 1.4.1 [list load [file join $dir tcldde14g.dll] dde]
package ifneeded dde 1.4.2 [list load [file join $dir tcldde14g.dll] dde]
} else {
package ifneeded dde 1.4.1 [list load [file join $dir tcldde14.dll] dde]
package ifneeded dde 1.4.2 [list load [file join $dir tcldde14.dll] dde]
}

BIN
amd64/lib/dde1.4/tcldde14.dll
View File

Binary file not shown.

16
amd64/lib/nmake/nmakehlp.c
View File

@@ -643,7 +643,7 @@ SubstituteFile(
}
/* debug: dump the list */
#ifdef _DEBUG
#ifndef NDEBUG
{
int n = 0;
list_item_t *p = NULL;
@@ -686,10 +686,10 @@ SubstituteFile(
BOOL FileExists(LPCTSTR szPath)
{
#ifndef INVALID_FILE_ATTRIBUTES
#define INVALID_FILE_ATTRIBUTES ((DWORD)-1)
#define INVALID_FILE_ATTRIBUTES ((DWORD)-1)
#endif
DWORD pathAttr = GetFileAttributes(szPath);
return (pathAttr != INVALID_FILE_ATTRIBUTES &&
return (pathAttr != INVALID_FILE_ATTRIBUTES &&
!(pathAttr & FILE_ATTRIBUTE_DIRECTORY));
}
@@ -740,7 +740,7 @@ static int LocateDependencyHelper(const char *dir, const char *keypath)
#if 0 /* This function is not available in Visual C++ 6 */
/*
* Use numerics 0 -> FindExInfoStandard,
* 1 -> FindExSearchLimitToDirectories,
* 1 -> FindExSearchLimitToDirectories,
* as these are not defined in Visual C++ 6
*/
hSearch = FindFirstFileEx(path, 0, &finfo, 1, NULL, 0);
@@ -755,7 +755,7 @@ static int LocateDependencyHelper(const char *dir, const char *keypath)
do {
int sublen;
/*
* We need to check it is a directory despite the
* We need to check it is a directory despite the
* FindExSearchLimitToDirectories in the above call. See SDK docs
*/
if ((finfo.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY) == 0)
@@ -786,15 +786,15 @@ static int LocateDependencyHelper(const char *dir, const char *keypath)
* that is used to confirm it is the correct directory.
* The search path for the package directory is currently only
* the parent and grandparent of the current working directory.
* If found, the command prints
* If found, the command prints
* name_DIRPATH=<full path of located directory>
* and returns 0. If not found, does not print anything and returns 1.
*/
static int LocateDependency(const char *keypath)
{
int i, ret;
static char *paths[] = {"..", "..\\..", "..\\..\\.."};
static const char *paths[] = {"..", "..\\..", "..\\..\\.."};
for (i = 0; i < (sizeof(paths)/sizeof(paths[0])); ++i) {
ret = LocateDependencyHelper(paths[i], keypath);
if (ret == 0)

3534
amd64/lib/nmake/rules.vc
View File

File diff suppressed because it is too large Load Diff

196
amd64/lib/nmake/targets.vc
View File

@@ -1,98 +1,98 @@
#------------------------------------------------------------- -*- makefile -*-
# targets.vc --
#
# Part of the nmake based build system for Tcl and its extensions.
# This file defines some standard targets for the convenience of extensions
# and can be optionally included by the extension makefile.
# See TIP 477 (https://core.tcl.tk/tips/doc/trunk/tip/477.md) for docs.
$(PROJECT): setup pkgindex $(PRJLIB)
!ifdef PRJ_STUBOBJS
$(PROJECT): $(PRJSTUBLIB)
$(PRJSTUBLIB): $(PRJ_STUBOBJS)
$(LIBCMD) $**
$(PRJ_STUBOBJS):
$(CCSTUBSCMD) %s
!endif # PRJ_STUBOBJS
!ifdef PRJ_MANIFEST
$(PROJECT): $(PRJLIB).manifest
$(PRJLIB).manifest: $(PRJ_MANIFEST)
@nmakehlp -s << $** >$@
@MACHINE@ $(MACHINE:IX86=X86)
<<
!endif
!if "$(PROJECT)" != "tcl" && "$(PROJECT)" != "tk"
$(PRJLIB): $(PRJ_OBJS) $(RESFILE)
!if $(STATIC_BUILD)
$(LIBCMD) $**
!else
$(DLLCMD) $**
$(_VC_MANIFEST_EMBED_DLL)
!endif
-@del $*.exp
!endif
!if "$(PRJ_HEADERS)" != "" && "$(PRJ_OBJS)" != ""
$(PRJ_OBJS): $(PRJ_HEADERS)
!endif
# If parent makefile has defined stub objects, add their installation
# to the default install
!if "$(PRJ_STUBOBJS)" != ""
default-install: default-install-stubs
!endif
# Unlike the other default targets, these cannot be in rules.vc because
# the executed command depends on existence of macro PRJ_HEADERS_PUBLIC
# that the parent makefile will not define until after including rules-ext.vc
!if "$(PRJ_HEADERS_PUBLIC)" != ""
default-install: default-install-headers
default-install-headers:
@echo Installing headers to '$(INCLUDE_INSTALL_DIR)'
@for %f in ($(PRJ_HEADERS_PUBLIC)) do @$(COPY) %f "$(INCLUDE_INSTALL_DIR)"
!endif
!if "$(DISABLE_STANDARD_TARGETS)" == ""
DISABLE_STANDARD_TARGETS = 0
!endif
!if "$(DISABLE_TARGET_setup)" == ""
DISABLE_TARGET_setup = 0
!endif
!if "$(DISABLE_TARGET_install)" == ""
DISABLE_TARGET_install = 0
!endif
!if "$(DISABLE_TARGET_clean)" == ""
DISABLE_TARGET_clean = 0
!endif
!if "$(DISABLE_TARGET_test)" == ""
DISABLE_TARGET_test = 0
!endif
!if "$(DISABLE_TARGET_shell)" == ""
DISABLE_TARGET_shell = 0
!endif
!if !$(DISABLE_STANDARD_TARGETS)
!if !$(DISABLE_TARGET_setup)
setup: default-setup
!endif
!if !$(DISABLE_TARGET_install)
install: default-install
!endif
!if !$(DISABLE_TARGET_clean)
clean: default-clean
realclean: hose
hose: default-hose
distclean: realclean default-distclean
!endif
!if !$(DISABLE_TARGET_test)
test: default-test
!endif
!if !$(DISABLE_TARGET_shell)
shell: default-shell
!endif
!endif # DISABLE_STANDARD_TARGETS
#------------------------------------------------------------- -*- makefile -*-
# targets.vc --
#
# Part of the nmake based build system for Tcl and its extensions.
# This file defines some standard targets for the convenience of extensions
# and can be optionally included by the extension makefile.
# See TIP 477 (https://core.tcl-lang.org/tips/doc/trunk/tip/477.md) for docs.
$(PROJECT): setup pkgindex $(PRJLIB)
!ifdef PRJ_STUBOBJS
$(PROJECT): $(PRJSTUBLIB)
$(PRJSTUBLIB): $(PRJ_STUBOBJS)
$(LIBCMD) $**
$(PRJ_STUBOBJS):
$(CCSTUBSCMD) %s
!endif # PRJ_STUBOBJS
!ifdef PRJ_MANIFEST
$(PROJECT): $(PRJLIB).manifest
$(PRJLIB).manifest: $(PRJ_MANIFEST)
@nmakehlp -s << $** >$@
@MACHINE@ $(MACHINE:IX86=X86)
<<
!endif
!if "$(PROJECT)" != "tcl" && "$(PROJECT)" != "tk"
$(PRJLIB): $(PRJ_OBJS) $(RESFILE)
!if $(STATIC_BUILD)
$(LIBCMD) $**
!else
$(DLLCMD) $**
$(_VC_MANIFEST_EMBED_DLL)
!endif
-@del $*.exp
!endif
!if "$(PRJ_HEADERS)" != "" && "$(PRJ_OBJS)" != ""
$(PRJ_OBJS): $(PRJ_HEADERS)
!endif
# If parent makefile has defined stub objects, add their installation
# to the default install
!if "$(PRJ_STUBOBJS)" != ""
default-install: default-install-stubs
!endif
# Unlike the other default targets, these cannot be in rules.vc because
# the executed command depends on existence of macro PRJ_HEADERS_PUBLIC
# that the parent makefile will not define until after including rules-ext.vc
!if "$(PRJ_HEADERS_PUBLIC)" != ""
default-install: default-install-headers
default-install-headers:
@echo Installing headers to '$(INCLUDE_INSTALL_DIR)'
@for %f in ($(PRJ_HEADERS_PUBLIC)) do @$(COPY) %f "$(INCLUDE_INSTALL_DIR)"
!endif
!if "$(DISABLE_STANDARD_TARGETS)" == ""
DISABLE_STANDARD_TARGETS = 0
!endif
!if "$(DISABLE_TARGET_setup)" == ""
DISABLE_TARGET_setup = 0
!endif
!if "$(DISABLE_TARGET_install)" == ""
DISABLE_TARGET_install = 0
!endif
!if "$(DISABLE_TARGET_clean)" == ""
DISABLE_TARGET_clean = 0
!endif
!if "$(DISABLE_TARGET_test)" == ""
DISABLE_TARGET_test = 0
!endif
!if "$(DISABLE_TARGET_shell)" == ""
DISABLE_TARGET_shell = 0
!endif
!if !$(DISABLE_STANDARD_TARGETS)
!if !$(DISABLE_TARGET_setup)
setup: default-setup
!endif
!if !$(DISABLE_TARGET_install)
install: default-install
!endif
!if !$(DISABLE_TARGET_clean)
clean: default-clean
realclean: hose
hose: default-hose
distclean: realclean default-distclean
!endif
!if !$(DISABLE_TARGET_test)
test: default-test
!endif
!if !$(DISABLE_TARGET_shell)
shell: default-shell
!endif
!endif # DISABLE_STANDARD_TARGETS

9
amd64/lib/nmake/tcl.nmake
View File

@@ -1,5 +1,4 @@
CORE_MACHINE = AMD64
CORE_DEBUG = 0
CORE_TCL_THREADS = 1
CORE_USE_THREAD_ALLOC = 1
CORE_USE_WIDECHAR_API = 1
CORE_MACHINE = AMD64
CORE_DEBUG = 0
CORE_TCL_THREADS = 1
CORE_USE_THREAD_ALLOC = 1

8
amd64/lib/reg1.3/pkgIndex.tcl
View File

@@ -1,9 +1,9 @@
if {([info commands ::tcl::pkgconfig] eq "")
|| ([info sharedlibextension] ne ".dll")} return
if {![package vsatisfies [package provide Tcl] 8.5]} return
if {[info sharedlibextension] != ".dll"} return
if {[::tcl::pkgconfig get debug]} {
package ifneeded registry 1.3.3 \
package ifneeded registry 1.3.4 \
[list load [file join $dir tclreg13g.dll] registry]
} else {
package ifneeded registry 1.3.3 \
package ifneeded registry 1.3.4 \
[list load [file join $dir tclreg13.dll] registry]
}

BIN
amd64/lib/reg1.3/tclreg13.dll
View File

Binary file not shown.

6
amd64/lib/tcl8.6/init.tcl
View File

@@ -16,7 +16,7 @@
if {[info commands package] == ""} {
error "version mismatch: library\nscripts expect Tcl version 7.5b1 or later but the loaded version is\nonly [info patchlevel]"
}
package require -exact Tcl 8.6.9
package require -exact Tcl 8.6.10
# Compute the auto path to use in this interpreter.
# The values on the path come from several locations:
@@ -668,7 +668,9 @@ proc auto_execok name {
}
set path "[file dirname [info nameof]];.;"
if {[info exists env(WINDIR)]} {
if {[info exists env(SystemRoot)]} {
set windir $env(SystemRoot)
} elseif {[info exists env(WINDIR)]} {
set windir $env(WINDIR)
}
if {[info exists windir]} {

2
amd64/lib/tcl8.6/msgs/ja.msg
View File

@@ -40,5 +40,5 @@ namespace eval ::tcl::clock {
::msgcat::mcset ja LOCALE_DATE_FORMAT "%EY\u5e74%m\u6708%d\u65e5"
::msgcat::mcset ja LOCALE_TIME_FORMAT "%H\u6642%M\u5206%S\u79d2"
::msgcat::mcset ja LOCALE_DATE_TIME_FORMAT "%EY\u5e74%m\u6708%d\u65e5 (%a) %H\u6642%M\u5206%S\u79d2 %z"
::msgcat::mcset ja LOCALE_ERAS "\u007b-9223372036854775808 \u897f\u66a6 0\u007d \u007b-3061011600 \u660e\u6cbb 1867\u007d \u007b-1812186000 \u5927\u6b63 1911\u007d \u007b-1357635600 \u662d\u548c 1925\u007d \u007b600220800 \u5e73\u6210 1988\u007d"
::msgcat::mcset ja LOCALE_ERAS "{-9223372036854775808 \u897f\u66a6 0} {-3061011600 \u660e\u6cbb 1867} {-1812186000 \u5927\u6b63 1911} {-1357635600 \u662d\u548c 1925} {600220800 \u5e73\u6210 1988} {1556668800 \u4ee4\u548c 2018}"
}

3
amd64/lib/tcl8.6/tclIndex
View File

@@ -73,3 +73,6 @@ set auto_index(::tcl::tm::Defaults) [list source [file join $dir tm.tcl]]
set auto_index(::tcl::tm::UnknownHandler) [list source [file join $dir tm.tcl]]
set auto_index(::tcl::tm::roots) [list source [file join $dir tm.tcl]]
set auto_index(::tcl::tm::path) [list source [file join $dir tm.tcl]]
if {[namespace exists ::tcl::unsupported]} {
set auto_index(timerate) {namespace import ::tcl::unsupported::timerate}
}

4
amd64/lib/tcl8.6/tm.tcl
View File

@@ -311,7 +311,7 @@ proc ::tcl::tm::UnknownHandler {original name args} {
proc ::tcl::tm::Defaults {} {
global env tcl_platform
lassign [split [info tclversion] .] major minor
regexp {^(\d+)\.(\d+)} [package provide Tcl] - major minor
set exe [file normalize [info nameofexecutable]]
# Note that we're using [::list], not [list] because [list] means
@@ -354,7 +354,7 @@ proc ::tcl::tm::Defaults {} {
# Calls 'path add' to paths to the list of module search paths.
proc ::tcl::tm::roots {paths} {
regexp {^(\d+)\.(\d+)} [package present Tcl] - major minor
regexp {^(\d+)\.(\d+)} [package provide Tcl] - major minor
foreach pa $paths {
set p [file join $pa tcl$major]
for {set n $minor} {$n >= 0} {incr n -1} {

144
amd64/lib/tcl8.6/tzdata/Africa/Casablanca
View File

@@ -56,5 +56,147 @@ set TZData(:Africa/Casablanca) {
{1521943200 3600 1 +00}
{1526176800 0 0 +00}
{1529200800 3600 1 +00}
{1540598400 3600 0 +01}
{1540695600 3600 0 +01}
{1557021600 0 1 +01}
{1560045600 3600 0 +01}
{1587261600 0 1 +01}
{1590285600 3600 0 +01}
{1618106400 0 1 +01}
{1621130400 3600 0 +01}
{1648346400 0 1 +01}
{1651975200 3600 0 +01}
{1679191200 0 1 +01}
{1682215200 3600 0 +01}
{1710036000 0 1 +01}
{1713060000 3600 0 +01}
{1740276000 0 1 +01}
{1743904800 3600 0 +01}
{1771120800 0 1 +01}
{1774144800 3600 0 +01}
{1801965600 0 1 +01}
{1804989600 3600 0 +01}
{1832205600 0 1 +01}
{1835229600 3600 0 +01}
{1863050400 0 1 +01}
{1866074400 3600 0 +01}
{1893290400 0 1 +01}
{1896919200 3600 0 +01}
{1924135200 0 1 +01}
{1927159200 3600 0 +01}
{1954980000 0 1 +01}
{1958004000 3600 0 +01}
{1985220000 0 1 +01}
{1988848800 3600 0 +01}
{2016064800 0 1 +01}
{2019088800 3600 0 +01}
{2046304800 0 1 +01}
{2049933600 3600 0 +01}
{2077149600 0 1 +01}
{2080173600 3600 0 +01}
{2107994400 0 1 +01}
{2111018400 3600 0 +01}
{2138234400 0 1 +01}
{2141863200 3600 0 +01}
{2169079200 0 1 +01}
{2172103200 3600 0 +01}
{2199924000 0 1 +01}
{2202948000 3600 0 +01}
{2230164000 0 1 +01}
{2233792800 3600 0 +01}
{2261008800 0 1 +01}
{2264032800 3600 0 +01}
{2291248800 0 1 +01}
{2294877600 3600 0 +01}
{2322093600 0 1 +01}
{2325117600 3600 0 +01}
{2352938400 0 1 +01}
{2355962400 3600 0 +01}
{2383178400 0 1 +01}
{2386807200 3600 0 +01}
{2414023200 0 1 +01}
{2417047200 3600 0 +01}
{2444868000 0 1 +01}
{2447892000 3600 0 +01}
{2475108000 0 1 +01}
{2478736800 3600 0 +01}
{2505952800 0 1 +01}
{2508976800 3600 0 +01}
{2536192800 0 1 +01}
{2539821600 3600 0 +01}
{2567037600 0 1 +01}
{2570061600 3600 0 +01}
{2597882400 0 1 +01}
{2600906400 3600 0 +01}
{2628122400 0 1 +01}
{2631751200 3600 0 +01}
{2658967200 0 1 +01}
{2661991200 3600 0 +01}
{2689812000 0 1 +01}
{2692836000 3600 0 +01}
{2720052000 0 1 +01}
{2723680800 3600 0 +01}
{2750896800 0 1 +01}
{2753920800 3600 0 +01}
{2781136800 0 1 +01}
{2784765600 3600 0 +01}
{2811981600 0 1 +01}
{2815005600 3600 0 +01}
{2842826400 0 1 +01}
{2845850400 3600 0 +01}
{2873066400 0 1 +01}
{2876695200 3600 0 +01}
{2903911200 0 1 +01}
{2906935200 3600 0 +01}
{2934756000 0 1 +01}
{2937780000 3600 0 +01}
{2964996000 0 1 +01}
{2968020000 3600 0 +01}
{2995840800 0 1 +01}
{2998864800 3600 0 +01}
{3026080800 0 1 +01}
{3029709600 3600 0 +01}
{3056925600 0 1 +01}
{3059949600 3600 0 +01}
{3087770400 0 1 +01}
{3090794400 3600 0 +01}
{3118010400 0 1 +01}
{3121639200 3600 0 +01}
{3148855200 0 1 +01}
{3151879200 3600 0 +01}
{3179700000 0 1 +01}
{3182724000 3600 0 +01}
{3209940000 0 1 +01}
{3212964000 3600 0 +01}
{3240784800 0 1 +01}
{3243808800 3600 0 +01}
{3271024800 0 1 +01}
{3274653600 3600 0 +01}
{3301869600 0 1 +01}
{3304893600 3600 0 +01}
{3332714400 0 1 +01}
{3335738400 3600 0 +01}
{3362954400 0 1 +01}
{3366583200 3600 0 +01}
{3393799200 0 1 +01}
{3396823200 3600 0 +01}
{3424644000 0 1 +01}
{3427668000 3600 0 +01}
{3454884000 0 1 +01}
{3457908000 3600 0 +01}
{3485728800 0 1 +01}
{3488752800 3600 0 +01}
{3515968800 0 1 +01}
{3519597600 3600 0 +01}
{3546813600 0 1 +01}
{3549837600 3600 0 +01}
{3577658400 0 1 +01}
{3580682400 3600 0 +01}
{3607898400 0 1 +01}
{3611527200 3600 0 +01}
{3638743200 0 1 +01}
{3641767200 3600 0 +01}
{3669588000 0 1 +01}
{3672612000 3600 0 +01}
{3699828000 0 1 +01}
{3702852000 3600 0 +01}
}

144
amd64/lib/tcl8.6/tzdata/Africa/El_Aaiun
View File

@@ -45,5 +45,147 @@ set TZData(:Africa/El_Aaiun) {
{1521943200 3600 1 +00}
{1526176800 0 0 +00}
{1529200800 3600 1 +00}
{1540598400 3600 0 +01}
{1540695600 3600 0 +01}
{1557021600 0 1 +01}
{1560045600 3600 0 +01}
{1587261600 0 1 +01}
{1590285600 3600 0 +01}
{1618106400 0 1 +01}
{1621130400 3600 0 +01}
{1648346400 0 1 +01}
{1651975200 3600 0 +01}
{1679191200 0 1 +01}
{1682215200 3600 0 +01}
{1710036000 0 1 +01}
{1713060000 3600 0 +01}
{1740276000 0 1 +01}
{1743904800 3600 0 +01}
{1771120800 0 1 +01}
{1774144800 3600 0 +01}
{1801965600 0 1 +01}
{1804989600 3600 0 +01}
{1832205600 0 1 +01}
{1835229600 3600 0 +01}
{1863050400 0 1 +01}
{1866074400 3600 0 +01}
{1893290400 0 1 +01}
{1896919200 3600 0 +01}
{1924135200 0 1 +01}
{1927159200 3600 0 +01}
{1954980000 0 1 +01}
{1958004000 3600 0 +01}
{1985220000 0 1 +01}
{1988848800 3600 0 +01}
{2016064800 0 1 +01}
{2019088800 3600 0 +01}
{2046304800 0 1 +01}
{2049933600 3600 0 +01}
{2077149600 0 1 +01}
{2080173600 3600 0 +01}
{2107994400 0 1 +01}
{2111018400 3600 0 +01}
{2138234400 0 1 +01}
{2141863200 3600 0 +01}
{2169079200 0 1 +01}
{2172103200 3600 0 +01}
{2199924000 0 1 +01}
{2202948000 3600 0 +01}
{2230164000 0 1 +01}
{2233792800 3600 0 +01}
{2261008800 0 1 +01}
{2264032800 3600 0 +01}
{2291248800 0 1 +01}
{2294877600 3600 0 +01}
{2322093600 0 1 +01}
{2325117600 3600 0 +01}
{2352938400 0 1 +01}
{2355962400 3600 0 +01}
{2383178400 0 1 +01}
{2386807200 3600 0 +01}
{2414023200 0 1 +01}
{2417047200 3600 0 +01}
{2444868000 0 1 +01}
{2447892000 3600 0 +01}
{2475108000 0 1 +01}
{2478736800 3600 0 +01}
{2505952800 0 1 +01}
{2508976800 3600 0 +01}
{2536192800 0 1 +01}
{2539821600 3600 0 +01}
{2567037600 0 1 +01}
{2570061600 3600 0 +01}
{2597882400 0 1 +01}
{2600906400 3600 0 +01}
{2628122400 0 1 +01}
{2631751200 3600 0 +01}
{2658967200 0 1 +01}
{2661991200 3600 0 +01}
{2689812000 0 1 +01}
{2692836000 3600 0 +01}
{2720052000 0 1 +01}
{2723680800 3600 0 +01}
{2750896800 0 1 +01}
{2753920800 3600 0 +01}
{2781136800 0 1 +01}
{2784765600 3600 0 +01}
{2811981600 0 1 +01}
{2815005600 3600 0 +01}
{2842826400 0 1 +01}
{2845850400 3600 0 +01}
{2873066400 0 1 +01}
{2876695200 3600 0 +01}
{2903911200 0 1 +01}
{2906935200 3600 0 +01}
{2934756000 0 1 +01}
{2937780000 3600 0 +01}
{2964996000 0 1 +01}
{2968020000 3600 0 +01}
{2995840800 0 1 +01}
{2998864800 3600 0 +01}
{3026080800 0 1 +01}
{3029709600 3600 0 +01}
{3056925600 0 1 +01}
{3059949600 3600 0 +01}
{3087770400 0 1 +01}
{3090794400 3600 0 +01}
{3118010400 0 1 +01}
{3121639200 3600 0 +01}
{3148855200 0 1 +01}
{3151879200 3600 0 +01}
{3179700000 0 1 +01}
{3182724000 3600 0 +01}
{3209940000 0 1 +01}
{3212964000 3600 0 +01}
{3240784800 0 1 +01}
{3243808800 3600 0 +01}
{3271024800 0 1 +01}
{3274653600 3600 0 +01}
{3301869600 0 1 +01}
{3304893600 3600 0 +01}
{3332714400 0 1 +01}
{3335738400 3600 0 +01}
{3362954400 0 1 +01}
{3366583200 3600 0 +01}
{3393799200 0 1 +01}
{3396823200 3600 0 +01}
{3424644000 0 1 +01}
{3427668000 3600 0 +01}
{3454884000 0 1 +01}
{3457908000 3600 0 +01}
{3485728800 0 1 +01}
{3488752800 3600 0 +01}
{3515968800 0 1 +01}
{3519597600 3600 0 +01}
{3546813600 0 1 +01}
{3549837600 3600 0 +01}
{3577658400 0 1 +01}
{3580682400 3600 0 +01}
{3607898400 0 1 +01}
{3611527200 3600 0 +01}
{3638743200 0 1 +01}
{3641767200 3600 0 +01}
{3669588000 0 1 +01}
{3672612000 3600 0 +01}
{3699828000 0 1 +01}
{3702852000 3600 0 +01}
}

1
amd64/lib/tcl8.6/tzdata/Africa/Sao_Tome
View File

@@ -5,4 +5,5 @@ set TZData(:Africa/Sao_Tome) {
{-2713912016 -2205 0 LMT}
{-1830384000 0 0 GMT}
{1514768400 3600 0 WAT}
{1546304400 0 0 GMT}
}

161
amd64/lib/tcl8.6/tzdata/America/Campo_Grande
View File

@@ -93,165 +93,4 @@ set TZData(:America/Campo_Grande) {
{1518922800 -14400 0 -04}
{1541304000 -10800 1 -04}
{1550372400 -14400 0 -04}
{1572753600 -10800 1 -04}
{1581822000 -14400 0 -04}
{1604203200 -10800 1 -04}
{1613876400 -14400 0 -04}
{1636257600 -10800 1 -04}
{1645326000 -14400 0 -04}
{1667707200 -10800 1 -04}
{1677380400 -14400 0 -04}
{1699156800 -10800 1 -04}
{1708225200 -14400 0 -04}
{1730606400 -10800 1 -04}
{1739674800 -14400 0 -04}
{1762056000 -10800 1 -04}
{1771729200 -14400 0 -04}
{1793505600 -10800 1 -04}
{1803178800 -14400 0 -04}
{1825560000 -10800 1 -04}
{1834628400 -14400 0 -04}
{1857009600 -10800 1 -04}
{1866078000 -14400 0 -04}
{1888459200 -10800 1 -04}
{1897527600 -14400 0 -04}
{1919908800 -10800 1 -04}
{1928977200 -14400 0 -04}
{1951358400 -10800 1 -04}
{1960426800 -14400 0 -04}
{1983412800 -10800 1 -04}
{1992481200 -14400 0 -04}
{2014862400 -10800 1 -04}
{2024535600 -14400 0 -04}
{2046312000 -10800 1 -04}
{2055380400 -14400 0 -04}
{2077761600 -10800 1 -04}
{2086830000 -14400 0 -04}
{2109211200 -10800 1 -04}
{2118884400 -14400 0 -04}
{2140660800 -10800 1 -04}
{2150334000 -14400 0 -04}
{2172715200 -10800 1 -04}
{2181783600 -14400 0 -04}
{2204164800 -10800 1 -04}
{2213233200 -14400 0 -04}
{2235614400 -10800 1 -04}
{2244682800 -14400 0 -04}
{2267064000 -10800 1 -04}
{2276132400 -14400 0 -04}
{2298513600 -10800 1 -04}
{2307582000 -14400 0 -04}
{2329963200 -10800 1 -04}
{2339636400 -14400 0 -04}
{2362017600 -10800 1 -04}
{2371086000 -14400 0 -04}
{2393467200 -10800 1 -04}
{2402535600 -14400 0 -04}
{2424916800 -10800 1 -04}
{2433985200 -14400 0 -04}
{2456366400 -10800 1 -04}
{2465434800 -14400 0 -04}
{2487816000 -10800 1 -04}
{2497489200 -14400 0 -04}
{2519870400 -10800 1 -04}
{2528938800 -14400 0 -04}
{2551320000 -10800 1 -04}
{2560388400 -14400 0 -04}
{2582769600 -10800 1 -04}
{2591838000 -14400 0 -04}
{2614219200 -10800 1 -04}
{2623287600 -14400 0 -04}
{2645668800 -10800 1 -04}
{2654737200 -14400 0 -04}
{2677118400 -10800 1 -04}
{2686791600 -14400 0 -04}
{2709172800 -10800 1 -04}
{2718241200 -14400 0 -04}
{2740622400 -10800 1 -04}
{2749690800 -14400 0 -04}
{2772072000 -10800 1 -04}
{2781140400 -14400 0 -04}
{2803521600 -10800 1 -04}
{2812590000 -14400 0 -04}
{2834971200 -10800 1 -04}
{2844039600 -14400 0 -04}
{2867025600 -10800 1 -04}
{2876094000 -14400 0 -04}
{2898475200 -10800 1 -04}
{2907543600 -14400 0 -04}
{2929924800 -10800 1 -04}
{2938993200 -14400 0 -04}
{2961374400 -10800 1 -04}
{2970442800 -14400 0 -04}
{2992824000 -10800 1 -04}
{3001892400 -14400 0 -04}
{3024273600 -10800 1 -04}
{3033946800 -14400 0 -04}
{3056328000 -10800 1 -04}
{3065396400 -14400 0 -04}
{3087777600 -10800 1 -04}
{3096846000 -14400 0 -04}
{3119227200 -10800 1 -04}
{3128295600 -14400 0 -04}
{3150676800 -10800 1 -04}
{3159745200 -14400 0 -04}
{3182126400 -10800 1 -04}
{3191194800 -14400 0 -04}
{3213576000 -10800 1 -04}
{3223249200 -14400 0 -04}
{3245630400 -10800 1 -04}
{3254698800 -14400 0 -04}
{3277080000 -10800 1 -04}
{3286148400 -14400 0 -04}
{3308529600 -10800 1 -04}
{3317598000 -14400 0 -04}
{3339979200 -10800 1 -04}
{3349047600 -14400 0 -04}
{3371428800 -10800 1 -04}
{3381102000 -14400 0 -04}
{3403483200 -10800 1 -04}
{3412551600 -14400 0 -04}
{3434932800 -10800 1 -04}
{3444001200 -14400 0 -04}
{3466382400 -10800 1 -04}
{3475450800 -14400 0 -04}
{3497832000 -10800 1 -04}
{3506900400 -14400 0 -04}
{3529281600 -10800 1 -04}
{3538350000 -14400 0 -04}
{3560731200 -10800 1 -04}
{3570404400 -14400 0 -04}
{3592785600 -10800 1 -04}
{3601854000 -14400 0 -04}
{3624235200 -10800 1 -04}
{3633303600 -14400 0 -04}
{3655684800 -10800 1 -04}
{3664753200 -14400 0 -04}
{3687134400 -10800 1 -04}
{3696202800 -14400 0 -04}
{3718584000 -10800 1 -04}
{3727652400 -14400 0 -04}
{3750638400 -10800 1 -04}
{3759706800 -14400 0 -04}
{3782088000 -10800 1 -04}
{3791156400 -14400 0 -04}
{3813537600 -10800 1 -04}
{3822606000 -14400 0 -04}
{3844987200 -10800 1 -04}
{3854055600 -14400 0 -04}
{3876436800 -10800 1 -04}
{3885505200 -14400 0 -04}
{3907886400 -10800 1 -04}
{3917559600 -14400 0 -04}
{3939940800 -10800 1 -04}
{3949009200 -14400 0 -04}
{3971390400 -10800 1 -04}
{3980458800 -14400 0 -04}
{4002840000 -10800 1 -04}
{4011908400 -14400 0 -04}
{4034289600 -10800 1 -04}
{4043358000 -14400 0 -04}
{4065739200 -10800 1 -04}
{4074807600 -14400 0 -04}
{4097188800 -10800 1 -04}
}

161
amd64/lib/tcl8.6/tzdata/America/Cuiaba
View File

@@ -93,165 +93,4 @@ set TZData(:America/Cuiaba) {
{1518922800 -14400 0 -04}
{1541304000 -10800 1 -04}
{1550372400 -14400 0 -04}
{1572753600 -10800 1 -04}
{1581822000 -14400 0 -04}
{1604203200 -10800 1 -04}
{1613876400 -14400 0 -04}
{1636257600 -10800 1 -04}
{1645326000 -14400 0 -04}
{1667707200 -10800 1 -04}
{1677380400 -14400 0 -04}
{1699156800 -10800 1 -04}
{1708225200 -14400 0 -04}
{1730606400 -10800 1 -04}
{1739674800 -14400 0 -04}
{1762056000 -10800 1 -04}
{1771729200 -14400 0 -04}
{1793505600 -10800 1 -04}
{1803178800 -14400 0 -04}
{1825560000 -10800 1 -04}
{1834628400 -14400 0 -04}
{1857009600 -10800 1 -04}
{1866078000 -14400 0 -04}
{1888459200 -10800 1 -04}
{1897527600 -14400 0 -04}
{1919908800 -10800 1 -04}
{1928977200 -14400 0 -04}
{1951358400 -10800 1 -04}
{1960426800 -14400 0 -04}
{1983412800 -10800 1 -04}
{1992481200 -14400 0 -04}
{2014862400 -10800 1 -04}
{2024535600 -14400 0 -04}
{2046312000 -10800 1 -04}
{2055380400 -14400 0 -04}
{2077761600 -10800 1 -04}
{2086830000 -14400 0 -04}
{2109211200 -10800 1 -04}
{2118884400 -14400 0 -04}
{2140660800 -10800 1 -04}
{2150334000 -14400 0 -04}
{2172715200 -10800 1 -04}
{2181783600 -14400 0 -04}
{2204164800 -10800 1 -04}
{2213233200 -14400 0 -04}
{2235614400 -10800 1 -04}
{2244682800 -14400 0 -04}
{2267064000 -10800 1 -04}
{2276132400 -14400 0 -04}
{2298513600 -10800 1 -04}
{2307582000 -14400 0 -04}
{2329963200 -10800 1 -04}
{2339636400 -14400 0 -04}
{2362017600 -10800 1 -04}
{2371086000 -14400 0 -04}
{2393467200 -10800 1 -04}
{2402535600 -14400 0 -04}
{2424916800 -10800 1 -04}
{2433985200 -14400 0 -04}
{2456366400 -10800 1 -04}
{2465434800 -14400 0 -04}
{2487816000 -10800 1 -04}
{2497489200 -14400 0 -04}
{2519870400 -10800 1 -04}
{2528938800 -14400 0 -04}
{2551320000 -10800 1 -04}
{2560388400 -14400 0 -04}
{2582769600 -10800 1 -04}
{2591838000 -14400 0 -04}
{2614219200 -10800 1 -04}
{2623287600 -14400 0 -04}
{2645668800 -10800 1 -04}
{2654737200 -14400 0 -04}
{2677118400 -10800 1 -04}
{2686791600 -14400 0 -04}
{2709172800 -10800 1 -04}
{2718241200 -14400 0 -04}
{2740622400 -10800 1 -04}
{2749690800 -14400 0 -04}
{2772072000 -10800 1 -04}
{2781140400 -14400 0 -04}
{2803521600 -10800 1 -04}
{2812590000 -14400 0 -04}
{2834971200 -10800 1 -04}
{2844039600 -14400 0 -04}
{2867025600 -10800 1 -04}
{2876094000 -14400 0 -04}
{2898475200 -10800 1 -04}
{2907543600 -14400 0 -04}
{2929924800 -10800 1 -04}
{2938993200 -14400 0 -04}
{2961374400 -10800 1 -04}
{2970442800 -14400 0 -04}
{2992824000 -10800 1 -04}
{3001892400 -14400 0 -04}
{3024273600 -10800 1 -04}
{3033946800 -14400 0 -04}
{3056328000 -10800 1 -04}
{3065396400 -14400 0 -04}
{3087777600 -10800 1 -04}
{3096846000 -14400 0 -04}
{3119227200 -10800 1 -04}
{3128295600 -14400 0 -04}
{3150676800 -10800 1 -04}
{3159745200 -14400 0 -04}
{3182126400 -10800 1 -04}
{3191194800 -14400 0 -04}
{3213576000 -10800 1 -04}
{3223249200 -14400 0 -04}
{3245630400 -10800 1 -04}
{3254698800 -14400 0 -04}
{3277080000 -10800 1 -04}
{3286148400 -14400 0 -04}
{3308529600 -10800 1 -04}
{3317598000 -14400 0 -04}
{3339979200 -10800 1 -04}
{3349047600 -14400 0 -04}
{3371428800 -10800 1 -04}
{3381102000 -14400 0 -04}
{3403483200 -10800 1 -04}
{3412551600 -14400 0 -04}
{3434932800 -10800 1 -04}
{3444001200 -14400 0 -04}
{3466382400 -10800 1 -04}
{3475450800 -14400 0 -04}
{3497832000 -10800 1 -04}
{3506900400 -14400 0 -04}
{3529281600 -10800 1 -04}
{3538350000 -14400 0 -04}
{3560731200 -10800 1 -04}
{3570404400 -14400 0 -04}
{3592785600 -10800 1 -04}
{3601854000 -14400 0 -04}
{3624235200 -10800 1 -04}
{3633303600 -14400 0 -04}
{3655684800 -10800 1 -04}
{3664753200 -14400 0 -04}
{3687134400 -10800 1 -04}
{3696202800 -14400 0 -04}
{3718584000 -10800 1 -04}
{3727652400 -14400 0 -04}
{3750638400 -10800 1 -04}
{3759706800 -14400 0 -04}
{3782088000 -10800 1 -04}
{3791156400 -14400 0 -04}
{3813537600 -10800 1 -04}
{3822606000 -14400 0 -04}
{3844987200 -10800 1 -04}
{3854055600 -14400 0 -04}
{3876436800 -10800 1 -04}
{3885505200 -14400 0 -04}
{3907886400 -10800 1 -04}
{3917559600 -14400 0 -04}
{3939940800 -10800 1 -04}
{3949009200 -14400 0 -04}
{3971390400 -10800 1 -04}
{3980458800 -14400 0 -04}
{4002840000 -10800 1 -04}
{4011908400 -14400 0 -04}
{4034289600 -10800 1 -04}
{4043358000 -14400 0 -04}
{4065739200 -10800 1 -04}
{4074807600 -14400 0 -04}
{4097188800 -10800 1 -04}
}

5
amd64/lib/tcl8.6/tzdata/America/Detroit
View File

@@ -11,6 +11,11 @@ set TZData(:America/Detroit) {
{-757364400 -18000 0 EST}
{-684349200 -14400 1 EDT}
{-671047200 -18000 0 EST}
{-80506740 -14400 0 EDT}
{-68666400 -18000 0 EST}
{-52938000 -14400 1 EDT}
{-37216800 -18000 0 EST}
{-31518000 -18000 0 EST}
{94712400 -18000 0 EST}
{104914800 -14400 1 EDT}
{120636000 -18000 0 EST}

4
amd64/lib/tcl8.6/tzdata/America/Edmonton
View File

@@ -20,10 +20,6 @@ set TZData(:America/Edmonton) {
{-765388800 -25200 0 MST}
{-715791600 -21600 1 MDT}
{-702489600 -25200 0 MST}
{-84380400 -21600 1 MDT}
{-68659200 -25200 0 MST}
{-21481200 -21600 1 MDT}
{-5760000 -25200 0 MST}
{73472400 -21600 1 MDT}
{89193600 -25200 0 MST}
{104922000 -21600 1 MDT}

16
amd64/lib/tcl8.6/tzdata/America/Indiana/Tell_City
View File

@@ -11,12 +11,6 @@ set TZData(:America/Indiana/Tell_City) {
{-769395600 -18000 1 CPT}
{-765392400 -21600 0 CST}
{-757360800 -21600 0 CST}
{-747244800 -18000 1 CDT}
{-733942800 -21600 0 CST}
{-526492800 -18000 1 CDT}
{-513190800 -21600 0 CST}
{-495043200 -18000 1 CDT}
{-481741200 -21600 0 CST}
{-462996000 -18000 1 CDT}
{-450291600 -21600 0 CST}
{-431539200 -18000 1 CDT}
@@ -28,16 +22,18 @@ set TZData(:America/Indiana/Tell_City) {
{-337190400 -18000 1 CDT}
{-323888400 -21600 0 CST}
{-305740800 -18000 1 CDT}
{-289414800 -21600 0 CST}
{-292438800 -21600 0 CST}
{-273686400 -18000 1 CDT}
{-260989200 -21600 0 CST}
{-257965200 -21600 0 CST}
{-242236800 -18000 1 CDT}
{-226515600 -21600 0 CST}
{-210787200 -18000 1 CDT}
{-195066000 -21600 0 CST}
{-179337600 -18000 0 EST}
{-31518000 -18000 0 EST}
{-21488400 -14400 1 EDT}
{-68662800 -21600 0 CST}
{-52934400 -18000 1 CDT}
{-37213200 -21600 0 CST}
{-21484800 -14400 0 EDT}
{-5767200 -18000 0 EST}
{9961200 -14400 1 EDT}
{25682400 -18000 0 EST}

9
amd64/lib/tcl8.6/tzdata/America/Kentucky/Louisville
View File

@@ -17,12 +17,9 @@ set TZData(:America/Kentucky/Louisville) {
{-769395600 -18000 1 CPT}
{-765392400 -21600 0 CST}
{-757360800 -21600 0 CST}
{-747244800 -18000 1 CDT}
{-747251940 -18000 1 CDT}
{-744224400 -21600 0 CST}
{-715795200 -18000 1 CDT}
{-684349200 -18000 1 CDT}
{-652899600 -18000 1 CDT}
{-620845200 -18000 1 CDT}
{-620841600 -18000 1 CDT}
{-608144400 -21600 0 CST}
{-589392000 -18000 1 CDT}
{-576090000 -21600 0 CST}
@@ -45,7 +42,7 @@ set TZData(:America/Kentucky/Louisville) {
{-305740800 -18000 1 CDT}
{-289414800 -21600 0 CST}
{-273686400 -18000 1 CDT}
{-266432400 -18000 0 EST}
{-266428800 -18000 0 EST}
{-63140400 -18000 0 EST}
{-52938000 -14400 1 EDT}
{-37216800 -18000 0 EST}

3
amd64/lib/tcl8.6/tzdata/America/Metlakatla
View File

@@ -46,7 +46,8 @@ set TZData(:America/Metlakatla) {
{1489316400 -28800 1 AKDT}
{1509876000 -32400 0 AKST}
{1520766000 -28800 1 AKDT}
{1541325600 -32400 0 AKST}
{1541329200 -28800 0 PST}
{1547978400 -32400 0 AKST}
{1552215600 -28800 1 AKDT}
{1572775200 -32400 0 AKST}
{1583665200 -28800 1 AKDT}

161
amd64/lib/tcl8.6/tzdata/America/Sao_Paulo
View File

@@ -94,165 +94,4 @@ set TZData(:America/Sao_Paulo) {
{1518919200 -10800 0 -03}
{1541300400 -7200 1 -03}
{1550368800 -10800 0 -03}
{1572750000 -7200 1 -03}
{1581818400 -10800 0 -03}
{1604199600 -7200 1 -03}
{1613872800 -10800 0 -03}
{1636254000 -7200 1 -03}
{1645322400 -10800 0 -03}
{1667703600 -7200 1 -03}
{1677376800 -10800 0 -03}
{1699153200 -7200 1 -03}
{1708221600 -10800 0 -03}
{1730602800 -7200 1 -03}
{1739671200 -10800 0 -03}
{1762052400 -7200 1 -03}
{1771725600 -10800 0 -03}
{1793502000 -7200 1 -03}
{1803175200 -10800 0 -03}
{1825556400 -7200 1 -03}
{1834624800 -10800 0 -03}
{1857006000 -7200 1 -03}
{1866074400 -10800 0 -03}
{1888455600 -7200 1 -03}
{1897524000 -10800 0 -03}
{1919905200 -7200 1 -03}
{1928973600 -10800 0 -03}
{1951354800 -7200 1 -03}
{1960423200 -10800 0 -03}
{1983409200 -7200 1 -03}
{1992477600 -10800 0 -03}
{2014858800 -7200 1 -03}
{2024532000 -10800 0 -03}
{2046308400 -7200 1 -03}
{2055376800 -10800 0 -03}
{2077758000 -7200 1 -03}
{2086826400 -10800 0 -03}
{2109207600 -7200 1 -03}
{2118880800 -10800 0 -03}
{2140657200 -7200 1 -03}
{2150330400 -10800 0 -03}
{2172711600 -7200 1 -03}
{2181780000 -10800 0 -03}
{2204161200 -7200 1 -03}
{2213229600 -10800 0 -03}
{2235610800 -7200 1 -03}
{2244679200 -10800 0 -03}
{2267060400 -7200 1 -03}
{2276128800 -10800 0 -03}
{2298510000 -7200 1 -03}
{2307578400 -10800 0 -03}
{2329959600 -7200 1 -03}
{2339632800 -10800 0 -03}
{2362014000 -7200 1 -03}
{2371082400 -10800 0 -03}
{2393463600 -7200 1 -03}
{2402532000 -10800 0 -03}
{2424913200 -7200 1 -03}
{2433981600 -10800 0 -03}
{2456362800 -7200 1 -03}
{2465431200 -10800 0 -03}
{2487812400 -7200 1 -03}
{2497485600 -10800 0 -03}
{2519866800 -7200 1 -03}
{2528935200 -10800 0 -03}
{2551316400 -7200 1 -03}
{2560384800 -10800 0 -03}
{2582766000 -7200 1 -03}
{2591834400 -10800 0 -03}
{2614215600 -7200 1 -03}
{2623284000 -10800 0 -03}
{2645665200 -7200 1 -03}
{2654733600 -10800 0 -03}
{2677114800 -7200 1 -03}
{2686788000 -10800 0 -03}
{2709169200 -7200 1 -03}
{2718237600 -10800 0 -03}
{2740618800 -7200 1 -03}
{2749687200 -10800 0 -03}
{2772068400 -7200 1 -03}
{2781136800 -10800 0 -03}
{2803518000 -7200 1 -03}
{2812586400 -10800 0 -03}
{2834967600 -7200 1 -03}
{2844036000 -10800 0 -03}
{2867022000 -7200 1 -03}
{2876090400 -10800 0 -03}
{2898471600 -7200 1 -03}
{2907540000 -10800 0 -03}
{2929921200 -7200 1 -03}
{2938989600 -10800 0 -03}
{2961370800 -7200 1 -03}
{2970439200 -10800 0 -03}
{2992820400 -7200 1 -03}
{3001888800 -10800 0 -03}
{3024270000 -7200 1 -03}
{3033943200 -10800 0 -03}
{3056324400 -7200 1 -03}
{3065392800 -10800 0 -03}
{3087774000 -7200 1 -03}
{3096842400 -10800 0 -03}
{3119223600 -7200 1 -03}
{3128292000 -10800 0 -03}
{3150673200 -7200 1 -03}
{3159741600 -10800 0 -03}
{3182122800 -7200 1 -03}
{3191191200 -10800 0 -03}
{3213572400 -7200 1 -03}
{3223245600 -10800 0 -03}
{3245626800 -7200 1 -03}
{3254695200 -10800 0 -03}
{3277076400 -7200 1 -03}
{3286144800 -10800 0 -03}
{3308526000 -7200 1 -03}
{3317594400 -10800 0 -03}
{3339975600 -7200 1 -03}
{3349044000 -10800 0 -03}
{3371425200 -7200 1 -03}
{3381098400 -10800 0 -03}
{3403479600 -7200 1 -03}
{3412548000 -10800 0 -03}
{3434929200 -7200 1 -03}
{3443997600 -10800 0 -03}
{3466378800 -7200 1 -03}
{3475447200 -10800 0 -03}
{3497828400 -7200 1 -03}
{3506896800 -10800 0 -03}
{3529278000 -7200 1 -03}
{3538346400 -10800 0 -03}
{3560727600 -7200 1 -03}
{3570400800 -10800 0 -03}
{3592782000 -7200 1 -03}
{3601850400 -10800 0 -03}
{3624231600 -7200 1 -03}
{3633300000 -10800 0 -03}
{3655681200 -7200 1 -03}
{3664749600 -10800 0 -03}
{3687130800 -7200 1 -03}
{3696199200 -10800 0 -03}
{3718580400 -7200 1 -03}
{3727648800 -10800 0 -03}
{3750634800 -7200 1 -03}
{3759703200 -10800 0 -03}
{3782084400 -7200 1 -03}
{3791152800 -10800 0 -03}
{3813534000 -7200 1 -03}
{3822602400 -10800 0 -03}
{3844983600 -7200 1 -03}
{3854052000 -10800 0 -03}
{3876433200 -7200 1 -03}
{3885501600 -10800 0 -03}
{3907882800 -7200 1 -03}
{3917556000 -10800 0 -03}
{3939937200 -7200 1 -03}
{3949005600 -10800 0 -03}
{3971386800 -7200 1 -03}
{3980455200 -10800 0 -03}
{4002836400 -7200 1 -03}
{4011904800 -10800 0 -03}
{4034286000 -7200 1 -03}
{4043354400 -10800 0 -03}
{4065735600 -7200 1 -03}
{4074804000 -10800 0 -03}
{4097185200 -7200 1 -03}
}

2
amd64/lib/tcl8.6/tzdata/America/Vancouver
View File

@@ -9,7 +9,7 @@ set TZData(:America/Vancouver) {
{-769395600 -25200 1 PPT}
{-765385200 -28800 0 PST}
{-747237600 -25200 1 PDT}
{-732726000 -28800 0 PST}
{-733935600 -28800 0 PST}
{-715788000 -25200 1 PDT}
{-702486000 -28800 0 PST}
{-684338400 -25200 1 PDT}

166
amd64/lib/tcl8.6/tzdata/Asia/Gaza
View File

@@ -40,6 +40,10 @@ set TZData(:Asia/Gaza) {
{150843600 7200 0 IST}
{167176800 10800 1 IDT}
{178664400 7200 0 IST}
{334015200 10800 1 IDT}
{337644000 7200 0 IST}
{452556000 10800 1 IDT}
{462232800 7200 0 IST}
{482277600 10800 1 IDT}
{495579600 7200 0 IST}
{516751200 10800 1 IDT}
@@ -113,166 +117,166 @@ set TZData(:Asia/Gaza) {
{1509141600 7200 0 EET}
{1521846000 10800 1 EEST}
{1540591200 7200 0 EET}
{1553295600 10800 1 EEST}
{1553810400 10800 1 EEST}
{1572040800 7200 0 EET}
{1585350000 10800 1 EEST}
{1585260000 10800 1 EEST}
{1604095200 7200 0 EET}
{1616799600 10800 1 EEST}
{1616709600 10800 1 EEST}
{1635544800 7200 0 EET}
{1648249200 10800 1 EEST}
{1648159200 10800 1 EEST}
{1666994400 7200 0 EET}
{1679698800 10800 1 EEST}
{1680213600 10800 1 EEST}
{1698444000 7200 0 EET}
{1711148400 10800 1 EEST}
{1711663200 10800 1 EEST}
{1729893600 7200 0 EET}
{1742598000 10800 1 EEST}
{1743112800 10800 1 EEST}
{1761343200 7200 0 EET}
{1774652400 10800 1 EEST}
{1774562400 10800 1 EEST}
{1793397600 7200 0 EET}
{1806102000 10800 1 EEST}
{1806012000 10800 1 EEST}
{1824847200 7200 0 EET}
{1837551600 10800 1 EEST}
{1838066400 10800 1 EEST}
{1856296800 7200 0 EET}
{1869001200 10800 1 EEST}
{1869516000 10800 1 EEST}
{1887746400 7200 0 EET}
{1900450800 10800 1 EEST}
{1900965600 10800 1 EEST}
{1919196000 7200 0 EET}
{1931900400 10800 1 EEST}
{1932415200 10800 1 EEST}
{1950645600 7200 0 EET}
{1963954800 10800 1 EEST}
{1963864800 10800 1 EEST}
{1982700000 7200 0 EET}
{1995404400 10800 1 EEST}
{1995314400 10800 1 EEST}
{2014149600 7200 0 EET}
{2026854000 10800 1 EEST}
{2027368800 10800 1 EEST}
{2045599200 7200 0 EET}
{2058303600 10800 1 EEST}
{2058818400 10800 1 EEST}
{2077048800 7200 0 EET}
{2089753200 10800 1 EEST}
{2090268000 10800 1 EEST}
{2108498400 7200 0 EET}
{2121807600 10800 1 EEST}
{2121717600 10800 1 EEST}
{2140552800 7200 0 EET}
{2153257200 10800 1 EEST}
{2153167200 10800 1 EEST}
{2172002400 7200 0 EET}
{2184706800 10800 1 EEST}
{2184616800 10800 1 EEST}
{2203452000 7200 0 EET}
{2216156400 10800 1 EEST}
{2216671200 10800 1 EEST}
{2234901600 7200 0 EET}
{2247606000 10800 1 EEST}
{2248120800 10800 1 EEST}
{2266351200 7200 0 EET}
{2279055600 10800 1 EEST}
{2279570400 10800 1 EEST}
{2297800800 7200 0 EET}
{2311110000 10800 1 EEST}
{2311020000 10800 1 EEST}
{2329855200 7200 0 EET}
{2342559600 10800 1 EEST}
{2342469600 10800 1 EEST}
{2361304800 7200 0 EET}
{2374009200 10800 1 EEST}
{2374524000 10800 1 EEST}
{2392754400 7200 0 EET}
{2405458800 10800 1 EEST}
{2405973600 10800 1 EEST}
{2424204000 7200 0 EET}
{2436908400 10800 1 EEST}
{2437423200 10800 1 EEST}
{2455653600 7200 0 EET}
{2468962800 10800 1 EEST}
{2468872800 10800 1 EEST}
{2487708000 7200 0 EET}
{2500412400 10800 1 EEST}
{2500322400 10800 1 EEST}
{2519157600 7200 0 EET}
{2531862000 10800 1 EEST}
{2531772000 10800 1 EEST}
{2550607200 7200 0 EET}
{2563311600 10800 1 EEST}
{2563826400 10800 1 EEST}
{2582056800 7200 0 EET}
{2594761200 10800 1 EEST}
{2595276000 10800 1 EEST}
{2613506400 7200 0 EET}
{2626210800 10800 1 EEST}
{2626725600 10800 1 EEST}
{2644956000 7200 0 EET}
{2658265200 10800 1 EEST}
{2658175200 10800 1 EEST}
{2677010400 7200 0 EET}
{2689714800 10800 1 EEST}
{2689624800 10800 1 EEST}
{2708460000 7200 0 EET}
{2721164400 10800 1 EEST}
{2721679200 10800 1 EEST}
{2739909600 7200 0 EET}
{2752614000 10800 1 EEST}
{2753128800 10800 1 EEST}
{2771359200 7200 0 EET}
{2784063600 10800 1 EEST}
{2784578400 10800 1 EEST}
{2802808800 7200 0 EET}
{2815513200 10800 1 EEST}
{2816028000 10800 1 EEST}
{2834258400 7200 0 EET}
{2847567600 10800 1 EEST}
{2847477600 10800 1 EEST}
{2866312800 7200 0 EET}
{2879017200 10800 1 EEST}
{2878927200 10800 1 EEST}
{2897762400 7200 0 EET}
{2910466800 10800 1 EEST}
{2910981600 10800 1 EEST}
{2929212000 7200 0 EET}
{2941916400 10800 1 EEST}
{2942431200 10800 1 EEST}
{2960661600 7200 0 EET}
{2973366000 10800 1 EEST}
{2973880800 10800 1 EEST}
{2992111200 7200 0 EET}
{3005420400 10800 1 EEST}
{3005330400 10800 1 EEST}
{3024165600 7200 0 EET}
{3036870000 10800 1 EEST}
{3036780000 10800 1 EEST}
{3055615200 7200 0 EET}
{3068319600 10800 1 EEST}
{3068229600 10800 1 EEST}
{3087064800 7200 0 EET}
{3099769200 10800 1 EEST}
{3100284000 10800 1 EEST}
{3118514400 7200 0 EET}
{3131218800 10800 1 EEST}
{3131733600 10800 1 EEST}
{3149964000 7200 0 EET}
{3162668400 10800 1 EEST}
{3163183200 10800 1 EEST}
{3181413600 7200 0 EET}
{3194722800 10800 1 EEST}
{3194632800 10800 1 EEST}
{3213468000 7200 0 EET}
{3226172400 10800 1 EEST}
{3226082400 10800 1 EEST}
{3244917600 7200 0 EET}
{3257622000 10800 1 EEST}
{3258136800 10800 1 EEST}
{3276367200 7200 0 EET}
{3289071600 10800 1 EEST}
{3289586400 10800 1 EEST}
{3307816800 7200 0 EET}
{3320521200 10800 1 EEST}
{3321036000 10800 1 EEST}
{3339266400 7200 0 EET}
{3352575600 10800 1 EEST}
{3352485600 10800 1 EEST}
{3371320800 7200 0 EET}
{3384025200 10800 1 EEST}
{3383935200 10800 1 EEST}
{3402770400 7200 0 EET}
{3415474800 10800 1 EEST}
{3415384800 10800 1 EEST}
{3434220000 7200 0 EET}
{3446924400 10800 1 EEST}
{3447439200 10800 1 EEST}
{3465669600 7200 0 EET}
{3478374000 10800 1 EEST}
{3478888800 10800 1 EEST}
{3497119200 7200 0 EET}
{3509823600 10800 1 EEST}
{3510338400 10800 1 EEST}
{3528568800 7200 0 EET}
{3541878000 10800 1 EEST}
{3541788000 10800 1 EEST}
{3560623200 7200 0 EET}
{3573327600 10800 1 EEST}
{3573237600 10800 1 EEST}
{3592072800 7200 0 EET}
{3604777200 10800 1 EEST}
{3605292000 10800 1 EEST}
{3623522400 7200 0 EET}
{3636226800 10800 1 EEST}
{3636741600 10800 1 EEST}
{3654972000 7200 0 EET}
{3667676400 10800 1 EEST}
{3668191200 10800 1 EEST}
{3686421600 7200 0 EET}
{3699126000 10800 1 EEST}
{3699640800 10800 1 EEST}
{3717871200 7200 0 EET}
{3731180400 10800 1 EEST}
{3731090400 10800 1 EEST}
{3749925600 7200 0 EET}
{3762630000 10800 1 EEST}
{3762540000 10800 1 EEST}
{3781375200 7200 0 EET}
{3794079600 10800 1 EEST}
{3794594400 10800 1 EEST}
{3812824800 7200 0 EET}
{3825529200 10800 1 EEST}
{3826044000 10800 1 EEST}
{3844274400 7200 0 EET}
{3856978800 10800 1 EEST}
{3857493600 10800 1 EEST}
{3875724000 7200 0 EET}
{3889033200 10800 1 EEST}
{3888943200 10800 1 EEST}
{3907778400 7200 0 EET}
{3920482800 10800 1 EEST}
{3920392800 10800 1 EEST}
{3939228000 7200 0 EET}
{3951932400 10800 1 EEST}
{3951842400 10800 1 EEST}
{3970677600 7200 0 EET}
{3983382000 10800 1 EEST}
{3983896800 10800 1 EEST}
{4002127200 7200 0 EET}
{4014831600 10800 1 EEST}
{4015346400 10800 1 EEST}
{4033576800 7200 0 EET}
{4046281200 10800 1 EEST}
{4046796000 10800 1 EEST}
{4065026400 7200 0 EET}
{4078335600 10800 1 EEST}
{4078245600 10800 1 EEST}
{4097080800 7200 0 EET}
}

166
amd64/lib/tcl8.6/tzdata/Asia/Hebron
View File

@@ -40,6 +40,10 @@ set TZData(:Asia/Hebron) {
{150843600 7200 0 IST}
{167176800 10800 1 IDT}
{178664400 7200 0 IST}
{334015200 10800 1 IDT}
{337644000 7200 0 IST}
{452556000 10800 1 IDT}
{462232800 7200 0 IST}
{482277600 10800 1 IDT}
{495579600 7200 0 IST}
{516751200 10800 1 IDT}
@@ -112,166 +116,166 @@ set TZData(:Asia/Hebron) {
{1509141600 7200 0 EET}
{1521846000 10800 1 EEST}
{1540591200 7200 0 EET}
{1553295600 10800 1 EEST}
{1553810400 10800 1 EEST}
{1572040800 7200 0 EET}
{1585350000 10800 1 EEST}
{1585260000 10800 1 EEST}
{1604095200 7200 0 EET}
{1616799600 10800 1 EEST}
{1616709600 10800 1 EEST}
{1635544800 7200 0 EET}
{1648249200 10800 1 EEST}
{1648159200 10800 1 EEST}
{1666994400 7200 0 EET}
{1679698800 10800 1 EEST}
{1680213600 10800 1 EEST}
{1698444000 7200 0 EET}
{1711148400 10800 1 EEST}
{1711663200 10800 1 EEST}
{1729893600 7200 0 EET}
{1742598000 10800 1 EEST}
{1743112800 10800 1 EEST}
{1761343200 7200 0 EET}
{1774652400 10800 1 EEST}
{1774562400 10800 1 EEST}
{1793397600 7200 0 EET}
{1806102000 10800 1 EEST}
{1806012000 10800 1 EEST}
{1824847200 7200 0 EET}
{1837551600 10800 1 EEST}
{1838066400 10800 1 EEST}
{1856296800 7200 0 EET}
{1869001200 10800 1 EEST}
{1869516000 10800 1 EEST}
{1887746400 7200 0 EET}
{1900450800 10800 1 EEST}
{1900965600 10800 1 EEST}
{1919196000 7200 0 EET}
{1931900400 10800 1 EEST}
{1932415200 10800 1 EEST}
{1950645600 7200 0 EET}
{1963954800 10800 1 EEST}
{1963864800 10800 1 EEST}
{1982700000 7200 0 EET}
{1995404400 10800 1 EEST}
{1995314400 10800 1 EEST}
{2014149600 7200 0 EET}
{2026854000 10800 1 EEST}
{2027368800 10800 1 EEST}
{2045599200 7200 0 EET}
{2058303600 10800 1 EEST}
{2058818400 10800 1 EEST}
{2077048800 7200 0 EET}
{2089753200 10800 1 EEST}
{2090268000 10800 1 EEST}
{2108498400 7200 0 EET}
{2121807600 10800 1 EEST}
{2121717600 10800 1 EEST}
{2140552800 7200 0 EET}
{2153257200 10800 1 EEST}
{2153167200 10800 1 EEST}
{2172002400 7200 0 EET}
{2184706800 10800 1 EEST}
{2184616800 10800 1 EEST}
{2203452000 7200 0 EET}
{2216156400 10800 1 EEST}
{2216671200 10800 1 EEST}
{2234901600 7200 0 EET}
{2247606000 10800 1 EEST}
{2248120800 10800 1 EEST}
{2266351200 7200 0 EET}
{2279055600 10800 1 EEST}
{2279570400 10800 1 EEST}
{2297800800 7200 0 EET}
{2311110000 10800 1 EEST}
{2311020000 10800 1 EEST}
{2329855200 7200 0 EET}
{2342559600 10800 1 EEST}
{2342469600 10800 1 EEST}
{2361304800 7200 0 EET}
{2374009200 10800 1 EEST}
{2374524000 10800 1 EEST}
{2392754400 7200 0 EET}
{2405458800 10800 1 EEST}
{2405973600 10800 1 EEST}
{2424204000 7200 0 EET}
{2436908400 10800 1 EEST}
{2437423200 10800 1 EEST}
{2455653600 7200 0 EET}
{2468962800 10800 1 EEST}
{2468872800 10800 1 EEST}
{2487708000 7200 0 EET}
{2500412400 10800 1 EEST}
{2500322400 10800 1 EEST}
{2519157600 7200 0 EET}
{2531862000 10800 1 EEST}
{2531772000 10800 1 EEST}
{2550607200 7200 0 EET}
{2563311600 10800 1 EEST}
{2563826400 10800 1 EEST}
{2582056800 7200 0 EET}
{2594761200 10800 1 EEST}
{2595276000 10800 1 EEST}
{2613506400 7200 0 EET}
{2626210800 10800 1 EEST}
{2626725600 10800 1 EEST}
{2644956000 7200 0 EET}
{2658265200 10800 1 EEST}
{2658175200 10800 1 EEST}
{2677010400 7200 0 EET}
{2689714800 10800 1 EEST}
{2689624800 10800 1 EEST}
{2708460000 7200 0 EET}
{2721164400 10800 1 EEST}
{2721679200 10800 1 EEST}
{2739909600 7200 0 EET}
{2752614000 10800 1 EEST}
{2753128800 10800 1 EEST}
{2771359200 7200 0 EET}
{2784063600 10800 1 EEST}
{2784578400 10800 1 EEST}
{2802808800 7200 0 EET}
{2815513200 10800 1 EEST}
{2816028000 10800 1 EEST}
{2834258400 7200 0 EET}
{2847567600 10800 1 EEST}
{2847477600 10800 1 EEST}
{2866312800 7200 0 EET}
{2879017200 10800 1 EEST}
{2878927200 10800 1 EEST}
{2897762400 7200 0 EET}
{2910466800 10800 1 EEST}
{2910981600 10800 1 EEST}
{2929212000 7200 0 EET}
{2941916400 10800 1 EEST}
{2942431200 10800 1 EEST}
{2960661600 7200 0 EET}
{2973366000 10800 1 EEST}
{2973880800 10800 1 EEST}
{2992111200 7200 0 EET}
{3005420400 10800 1 EEST}
{3005330400 10800 1 EEST}
{3024165600 7200 0 EET}
{3036870000 10800 1 EEST}
{3036780000 10800 1 EEST}
{3055615200 7200 0 EET}
{3068319600 10800 1 EEST}
{3068229600 10800 1 EEST}
{3087064800 7200 0 EET}
{3099769200 10800 1 EEST}
{3100284000 10800 1 EEST}
{3118514400 7200 0 EET}
{3131218800 10800 1 EEST}
{3131733600 10800 1 EEST}
{3149964000 7200 0 EET}
{3162668400 10800 1 EEST}
{3163183200 10800 1 EEST}
{3181413600 7200 0 EET}
{3194722800 10800 1 EEST}
{3194632800 10800 1 EEST}
{3213468000 7200 0 EET}
{3226172400 10800 1 EEST}
{3226082400 10800 1 EEST}
{3244917600 7200 0 EET}
{3257622000 10800 1 EEST}
{3258136800 10800 1 EEST}
{3276367200 7200 0 EET}
{3289071600 10800 1 EEST}
{3289586400 10800 1 EEST}
{3307816800 7200 0 EET}
{3320521200 10800 1 EEST}
{3321036000 10800 1 EEST}
{3339266400 7200 0 EET}
{3352575600 10800 1 EEST}
{3352485600 10800 1 EEST}
{3371320800 7200 0 EET}
{3384025200 10800 1 EEST}
{3383935200 10800 1 EEST}
{3402770400 7200 0 EET}
{3415474800 10800 1 EEST}
{3415384800 10800 1 EEST}
{3434220000 7200 0 EET}
{3446924400 10800 1 EEST}
{3447439200 10800 1 EEST}
{3465669600 7200 0 EET}
{3478374000 10800 1 EEST}
{3478888800 10800 1 EEST}
{3497119200 7200 0 EET}
{3509823600 10800 1 EEST}
{3510338400 10800 1 EEST}
{3528568800 7200 0 EET}
{3541878000 10800 1 EEST}
{3541788000 10800 1 EEST}
{3560623200 7200 0 EET}
{3573327600 10800 1 EEST}
{3573237600 10800 1 EEST}
{3592072800 7200 0 EET}
{3604777200 10800 1 EEST}
{3605292000 10800 1 EEST}
{3623522400 7200 0 EET}
{3636226800 10800 1 EEST}
{3636741600 10800 1 EEST}
{3654972000 7200 0 EET}
{3667676400 10800 1 EEST}
{3668191200 10800 1 EEST}
{3686421600 7200 0 EET}
{3699126000 10800 1 EEST}
{3699640800 10800 1 EEST}
{3717871200 7200 0 EET}
{3731180400 10800 1 EEST}
{3731090400 10800 1 EEST}
{3749925600 7200 0 EET}
{3762630000 10800 1 EEST}
{3762540000 10800 1 EEST}
{3781375200 7200 0 EET}
{3794079600 10800 1 EEST}
{3794594400 10800 1 EEST}
{3812824800 7200 0 EET}
{3825529200 10800 1 EEST}
{3826044000 10800 1 EEST}
{3844274400 7200 0 EET}
{3856978800 10800 1 EEST}
{3857493600 10800 1 EEST}
{3875724000 7200 0 EET}
{3889033200 10800 1 EEST}
{3888943200 10800 1 EEST}
{3907778400 7200 0 EET}
{3920482800 10800 1 EEST}
{3920392800 10800 1 EEST}
{3939228000 7200 0 EET}
{3951932400 10800 1 EEST}
{3951842400 10800 1 EEST}
{3970677600 7200 0 EET}
{3983382000 10800 1 EEST}
{3983896800 10800 1 EEST}
{4002127200 7200 0 EET}
{4014831600 10800 1 EEST}
{4015346400 10800 1 EEST}
{4033576800 7200 0 EET}
{4046281200 10800 1 EEST}
{4046796000 10800 1 EEST}
{4065026400 7200 0 EET}
{4078335600 10800 1 EEST}
{4078245600 10800 1 EEST}
{4097080800 7200 0 EET}
}

26
amd64/lib/tcl8.6/tzdata/Asia/Hong_Kong
View File

@@ -2,25 +2,25 @@
set TZData(:Asia/Hong_Kong) {
{-9223372036854775808 27402 0 LMT}
{-2056693002 28800 0 HKT}
{-907389000 32400 1 HKST}
{-891667800 28800 0 HKT}
{-884246400 32400 0 JST}
{-766746000 28800 0 HKT}
{-747981000 32400 1 HKST}
{-728544600 28800 0 HKT}
{-2056690800 28800 0 HKT}
{-900910800 32400 1 HKST}
{-891579600 30600 1 HKWT}
{-884248200 32400 0 JST}
{-761209200 28800 0 HKT}
{-747907200 32400 1 HKST}
{-728541000 28800 0 HKT}
{-717049800 32400 1 HKST}
{-694503000 28800 0 HKT}
{-697091400 28800 0 HKT}
{-683785800 32400 1 HKST}
{-668064600 28800 0 HKT}
{-668061000 28800 0 HKT}
{-654755400 32400 1 HKST}
{-636615000 28800 0 HKT}
{-636611400 28800 0 HKT}
{-623305800 32400 1 HKST}
{-605165400 28800 0 HKT}
{-605161800 28800 0 HKT}
{-591856200 32400 1 HKST}
{-573715800 28800 0 HKT}
{-573712200 28800 0 HKT}
{-559801800 32400 1 HKST}
{-542352600 28800 0 HKT}
{-541657800 28800 0 HKT}
{-528352200 32400 1 HKST}
{-510211800 28800 0 HKT}
{-498112200 32400 1 HKST}

4
amd64/lib/tcl8.6/tzdata/Asia/Jerusalem
View File

@@ -39,6 +39,10 @@ set TZData(:Asia/Jerusalem) {
{150843600 7200 0 IST}
{167176800 10800 1 IDT}
{178664400 7200 0 IST}
{334015200 10800 1 IDT}
{337644000 7200 0 IST}
{452556000 10800 1 IDT}
{462232800 7200 0 IST}
{482277600 10800 1 IDT}
{495579600 7200 0 IST}
{516751200 10800 1 IDT}

58
amd64/lib/tcl8.6/tzdata/Asia/Qostanay Normal file
View File

@@ -0,0 +1,58 @@
# created by tools/tclZIC.tcl - do not edit
set TZData(:Asia/Qostanay) {
{-9223372036854775808 15268 0 LMT}
{-1441167268 14400 0 +04}
{-1247544000 18000 0 +05}
{354913200 21600 1 +06}
{370720800 21600 0 +06}
{386445600 18000 0 +05}
{386449200 21600 1 +05}
{402256800 18000 0 +05}
{417985200 21600 1 +05}
{433792800 18000 0 +05}
{449607600 21600 1 +05}
{465339600 18000 0 +05}
{481064400 21600 1 +05}
{496789200 18000 0 +05}
{512514000 21600 1 +05}
{528238800 18000 0 +05}
{543963600 21600 1 +05}
{559688400 18000 0 +05}
{575413200 21600 1 +05}
{591138000 18000 0 +05}
{606862800 21600 1 +05}
{622587600 18000 0 +05}
{638312400 21600 1 +05}
{654642000 18000 0 +05}
{670366800 14400 0 +04}
{670370400 18000 1 +04}
{686095200 14400 0 +04}
{695772000 18000 0 +05}
{701816400 21600 1 +05}
{717541200 18000 0 +05}
{733266000 21600 1 +05}
{748990800 18000 0 +05}
{764715600 21600 1 +05}
{780440400 18000 0 +05}
{796165200 21600 1 +05}
{811890000 18000 0 +05}
{828219600 21600 1 +05}
{846363600 18000 0 +05}
{859669200 21600 1 +05}
{877813200 18000 0 +05}
{891118800 21600 1 +05}
{909262800 18000 0 +05}
{922568400 21600 1 +05}
{941317200 18000 0 +05}
{954018000 21600 1 +05}
{972766800 18000 0 +05}
{985467600 21600 1 +05}
{1004216400 18000 0 +05}
{1017522000 21600 1 +05}
{1035666000 18000 0 +05}
{1048971600 21600 1 +05}
{1067115600 18000 0 +05}
{1080421200 21600 1 +05}
{1099170000 21600 0 +06}
}

1
amd64/lib/tcl8.6/tzdata/Asia/Qyzylorda
View File

@@ -54,4 +54,5 @@ set TZData(:Asia/Qyzylorda) {
{1067115600 18000 0 +05}
{1080421200 21600 1 +05}
{1099170000 21600 0 +06}
{1545328800 18000 0 +05}
}

8
amd64/lib/tcl8.6/tzdata/Asia/Seoul
View File

@@ -5,6 +5,14 @@ set TZData(:Asia/Seoul) {
{-1948782472 30600 0 KST}
{-1830414600 32400 0 JST}
{-767350800 32400 0 KST}
{-681210000 36000 1 KDT}
{-672228000 32400 0 KST}
{-654771600 36000 1 KDT}
{-640864800 32400 0 KST}
{-623408400 36000 1 KDT}
{-609415200 32400 0 KST}
{-588848400 36000 1 KDT}
{-577965600 32400 0 KST}
{-498128400 30600 0 KST}
{-462702600 34200 1 KDT}
{-451733400 30600 0 KST}

76
amd64/lib/tcl8.6/tzdata/Asia/Tehran
View File

@@ -102,106 +102,106 @@ set TZData(:Asia/Tehran) {
{2105551800 12600 0 +0330}
{2121193800 16200 1 +0330}
{2137087800 12600 0 +0330}
{2152729800 16200 1 +0330}
{2168623800 12600 0 +0330}
{2184265800 16200 1 +0330}
{2200159800 12600 0 +0330}
{2152816200 16200 1 +0330}
{2168710200 12600 0 +0330}
{2184352200 16200 1 +0330}
{2200246200 12600 0 +0330}
{2215888200 16200 1 +0330}
{2231782200 12600 0 +0330}
{2247424200 16200 1 +0330}
{2263318200 12600 0 +0330}
{2278960200 16200 1 +0330}
{2294854200 12600 0 +0330}
{2310496200 16200 1 +0330}
{2326390200 12600 0 +0330}
{2279046600 16200 1 +0330}
{2294940600 12600 0 +0330}
{2310582600 16200 1 +0330}
{2326476600 12600 0 +0330}
{2342118600 16200 1 +0330}
{2358012600 12600 0 +0330}
{2373654600 16200 1 +0330}
{2389548600 12600 0 +0330}
{2405190600 16200 1 +0330}
{2421084600 12600 0 +0330}
{2436726600 16200 1 +0330}
{2452620600 12600 0 +0330}
{2405277000 16200 1 +0330}
{2421171000 12600 0 +0330}
{2436813000 16200 1 +0330}
{2452707000 12600 0 +0330}
{2468349000 16200 1 +0330}
{2484243000 12600 0 +0330}
{2499885000 16200 1 +0330}
{2515779000 12600 0 +0330}
{2531421000 16200 1 +0330}
{2547315000 12600 0 +0330}
{2562957000 16200 1 +0330}
{2578851000 12600 0 +0330}
{2531507400 16200 1 +0330}
{2547401400 12600 0 +0330}
{2563043400 16200 1 +0330}
{2578937400 12600 0 +0330}
{2594579400 16200 1 +0330}
{2610473400 12600 0 +0330}
{2626115400 16200 1 +0330}
{2642009400 12600 0 +0330}
{2657651400 16200 1 +0330}
{2673545400 12600 0 +0330}
{2689187400 16200 1 +0330}
{2705081400 12600 0 +0330}
{2657737800 16200 1 +0330}
{2673631800 12600 0 +0330}
{2689273800 16200 1 +0330}
{2705167800 12600 0 +0330}
{2720809800 16200 1 +0330}
{2736703800 12600 0 +0330}
{2752345800 16200 1 +0330}
{2768239800 12600 0 +0330}
{2783881800 16200 1 +0330}
{2799775800 12600 0 +0330}
{2815417800 16200 1 +0330}
{2831311800 12600 0 +0330}
{2783968200 16200 1 +0330}
{2799862200 12600 0 +0330}
{2815504200 16200 1 +0330}
{2831398200 12600 0 +0330}
{2847040200 16200 1 +0330}
{2862934200 12600 0 +0330}
{2878576200 16200 1 +0330}
{2894470200 12600 0 +0330}
{2910112200 16200 1 +0330}
{2926006200 12600 0 +0330}
{2941648200 16200 1 +0330}
{2957542200 12600 0 +0330}
{2941734600 16200 1 +0330}
{2957628600 12600 0 +0330}
{2973270600 16200 1 +0330}
{2989164600 12600 0 +0330}
{3004806600 16200 1 +0330}
{3020700600 12600 0 +0330}
{3036342600 16200 1 +0330}
{3052236600 12600 0 +0330}
{3067878600 16200 1 +0330}
{3083772600 12600 0 +0330}
{3067965000 16200 1 +0330}
{3083859000 12600 0 +0330}
{3099501000 16200 1 +0330}
{3115395000 12600 0 +0330}
{3131037000 16200 1 +0330}
{3146931000 12600 0 +0330}
{3162573000 16200 1 +0330}
{3178467000 12600 0 +0330}
{3194109000 16200 1 +0330}
{3210003000 12600 0 +0330}
{3194195400 16200 1 +0330}
{3210089400 12600 0 +0330}
{3225731400 16200 1 +0330}
{3241625400 12600 0 +0330}
{3257267400 16200 1 +0330}
{3273161400 12600 0 +0330}
{3288803400 16200 1 +0330}
{3304697400 12600 0 +0330}
{3320339400 16200 1 +0330}
{3336233400 12600 0 +0330}
{3320425800 16200 1 +0330}
{3336319800 12600 0 +0330}
{3351961800 16200 1 +0330}
{3367855800 12600 0 +0330}
{3383497800 16200 1 +0330}
{3399391800 12600 0 +0330}
{3415033800 16200 1 +0330}
{3430927800 12600 0 +0330}
{3446569800 16200 1 +0330}
{3462463800 12600 0 +0330}
{3446656200 16200 1 +0330}
{3462550200 12600 0 +0330}
{3478192200 16200 1 +0330}
{3494086200 12600 0 +0330}
{3509728200 16200 1 +0330}
{3525622200 12600 0 +0330}
{3541264200 16200 1 +0330}
{3557158200 12600 0 +0330}
{3572800200 16200 1 +0330}
{3588694200 12600 0 +0330}
{3572886600 16200 1 +0330}
{3588780600 12600 0 +0330}
{3604422600 16200 1 +0330}
{3620316600 12600 0 +0330}
{3635958600 16200 1 +0330}
{3651852600 12600 0 +0330}
{3667494600 16200 1 +0330}
{3683388600 12600 0 +0330}
{3699030600 16200 1 +0330}
{3714924600 12600 0 +0330}
{3699117000 16200 1 +0330}
{3715011000 12600 0 +0330}
{3730653000 16200 1 +0330}
{3746547000 12600 0 +0330}
{3762189000 16200 1 +0330}

6
amd64/lib/tcl8.6/tzdata/Etc/UCT
View File

@@ -1,5 +1,5 @@
# created by tools/tclZIC.tcl - do not edit
set TZData(:Etc/UCT) {
{-9223372036854775808 0 0 UCT}
if {![info exists TZData(Etc/UTC)]} {
LoadTimeZoneFile Etc/UTC
}
set TZData(:Etc/UCT) $TZData(:Etc/UTC)

2
amd64/lib/tcl8.6/tzdata/Europe/Brussels
View File

@@ -3,7 +3,7 @@
set TZData(:Europe/Brussels) {
{-9223372036854775808 1050 0 LMT}
{-2840141850 1050 0 BMT}
{-2450953050 0 0 WET}
{-2450995200 0 0 WET}
{-1740355200 3600 0 CET}
{-1693702800 7200 0 CEST}
{-1680483600 3600 0 CET}

57
amd64/lib/tcl8.6/tzdata/Europe/Istanbul
View File

@@ -16,13 +16,11 @@ set TZData(:Europe/Istanbul) {
{-1428030000 7200 0 EET}
{-1409709600 10800 1 EEST}
{-1396494000 7200 0 EET}
{-931140000 10800 1 EEST}
{-922762800 7200 0 EET}
{-931053600 10800 1 EEST}
{-922676400 7200 0 EET}
{-917834400 10800 1 EEST}
{-892436400 7200 0 EET}
{-875844000 10800 1 EEST}
{-857358000 7200 0 EET}
{-781063200 10800 1 EEST}
{-764737200 7200 0 EET}
{-744343200 10800 1 EEST}
{-733806000 7200 0 EET}
@@ -32,45 +30,32 @@ set TZData(:Europe/Istanbul) {
{-670474800 7200 0 EET}
{-654141600 10800 1 EEST}
{-639025200 7200 0 EET}
{-621828000 10800 1 EEST}
{-622087200 10800 1 EEST}
{-606970800 7200 0 EET}
{-590032800 10800 1 EEST}
{-575434800 7200 0 EET}
{-575521200 7200 0 EET}
{-235620000 10800 1 EEST}
{-228279600 7200 0 EET}
{-194842800 7200 0 EET}
{-177732000 10800 1 EEST}
{-165726000 7200 0 EET}
{10533600 10800 1 EEST}
{23835600 7200 0 EET}
{41983200 10800 1 EEST}
{55285200 7200 0 EET}
{74037600 10800 1 EEST}
{87339600 7200 0 EET}
{107910000 10800 1 EEST}
{121219200 7200 0 EET}
{121215600 7200 0 EET}
{133920000 10800 1 EEST}
{152676000 7200 0 EET}
{165362400 10800 1 EEST}
{183502800 7200 0 EET}
{202428000 10800 1 EEST}
{215557200 7200 0 EET}
{228866400 10800 1 EEST}
{245797200 7200 0 EET}
{260316000 10800 1 EEST}
{277246800 14400 0 +04}
{291769200 14400 1 +04}
{308779200 10800 0 +03}
{323827200 14400 1 +04}
{340228800 10800 0 +03}
{354672000 14400 1 +04}
{371678400 10800 0 +03}
{386121600 14400 1 +04}
{403128000 10800 0 +03}
{428446800 14400 1 +04}
{433886400 10800 0 +03}
{482792400 7200 0 EET}
{482796000 10800 1 EEST}
{496702800 7200 0 EET}
{152665200 7200 0 EET}
{164678400 10800 1 EEST}
{184114800 7200 0 EET}
{196214400 10800 1 EEST}
{215564400 7200 0 EET}
{228873600 10800 1 EEST}
{245804400 7200 0 EET}
{260323200 10800 1 EEST}
{267919200 10800 0 +03}
{277254000 10800 0 +03}
{428454000 14400 1 +04}
{433893600 10800 0 +03}
{468111600 7200 0 EET}
{482799600 10800 1 EEST}
{496710000 7200 0 EET}
{512521200 10800 1 EEST}
{528246000 7200 0 EET}
{543970800 10800 1 EEST}

9
amd64/lib/tcl8.6/tzdata/Europe/Kaliningrad
View File

@@ -15,10 +15,11 @@ set TZData(:Europe/Kaliningrad) {
{-828226800 3600 0 CET}
{-812502000 7200 1 CEST}
{-796777200 3600 0 CET}
{-788922000 7200 0 CET}
{-778730400 10800 1 CEST}
{-762663600 7200 0 CET}
{-757389600 10800 0 MSD}
{-781052400 7200 1 CEST}
{-780368400 7200 0 EET}
{-778730400 10800 1 EEST}
{-762663600 7200 0 EET}
{-749095200 10800 0 MSD}
{354920400 14400 1 MSD}
{370728000 10800 0 MSK}
{386456400 14400 1 MSD}

2
amd64/lib/tcl8.6/tzdata/Europe/Rome
View File

@@ -2,7 +2,7 @@
set TZData(:Europe/Rome) {
{-9223372036854775808 2996 0 LMT}
{-3259097396 2996 0 RMT}
{-3252098996 2996 0 RMT}
{-2403565200 3600 0 CET}
{-1690765200 7200 1 CEST}
{-1680487200 3600 0 CET}

2
amd64/lib/tcl8.6/tzdata/Europe/Vienna
View File

@@ -22,7 +22,7 @@ set TZData(:Europe/Vienna) {
{-780188400 3600 0 CET}
{-757386000 3600 0 CET}
{-748479600 7200 1 CEST}
{-733359600 3600 0 CET}
{-733273200 3600 0 CET}
{-717634800 7200 1 CEST}
{-701910000 3600 0 CET}
{-684975600 7200 1 CEST}

7
amd64/lib/tcl8.6/tzdata/Pacific/Chuuk
View File

@@ -1,6 +1,11 @@
# created by tools/tclZIC.tcl - do not edit
set TZData(:Pacific/Chuuk) {
{-9223372036854775808 36428 0 LMT}
{-9223372036854775808 -49972 0 LMT}
{-3944628428 36428 0 LMT}
{-2177489228 36000 0 +10}
{-1743674400 32400 0 +09}
{-1606813200 36000 0 +10}
{-907408800 32400 0 +09}
{-770634000 36000 0 +10}
}

186
amd64/lib/tcl8.6/tzdata/Pacific/Fiji
View File

@@ -27,165 +27,165 @@ set TZData(:Pacific/Fiji) {
{1515852000 43200 0 +12}
{1541253600 46800 1 +12}
{1547301600 43200 0 +12}
{1572703200 46800 1 +12}
{1579356000 43200 0 +12}
{1604152800 46800 1 +12}
{1573308000 46800 1 +12}
{1578751200 43200 0 +12}
{1604757600 46800 1 +12}
{1610805600 43200 0 +12}
{1636207200 46800 1 +12}
{1636812000 46800 1 +12}
{1642255200 43200 0 +12}
{1667656800 46800 1 +12}
{1668261600 46800 1 +12}
{1673704800 43200 0 +12}
{1699106400 46800 1 +12}
{1699711200 46800 1 +12}
{1705154400 43200 0 +12}
{1730556000 46800 1 +12}
{1737208800 43200 0 +12}
{1762005600 46800 1 +12}
{1731160800 46800 1 +12}
{1736604000 43200 0 +12}
{1762610400 46800 1 +12}
{1768658400 43200 0 +12}
{1793455200 46800 1 +12}
{1794060000 46800 1 +12}
{1800108000 43200 0 +12}
{1825509600 46800 1 +12}
{1826114400 46800 1 +12}
{1831557600 43200 0 +12}
{1856959200 46800 1 +12}
{1857564000 46800 1 +12}
{1863007200 43200 0 +12}
{1888408800 46800 1 +12}
{1889013600 46800 1 +12}
{1894456800 43200 0 +12}
{1919858400 46800 1 +12}
{1926511200 43200 0 +12}
{1951308000 46800 1 +12}
{1920463200 46800 1 +12}
{1925906400 43200 0 +12}
{1951912800 46800 1 +12}
{1957960800 43200 0 +12}
{1983362400 46800 1 +12}
{1983967200 46800 1 +12}
{1989410400 43200 0 +12}
{2014812000 46800 1 +12}
{2015416800 46800 1 +12}
{2020860000 43200 0 +12}
{2046261600 46800 1 +12}
{2046866400 46800 1 +12}
{2052309600 43200 0 +12}
{2077711200 46800 1 +12}
{2078316000 46800 1 +12}
{2083759200 43200 0 +12}
{2109160800 46800 1 +12}
{2109765600 46800 1 +12}
{2115813600 43200 0 +12}
{2140610400 46800 1 +12}
{2141215200 46800 1 +12}
{2147263200 43200 0 +12}
{2172664800 46800 1 +12}
{2173269600 46800 1 +12}
{2178712800 43200 0 +12}
{2204114400 46800 1 +12}
{2204719200 46800 1 +12}
{2210162400 43200 0 +12}
{2235564000 46800 1 +12}
{2236168800 46800 1 +12}
{2241612000 43200 0 +12}
{2267013600 46800 1 +12}
{2273666400 43200 0 +12}
{2298463200 46800 1 +12}
{2267618400 46800 1 +12}
{2273061600 43200 0 +12}
{2299068000 46800 1 +12}
{2305116000 43200 0 +12}
{2329912800 46800 1 +12}
{2330517600 46800 1 +12}
{2336565600 43200 0 +12}
{2361967200 46800 1 +12}
{2362572000 46800 1 +12}
{2368015200 43200 0 +12}
{2393416800 46800 1 +12}
{2394021600 46800 1 +12}
{2399464800 43200 0 +12}
{2424866400 46800 1 +12}
{2425471200 46800 1 +12}
{2430914400 43200 0 +12}
{2456316000 46800 1 +12}
{2462968800 43200 0 +12}
{2487765600 46800 1 +12}
{2456920800 46800 1 +12}
{2462364000 43200 0 +12}
{2488370400 46800 1 +12}
{2494418400 43200 0 +12}
{2519820000 46800 1 +12}
{2520424800 46800 1 +12}
{2525868000 43200 0 +12}
{2551269600 46800 1 +12}
{2551874400 46800 1 +12}
{2557317600 43200 0 +12}
{2582719200 46800 1 +12}
{2583324000 46800 1 +12}
{2588767200 43200 0 +12}
{2614168800 46800 1 +12}
{2620821600 43200 0 +12}
{2645618400 46800 1 +12}
{2614773600 46800 1 +12}
{2620216800 43200 0 +12}
{2646223200 46800 1 +12}
{2652271200 43200 0 +12}
{2677068000 46800 1 +12}
{2677672800 46800 1 +12}
{2683720800 43200 0 +12}
{2709122400 46800 1 +12}
{2709727200 46800 1 +12}
{2715170400 43200 0 +12}
{2740572000 46800 1 +12}
{2741176800 46800 1 +12}
{2746620000 43200 0 +12}
{2772021600 46800 1 +12}
{2772626400 46800 1 +12}
{2778069600 43200 0 +12}
{2803471200 46800 1 +12}
{2810124000 43200 0 +12}
{2834920800 46800 1 +12}
{2804076000 46800 1 +12}
{2809519200 43200 0 +12}
{2835525600 46800 1 +12}
{2841573600 43200 0 +12}
{2866975200 46800 1 +12}
{2867580000 46800 1 +12}
{2873023200 43200 0 +12}
{2898424800 46800 1 +12}
{2899029600 46800 1 +12}
{2904472800 43200 0 +12}
{2929874400 46800 1 +12}
{2930479200 46800 1 +12}
{2935922400 43200 0 +12}
{2961324000 46800 1 +12}
{2961928800 46800 1 +12}
{2967372000 43200 0 +12}
{2992773600 46800 1 +12}
{2993378400 46800 1 +12}
{2999426400 43200 0 +12}
{3024223200 46800 1 +12}
{3024828000 46800 1 +12}
{3030876000 43200 0 +12}
{3056277600 46800 1 +12}
{3056882400 46800 1 +12}
{3062325600 43200 0 +12}
{3087727200 46800 1 +12}
{3088332000 46800 1 +12}
{3093775200 43200 0 +12}
{3119176800 46800 1 +12}
{3119781600 46800 1 +12}
{3125224800 43200 0 +12}
{3150626400 46800 1 +12}
{3157279200 43200 0 +12}
{3182076000 46800 1 +12}
{3151231200 46800 1 +12}
{3156674400 43200 0 +12}
{3182680800 46800 1 +12}
{3188728800 43200 0 +12}
{3213525600 46800 1 +12}
{3214130400 46800 1 +12}
{3220178400 43200 0 +12}
{3245580000 46800 1 +12}
{3246184800 46800 1 +12}
{3251628000 43200 0 +12}
{3277029600 46800 1 +12}
{3277634400 46800 1 +12}
{3283077600 43200 0 +12}
{3308479200 46800 1 +12}
{3309084000 46800 1 +12}
{3314527200 43200 0 +12}
{3339928800 46800 1 +12}
{3346581600 43200 0 +12}
{3371378400 46800 1 +12}
{3340533600 46800 1 +12}
{3345976800 43200 0 +12}
{3371983200 46800 1 +12}
{3378031200 43200 0 +12}
{3403432800 46800 1 +12}
{3404037600 46800 1 +12}
{3409480800 43200 0 +12}
{3434882400 46800 1 +12}
{3435487200 46800 1 +12}
{3440930400 43200 0 +12}
{3466332000 46800 1 +12}
{3466936800 46800 1 +12}
{3472380000 43200 0 +12}
{3497781600 46800 1 +12}
{3504434400 43200 0 +12}
{3529231200 46800 1 +12}
{3498386400 46800 1 +12}
{3503829600 43200 0 +12}
{3529836000 46800 1 +12}
{3535884000 43200 0 +12}
{3560680800 46800 1 +12}
{3561285600 46800 1 +12}
{3567333600 43200 0 +12}
{3592735200 46800 1 +12}
{3593340000 46800 1 +12}
{3598783200 43200 0 +12}
{3624184800 46800 1 +12}
{3624789600 46800 1 +12}
{3630232800 43200 0 +12}
{3655634400 46800 1 +12}
{3656239200 46800 1 +12}
{3661682400 43200 0 +12}
{3687084000 46800 1 +12}
{3693736800 43200 0 +12}
{3718533600 46800 1 +12}
{3687688800 46800 1 +12}
{3693132000 43200 0 +12}
{3719138400 46800 1 +12}
{3725186400 43200 0 +12}
{3750588000 46800 1 +12}
{3751192800 46800 1 +12}
{3756636000 43200 0 +12}
{3782037600 46800 1 +12}
{3782642400 46800 1 +12}
{3788085600 43200 0 +12}
{3813487200 46800 1 +12}
{3814092000 46800 1 +12}
{3819535200 43200 0 +12}
{3844936800 46800 1 +12}
{3845541600 46800 1 +12}
{3850984800 43200 0 +12}
{3876386400 46800 1 +12}
{3876991200 46800 1 +12}
{3883039200 43200 0 +12}
{3907836000 46800 1 +12}
{3908440800 46800 1 +12}
{3914488800 43200 0 +12}
{3939890400 46800 1 +12}
{3940495200 46800 1 +12}
{3945938400 43200 0 +12}
{3971340000 46800 1 +12}
{3971944800 46800 1 +12}
{3977388000 43200 0 +12}
{4002789600 46800 1 +12}
{4003394400 46800 1 +12}
{4008837600 43200 0 +12}
{4034239200 46800 1 +12}
{4040892000 43200 0 +12}
{4065688800 46800 1 +12}
{4034844000 46800 1 +12}
{4040287200 43200 0 +12}
{4066293600 46800 1 +12}
{4072341600 43200 0 +12}
{4097138400 46800 1 +12}
{4097743200 46800 1 +12}
}

18
amd64/lib/tcl8.6/tzdata/Pacific/Guam
View File

@@ -4,5 +4,23 @@ set TZData(:Pacific/Guam) {
{-9223372036854775808 -51660 0 LMT}
{-3944626740 34740 0 LMT}
{-2177487540 36000 0 GST}
{-885549600 32400 0 +09}
{-802256400 36000 0 GST}
{-331891200 39600 1 GDT}
{-281610000 36000 0 GST}
{-73728000 39600 1 GDT}
{-29415540 36000 0 GST}
{-16704000 39600 1 GDT}
{-10659600 36000 0 GST}
{9907200 39600 1 GDT}
{21394800 36000 0 GST}
{41356800 39600 1 GDT}
{52844400 36000 0 GST}
{124819200 39600 1 GDT}
{130863600 36000 0 GST}
{201888000 39600 1 GDT}
{209487660 36000 0 GST}
{230659200 39600 1 GDT}
{241542000 36000 0 GST}
{977493600 36000 0 ChST}
}

8
amd64/lib/tcl8.6/tzdata/Pacific/Kosrae
View File

@@ -1,8 +1,14 @@
# created by tools/tclZIC.tcl - do not edit
set TZData(:Pacific/Kosrae) {
{-9223372036854775808 39116 0 LMT}
{-9223372036854775808 -47284 0 LMT}
{-3944631116 39116 0 LMT}
{-2177491916 39600 0 +11}
{-1743678000 32400 0 +09}
{-1606813200 39600 0 +11}
{-1041418800 36000 0 +10}
{-907408800 32400 0 +09}
{-770634000 39600 0 +11}
{-7988400 43200 0 +12}
{915105600 39600 0 +11}
}

5
amd64/lib/tcl8.6/tzdata/Pacific/Kwajalein
View File

@@ -3,6 +3,9 @@
set TZData(:Pacific/Kwajalein) {
{-9223372036854775808 40160 0 LMT}
{-2177492960 39600 0 +11}
{-1041418800 36000 0 +10}
{-907408800 32400 0 +09}
{-817462800 39600 0 +11}
{-7988400 -43200 0 -12}
{745848000 43200 0 +12}
{745934400 43200 0 +12}
}

5
amd64/lib/tcl8.6/tzdata/Pacific/Majuro
View File

@@ -3,5 +3,10 @@
set TZData(:Pacific/Majuro) {
{-9223372036854775808 41088 0 LMT}
{-2177493888 39600 0 +11}
{-1743678000 32400 0 +09}
{-1606813200 39600 0 +11}
{-1041418800 36000 0 +10}
{-907408800 32400 0 +09}
{-818067600 39600 0 +11}
{-7988400 43200 0 +12}
}

6
amd64/lib/tcl8.6/tzdata/Pacific/Nauru
View File

@@ -3,7 +3,7 @@
set TZData(:Pacific/Nauru) {
{-9223372036854775808 40060 0 LMT}
{-1545131260 41400 0 +1130}
{-877347000 32400 0 +09}
{-800960400 41400 0 +1130}
{294323400 43200 0 +12}
{-862918200 32400 0 +09}
{-767350800 41400 0 +1130}
{287418600 43200 0 +12}
}

164
amd64/lib/tcl8.6/tzdata/Pacific/Norfolk
View File

@@ -5,6 +5,168 @@ set TZData(:Pacific/Norfolk) {
{-2177493112 40320 0 +1112}
{-599656320 41400 0 +1130}
{152029800 45000 1 +1230}
{162912600 41400 0 +1130}
{162916200 41400 0 +1130}
{1443882600 39600 0 +11}
{1561899600 39600 0 +12}
{1570287600 43200 1 +12}
{1586012400 39600 0 +12}
{1601737200 43200 1 +12}
{1617462000 39600 0 +12}
{1633186800 43200 1 +12}
{1648911600 39600 0 +12}
{1664636400 43200 1 +12}
{1680361200 39600 0 +12}
{1696086000 43200 1 +12}
{1712415600 39600 0 +12}
{1728140400 43200 1 +12}
{1743865200 39600 0 +12}
{1759590000 43200 1 +12}
{1775314800 39600 0 +12}
{1791039600 43200 1 +12}
{1806764400 39600 0 +12}
{1822489200 43200 1 +12}
{1838214000 39600 0 +12}
{1853938800 43200 1 +12}
{1869663600 39600 0 +12}
{1885993200 43200 1 +12}
{1901718000 39600 0 +12}
{1917442800 43200 1 +12}
{1933167600 39600 0 +12}
{1948892400 43200 1 +12}
{1964617200 39600 0 +12}
{1980342000 43200 1 +12}
{1996066800 39600 0 +12}
{2011791600 43200 1 +12}
{2027516400 39600 0 +12}
{2043241200 43200 1 +12}
{2058966000 39600 0 +12}
{2075295600 43200 1 +12}
{2091020400 39600 0 +12}
{2106745200 43200 1 +12}
{2122470000 39600 0 +12}
{2138194800 43200 1 +12}
{2153919600 39600 0 +12}
{2169644400 43200 1 +12}
{2185369200 39600 0 +12}
{2201094000 43200 1 +12}
{2216818800 39600 0 +12}
{2233148400 43200 1 +12}
{2248873200 39600 0 +12}
{2264598000 43200 1 +12}
{2280322800 39600 0 +12}
{2296047600 43200 1 +12}
{2311772400 39600 0 +12}
{2327497200 43200 1 +12}
{2343222000 39600 0 +12}
{2358946800 43200 1 +12}
{2374671600 39600 0 +12}
{2390396400 43200 1 +12}
{2406121200 39600 0 +12}
{2422450800 43200 1 +12}
{2438175600 39600 0 +12}
{2453900400 43200 1 +12}
{2469625200 39600 0 +12}
{2485350000 43200 1 +12}
{2501074800 39600 0 +12}
{2516799600 43200 1 +12}
{2532524400 39600 0 +12}
{2548249200 43200 1 +12}
{2563974000 39600 0 +12}
{2579698800 43200 1 +12}
{2596028400 39600 0 +12}
{2611753200 43200 1 +12}
{2627478000 39600 0 +12}
{2643202800 43200 1 +12}
{2658927600 39600 0 +12}
{2674652400 43200 1 +12}
{2690377200 39600 0 +12}
{2706102000 43200 1 +12}
{2721826800 39600 0 +12}
{2737551600 43200 1 +12}
{2753276400 39600 0 +12}
{2769606000 43200 1 +12}
{2785330800 39600 0 +12}
{2801055600 43200 1 +12}
{2816780400 39600 0 +12}
{2832505200 43200 1 +12}
{2848230000 39600 0 +12}
{2863954800 43200 1 +12}
{2879679600 39600 0 +12}
{2895404400 43200 1 +12}
{2911129200 39600 0 +12}
{2926854000 43200 1 +12}
{2942578800 39600 0 +12}
{2958908400 43200 1 +12}
{2974633200 39600 0 +12}
{2990358000 43200 1 +12}
{3006082800 39600 0 +12}
{3021807600 43200 1 +12}
{3037532400 39600 0 +12}
{3053257200 43200 1 +12}
{3068982000 39600 0 +12}
{3084706800 43200 1 +12}
{3100431600 39600 0 +12}
{3116761200 43200 1 +12}
{3132486000 39600 0 +12}
{3148210800 43200 1 +12}
{3163935600 39600 0 +12}
{3179660400 43200 1 +12}
{3195385200 39600 0 +12}
{3211110000 43200 1 +12}
{3226834800 39600 0 +12}
{3242559600 43200 1 +12}
{3258284400 39600 0 +12}
{3274009200 43200 1 +12}
{3289734000 39600 0 +12}
{3306063600 43200 1 +12}
{3321788400 39600 0 +12}
{3337513200 43200 1 +12}
{3353238000 39600 0 +12}
{3368962800 43200 1 +12}
{3384687600 39600 0 +12}
{3400412400 43200 1 +12}
{3416137200 39600 0 +12}
{3431862000 43200 1 +12}
{3447586800 39600 0 +12}
{3463311600 43200 1 +12}
{3479641200 39600 0 +12}
{3495366000 43200 1 +12}
{3511090800 39600 0 +12}
{3526815600 43200 1 +12}
{3542540400 39600 0 +12}
{3558265200 43200 1 +12}
{3573990000 39600 0 +12}
{3589714800 43200 1 +12}
{3605439600 39600 0 +12}
{3621164400 43200 1 +12}
{3636889200 39600 0 +12}
{3653218800 43200 1 +12}
{3668943600 39600 0 +12}
{3684668400 43200 1 +12}
{3700393200 39600 0 +12}
{3716118000 43200 1 +12}
{3731842800 39600 0 +12}
{3747567600 43200 1 +12}
{3763292400 39600 0 +12}
{3779017200 43200 1 +12}
{3794742000 39600 0 +12}
{3810466800 43200 1 +12}
{3826191600 39600 0 +12}
{3842521200 43200 1 +12}
{3858246000 39600 0 +12}
{3873970800 43200 1 +12}
{3889695600 39600 0 +12}
{3905420400 43200 1 +12}
{3921145200 39600 0 +12}
{3936870000 43200 1 +12}
{3952594800 39600 0 +12}
{3968319600 43200 1 +12}
{3984044400 39600 0 +12}
{4000374000 43200 1 +12}
{4016098800 39600 0 +12}
{4031823600 43200 1 +12}
{4047548400 39600 0 +12}
{4063273200 43200 1 +12}
{4078998000 39600 0 +12}
{4094722800 43200 1 +12}
}

3
amd64/lib/tcl8.6/tzdata/Pacific/Palau
View File

@@ -1,6 +1,7 @@
# created by tools/tclZIC.tcl - do not edit
set TZData(:Pacific/Palau) {
{-9223372036854775808 32276 0 LMT}
{-9223372036854775808 -54124 0 LMT}
{-3944624276 32276 0 LMT}
{-2177485076 32400 0 +09}
}

8
amd64/lib/tcl8.6/tzdata/Pacific/Pohnpei
View File

@@ -1,6 +1,12 @@
# created by tools/tclZIC.tcl - do not edit
set TZData(:Pacific/Pohnpei) {
{-9223372036854775808 37972 0 LMT}
{-9223372036854775808 -48428 0 LMT}
{-3944629972 37972 0 LMT}
{-2177490772 39600 0 +11}
{-1743678000 32400 0 +09}
{-1606813200 39600 0 +11}
{-1041418800 36000 0 +10}
{-907408800 32400 0 +09}
{-770634000 39600 0 +11}
}

6
amd64/lib/tcl8.6/tzdata/UCT
View File

@@ -1,5 +1,5 @@
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Etc/UCT)]} {
LoadTimeZoneFile Etc/UCT
if {![info exists TZData(Etc/UTC)]} {
LoadTimeZoneFile Etc/UTC
}
set TZData(:UCT) $TZData(:Etc/UCT)
set TZData(:UCT) $TZData(:Etc/UTC)

9
amd64/lib/tcl8/8.5/tcltest-2.5.0.tm → amd64/lib/tcl8/8.5/tcltest-2.5.1.tm
View File

@@ -22,7 +22,7 @@ namespace eval tcltest {
# When the version number changes, be sure to update the pkgIndex.tcl file,
# and the install directory in the Makefiles. When the minor version
# changes (new feature) be sure to update the man page as well.
variable Version 2.5.0
variable Version 2.5.1
# Compatibility support for dumb variables defined in tcltest 1
# Do not use these. Call [package provide Tcl] and [info patchlevel]
@@ -3072,7 +3072,12 @@ proc tcltest::removeFile {name {directory ""}} {
Warn "removeFile removing \"$fullName\":\n not a file"
}
}
return [file delete -- $fullName]
if {[catch {file delete -- $fullName} msg ]} {
DebugDo 1 {
Warn "removeFile removing \"$fullName\":\n failed: $msg"
}
}
return
}
# tcltest::makeDirectory --

4
amd64/lib/tcl8/8.6/http-2.9.0.tm → amd64/lib/tcl8/8.6/http-2.9.1.tm
View File

@@ -11,7 +11,7 @@
package require Tcl 8.6-
# Keep this in sync with pkgIndex.tcl and with the install directories in
# Makefiles
package provide http 2.9.0
package provide http 2.9.1
namespace eval http {
# Allow resourcing to not clobber existing data
@@ -2978,7 +2978,7 @@ proc http::IsBinaryContentType {type} {
# and so on.
if {$major eq "application"} {
set minor [string trimright $minor]
if {$minor in {"xml" "xml-external-parsed-entity" "xml-dtd"}} {
if {$minor in {"json" "xml" "xml-external-parsed-entity" "xml-dtd"}} {
return false
}
}

BIN
amd64/lib/tcl86t.lib
View File

Binary file not shown.

362
amd64/lib/tclConfig.sh
View File

@@ -1,181 +1,181 @@
# tclConfig.sh --
#
# This shell script (for sh) is generated automatically by Tcl's
# configure script. It will create shell variables for most of
# the configuration options discovered by the configure script.
# This script is intended to be included by the configure scripts
# for Tcl extensions so that they don't have to figure this all
# out for themselves.
#
# The information in this file is specific to a single platform.
TCL_DLL_FILE="tcl86t.dll"
# Tcl's version number.
TCL_VERSION='8.6'
TCL_MAJOR_VERSION='8'
TCL_MINOR_VERSION='6'
TCL_PATCH_LEVEL='8.6.9'
# C compiler to use for compilation.
TCL_CC='cl'
# -D flags for use with the C compiler.
TCL_DEFS='-nologo -c /D_ATL_XP_TARGETING /DUNICODE /D_UNICODE -W3 -wd4311 -wd4312 -wd4311 -wd4312 -FpC:\_work\11\b\tcl-core-8.6.9.0\win\Release_AMD64_VC13\tcl_ThreadedDynamic\ -fp:strict -O2 -GS -GL -MD -I"C:\_work\11\b\tcl-core-8.6.9.0\win\..\win" -I"C:\_work\11\b\tcl-core-8.6.9.0\win\..\generic" -I"C:\_work\11\b\tcl-core-8.6.9.0\win\..\libtommath" -DTCL_TOMMATH -DMP_PREC=4 -Dinline=__inline -DHAVE_ZLIB=1 -D_CRT_SECURE_NO_DEPRECATE -D_CRT_NONSTDC_NO_DEPRECATE -DTCL_CFGVAL_ENCODING=\"cp1252\" -DSTDC_HEADERS -DTCL_THREADS=1 -DUSE_THREAD_ALLOC=1 -DNDEBUG -DTCL_CFG_OPTIMIZED -DTCL_CFG_DO64BIT -DBUILD_tcl'
# If TCL was built with debugging symbols, generated libraries contain
# this string at the end of the library name (before the extension).
TCL_DBGX=t
# Default flags used in an optimized and debuggable build, respectively.
TCL_CFLAGS_DEBUG='-nologo -c -W3 -YX -FpC:\_work\11\b\tcl-core-8.6.9.0\win\Release_AMD64_VC13\tcl_ThreadedDynamic\ -MDd'
TCL_CFLAGS_OPTIMIZE='-nologo -c -W3 -YX -FpC:\_work\11\b\tcl-core-8.6.9.0\win\Release_AMD64_VC13\tcl_ThreadedDynamic\ -MD'
# Default linker flags used in an optimized and debuggable build, respectively.
TCL_LDFLAGS_DEBUG='-nologo -machine:AMD64 -debug -debugtype:cv'
TCL_LDFLAGS_OPTIMIZE='-nologo -machine:AMD64 -release -opt:ref -opt:icf,3'
# Flag, 1: we built a shared lib, 0 we didn't
TCL_SHARED_BUILD=1
# The name of the Tcl library (may be either a .a file or a shared library):
TCL_LIB_FILE='tcl86t.lib'
# Flag to indicate whether shared libraries need export files.
TCL_NEEDS_EXP_FILE=
# String that can be evaluated to generate the part of the export file
# name that comes after the "libxxx" (includes version number, if any,
# extension, and anything else needed). May depend on the variables
# VERSION. On most UNIX systems this is ${VERSION}.exp.
TCL_EXPORT_FILE_SUFFIX='86t.lib'
# Additional libraries to use when linking Tcl.
TCL_LIBS='kernel32.lib advapi32.lib netapi32.lib user32.lib userenv.lib ws2_32.lib ucrt.lib netapi32.lib user32.lib userenv.lib ws2_32.lib'
# Top-level directory in which Tcl's platform-independent files are
# installed.
TCL_PREFIX='C:\_work\11\b\tcltk-8.6.9.0\amd64'
# Top-level directory in which Tcl's platform-specific files (e.g.
# executables) are installed.
TCL_EXEC_PREFIX='C:\_work\11\b\tcltk-8.6.9.0\amd64\bin'
# Flags to pass to cc when compiling the components of a shared library:
TCL_SHLIB_CFLAGS=''
# Flags to pass to cc to get warning messages
TCL_CFLAGS_WARNING='-W3'
# Extra flags to pass to cc:
TCL_EXTRA_CFLAGS='-YX'
# Base command to use for combining object files into a shared library:
TCL_SHLIB_LD='link -nologo -machine:AMD64 -ltcg -release -opt:ref -opt:icf,3 -nodefaultlib:libucrt.lib -dll'
# Base command to use for combining object files into a static library:
TCL_STLIB_LD='lib -nologo'
# Either '$LIBS' (if dependent libraries should be included when linking
# shared libraries) or an empty string. See Tcl's configure.in for more
# explanation.
TCL_SHLIB_LD_LIBS='kernel32.lib advapi32.lib netapi32.lib user32.lib userenv.lib ws2_32.lib ucrt.lib netapi32.lib user32.lib userenv.lib ws2_32.lib'
# Suffix to use for the name of a shared library.
TCL_SHLIB_SUFFIX='.dll'
# Library file(s) to include in tclsh and other base applications
# in order to provide facilities needed by DLOBJ above.
TCL_DL_LIBS=''
# Flags to pass to the compiler when linking object files into
# an executable tclsh or tcltest binary.
TCL_LD_FLAGS=''
# Flags to pass to cc/ld, such as "-R /usr/local/tcl/lib", that tell the
# run-time dynamic linker where to look for shared libraries such as
# libtcl.so. Used when linking applications. Only works if there
# is a variable "LIB_RUNTIME_DIR" defined in the Makefile.
TCL_CC_SEARCH_FLAGS=''
TCL_LD_SEARCH_FLAGS=''
# Additional object files linked with Tcl to provide compatibility
# with standard facilities from ANSI C or POSIX.
TCL_COMPAT_OBJS=''
# Name of the ranlib program to use.
TCL_RANLIB=''
# -l flag to pass to the linker to pick up the Tcl library
TCL_LIB_FLAG=''
# String to pass to linker to pick up the Tcl library from its
# build directory.
TCL_BUILD_LIB_SPEC=''
# String to pass to linker to pick up the Tcl library from its
# installed directory.
TCL_LIB_SPEC='C:\_work\11\b\tcltk-8.6.9.0\amd64\lib\tcl86t.lib'
# String to pass to the compiler so that an extension can
# find installed Tcl headers.
TCL_INCLUDE_SPEC='-IC:\_work\11\b\tcltk-8.6.9.0\amd64\include'
# Indicates whether a version numbers should be used in -l switches
# ("ok" means it's safe to use switches like -ltcl7.5; "nodots" means
# use switches like -ltcl75). SunOS and FreeBSD require "nodots", for
# example.
TCL_LIB_VERSIONS_OK=''
# String that can be evaluated to generate the part of a shared library
# name that comes after the "libxxx" (includes version number, if any,
# extension, and anything else needed). May depend on the variables
# VERSION and SHLIB_SUFFIX. On most UNIX systems this is
# ${VERSION}${SHLIB_SUFFIX}.
TCL_SHARED_LIB_SUFFIX='86t.dll'
# String that can be evaluated to generate the part of an unshared library
# name that comes after the "libxxx" (includes version number, if any,
# extension, and anything else needed). May depend on the variable
# VERSION. On most UNIX systems this is ${VERSION}.a.
TCL_UNSHARED_LIB_SUFFIX='86t.lib'
# Location of the top-level source directory from which Tcl was built.
# This is the directory that contains a README file as well as
# subdirectories such as generic, unix, etc. If Tcl was compiled in a
# different place than the directory containing the source files, this
# points to the location of the sources, not the location where Tcl was
# compiled.
TCL_SRC_DIR='C:\_work\11\b\tcl-core-8.6.9.0\win\..'
# List of standard directories in which to look for packages during
# "package require" commands. Contains the "prefix" directory plus also
# the "exec_prefix" directory, if it is different.
TCL_PACKAGE_PATH=''
# Tcl supports stub.
TCL_SUPPORTS_STUBS=1
# The name of the Tcl stub library (.a):
TCL_STUB_LIB_FILE='tclstub86.lib'
# -l flag to pass to the linker to pick up the Tcl stub library
TCL_STUB_LIB_FLAG='tclstub86.lib'
# String to pass to linker to pick up the Tcl stub library from its
# build directory.
TCL_BUILD_STUB_LIB_SPEC='-LC:\_work\11\b\tcl-core-8.6.9.0\win\Release_AMD64_VC13 tclstub86.lib'
# String to pass to linker to pick up the Tcl stub library from its
# installed directory.
TCL_STUB_LIB_SPEC='-LC:\_work\11\b\tcltk-8.6.9.0\amd64\lib tclstub86.lib'
# Path to the Tcl stub library in the build directory.
TCL_BUILD_STUB_LIB_PATH='C:\_work\11\b\tcl-core-8.6.9.0\win\Release_AMD64_VC13\tclstub86.lib'
# Path to the Tcl stub library in the install directory.
TCL_STUB_LIB_PATH='C:\_work\11\b\tcltk-8.6.9.0\amd64\lib\tclstub86.lib'
# Flag, 1: we built Tcl with threads enabled, 0 we didn't
TCL_THREADS=1
# tclConfig.sh --
#
# This shell script (for sh) is generated automatically by Tcl's
# configure script. It will create shell variables for most of
# the configuration options discovered by the configure script.
# This script is intended to be included by the configure scripts
# for Tcl extensions so that they don't have to figure this all
# out for themselves.
#
# The information in this file is specific to a single platform.
TCL_DLL_FILE="tcl86t.dll"
# Tcl's version number.
TCL_VERSION='8.6'
TCL_MAJOR_VERSION='8'
TCL_MINOR_VERSION='6'
TCL_PATCH_LEVEL='8.6.10'
# C compiler to use for compilation.
TCL_CC='cl'
# -D flags for use with the C compiler.
TCL_DEFS='-nologo -c /D_ATL_XP_TARGETING -W3 -wd4311 -wd4312 -wd4311 -wd4312 -FpC:\A\32\b\tcl-core-8.6.10.0\win\Release_AMD64_VC13\tcl_ThreadedDynamic\ -fp:strict -O2 -GS -GL -MD -I"C:\A\32\b\tcl-core-8.6.10.0\win\..\win" -I"C:\A\32\b\tcl-core-8.6.10.0\win\..\generic" -I"C:\A\32\b\tcl-core-8.6.10.0\win\..\libtommath" /DTCL_TOMMATH /DMP_PREC=4 /Dinline=__inline /DHAVE_ZLIB=1 /D_CRT_SECURE_NO_DEPRECATE /D_CRT_NONSTDC_NO_DEPRECATE /DMP_FIXED_CUTOFFS /DMP_NO_STDINT /DTCL_CFGVAL_ENCODING=\"cp1252\" /DSTDC_HEADERS /DTCL_THREADS=1 /DUSE_THREAD_ALLOC=1 /DNDEBUG /DTCL_CFG_OPTIMIZED /DTCL_CFG_DO64BIT /DBUILD_tcl'
# If TCL was built with debugging symbols, generated libraries contain
# this string at the end of the library name (before the extension).
TCL_DBGX=t
# Default flags used in an optimized and debuggable build, respectively.
TCL_CFLAGS_DEBUG='-nologo -c -W3 -YX -FpC:\A\32\b\tcl-core-8.6.10.0\win\Release_AMD64_VC13\tcl_ThreadedDynamic\ -MDd'
TCL_CFLAGS_OPTIMIZE='-nologo -c -W3 -YX -FpC:\A\32\b\tcl-core-8.6.10.0\win\Release_AMD64_VC13\tcl_ThreadedDynamic\ -MD'
# Default linker flags used in an optimized and debuggable build, respectively.
TCL_LDFLAGS_DEBUG='-nologo -machine:AMD64 -debug -debugtype:cv'
TCL_LDFLAGS_OPTIMIZE='-nologo -machine:AMD64 -release -opt:ref -opt:icf,3'
# Flag, 1: we built a shared lib, 0 we didn't
TCL_SHARED_BUILD=1
# The name of the Tcl library (may be either a .a file or a shared library):
TCL_LIB_FILE='tcl86t.lib'
# Flag to indicate whether shared libraries need export files.
TCL_NEEDS_EXP_FILE=
# String that can be evaluated to generate the part of the export file
# name that comes after the "libxxx" (includes version number, if any,
# extension, and anything else needed). May depend on the variables
# VERSION. On most UNIX systems this is ${VERSION}.exp.
TCL_EXPORT_FILE_SUFFIX='86t.lib'
# Additional libraries to use when linking Tcl.
TCL_LIBS='kernel32.lib advapi32.lib netapi32.lib user32.lib userenv.lib ws2_32.lib ucrt.lib netapi32.lib user32.lib userenv.lib ws2_32.lib'
# Top-level directory in which Tcl's platform-independent files are
# installed.
TCL_PREFIX='C:\A\32\b\tcltk-8.6.10.0\amd64'
# Top-level directory in which Tcl's platform-specific files (e.g.
# executables) are installed.
TCL_EXEC_PREFIX='C:\A\32\b\tcltk-8.6.10.0\amd64\bin'
# Flags to pass to cc when compiling the components of a shared library:
TCL_SHLIB_CFLAGS=''
# Flags to pass to cc to get warning messages
TCL_CFLAGS_WARNING='-W3'
# Extra flags to pass to cc:
TCL_EXTRA_CFLAGS='-YX'
# Base command to use for combining object files into a shared library:
TCL_SHLIB_LD='link -nologo -machine:AMD64 -ltcg -release -opt:ref -opt:icf,3 -nodefaultlib:libucrt.lib -dll'
# Base command to use for combining object files into a static library:
TCL_STLIB_LD='lib -nologo'
# Either '$LIBS' (if dependent libraries should be included when linking
# shared libraries) or an empty string. See Tcl's configure.in for more
# explanation.
TCL_SHLIB_LD_LIBS='kernel32.lib advapi32.lib netapi32.lib user32.lib userenv.lib ws2_32.lib ucrt.lib netapi32.lib user32.lib userenv.lib ws2_32.lib'
# Suffix to use for the name of a shared library.
TCL_SHLIB_SUFFIX='.dll'
# Library file(s) to include in tclsh and other base applications
# in order to provide facilities needed by DLOBJ above.
TCL_DL_LIBS=''
# Flags to pass to the compiler when linking object files into
# an executable tclsh or tcltest binary.
TCL_LD_FLAGS=''
# Flags to pass to cc/ld, such as "-R /usr/local/tcl/lib", that tell the
# run-time dynamic linker where to look for shared libraries such as
# libtcl.so. Used when linking applications. Only works if there
# is a variable "LIB_RUNTIME_DIR" defined in the Makefile.
TCL_CC_SEARCH_FLAGS=''
TCL_LD_SEARCH_FLAGS=''
# Additional object files linked with Tcl to provide compatibility
# with standard facilities from ANSI C or POSIX.
TCL_COMPAT_OBJS=''
# Name of the ranlib program to use.
TCL_RANLIB=''
# -l flag to pass to the linker to pick up the Tcl library
TCL_LIB_FLAG=''
# String to pass to linker to pick up the Tcl library from its
# build directory.
TCL_BUILD_LIB_SPEC=''
# String to pass to linker to pick up the Tcl library from its
# installed directory.
TCL_LIB_SPEC='C:\A\32\b\tcltk-8.6.10.0\amd64\lib\tcl86t.lib'
# String to pass to the compiler so that an extension can
# find installed Tcl headers.
TCL_INCLUDE_SPEC='-IC:\A\32\b\tcltk-8.6.10.0\amd64\include'
# Indicates whether a version numbers should be used in -l switches
# ("ok" means it's safe to use switches like -ltcl7.5; "nodots" means
# use switches like -ltcl75). SunOS and FreeBSD require "nodots", for
# example.
TCL_LIB_VERSIONS_OK=''
# String that can be evaluated to generate the part of a shared library
# name that comes after the "libxxx" (includes version number, if any,
# extension, and anything else needed). May depend on the variables
# VERSION and SHLIB_SUFFIX. On most UNIX systems this is
# ${VERSION}${SHLIB_SUFFIX}.
TCL_SHARED_LIB_SUFFIX='86t.dll'
# String that can be evaluated to generate the part of an unshared library
# name that comes after the "libxxx" (includes version number, if any,
# extension, and anything else needed). May depend on the variable
# VERSION. On most UNIX systems this is ${VERSION}.a.
TCL_UNSHARED_LIB_SUFFIX='86t.lib'
# Location of the top-level source directory from which Tcl was built.
# This is the directory that contains a README file as well as
# subdirectories such as generic, unix, etc. If Tcl was compiled in a
# different place than the directory containing the source files, this
# points to the location of the sources, not the location where Tcl was
# compiled.
TCL_SRC_DIR='C:\A\32\b\tcl-core-8.6.10.0\win\..'
# List of standard directories in which to look for packages during
# "package require" commands. Contains the "prefix" directory plus also
# the "exec_prefix" directory, if it is different.
TCL_PACKAGE_PATH=''
# Tcl supports stub.
TCL_SUPPORTS_STUBS=1
# The name of the Tcl stub library (.a):
TCL_STUB_LIB_FILE='tclstub86.lib'
# -l flag to pass to the linker to pick up the Tcl stub library
TCL_STUB_LIB_FLAG='tclstub86.lib'
# String to pass to linker to pick up the Tcl stub library from its
# build directory.
TCL_BUILD_STUB_LIB_SPEC='-LC:\A\32\b\tcl-core-8.6.10.0\win\Release_AMD64_VC13 tclstub86.lib'
# String to pass to linker to pick up the Tcl stub library from its
# installed directory.
TCL_STUB_LIB_SPEC='-LC:\A\32\b\tcltk-8.6.10.0\amd64\lib tclstub86.lib'
# Path to the Tcl stub library in the build directory.
TCL_BUILD_STUB_LIB_PATH='C:\A\32\b\tcl-core-8.6.10.0\win\Release_AMD64_VC13\tclstub86.lib'
# Path to the Tcl stub library in the install directory.
TCL_STUB_LIB_PATH='C:\A\32\b\tcltk-8.6.10.0\amd64\lib\tclstub86.lib'
# Flag, 1: we built Tcl with threads enabled, 0 we didn't
TCL_THREADS=1

BIN
amd64/lib/tclstub86.lib
View File

Binary file not shown.

1170
amd64/lib/tix8.4.3/Balloon.tcl
View File

File diff suppressed because it is too large Load Diff

240
amd64/lib/tix8.4.3/BtnBox.tcl
View File

@@ -1,120 +1,120 @@
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: BtnBox.tcl,v 1.2 2001/12/09 05:04:02 idiscovery Exp $
#
# BtnBox.tcl --
#
# Implements the tixButtonBox 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.
#
tixWidgetClass tixButtonBox {
-superclass tixPrimitive
-classname TixButtonBox
-method {
add invoke button buttons
}
-flag {
-orientation -orient -padx -pady -state
}
-static {
-orientation
}
-configspec {
{-orientation orientation Orientation horizontal}
{-padx padX Pad 0}
{-pady padY Pad 0}
{-state state State normal}
}
-alias {
{-orient -orientation}
}
-default {
{.borderWidth 1}
{.relief raised}
{.padX 5}
{.padY 10}
{*Button.anchor c}
{*Button.padX 5}
}
}
proc tixButtonBox:InitWidgetRec {w} {
upvar #0 $w data
tixChainMethod $w InitWidgetRec
set data(g:buttons) ""
}
#----------------------------------------------------------------------
# CONFIG OPTIONS
#----------------------------------------------------------------------
proc tixButtonBox:config-padx {w arg} {
upvar #0 $w data
foreach item $data(g:buttons) {
pack configure $w.$item -padx $arg
}
}
proc tixButtonBox:config-pady {w arg} {
upvar #0 $w data
foreach item $data(g:buttons) {
pack configure $w.$item -pady $arg
}
}
proc tixButtonBox:config-state {w arg} {
upvar #0 $w data
foreach item $data(g:buttons) {
$w.$item config -state $arg
}
}
#----------------------------------------------------------------------
# Methods
# WIDGET COMMANDS
#----------------------------------------------------------------------
proc tixButtonBox:add {w name args} {
upvar #0 $w data
eval button $w.$name $args
if {$data(-orientation) == "horizontal"} {
pack $w.$name -side left -expand yes -fill y\
-padx $data(-padx) -pady $data(-pady)
} else {
pack $w.$name -side top -expand yes -fill x\
-padx $data(-padx) -pady $data(-pady)
}
# allow for subwidget access
#
lappend data(g:buttons) $name
set data(w:$name) $w.$name
return $w.$name
}
proc tixButtonBox:button {w name args} {
return [eval tixCallMethod $w subwidget $name $args]
}
proc tixButtonBox:buttons {w args} {
return [eval tixCallMethod $w subwidgets -group buttons $args]
}
#
# call the command
proc tixButtonBox:invoke {w name} {
upvar #0 $w data
$w.$name invoke
}
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: BtnBox.tcl,v 1.2 2001/12/09 05:04:02 idiscovery Exp $
#
# BtnBox.tcl --
#
# Implements the tixButtonBox 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.
#
tixWidgetClass tixButtonBox {
-superclass tixPrimitive
-classname TixButtonBox
-method {
add invoke button buttons
}
-flag {
-orientation -orient -padx -pady -state
}
-static {
-orientation
}
-configspec {
{-orientation orientation Orientation horizontal}
{-padx padX Pad 0}
{-pady padY Pad 0}
{-state state State normal}
}
-alias {
{-orient -orientation}
}
-default {
{.borderWidth 1}
{.relief raised}
{.padX 5}
{.padY 10}
{*Button.anchor c}
{*Button.padX 5}
}
}
proc tixButtonBox:InitWidgetRec {w} {
upvar #0 $w data
tixChainMethod $w InitWidgetRec
set data(g:buttons) ""
}
#----------------------------------------------------------------------
# CONFIG OPTIONS
#----------------------------------------------------------------------
proc tixButtonBox:config-padx {w arg} {
upvar #0 $w data
foreach item $data(g:buttons) {
pack configure $w.$item -padx $arg
}
}
proc tixButtonBox:config-pady {w arg} {
upvar #0 $w data
foreach item $data(g:buttons) {
pack configure $w.$item -pady $arg
}
}
proc tixButtonBox:config-state {w arg} {
upvar #0 $w data
foreach item $data(g:buttons) {
$w.$item config -state $arg
}
}
#----------------------------------------------------------------------
# Methods
# WIDGET COMMANDS
#----------------------------------------------------------------------
proc tixButtonBox:add {w name args} {
upvar #0 $w data
eval button $w.$name $args
if {$data(-orientation) == "horizontal"} {
pack $w.$name -side left -expand yes -fill y\
-padx $data(-padx) -pady $data(-pady)
} else {
pack $w.$name -side top -expand yes -fill x\
-padx $data(-padx) -pady $data(-pady)
}
# allow for subwidget access
#
lappend data(g:buttons) $name
set data(w:$name) $w.$name
return $w.$name
}
proc tixButtonBox:button {w name args} {
return [eval tixCallMethod $w subwidget $name $args]
}
proc tixButtonBox:buttons {w args} {
return [eval tixCallMethod $w subwidgets -group buttons $args]
}
#
# call the command
proc tixButtonBox:invoke {w name} {
upvar #0 $w data
$w.$name invoke
}

720
amd64/lib/tix8.4.3/CObjView.tcl
View File

@@ -1,360 +1,360 @@
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: CObjView.tcl,v 1.3 2001/12/09 05:04:02 idiscovery Exp $
#
# CObjView.tcl --
#
# This file implements the Canvas Object View widget. This is a base
# class of IconView. It implements:
# (1) Automatic placement/adjustment of the scrollbars according
# to the canvas objects inside the canvas subwidget. The
# scrollbars are adjusted so that the canvas is just large
# enough to see all the objects.
#
# (2) D+D bindings of the objects (%% not implemented)
#
# (3) Keyboard traversal of the objects (%% not implemented). By the
# virtual method :SelectObject.
#
#
# 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.
#
tixWidgetClass tixCObjView {
-classname TixCObjView
-superclass tixScrolledWidget
-method {
adjustscrollregion
}
-flag {
-xscrollincrement -yscrollincrement
}
-static {
}
-configspec {
{-xscrollincrement xScrollIncrement ScrollIncrement 10}
{-yscrollincrement yScrollIncrement ScrollIncrement 10}
}
-default {
{.scrollbar auto}
{*borderWidth 1}
{*canvas.background #c3c3c3}
{*canvas.highlightBackground #d9d9d9}
{*canvas.relief sunken}
{*canvas.takeFocus 1}
{*Scrollbar.takeFocus 0}
}
-forcecall {
-scrollbar
}
}
proc tixCObjView:ConstructWidget {w} {
upvar #0 $w data
tixChainMethod $w ConstructWidget
set data(w:canvas) \
[canvas $w.canvas]
set data(w:hsb) \
[scrollbar $w.hsb -orient horizontal]
set data(w:vsb) \
[scrollbar $w.vsb -orient vertical]
set data(pw:client) $data(w:canvas)
set data(xorig) 0
set data(yorig) 0
set data(sx1) 0
set data(sy1) 0
set data(sx2) 0
set data(sy2) 0
}
proc tixCObjView:SetBindings {w} {
upvar #0 $w data
tixChainMethod $w SetBindings
# %% scan/drag of canvas??
#
# $data(w:canvas) config \
# -xscrollcommand "tixCObjView:XScroll $w"\
# -yscrollcommand "tixCObjView:YScroll $w"
$data(w:hsb) config -command "tixCObjView:UserScroll $w x"
$data(w:vsb) config -command "tixCObjView:UserScroll $w y"
}
#----------------------------------------------------------------------
#
# option configs
#----------------------------------------------------------------------
proc tixCObjView:config-takefocus {w value} {
upvar #0 $w data
$data(w:canvas) config -takefocus $value
}
#----------------------------------------------------------------------
#
# Widget commands
#----------------------------------------------------------------------
proc tixCObjView:adjustscrollregion {w} {
upvar #0 $w data
set cW [tixWinWidth $data(w:canvas)]
set cH [tixWinHeight $data(w:canvas)]
tixCObjView:GetScrollRegion $w $cW $cH 1 1
}
#----------------------------------------------------------------------
#
# Private Methods
#----------------------------------------------------------------------
proc tixCObjView:GeometryInfo {w cW cH} {
upvar #0 $w data
set bd \
[expr [$data(w:canvas) cget -bd] + [$data(w:canvas) cget -highlightthickness]]
incr cW -[expr {2*$bd}]
incr cH -[expr {2*$bd}]
return [tixCObjView:GetScrollRegion $w $cW $cH 0 0]
}
proc tixCObjView:PlaceWindow {w} {
upvar #0 $w data
set cW [tixWinWidth $data(w:canvas)]
set cH [tixWinHeight $data(w:canvas)]
tixCObjView:GetScrollRegion $w $cW $cH 1 0
tixChainMethod $w PlaceWindow
}
proc tixCObjView:GetScrollRegion {w cW cH setReg callConfig} {
upvar #0 $w data
set x1max $data(xorig)
set y1max $data(yorig)
set x2min [expr {$x1max + $cW - 1}]
set y2min [expr {$y1max + $cH - 1}]
set bbox [$data(w:canvas) bbox all]
if {$bbox == ""} {
set bbox {0 0 1 1}
}
set x1 [lindex $bbox 0]
set y1 [lindex $bbox 1]
set x2 [lindex $bbox 2]
set y2 [lindex $bbox 3]
set bd \
[expr [$data(w:canvas) cget -bd] + [$data(w:canvas) cget -highlightthickness]]
incr x1 -$bd
incr y1 -$bd
incr x2 -$bd
incr y2 -$bd
if {$x1 > $x1max} {
set x1 $x1max
}
if {$y1 > $y1max} {
set y1 $y1max
}
if {$x2 < $x2min} {
set x2 $x2min
}
if {$y2 < $y2min} {
set y2 $y2min
}
set data(sx1) $x1
set data(sy1) $y1
set data(sx2) $x2
set data(sy2) $y2
set sW [expr {$x2 - $x1 + 1}]
set sH [expr {$y2 - $y1 + 1}]
# puts "sregion = {$x1 $y1 $x2 $y2}; sW=$sW; cW=$cW"
if {$sW > $cW} {
set hsbSpec {0.5 1}
} else {
set hsbSpec {0 1}
}
if {$sH > $cH} {
set vsbSpec {0.5 1}
} else {
set vsbSpec {0 1}
}
if $setReg {
tixCObjView:SetScrollBars $w $cW $cH $sW $sH
}
if $callConfig {
tixWidgetDoWhenIdle tixScrolledWidget:Configure $w
}
return [list $hsbSpec $vsbSpec]
}
#xF = xFirst
#
proc tixCObjView:SetScrollBars {w cW cH sW sH} {
upvar #0 $w data
# puts "$data(xorig) <--> $data(sx1)"
set xF [expr ($data(xorig).0-$data(sx1).0)/$sW.0]
set xL [expr $cW.0/$sW.0 + $xF]
set yF [expr ($data(yorig).0-$data(sy1).0)/$sH.0]
set yL [expr $cH.0/$sH.0 + $yF]
# puts "$xF $xL : $yF $yL"
$data(w:hsb) set $xF $xL
$data(w:vsb) set $yF $yL
}
proc tixCObjView:UserScroll {w dir type args} {
upvar #0 $w data
$data(w:canvas) config -xscrollincrement 1 -yscrollincrement 1
case $dir {
x {
set n $data(xorig)
set orig $data(xorig)
set s1 $data(sx1)
set total [expr {$data(sx2)-$data(sx1)}]
set page [tixWinWidth $data(w:canvas)]
set min $data(sx1)
set max [expr {$data(sx1)+$total-$page}]
set inc $data(-xscrollincrement)
}
y {
set n $data(yorig)
set orig $data(yorig)
set s1 $data(sy1)
set total [expr {$data(sy2)-$data(sy1)}]
set page [tixWinHeight $data(w:canvas)]
set min $data(sy1)
set max [expr {$data(sy1)+$total-$page}]
set inc $data(-yscrollincrement)
}
}
case $type {
scroll {
set amt [lindex $args 0]
set unit [lindex $args 1]
case $unit {
units {
incr n [expr int($inc)*$amt]
}
pages {
incr n [expr {$page*$amt}]
}
}
}
moveto {
set first [lindex $args 0]
set n [expr round($first*$total)+$s1]
}
}
if {$n < $min} {
set n $min
}
if {$n > $max} {
set n $max
}
# puts "n=$n min=$min max=$max"
case $dir {
x {
$data(w:canvas) xview scroll [expr {$n-$orig}] units
set data(xorig) $n
}
y {
$data(w:canvas) yview scroll [expr {$n-$orig}] units
set data(yorig) $n
}
}
set cW [tixWinWidth $data(w:canvas)]
set cH [tixWinHeight $data(w:canvas)]
set sW [expr {$data(sx2)-$data(sx1)+1}]
set sH [expr {$data(sy2)-$data(sy1)+1}]
tixCObjView:SetScrollBars $w $cW $cH $sW $sH
}
# Junk
#
#
proc tixCObjView:XScroll {w first last} {
upvar #0 $w data
set sc [$data(w:canvas) cget -scrollregion]
if {$sc == ""} {
set x1 1
set x2 [tixWinWidth $data(w:canvas)]
} else {
set x1 [lindex $sc 0]
set x2 [lindex $sc 2]
}
set W [expr {$x2 - $x1}]
if {$W < 1} {
set W 1
}
$data(w:hsb) set $first $last
# tixWidgetDoWhenIdle tixScrolledWidget:Configure $w
}
# Junk
#
proc tixCObjView:YScroll {w first last} {
upvar #0 $w data
set sc [$data(w:canvas) cget -scrollregion]
if {$sc == ""} {
set y1 1
set y2 [tixWinHeight $data(w:canvas)]
} else {
set y1 [lindex $sc 1]
set y2 [lindex $sc 3]
}
set H [expr {$y2 - $y1}]
if {$H < 1} {
set H 1
}
$data(w:vsb) set $first $last
# tixWidgetDoWhenIdle tixScrolledWidget:Configure $w
}
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: CObjView.tcl,v 1.3 2001/12/09 05:04:02 idiscovery Exp $
#
# CObjView.tcl --
#
# This file implements the Canvas Object View widget. This is a base
# class of IconView. It implements:
# (1) Automatic placement/adjustment of the scrollbars according
# to the canvas objects inside the canvas subwidget. The
# scrollbars are adjusted so that the canvas is just large
# enough to see all the objects.
#
# (2) D+D bindings of the objects (%% not implemented)
#
# (3) Keyboard traversal of the objects (%% not implemented). By the
# virtual method :SelectObject.
#
#
# 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.
#
tixWidgetClass tixCObjView {
-classname TixCObjView
-superclass tixScrolledWidget
-method {
adjustscrollregion
}
-flag {
-xscrollincrement -yscrollincrement
}
-static {
}
-configspec {
{-xscrollincrement xScrollIncrement ScrollIncrement 10}
{-yscrollincrement yScrollIncrement ScrollIncrement 10}
}
-default {
{.scrollbar auto}
{*borderWidth 1}
{*canvas.background #c3c3c3}
{*canvas.highlightBackground #d9d9d9}
{*canvas.relief sunken}
{*canvas.takeFocus 1}
{*Scrollbar.takeFocus 0}
}
-forcecall {
-scrollbar
}
}
proc tixCObjView:ConstructWidget {w} {
upvar #0 $w data
tixChainMethod $w ConstructWidget
set data(w:canvas) \
[canvas $w.canvas]
set data(w:hsb) \
[scrollbar $w.hsb -orient horizontal]
set data(w:vsb) \
[scrollbar $w.vsb -orient vertical]
set data(pw:client) $data(w:canvas)
set data(xorig) 0
set data(yorig) 0
set data(sx1) 0
set data(sy1) 0
set data(sx2) 0
set data(sy2) 0
}
proc tixCObjView:SetBindings {w} {
upvar #0 $w data
tixChainMethod $w SetBindings
# %% scan/drag of canvas??
#
# $data(w:canvas) config \
# -xscrollcommand "tixCObjView:XScroll $w"\
# -yscrollcommand "tixCObjView:YScroll $w"
$data(w:hsb) config -command "tixCObjView:UserScroll $w x"
$data(w:vsb) config -command "tixCObjView:UserScroll $w y"
}
#----------------------------------------------------------------------
#
# option configs
#----------------------------------------------------------------------
proc tixCObjView:config-takefocus {w value} {
upvar #0 $w data
$data(w:canvas) config -takefocus $value
}
#----------------------------------------------------------------------
#
# Widget commands
#----------------------------------------------------------------------
proc tixCObjView:adjustscrollregion {w} {
upvar #0 $w data
set cW [tixWinWidth $data(w:canvas)]
set cH [tixWinHeight $data(w:canvas)]
tixCObjView:GetScrollRegion $w $cW $cH 1 1
}
#----------------------------------------------------------------------
#
# Private Methods
#----------------------------------------------------------------------
proc tixCObjView:GeometryInfo {w cW cH} {
upvar #0 $w data
set bd \
[expr [$data(w:canvas) cget -bd] + [$data(w:canvas) cget -highlightthickness]]
incr cW -[expr {2*$bd}]
incr cH -[expr {2*$bd}]
return [tixCObjView:GetScrollRegion $w $cW $cH 0 0]
}
proc tixCObjView:PlaceWindow {w} {
upvar #0 $w data
set cW [tixWinWidth $data(w:canvas)]
set cH [tixWinHeight $data(w:canvas)]
tixCObjView:GetScrollRegion $w $cW $cH 1 0
tixChainMethod $w PlaceWindow
}
proc tixCObjView:GetScrollRegion {w cW cH setReg callConfig} {
upvar #0 $w data
set x1max $data(xorig)
set y1max $data(yorig)
set x2min [expr {$x1max + $cW - 1}]
set y2min [expr {$y1max + $cH - 1}]
set bbox [$data(w:canvas) bbox all]
if {$bbox == ""} {
set bbox {0 0 1 1}
}
set x1 [lindex $bbox 0]
set y1 [lindex $bbox 1]
set x2 [lindex $bbox 2]
set y2 [lindex $bbox 3]
set bd \
[expr [$data(w:canvas) cget -bd] + [$data(w:canvas) cget -highlightthickness]]
incr x1 -$bd
incr y1 -$bd
incr x2 -$bd
incr y2 -$bd
if {$x1 > $x1max} {
set x1 $x1max
}
if {$y1 > $y1max} {
set y1 $y1max
}
if {$x2 < $x2min} {
set x2 $x2min
}
if {$y2 < $y2min} {
set y2 $y2min
}
set data(sx1) $x1
set data(sy1) $y1
set data(sx2) $x2
set data(sy2) $y2
set sW [expr {$x2 - $x1 + 1}]
set sH [expr {$y2 - $y1 + 1}]
# puts "sregion = {$x1 $y1 $x2 $y2}; sW=$sW; cW=$cW"
if {$sW > $cW} {
set hsbSpec {0.5 1}
} else {
set hsbSpec {0 1}
}
if {$sH > $cH} {
set vsbSpec {0.5 1}
} else {
set vsbSpec {0 1}
}
if $setReg {
tixCObjView:SetScrollBars $w $cW $cH $sW $sH
}
if $callConfig {
tixWidgetDoWhenIdle tixScrolledWidget:Configure $w
}
return [list $hsbSpec $vsbSpec]
}
#xF = xFirst
#
proc tixCObjView:SetScrollBars {w cW cH sW sH} {
upvar #0 $w data
# puts "$data(xorig) <--> $data(sx1)"
set xF [expr ($data(xorig).0-$data(sx1).0)/$sW.0]
set xL [expr $cW.0/$sW.0 + $xF]
set yF [expr ($data(yorig).0-$data(sy1).0)/$sH.0]
set yL [expr $cH.0/$sH.0 + $yF]
# puts "$xF $xL : $yF $yL"
$data(w:hsb) set $xF $xL
$data(w:vsb) set $yF $yL
}
proc tixCObjView:UserScroll {w dir type args} {
upvar #0 $w data
$data(w:canvas) config -xscrollincrement 1 -yscrollincrement 1
case $dir {
x {
set n $data(xorig)
set orig $data(xorig)
set s1 $data(sx1)
set total [expr {$data(sx2)-$data(sx1)}]
set page [tixWinWidth $data(w:canvas)]
set min $data(sx1)
set max [expr {$data(sx1)+$total-$page}]
set inc $data(-xscrollincrement)
}
y {
set n $data(yorig)
set orig $data(yorig)
set s1 $data(sy1)
set total [expr {$data(sy2)-$data(sy1)}]
set page [tixWinHeight $data(w:canvas)]
set min $data(sy1)
set max [expr {$data(sy1)+$total-$page}]
set inc $data(-yscrollincrement)
}
}
case $type {
scroll {
set amt [lindex $args 0]
set unit [lindex $args 1]
case $unit {
units {
incr n [expr int($inc)*$amt]
}
pages {
incr n [expr {$page*$amt}]
}
}
}
moveto {
set first [lindex $args 0]
set n [expr round($first*$total)+$s1]
}
}
if {$n < $min} {
set n $min
}
if {$n > $max} {
set n $max
}
# puts "n=$n min=$min max=$max"
case $dir {
x {
$data(w:canvas) xview scroll [expr {$n-$orig}] units
set data(xorig) $n
}
y {
$data(w:canvas) yview scroll [expr {$n-$orig}] units
set data(yorig) $n
}
}
set cW [tixWinWidth $data(w:canvas)]
set cH [tixWinHeight $data(w:canvas)]
set sW [expr {$data(sx2)-$data(sx1)+1}]
set sH [expr {$data(sy2)-$data(sy1)+1}]
tixCObjView:SetScrollBars $w $cW $cH $sW $sH
}
# Junk
#
#
proc tixCObjView:XScroll {w first last} {
upvar #0 $w data
set sc [$data(w:canvas) cget -scrollregion]
if {$sc == ""} {
set x1 1
set x2 [tixWinWidth $data(w:canvas)]
} else {
set x1 [lindex $sc 0]
set x2 [lindex $sc 2]
}
set W [expr {$x2 - $x1}]
if {$W < 1} {
set W 1
}
$data(w:hsb) set $first $last
# tixWidgetDoWhenIdle tixScrolledWidget:Configure $w
}
# Junk
#
proc tixCObjView:YScroll {w first last} {
upvar #0 $w data
set sc [$data(w:canvas) cget -scrollregion]
if {$sc == ""} {
set y1 1
set y2 [tixWinHeight $data(w:canvas)]
} else {
set y1 [lindex $sc 1]
set y2 [lindex $sc 3]
}
set H [expr {$y2 - $y1}]
if {$H < 1} {
set H 1
}
$data(w:vsb) set $first $last
# tixWidgetDoWhenIdle tixScrolledWidget:Configure $w
}

478
amd64/lib/tix8.4.3/ChkList.tcl
View File

@@ -1,239 +1,239 @@
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: ChkList.tcl,v 1.6 2004/03/28 02:44:57 hobbs Exp $
#
# ChkList.tcl --
#
# This file implements the TixCheckList widget.
#
# 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 tixCheckList {
-classname TixCheckList
-superclass tixTree
-method {
getselection getstatus setstatus
}
-flag {
-radio
}
-configspec {
{-radio radio Radio false tixVerifyBoolean}
{-ignoreinvoke ignoreInvoke IgnoreInvoke true tixVerifyBoolean}
}
-static {
-radio
}
-default {
{.scrollbar auto}
{.doubleClick false}
{*Scrollbar.takeFocus 0}
{*borderWidth 1}
{*hlist.background #c3c3c3}
{*hlist.drawBranch 1}
{*hlist.height 10}
{*hlist.highlightBackground #d9d9d9}
{*hlist.indicator 1}
{*hlist.indent 20}
{*hlist.itemType imagetext}
{*hlist.padX 3}
{*hlist.padY 0}
{*hlist.relief sunken}
{*hlist.takeFocus 1}
{*hlist.wideSelection 0}
{*hlist.width 20}
}
}
proc tixCheckList:InitWidgetRec {w} {
upvar #0 $w data
tixChainMethod $w InitWidgetRec
if {$data(-radio)} {
set data(selected) ""
}
}
#----------------------------------------------------------------------
#
# Widget commands
#
#----------------------------------------------------------------------
# Helper function for getselection
#
proc tixCheckList:GetSel {w var ent mode} {
upvar #0 $w data
upvar $var img
set ents ""
catch {
if {[$data(w:hlist) entrycget $ent -bitmap] eq $img($mode)} {
lappend ents $ent
}
}
foreach child [$data(w:hlist) info children $ent] {
set ents [concat $ents [tixCheckList:GetSel $w img $child $mode]]
}
return $ents
}
# Mode can be on, off, default
#
proc tixCheckList:getselection {w {mode on}} {
upvar #0 $w data
set img(on) [tix getbitmap ck_on]
set img(off) [tix getbitmap ck_off]
set img(default) [tix getbitmap ck_def]
set ents ""
foreach child [$data(w:hlist) info children] {
set ents [concat $ents [tixCheckList:GetSel $w img $child $mode]]
}
return $ents
}
proc tixCheckList:getstatus {w ent} {
upvar #0 $w data
if {[$data(w:hlist) entrycget $ent -itemtype] eq "imagetext"} {
set img(on) [tix getbitmap ck_on]
set img(off) [tix getbitmap ck_off]
set img(default) [tix getbitmap ck_def]
set bitmap [$data(w:hlist) entrycget $ent -bitmap]
if {$bitmap eq $img(on)} {
set status on
}
if {$bitmap eq $img(off)} {
set status off
}
if {$bitmap eq $img(default)} {
set status default
}
}
if {[info exists status]} {
return $status
} else {
return "none"
}
}
proc tixCheckList:setstatus {w ent {mode on}} {
upvar #0 $w data
if {$data(-radio)} {
set status [tixCheckList:getstatus $w $ent]
if {$status eq $mode} {
return
}
if {$mode eq "on"} {
if {$data(selected) != ""} {
tixCheckList:Select $w $data(selected) off
}
set data(selected) $ent
tixCheckList:Select $w $ent $mode
} elseif {$mode eq "off"} {
if {$data(selected) eq $ent} {
return
}
tixCheckList:Select $w $ent $mode
} else {
tixCheckList:Select $w $ent $mode
}
} else {
tixCheckList:Select $w $ent $mode
}
}
proc tixCheckList:Select {w ent mode} {
upvar #0 $w data
if {[$data(w:hlist) entrycget $ent -itemtype] eq "imagetext"} {
set img(on) ck_on
set img(off) ck_off
set img(default) ck_def
if [catch {
set bitmap [tix getbitmap $img($mode)]
$data(w:hlist) entryconfig $ent -bitmap $bitmap
}] {
# must be the "none" mode
#
catch {
$data(w:hlist) entryconfig $ent -bitmap ""
}
}
}
return $mode
}
proc tixCheckList:HandleCheck {w ent} {
upvar #0 $w data
if {[$data(w:hlist) entrycget $ent -itemtype] eq "imagetext"} {
set img(on) [tix getbitmap ck_on]
set img(off) [tix getbitmap ck_off]
set img(default) [tix getbitmap ck_def]
set curMode [tixCheckList:getstatus $w $ent]
case $curMode {
on {
tixCheckList:setstatus $w $ent off
}
off {
tixCheckList:setstatus $w $ent on
}
none {
return
}
default {
tixCheckList:setstatus $w $ent on
}
}
}
}
proc tixCheckList:Command {w B} {
upvar #0 $w data
upvar $B bind
set ent [tixEvent flag V]
tixCheckList:HandleCheck $w $ent
tixChainMethod $w Command $B
}
proc tixCheckList:BrowseCmd {w B} {
upvar #0 $w data
upvar $B bind
set ent [tixEvent flag V]
case [tixEvent type] {
{<ButtonPress-1> <space>} {
tixCheckList:HandleCheck $w $ent
}
}
tixChainMethod $w BrowseCmd $B
}
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: ChkList.tcl,v 1.6 2004/03/28 02:44:57 hobbs Exp $
#
# ChkList.tcl --
#
# This file implements the TixCheckList widget.
#
# 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 tixCheckList {
-classname TixCheckList
-superclass tixTree
-method {
getselection getstatus setstatus
}
-flag {
-radio
}
-configspec {
{-radio radio Radio false tixVerifyBoolean}
{-ignoreinvoke ignoreInvoke IgnoreInvoke true tixVerifyBoolean}
}
-static {
-radio
}
-default {
{.scrollbar auto}
{.doubleClick false}
{*Scrollbar.takeFocus 0}
{*borderWidth 1}
{*hlist.background #c3c3c3}
{*hlist.drawBranch 1}
{*hlist.height 10}
{*hlist.highlightBackground #d9d9d9}
{*hlist.indicator 1}
{*hlist.indent 20}
{*hlist.itemType imagetext}
{*hlist.padX 3}
{*hlist.padY 0}
{*hlist.relief sunken}
{*hlist.takeFocus 1}
{*hlist.wideSelection 0}
{*hlist.width 20}
}
}
proc tixCheckList:InitWidgetRec {w} {
upvar #0 $w data
tixChainMethod $w InitWidgetRec
if {$data(-radio)} {
set data(selected) ""
}
}
#----------------------------------------------------------------------
#
# Widget commands
#
#----------------------------------------------------------------------
# Helper function for getselection
#
proc tixCheckList:GetSel {w var ent mode} {
upvar #0 $w data
upvar $var img
set ents ""
catch {
if {[$data(w:hlist) entrycget $ent -bitmap] eq $img($mode)} {
lappend ents $ent
}
}
foreach child [$data(w:hlist) info children $ent] {
set ents [concat $ents [tixCheckList:GetSel $w img $child $mode]]
}
return $ents
}
# Mode can be on, off, default
#
proc tixCheckList:getselection {w {mode on}} {
upvar #0 $w data
set img(on) [tix getbitmap ck_on]
set img(off) [tix getbitmap ck_off]
set img(default) [tix getbitmap ck_def]
set ents ""
foreach child [$data(w:hlist) info children] {
set ents [concat $ents [tixCheckList:GetSel $w img $child $mode]]
}
return $ents
}
proc tixCheckList:getstatus {w ent} {
upvar #0 $w data
if {[$data(w:hlist) entrycget $ent -itemtype] eq "imagetext"} {
set img(on) [tix getbitmap ck_on]
set img(off) [tix getbitmap ck_off]
set img(default) [tix getbitmap ck_def]
set bitmap [$data(w:hlist) entrycget $ent -bitmap]
if {$bitmap eq $img(on)} {
set status on
}
if {$bitmap eq $img(off)} {
set status off
}
if {$bitmap eq $img(default)} {
set status default
}
}
if {[info exists status]} {
return $status
} else {
return "none"
}
}
proc tixCheckList:setstatus {w ent {mode on}} {
upvar #0 $w data
if {$data(-radio)} {
set status [tixCheckList:getstatus $w $ent]
if {$status eq $mode} {
return
}
if {$mode eq "on"} {
if {$data(selected) != ""} {
tixCheckList:Select $w $data(selected) off
}
set data(selected) $ent
tixCheckList:Select $w $ent $mode
} elseif {$mode eq "off"} {
if {$data(selected) eq $ent} {
return
}
tixCheckList:Select $w $ent $mode
} else {
tixCheckList:Select $w $ent $mode
}
} else {
tixCheckList:Select $w $ent $mode
}
}
proc tixCheckList:Select {w ent mode} {
upvar #0 $w data
if {[$data(w:hlist) entrycget $ent -itemtype] eq "imagetext"} {
set img(on) ck_on
set img(off) ck_off
set img(default) ck_def
if [catch {
set bitmap [tix getbitmap $img($mode)]
$data(w:hlist) entryconfig $ent -bitmap $bitmap
}] {
# must be the "none" mode
#
catch {
$data(w:hlist) entryconfig $ent -bitmap ""
}
}
}
return $mode
}
proc tixCheckList:HandleCheck {w ent} {
upvar #0 $w data
if {[$data(w:hlist) entrycget $ent -itemtype] eq "imagetext"} {
set img(on) [tix getbitmap ck_on]
set img(off) [tix getbitmap ck_off]
set img(default) [tix getbitmap ck_def]
set curMode [tixCheckList:getstatus $w $ent]
case $curMode {
on {
tixCheckList:setstatus $w $ent off
}
off {
tixCheckList:setstatus $w $ent on
}
none {
return
}
default {
tixCheckList:setstatus $w $ent on
}
}
}
}
proc tixCheckList:Command {w B} {
upvar #0 $w data
upvar $B bind
set ent [tixEvent flag V]
tixCheckList:HandleCheck $w $ent
tixChainMethod $w Command $B
}
proc tixCheckList:BrowseCmd {w B} {
upvar #0 $w data
upvar $B bind
set ent [tixEvent flag V]
case [tixEvent type] {
{<ButtonPress-1> <space>} {
tixCheckList:HandleCheck $w $ent
}
}
tixChainMethod $w BrowseCmd $B
}

3116
amd64/lib/tix8.4.3/ComboBox.tcl
View File

File diff suppressed because it is too large Load Diff

66
amd64/lib/tix8.4.3/Compat.tcl
View File

@@ -1,33 +1,33 @@
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: Compat.tcl,v 1.3 2004/03/28 02:44:57 hobbs Exp $
#
# Compat.tcl --
#
# This file wraps around many incompatibilities from Tix 3.6
# to Tix 4.0.
#
# (1) "box" to "Box" changes
# (2) "DlgBtns" to "ButtonBox" changes
#
# 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.
#
foreach {old new} {
tixDlgBtns tixButtonBox
tixStdDlgBtns tixStdButtonBox
tixCombobox tixComboBox
tixFileSelectbox tixFileSelectBox
tixScrolledListbox tixScrolledListBox
} {
interp alias {} $old {} $new
}
proc tixInit {args} {
eval tix config $args
puts stderr "tixInit no longer needed for this version of Tix"
}
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: Compat.tcl,v 1.3 2004/03/28 02:44:57 hobbs Exp $
#
# Compat.tcl --
#
# This file wraps around many incompatibilities from Tix 3.6
# to Tix 4.0.
#
# (1) "box" to "Box" changes
# (2) "DlgBtns" to "ButtonBox" changes
#
# 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.
#
foreach {old new} {
tixDlgBtns tixButtonBox
tixStdDlgBtns tixStdButtonBox
tixCombobox tixComboBox
tixFileSelectbox tixFileSelectBox
tixScrolledListbox tixScrolledListBox
} {
interp alias {} $old {} $new
}
proc tixInit {args} {
eval tix config $args
puts stderr "tixInit no longer needed for this version of Tix"
}

1224
amd64/lib/tix8.4.3/Console.tcl
View File

File diff suppressed because it is too large Load Diff

964
amd64/lib/tix8.4.3/Control.tcl
View File

@@ -1,482 +1,482 @@
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: Control.tcl,v 1.9 2004/03/28 02:44:57 hobbs Exp $
#
# Control.tcl --
#
# Implements the TixControl Widget. It is called the "SpinBox"
# in other toolkits.
#
# 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 tixControl {
-classname TixControl
-superclass tixLabelWidget
-method {
incr decr invoke update
}
-flag {
-allowempty -autorepeat -command -decrcmd -disablecallback
-disabledforeground -incrcmd -initwait -integer -llimit
-repeatrate -max -min -selectmode -step -state -validatecmd
-value -variable -ulimit
}
-forcecall {
-variable -state
}
-configspec {
{-allowempty allowEmpty AllowEmpty false}
{-autorepeat autoRepeat AutoRepeat true}
{-command command Command ""}
{-decrcmd decrCmd DecrCmd ""}
{-disablecallback disableCallback DisableCallback 0 tixVerifyBoolean}
{-disabledforeground disabledForeground DisabledForeground #303030}
{-incrcmd incrCmd IncrCmd ""}
{-initwait initWait InitWait 500}
{-integer integer Integer false}
{-max max Max ""}
{-min min Min ""}
{-repeatrate repeatRate RepeatRate 50}
{-step step Step 1}
{-state state State normal}
{-selectmode selectMode SelectMode normal}
{-validatecmd validateCmd ValidateCmd ""}
{-value value Value 0}
{-variable variable Variable ""}
}
-alias {
{-llimit -min}
{-ulimit -max}
}
-default {
{.borderWidth 0}
{*entry.relief sunken}
{*entry.width 5}
{*label.anchor e}
{*label.borderWidth 0}
{*Button.anchor c}
{*Button.borderWidth 2}
{*Button.highlightThickness 1}
{*Button.takeFocus 0}
}
}
proc tixControl:InitWidgetRec {w} {
upvar #0 $w data
tixChainMethod $w InitWidgetRec
set data(varInited) 0
set data(serial) 0
}
proc tixControl:ConstructFramedWidget {w frame} {
upvar #0 $w data
tixChainMethod $w ConstructFramedWidget $frame
set data(w:entry) [entry $frame.entry]
set data(w:incr) \
[button $frame.incr -bitmap [tix getbitmap incr] -takefocus 0]
set data(w:decr) \
[button $frame.decr -bitmap [tix getbitmap decr] -takefocus 0]
# tixForm $data(w:entry) -left 0 -top 0 -bottom -1 -right $data(w:decr)
# tixForm $data(w:incr) -right -1 -top 0 -bottom %50
# tixForm $data(w:decr) -right -1 -top $data(w:incr) -bottom -1
pack $data(w:entry) -side left -expand yes -fill both
pack $data(w:decr) -side bottom -fill both -expand yes
pack $data(w:incr) -side top -fill both -expand yes
$data(w:entry) delete 0 end
$data(w:entry) insert 0 $data(-value)
# This value is used to configure the disable/normal fg of the ebtry
set data(entryfg) [$data(w:entry) cget -fg]
set data(labelfg) [$data(w:label) cget -fg]
}
proc tixControl:SetBindings {w} {
upvar #0 $w data
tixChainMethod $w SetBindings
bind $data(w:incr) <ButtonPress-1> \
[list after idle tixControl:StartRepeat $w 1]
bind $data(w:decr) <ButtonPress-1> \
[list after idle tixControl:StartRepeat $w -1]
# These bindings will stop the button autorepeat when the
# mouse button is up
foreach btn [list $data(w:incr) $data(w:decr)] {
bind $btn <ButtonRelease-1> [list tixControl:StopRepeat $w]
}
tixSetMegaWidget $data(w:entry) $w
# If user press <return>, verify the value and call the -command
#
tixAddBindTag $data(w:entry) TixControl:Entry
}
proc tixControlBind {} {
tixBind TixControl:Entry <Return> {
tixControl:Invoke [tixGetMegaWidget %W] 1
}
tixBind TixControl:Entry <Escape> {
tixControl:Escape [tixGetMegaWidget %W]
}
tixBind TixControl:Entry <Up> {
[tixGetMegaWidget %W] incr
}
tixBind TixControl:Entry <Down> {
[tixGetMegaWidget %W] decr
}
tixBind TixControl:Entry <FocusOut> {
if {"%d" eq "NotifyNonlinear" || "%d" eq "NotifyNonlinearVirtual"} {
tixControl:Tab [tixGetMegaWidget %W] %d
}
}
tixBind TixControl:Entry <Any-KeyPress> {
tixControl:KeyPress [tixGetMegaWidget %W]
}
tixBind TixControl:Entry <Any-Tab> {
# This has a higher priority than the <Any-KeyPress> binding
# --> so that data(edited) is not set
}
}
#----------------------------------------------------------------------
# CONFIG OPTIONS
#----------------------------------------------------------------------
proc tixControl:config-state {w arg} {
upvar #0 $w data
if {$arg eq "normal"} {
$data(w:incr) config -state $arg
$data(w:decr) config -state $arg
catch {
$data(w:label) config -fg $data(labelfg)
}
$data(w:entry) config -state $arg -fg $data(entryfg)
} else {
$data(w:incr) config -state $arg
$data(w:decr) config -state $arg
catch {
$data(w:label) config -fg $data(-disabledforeground)
}
$data(w:entry) config -state $arg -fg $data(-disabledforeground)
}
}
proc tixControl:config-value {w value} {
upvar #0 $w data
tixControl:SetValue $w $value 0 1
# This will tell the Intrinsics: "Please use this value"
# because "value" might be altered by SetValues
#
return $data(-value)
}
proc tixControl:config-variable {w arg} {
upvar #0 $w data
if {[tixVariable:ConfigVariable $w $arg]} {
# The value of data(-value) is changed if tixVariable:ConfigVariable
# returns true
tixControl:SetValue $w $data(-value) 1 1
}
catch {
unset data(varInited)
}
set data(-variable) $arg
}
#----------------------------------------------------------------------
# User Commands
#----------------------------------------------------------------------
proc tixControl:incr {w {by 1}} {
upvar #0 $w data
if {$data(-state) ne "disabled"} {
if {![catch {$data(w:entry) index sel.first}]} {
$data(w:entry) select from end
$data(w:entry) select to end
}
# CYGNUS - why set value before changing it?
#tixControl:SetValue $w [$data(w:entry) get] 0 1
tixControl:AdjustValue $w $by
}
}
proc tixControl:decr {w {by 1}} {
upvar #0 $w data
if {$data(-state) ne "disabled"} {
if {![catch {$data(w:entry) index sel.first}]} {
$data(w:entry) select from end
$data(w:entry) select to end
}
# CYGNUS - why set value before changing it?
#tixControl:SetValue $w [$data(w:entry) get] 0 1
tixControl:AdjustValue $w [expr {0 - $by}]
}
}
proc tixControl:invoke {w} {
upvar #0 $w data
tixControl:Invoke $w 0
}
proc tixControl:update {w} {
upvar #0 $w data
if {[info exists data(edited)]} {
tixControl:invoke $w
}
}
#----------------------------------------------------------------------
# Internal Commands
#----------------------------------------------------------------------
# Change the value by a multiple of the data(-step)
#
proc tixControl:AdjustValue {w amount} {
upvar #0 $w data
if {$amount == 1 && [llength $data(-incrcmd)]} {
set newValue [tixEvalCmdBinding $w $data(-incrcmd) "" $data(-value)]
} elseif {$amount == -1 && [llength $data(-decrcmd)]} {
set newValue [tixEvalCmdBinding $w $data(-decrcmd) "" $data(-value)]
} else {
set newValue [expr {$data(-value) + $amount * $data(-step)}]
}
if {$data(-state) ne "disabled"} {
tixControl:SetValue $w $newValue 0 1
}
}
proc tixControl:SetValue {w newvalue noUpdate forced} {
upvar #0 $w data
if {[$data(w:entry) selection present]} {
set oldSelection [list [$data(w:entry) index sel.first] \
[$data(w:entry) index sel.last]]
}
set oldvalue $data(-value)
set oldCursor [$data(w:entry) index insert]
set changed 0
if {[llength $data(-validatecmd)]} {
# Call the user supplied validation command
#
set data(-value) [tixEvalCmdBinding $w $data(-validatecmd) "" $newvalue]
} else {
# Here we only allow int or floating numbers
#
# If the new value is not a valid number, the old value will be
# kept due to the "catch" statements
#
if {[catch {expr 0+$newvalue}]} {
set newvalue 0
set data(-value) 0
set changed 1
}
if {$newvalue == ""} {
if {![string is true -strict $data(-allowempty)]} {
set newvalue 0
set changed 1
} else {
set data(-value) ""
}
}
if {$newvalue != ""} {
# Change this to a valid decimal string (trim leading 0)
#
regsub -- {^[0]*} $newvalue "" newvalue
if {[catch {expr 0+$newvalue}]} {
set newvalue 0
set data(-value) 0
set changed 1
}
if {$newvalue == ""} {
set newvalue 0
}
if {[string is true -strict $data(-integer)]} {
set data(-value) [tixGetInt -nocomplain $newvalue]
} else {
if {[catch {set data(-value) [format "%d" $newvalue]}]} {
if {[catch {set data(-value) [expr $newvalue+0.0]}]} {
set data(-value) $oldvalue
}
}
}
# Now perform boundary checking
#
if {$data(-max) != "" && $data(-value) > $data(-max)} {
set data(-value) $data(-max)
}
if {$data(-min) != "" && $data(-value) < $data(-min)} {
set data(-value) $data(-min)
}
}
}
if {! $noUpdate} {
tixVariable:UpdateVariable $w
}
if {$forced || ($newvalue ne $data(-value)) || $changed} {
$data(w:entry) delete 0 end
$data(w:entry) insert 0 $data(-value)
$data(w:entry) icursor $oldCursor
if {[info exists oldSelection]} {
eval [list $data(w:entry) selection range] $oldSelection
}
}
if {!$data(-disablecallback) && $data(-command) != ""} {
if {![info exists data(varInited)]} {
set bind(specs) ""
tixEvalCmdBinding $w $data(-command) bind $data(-value)
}
}
}
proc tixControl:Invoke {w forced} {
upvar #0 $w data
catch {
unset data(edited)
}
if {[catch {$data(w:entry) index sel.first}] == 0} {
# THIS ENTRY OWNS SELECTION --> TURN IT OFF
#
$data(w:entry) select from end
$data(w:entry) select to end
}
tixControl:SetValue $w [$data(w:entry) get] 0 $forced
}
#----------------------------------------------------------------------
# The three functions StartRepeat, Repeat and StopRepeat make use of the
# data(serial) variable to discard spurious repeats: If a button is clicked
# repeatedly but is not hold down, the serial counter will increase
# successively and all "after" time event handlers will be discarded
#----------------------------------------------------------------------
proc tixControl:StartRepeat {w amount} {
if {![winfo exists $w]} {
return
}
upvar #0 $w data
incr data(serial)
# CYGNUS bug fix
# Need to set a local variable because otherwise the buttonrelease
# callback could change the value of data(serial) between now and
# the time the repeat is scheduled.
set serial $data(serial)
if {![catch {$data(w:entry) index sel.first}]} {
$data(w:entry) select from end
$data(w:entry) select to end
}
if {[info exists data(edited)]} {
unset data(edited)
tixControl:SetValue $w [$data(w:entry) get] 0 1
}
tixControl:AdjustValue $w $amount
if {$data(-autorepeat)} {
after $data(-initwait) tixControl:Repeat $w $amount $serial
}
focus $data(w:entry)
}
proc tixControl:Repeat {w amount serial} {
if {![winfo exists $w]} {
return
}
upvar #0 $w data
if {$serial eq $data(serial)} {
tixControl:AdjustValue $w $amount
if {$data(-autorepeat)} {
after $data(-repeatrate) tixControl:Repeat $w $amount $serial
}
}
}
proc tixControl:StopRepeat {w} {
upvar #0 $w data
incr data(serial)
}
proc tixControl:Destructor {w} {
tixVariable:DeleteVariable $w
# Chain this to the superclass
#
tixChainMethod $w Destructor
}
# ToDo: maybe should return -code break if the value is not good ...
#
proc tixControl:Tab {w detail} {
upvar #0 $w data
if {![info exists data(edited)]} {
return
} else {
unset data(edited)
}
tixControl:invoke $w
}
proc tixControl:Escape {w} {
upvar #0 $w data
$data(w:entry) delete 0 end
$data(w:entry) insert 0 $data(-value)
}
proc tixControl:KeyPress {w} {
upvar #0 $w data
if {$data(-selectmode) eq "normal"} {
set data(edited) 0
return
} else {
# == "immediate"
after 1 tixControl:invoke $w
}
}
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: Control.tcl,v 1.9 2004/03/28 02:44:57 hobbs Exp $
#
# Control.tcl --
#
# Implements the TixControl Widget. It is called the "SpinBox"
# in other toolkits.
#
# 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 tixControl {
-classname TixControl
-superclass tixLabelWidget
-method {
incr decr invoke update
}
-flag {
-allowempty -autorepeat -command -decrcmd -disablecallback
-disabledforeground -incrcmd -initwait -integer -llimit
-repeatrate -max -min -selectmode -step -state -validatecmd
-value -variable -ulimit
}
-forcecall {
-variable -state
}
-configspec {
{-allowempty allowEmpty AllowEmpty false}
{-autorepeat autoRepeat AutoRepeat true}
{-command command Command ""}
{-decrcmd decrCmd DecrCmd ""}
{-disablecallback disableCallback DisableCallback 0 tixVerifyBoolean}
{-disabledforeground disabledForeground DisabledForeground #303030}
{-incrcmd incrCmd IncrCmd ""}
{-initwait initWait InitWait 500}
{-integer integer Integer false}
{-max max Max ""}
{-min min Min ""}
{-repeatrate repeatRate RepeatRate 50}
{-step step Step 1}
{-state state State normal}
{-selectmode selectMode SelectMode normal}
{-validatecmd validateCmd ValidateCmd ""}
{-value value Value 0}
{-variable variable Variable ""}
}
-alias {
{-llimit -min}
{-ulimit -max}
}
-default {
{.borderWidth 0}
{*entry.relief sunken}
{*entry.width 5}
{*label.anchor e}
{*label.borderWidth 0}
{*Button.anchor c}
{*Button.borderWidth 2}
{*Button.highlightThickness 1}
{*Button.takeFocus 0}
}
}
proc tixControl:InitWidgetRec {w} {
upvar #0 $w data
tixChainMethod $w InitWidgetRec
set data(varInited) 0
set data(serial) 0
}
proc tixControl:ConstructFramedWidget {w frame} {
upvar #0 $w data
tixChainMethod $w ConstructFramedWidget $frame
set data(w:entry) [entry $frame.entry]
set data(w:incr) \
[button $frame.incr -bitmap [tix getbitmap incr] -takefocus 0]
set data(w:decr) \
[button $frame.decr -bitmap [tix getbitmap decr] -takefocus 0]
# tixForm $data(w:entry) -left 0 -top 0 -bottom -1 -right $data(w:decr)
# tixForm $data(w:incr) -right -1 -top 0 -bottom %50
# tixForm $data(w:decr) -right -1 -top $data(w:incr) -bottom -1
pack $data(w:entry) -side left -expand yes -fill both
pack $data(w:decr) -side bottom -fill both -expand yes
pack $data(w:incr) -side top -fill both -expand yes
$data(w:entry) delete 0 end
$data(w:entry) insert 0 $data(-value)
# This value is used to configure the disable/normal fg of the ebtry
set data(entryfg) [$data(w:entry) cget -fg]
set data(labelfg) [$data(w:label) cget -fg]
}
proc tixControl:SetBindings {w} {
upvar #0 $w data
tixChainMethod $w SetBindings
bind $data(w:incr) <ButtonPress-1> \
[list after idle tixControl:StartRepeat $w 1]
bind $data(w:decr) <ButtonPress-1> \
[list after idle tixControl:StartRepeat $w -1]
# These bindings will stop the button autorepeat when the
# mouse button is up
foreach btn [list $data(w:incr) $data(w:decr)] {
bind $btn <ButtonRelease-1> [list tixControl:StopRepeat $w]
}
tixSetMegaWidget $data(w:entry) $w
# If user press <return>, verify the value and call the -command
#
tixAddBindTag $data(w:entry) TixControl:Entry
}
proc tixControlBind {} {
tixBind TixControl:Entry <Return> {
tixControl:Invoke [tixGetMegaWidget %W] 1
}
tixBind TixControl:Entry <Escape> {
tixControl:Escape [tixGetMegaWidget %W]
}
tixBind TixControl:Entry <Up> {
[tixGetMegaWidget %W] incr
}
tixBind TixControl:Entry <Down> {
[tixGetMegaWidget %W] decr
}
tixBind TixControl:Entry <FocusOut> {
if {"%d" eq "NotifyNonlinear" || "%d" eq "NotifyNonlinearVirtual"} {
tixControl:Tab [tixGetMegaWidget %W] %d
}
}
tixBind TixControl:Entry <Any-KeyPress> {
tixControl:KeyPress [tixGetMegaWidget %W]
}
tixBind TixControl:Entry <Any-Tab> {
# This has a higher priority than the <Any-KeyPress> binding
# --> so that data(edited) is not set
}
}
#----------------------------------------------------------------------
# CONFIG OPTIONS
#----------------------------------------------------------------------
proc tixControl:config-state {w arg} {
upvar #0 $w data
if {$arg eq "normal"} {
$data(w:incr) config -state $arg
$data(w:decr) config -state $arg
catch {
$data(w:label) config -fg $data(labelfg)
}
$data(w:entry) config -state $arg -fg $data(entryfg)
} else {
$data(w:incr) config -state $arg
$data(w:decr) config -state $arg
catch {
$data(w:label) config -fg $data(-disabledforeground)
}
$data(w:entry) config -state $arg -fg $data(-disabledforeground)
}
}
proc tixControl:config-value {w value} {
upvar #0 $w data
tixControl:SetValue $w $value 0 1
# This will tell the Intrinsics: "Please use this value"
# because "value" might be altered by SetValues
#
return $data(-value)
}
proc tixControl:config-variable {w arg} {
upvar #0 $w data
if {[tixVariable:ConfigVariable $w $arg]} {
# The value of data(-value) is changed if tixVariable:ConfigVariable
# returns true
tixControl:SetValue $w $data(-value) 1 1
}
catch {
unset data(varInited)
}
set data(-variable) $arg
}
#----------------------------------------------------------------------
# User Commands
#----------------------------------------------------------------------
proc tixControl:incr {w {by 1}} {
upvar #0 $w data
if {$data(-state) ne "disabled"} {
if {![catch {$data(w:entry) index sel.first}]} {
$data(w:entry) select from end
$data(w:entry) select to end
}
# CYGNUS - why set value before changing it?
#tixControl:SetValue $w [$data(w:entry) get] 0 1
tixControl:AdjustValue $w $by
}
}
proc tixControl:decr {w {by 1}} {
upvar #0 $w data
if {$data(-state) ne "disabled"} {
if {![catch {$data(w:entry) index sel.first}]} {
$data(w:entry) select from end
$data(w:entry) select to end
}
# CYGNUS - why set value before changing it?
#tixControl:SetValue $w [$data(w:entry) get] 0 1
tixControl:AdjustValue $w [expr {0 - $by}]
}
}
proc tixControl:invoke {w} {
upvar #0 $w data
tixControl:Invoke $w 0
}
proc tixControl:update {w} {
upvar #0 $w data
if {[info exists data(edited)]} {
tixControl:invoke $w
}
}
#----------------------------------------------------------------------
# Internal Commands
#----------------------------------------------------------------------
# Change the value by a multiple of the data(-step)
#
proc tixControl:AdjustValue {w amount} {
upvar #0 $w data
if {$amount == 1 && [llength $data(-incrcmd)]} {
set newValue [tixEvalCmdBinding $w $data(-incrcmd) "" $data(-value)]
} elseif {$amount == -1 && [llength $data(-decrcmd)]} {
set newValue [tixEvalCmdBinding $w $data(-decrcmd) "" $data(-value)]
} else {
set newValue [expr {$data(-value) + $amount * $data(-step)}]
}
if {$data(-state) ne "disabled"} {
tixControl:SetValue $w $newValue 0 1
}
}
proc tixControl:SetValue {w newvalue noUpdate forced} {
upvar #0 $w data
if {[$data(w:entry) selection present]} {
set oldSelection [list [$data(w:entry) index sel.first] \
[$data(w:entry) index sel.last]]
}
set oldvalue $data(-value)
set oldCursor [$data(w:entry) index insert]
set changed 0
if {[llength $data(-validatecmd)]} {
# Call the user supplied validation command
#
set data(-value) [tixEvalCmdBinding $w $data(-validatecmd) "" $newvalue]
} else {
# Here we only allow int or floating numbers
#
# If the new value is not a valid number, the old value will be
# kept due to the "catch" statements
#
if {[catch {expr 0+$newvalue}]} {
set newvalue 0
set data(-value) 0
set changed 1
}
if {$newvalue == ""} {
if {![string is true -strict $data(-allowempty)]} {
set newvalue 0
set changed 1
} else {
set data(-value) ""
}
}
if {$newvalue != ""} {
# Change this to a valid decimal string (trim leading 0)
#
regsub -- {^[0]*} $newvalue "" newvalue
if {[catch {expr 0+$newvalue}]} {
set newvalue 0
set data(-value) 0
set changed 1
}
if {$newvalue == ""} {
set newvalue 0
}
if {[string is true -strict $data(-integer)]} {
set data(-value) [tixGetInt -nocomplain $newvalue]
} else {
if {[catch {set data(-value) [format "%d" $newvalue]}]} {
if {[catch {set data(-value) [expr $newvalue+0.0]}]} {
set data(-value) $oldvalue
}
}
}
# Now perform boundary checking
#
if {$data(-max) != "" && $data(-value) > $data(-max)} {
set data(-value) $data(-max)
}
if {$data(-min) != "" && $data(-value) < $data(-min)} {
set data(-value) $data(-min)
}
}
}
if {! $noUpdate} {
tixVariable:UpdateVariable $w
}
if {$forced || ($newvalue ne $data(-value)) || $changed} {
$data(w:entry) delete 0 end
$data(w:entry) insert 0 $data(-value)
$data(w:entry) icursor $oldCursor
if {[info exists oldSelection]} {
eval [list $data(w:entry) selection range] $oldSelection
}
}
if {!$data(-disablecallback) && $data(-command) != ""} {
if {![info exists data(varInited)]} {
set bind(specs) ""
tixEvalCmdBinding $w $data(-command) bind $data(-value)
}
}
}
proc tixControl:Invoke {w forced} {
upvar #0 $w data
catch {
unset data(edited)
}
if {[catch {$data(w:entry) index sel.first}] == 0} {
# THIS ENTRY OWNS SELECTION --> TURN IT OFF
#
$data(w:entry) select from end
$data(w:entry) select to end
}
tixControl:SetValue $w [$data(w:entry) get] 0 $forced
}
#----------------------------------------------------------------------
# The three functions StartRepeat, Repeat and StopRepeat make use of the
# data(serial) variable to discard spurious repeats: If a button is clicked
# repeatedly but is not hold down, the serial counter will increase
# successively and all "after" time event handlers will be discarded
#----------------------------------------------------------------------
proc tixControl:StartRepeat {w amount} {
if {![winfo exists $w]} {
return
}
upvar #0 $w data
incr data(serial)
# CYGNUS bug fix
# Need to set a local variable because otherwise the buttonrelease
# callback could change the value of data(serial) between now and
# the time the repeat is scheduled.
set serial $data(serial)
if {![catch {$data(w:entry) index sel.first}]} {
$data(w:entry) select from end
$data(w:entry) select to end
}
if {[info exists data(edited)]} {
unset data(edited)
tixControl:SetValue $w [$data(w:entry) get] 0 1
}
tixControl:AdjustValue $w $amount
if {$data(-autorepeat)} {
after $data(-initwait) tixControl:Repeat $w $amount $serial
}
focus $data(w:entry)
}
proc tixControl:Repeat {w amount serial} {
if {![winfo exists $w]} {
return
}
upvar #0 $w data
if {$serial eq $data(serial)} {
tixControl:AdjustValue $w $amount
if {$data(-autorepeat)} {
after $data(-repeatrate) tixControl:Repeat $w $amount $serial
}
}
}
proc tixControl:StopRepeat {w} {
upvar #0 $w data
incr data(serial)
}
proc tixControl:Destructor {w} {
tixVariable:DeleteVariable $w
# Chain this to the superclass
#
tixChainMethod $w Destructor
}
# ToDo: maybe should return -code break if the value is not good ...
#
proc tixControl:Tab {w detail} {
upvar #0 $w data
if {![info exists data(edited)]} {
return
} else {
unset data(edited)
}
tixControl:invoke $w
}
proc tixControl:Escape {w} {
upvar #0 $w data
$data(w:entry) delete 0 end
$data(w:entry) insert 0 $data(-value)
}
proc tixControl:KeyPress {w} {
upvar #0 $w data
if {$data(-selectmode) eq "normal"} {
set data(edited) 0
return
} else {
# == "immediate"
after 1 tixControl:invoke $w
}
}

206
amd64/lib/tix8.4.3/DefSchm.tcl
View File

@@ -1,103 +1,103 @@
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: DefSchm.tcl,v 1.2 2001/12/09 05:04:02 idiscovery Exp $
#
# DefSchm.tcl --
#
# Implements the default color and font schemes for Tix.
#
# 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.
#
proc tixSetDefaultFontset {} {
global tixOption tcl_platform
switch -- $tcl_platform(platform) "windows" {
# This should be Tahoma for Win2000/XP
set font "MS Sans Serif"
set fixedfont "Courier New"
set size 8
} unix {
set font "helvetica"
set fixedfont "courier"
set size -12
}
set tixOption(font) [list $font $size]
set tixOption(bold_font) [list $font $size bold]
set tixOption(menu_font) [list $font $size]
set tixOption(italic_font) [list $font $size bold italic]
set tixOption(fixed_font) [list $fixedfont $size]
set tixOption(border1) 1
}
proc tixSetDefaultScheme-Color {} {
global tixOption
set tixOption(bg) #d9d9d9
set tixOption(fg) black
set tixOption(dark1_bg) #c3c3c3
set tixOption(dark1_fg) black
set tixOption(dark2_bg) #a3a3a3
set tixOption(dark2_fg) black
set tixOption(inactive_bg) #a3a3a3
set tixOption(inactive_fg) black
set tixOption(light1_bg) #ececec
set tixOption(light1_fg) white
set tixOption(light2_bg) #fcfcfc
set tixOption(light2_fg) white
set tixOption(active_bg) $tixOption(dark1_bg)
set tixOption(active_fg) $tixOption(fg)
set tixOption(disabled_fg) gray55
set tixOption(input1_bg) #d9d9d9
set tixOption(input2_bg) #d9d9d9
set tixOption(output1_bg) $tixOption(dark1_bg)
set tixOption(output2_bg) $tixOption(bg)
set tixOption(select_fg) black
set tixOption(select_bg) #c3c3c3
set tixOption(selector) #b03060
}
proc tixSetDefaultScheme-Mono {} {
global tixOption
set tixOption(bg) lightgray
set tixOption(fg) black
set tixOption(dark1_bg) gray70
set tixOption(dark1_fg) black
set tixOption(dark2_bg) gray60
set tixOption(dark2_fg) white
set tixOption(inactive_bg) lightgray
set tixOption(inactive_fg) black
set tixOption(light1_bg) gray90
set tixOption(light1_fg) white
set tixOption(light2_bg) gray95
set tixOption(light2_fg) white
set tixOption(active_bg) gray90
set tixOption(active_fg) $tixOption(fg)
set tixOption(disabled_fg) gray55
set tixOption(input1_bg) $tixOption(light1_bg)
set tixOption(input2_bg) $tixOption(light1_bg)
set tixOption(output1_bg) $tixOption(light1_bg)
set tixOption(output2_bg) $tixOption(light1_bg)
set tixOption(select_fg) white
set tixOption(select_bg) black
set tixOption(selector) black
}
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: DefSchm.tcl,v 1.2 2001/12/09 05:04:02 idiscovery Exp $
#
# DefSchm.tcl --
#
# Implements the default color and font schemes for Tix.
#
# 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.
#
proc tixSetDefaultFontset {} {
global tixOption tcl_platform
switch -- $tcl_platform(platform) "windows" {
# This should be Tahoma for Win2000/XP
set font "MS Sans Serif"
set fixedfont "Courier New"
set size 8
} unix {
set font "helvetica"
set fixedfont "courier"
set size -12
}
set tixOption(font) [list $font $size]
set tixOption(bold_font) [list $font $size bold]
set tixOption(menu_font) [list $font $size]
set tixOption(italic_font) [list $font $size bold italic]
set tixOption(fixed_font) [list $fixedfont $size]
set tixOption(border1) 1
}
proc tixSetDefaultScheme-Color {} {
global tixOption
set tixOption(bg) #d9d9d9
set tixOption(fg) black
set tixOption(dark1_bg) #c3c3c3
set tixOption(dark1_fg) black
set tixOption(dark2_bg) #a3a3a3
set tixOption(dark2_fg) black
set tixOption(inactive_bg) #a3a3a3
set tixOption(inactive_fg) black
set tixOption(light1_bg) #ececec
set tixOption(light1_fg) white
set tixOption(light2_bg) #fcfcfc
set tixOption(light2_fg) white
set tixOption(active_bg) $tixOption(dark1_bg)
set tixOption(active_fg) $tixOption(fg)
set tixOption(disabled_fg) gray55
set tixOption(input1_bg) #d9d9d9
set tixOption(input2_bg) #d9d9d9
set tixOption(output1_bg) $tixOption(dark1_bg)
set tixOption(output2_bg) $tixOption(bg)
set tixOption(select_fg) black
set tixOption(select_bg) #c3c3c3
set tixOption(selector) #b03060
}
proc tixSetDefaultScheme-Mono {} {
global tixOption
set tixOption(bg) lightgray
set tixOption(fg) black
set tixOption(dark1_bg) gray70
set tixOption(dark1_fg) black
set tixOption(dark2_bg) gray60
set tixOption(dark2_fg) white
set tixOption(inactive_bg) lightgray
set tixOption(inactive_fg) black
set tixOption(light1_bg) gray90
set tixOption(light1_fg) white
set tixOption(light2_bg) gray95
set tixOption(light2_fg) white
set tixOption(active_bg) gray90
set tixOption(active_fg) $tixOption(fg)
set tixOption(disabled_fg) gray55
set tixOption(input1_bg) $tixOption(light1_bg)
set tixOption(input2_bg) $tixOption(light1_bg)
set tixOption(output1_bg) $tixOption(light1_bg)
set tixOption(output2_bg) $tixOption(light1_bg)
set tixOption(select_fg) white
set tixOption(select_bg) black
set tixOption(selector) black
}

350
amd64/lib/tix8.4.3/DialogS.tcl
View File

@@ -1,175 +1,175 @@
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: DialogS.tcl,v 1.5 2004/03/28 02:44:57 hobbs Exp $
#
# DialogS.tcl --
#
#
# Implements the DialogShell widget. It tells the window
# manager that it is a dialog window and should be treated specially.
# The exact treatment depends on the treatment of the window
# manager
#
# Copyright (c) 1994-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 tixDialogShell {
-superclass tixShell
-classname TixDialogShell
-method {
popdown popup center
}
-flag {
-mapped -minheight -minwidth -parent -transient
}
-static {}
-configspec {
{-mapped mapped Mapped 0}
{-minwidth minWidth MinWidth 0}
{-minheight minHeight MinHeight 0}
{-transient transient Transient true}
{-parent parent Parent ""}
}
}
#----------------------------------------------------------------------
# Construct widget
#----------------------------------------------------------------------
proc tixDialogShell:ConstructWidget {w} {
upvar #0 $w data
tixChainMethod $w ConstructWidget
# Set the title of this shell appropriately
#
if {$data(-title) == ""} {
# dynamically sets the title
#
set data(-title) [winfo name $w]
}
wm title $w $data(-title)
# Set the parent of this dialog shell
#
if {$data(-parent) == ""} {
set data(-parent) [winfo parent $w]
}
# Set the minsize and maxsize of the thing
#
wm minsize $w $data(-minwidth) $data(-minheight)
wm transient $w ""
}
# The next procedures manage the dialog boxes
#
proc tixDialogShell:popup {w {parent ""}} {
upvar #0 $w data
# First update to make sure the boxes are the right size
#
update idletask
# Then we set the position and update
#
# tixDialogShell:center $w $parent
# and now make it visible. Viola! Centered over parent.
#
wm deiconify $w
after idle raise $w
}
# This procedure centers a dialog box over a window making sure that the
# dialog box doesn't appear off the screen
#
# However, if the parent is smaller than this dialog, make this dialog
# appear at parent(x,y) + (20,20)
#
proc tixDialogShell:center {w {parent ""}} {
upvar #0 $w data
# Tell the WM that we'll do this ourselves.
wm sizefrom $w user
wm positionfrom $w user
if {$parent == ""} {
set parent $data(-parent)
}
if {$parent == "" || [catch {set parent [winfo toplevel $parent]}]} {
set parent "."
}
# Where is my parent and what are it's dimensions
#
if {$parent != ""} {
set pargeo [split [wm geometry $parent] "+x"]
set parentW [lindex $pargeo 0]
set parentH [lindex $pargeo 1]
set parx [lindex $pargeo 2]
set pary [lindex $pargeo 3]
if {[string is true -strict $data(-transient)]} {
wm transient $w $parent
}
} else {
set parentW [winfo screenwidth $w]
set parentH [winfo screenheight $w]
set parx 0
set pary 0
set parent [winfo parent $w]
}
# What are is the offset of the virtual window
set vrootx [winfo vrootx $parent]
set vrooty [winfo vrooty $parent]
# What are my dimensions ?
set dialogW [winfo reqwidth $w]
set dialogH [winfo reqheight $w]
if {$dialogW < $parentW-30 || $dialogW < $parentH-30} {
set dialogx [expr {$parx+($parentW-$dialogW)/2+$vrootx}]
set dialogy [expr {$pary+($parentH-$dialogH)/2+$vrooty}]
} else {
# This dialog is too big. Place it at (parentx, parenty) + (20,20)
#
set dialogx [expr {$parx+20+$vrootx}]
set dialogy [expr {$pary+20+$vrooty}]
}
set maxx [expr {[winfo screenwidth $parent] - $dialogW}]
set maxy [expr {[winfo screenheight $parent] - $dialogH}]
# Make sure it doesn't go off screen
#
if {$dialogx < 0} {
set dialogx 0
} else {
if {$dialogx > $maxx} {
set dialogx $maxx
}
}
if {$dialogy < 0} {
set dialogy 0
} else {
if {$dialogy > $maxy} {
set dialogy $maxy
}
}
# set my new position (and dimensions)
#
if {[wm geometry $w] == "1x1+0+0"} {
wm geometry $w ${dialogW}x${dialogH}+${dialogx}+${dialogy}
}
}
proc tixDialogShell:popdown {w args} {
wm withdraw $w
}
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: DialogS.tcl,v 1.5 2004/03/28 02:44:57 hobbs Exp $
#
# DialogS.tcl --
#
#
# Implements the DialogShell widget. It tells the window
# manager that it is a dialog window and should be treated specially.
# The exact treatment depends on the treatment of the window
# manager
#
# Copyright (c) 1994-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 tixDialogShell {
-superclass tixShell
-classname TixDialogShell
-method {
popdown popup center
}
-flag {
-mapped -minheight -minwidth -parent -transient
}
-static {}
-configspec {
{-mapped mapped Mapped 0}
{-minwidth minWidth MinWidth 0}
{-minheight minHeight MinHeight 0}
{-transient transient Transient true}
{-parent parent Parent ""}
}
}
#----------------------------------------------------------------------
# Construct widget
#----------------------------------------------------------------------
proc tixDialogShell:ConstructWidget {w} {
upvar #0 $w data
tixChainMethod $w ConstructWidget
# Set the title of this shell appropriately
#
if {$data(-title) == ""} {
# dynamically sets the title
#
set data(-title) [winfo name $w]
}
wm title $w $data(-title)
# Set the parent of this dialog shell
#
if {$data(-parent) == ""} {
set data(-parent) [winfo parent $w]
}
# Set the minsize and maxsize of the thing
#
wm minsize $w $data(-minwidth) $data(-minheight)
wm transient $w ""
}
# The next procedures manage the dialog boxes
#
proc tixDialogShell:popup {w {parent ""}} {
upvar #0 $w data
# First update to make sure the boxes are the right size
#
update idletask
# Then we set the position and update
#
# tixDialogShell:center $w $parent
# and now make it visible. Viola! Centered over parent.
#
wm deiconify $w
after idle raise $w
}
# This procedure centers a dialog box over a window making sure that the
# dialog box doesn't appear off the screen
#
# However, if the parent is smaller than this dialog, make this dialog
# appear at parent(x,y) + (20,20)
#
proc tixDialogShell:center {w {parent ""}} {
upvar #0 $w data
# Tell the WM that we'll do this ourselves.
wm sizefrom $w user
wm positionfrom $w user
if {$parent == ""} {
set parent $data(-parent)
}
if {$parent == "" || [catch {set parent [winfo toplevel $parent]}]} {
set parent "."
}
# Where is my parent and what are it's dimensions
#
if {$parent != ""} {
set pargeo [split [wm geometry $parent] "+x"]
set parentW [lindex $pargeo 0]
set parentH [lindex $pargeo 1]
set parx [lindex $pargeo 2]
set pary [lindex $pargeo 3]
if {[string is true -strict $data(-transient)]} {
wm transient $w $parent
}
} else {
set parentW [winfo screenwidth $w]
set parentH [winfo screenheight $w]
set parx 0
set pary 0
set parent [winfo parent $w]
}
# What are is the offset of the virtual window
set vrootx [winfo vrootx $parent]
set vrooty [winfo vrooty $parent]
# What are my dimensions ?
set dialogW [winfo reqwidth $w]
set dialogH [winfo reqheight $w]
if {$dialogW < $parentW-30 || $dialogW < $parentH-30} {
set dialogx [expr {$parx+($parentW-$dialogW)/2+$vrootx}]
set dialogy [expr {$pary+($parentH-$dialogH)/2+$vrooty}]
} else {
# This dialog is too big. Place it at (parentx, parenty) + (20,20)
#
set dialogx [expr {$parx+20+$vrootx}]
set dialogy [expr {$pary+20+$vrooty}]
}
set maxx [expr {[winfo screenwidth $parent] - $dialogW}]
set maxy [expr {[winfo screenheight $parent] - $dialogH}]
# Make sure it doesn't go off screen
#
if {$dialogx < 0} {
set dialogx 0
} else {
if {$dialogx > $maxx} {
set dialogx $maxx
}
}
if {$dialogy < 0} {
set dialogy 0
} else {
if {$dialogy > $maxy} {
set dialogy $maxy
}
}
# set my new position (and dimensions)
#
if {[wm geometry $w] == "1x1+0+0"} {
wm geometry $w ${dialogW}x${dialogH}+${dialogx}+${dialogy}
}
}
proc tixDialogShell:popdown {w args} {
wm withdraw $w
}

414
amd64/lib/tix8.4.3/DirBox.tcl
View File

@@ -1,207 +1,207 @@
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: DirBox.tcl,v 1.4 2004/03/28 02:44:57 hobbs Exp $
#
# DirBox.tcl --
#
# Implements the tixDirSelectBox widget.
#
# - overrides the -browsecmd and -command options of the
# HList subwidget
#
# 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 tixDirSelectBox {
-classname TixDirSelectBox
-superclass tixPrimitive
-method {
}
-flag {
-command -disablecallback -value
}
-configspec {
{-command command Command ""}
{-disablecallback disableCallback DisableCallback 0 tixVerifyBoolean}
{-label label Label "Directory:"}
{-value value Value ""}
}
-forcecall {
-value -label
}
-default {
{*combo*listbox.height 5}
{*combo.label.anchor w}
{*combo.labelSide top}
{*combo.history true}
{*combo.historyLimit 20}
}
}
proc tixDirSelectBox:InitWidgetRec {w} {
upvar #0 $w data
tixChainMethod $w InitWidgetRec
}
proc tixDirSelectBox:ConstructWidget {w} {
upvar #0 $w data
tixChainMethod $w ConstructWidget
set data(w:dircbx) [tixFileComboBox $w.dircbx]
set data(w:dirlist) [tixDirList $w.dirlist]
pack $data(w:dircbx) -side top -fill x -padx 4 -pady 2
pack $data(w:dirlist) -side top -fill both -expand yes -padx 4 -pady 2
if {$data(-value) eq ""} {
set data(-value) [pwd]
}
}
proc tixDirSelectBox:SetBindings {w} {
upvar #0 $w data
tixChainMethod $w SetBindings
$data(w:dircbx) config -command [list tixDirSelectBox:Cmd-DirCbx $w]
$data(w:dirlist) config -command [list tixDirSelectBox:Cmd-DirList $w]\
-browsecmd [list tixDirSelectBox:Browse-DirList $w]
}
#----------------------------------------------------------------------
# Incoming event: User
#----------------------------------------------------------------------
# User activates the FileComboBox
#
#
proc tixDirSelectBox:Cmd-DirCbx {w args} {
upvar #0 $w data
set fInfo [tixEvent value]
set path [lindex $fInfo 0]
if {![file exists $path]} {
# 1.1 Check for validity. The pathname cannot contain invalid chars
#
if {![tixFSIsValid $path]} {
tk_messageBox -title "Invalid Directory" \
-type ok -icon error \
-message "\"$path\" is not a valid directory name"
$data(w:dircbx) config \
-text [tixFSDisplayName [file normalize $data(-value)]] \
-directory $data(-value)
return
}
# 1.2 Prompt for creation
#
set choice [tk_messageBox -title "Create Directory?" \
-type yesno -icon question \
-message "Directory \"$path\" does not exist.\
\nDo you want to create it?"]
if {$choice eq "yes"
&& [catch {file mkdir [file dirname $path]} err]} {
tk_messageBox -title "Error Creating Directory" \
-icon error -type ok \
-message "Cannot create directory \"$path\":\n$err"
set choice "no"
}
if {$choice eq "no"} {
$data(w:dircbx) config \
-text [tixFSDisplayName [file normalize $data(-value)]] \
-directory $data(-value)
return
}
tixDirSelectBox:SetValue $w $path 1 1
} elseif {![file isdirectory $path]} {
# 2.1: Can't choose a non-directory file
#
tk_messageBox -title "Invalid Directory" \
-type ok -icon error \
-message "\"$path\" is not a directory"
$data(w:dircbx) config \
-text [tixFSDisplayName [file normalize $data(-value)]] \
-directory $data(-value)
return
} else {
# OK. It is an existing directory
#
tixDirSelectBox:SetValue $w $path 1 1
}
}
# User activates the dir list
#
#
proc tixDirSelectBox:Cmd-DirList {w args} {
upvar #0 $w data
set dir $data(-value)
catch {set dir [tixEvent flag V]}
set dir [tixFSNormalize $dir]
tixDirSelectBox:SetValue $w $dir 0 0
}
# User browses the dir list
#
#
proc tixDirSelectBox:Browse-DirList {w args} {
upvar #0 $w data
set dir $data(-value)
catch {set dir [tixEvent flag V]}
set dir [tixFSNormalize $dir]
tixDirSelectBox:SetValue $w $dir 0 0
}
#----------------------------------------------------------------------
# Incoming event: Application
#----------------------------------------------------------------------
proc tixDirSelectBox:config-value {w value} {
upvar #0 $w data
set value [tixFSNormalize $value]
tixDirSelectBox:SetValue $w $value 1 1
return $value
}
proc tixDirSelectBox:config-label {w value} {
upvar #0 $w data
$data(w:dircbx) subwidget combo config -label $value
}
#----------------------------------------------------------------------
#
# Internal functions
#
#----------------------------------------------------------------------
# Arguments:
# callback:Bool Should we invoke the the -command.
# setlist:Bool Should we set the -value of the DirList subwidget.
#
proc tixDirSelectBox:SetValue {w dir callback setlist} {
upvar #0 $w data
set data(-value) $dir
$data(w:dircbx) config -text [tixFSDisplayName $dir] -directory $dir
if {$setlist && [file isdirectory $dir]} {
tixSetSilent $data(w:dirlist) $dir
}
if {$callback} {
if {!$data(-disablecallback) && [llength $data(-command)]} {
set bind(specs) {%V}
set bind(%V) $data(-value)
tixEvalCmdBinding $w $data(-command) bind $data(-value)
}
}
}
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: DirBox.tcl,v 1.4 2004/03/28 02:44:57 hobbs Exp $
#
# DirBox.tcl --
#
# Implements the tixDirSelectBox widget.
#
# - overrides the -browsecmd and -command options of the
# HList subwidget
#
# 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 tixDirSelectBox {
-classname TixDirSelectBox
-superclass tixPrimitive
-method {
}
-flag {
-command -disablecallback -value
}
-configspec {
{-command command Command ""}
{-disablecallback disableCallback DisableCallback 0 tixVerifyBoolean}
{-label label Label "Directory:"}
{-value value Value ""}
}
-forcecall {
-value -label
}
-default {
{*combo*listbox.height 5}
{*combo.label.anchor w}
{*combo.labelSide top}
{*combo.history true}
{*combo.historyLimit 20}
}
}
proc tixDirSelectBox:InitWidgetRec {w} {
upvar #0 $w data
tixChainMethod $w InitWidgetRec
}
proc tixDirSelectBox:ConstructWidget {w} {
upvar #0 $w data
tixChainMethod $w ConstructWidget
set data(w:dircbx) [tixFileComboBox $w.dircbx]
set data(w:dirlist) [tixDirList $w.dirlist]
pack $data(w:dircbx) -side top -fill x -padx 4 -pady 2
pack $data(w:dirlist) -side top -fill both -expand yes -padx 4 -pady 2
if {$data(-value) eq ""} {
set data(-value) [pwd]
}
}
proc tixDirSelectBox:SetBindings {w} {
upvar #0 $w data
tixChainMethod $w SetBindings
$data(w:dircbx) config -command [list tixDirSelectBox:Cmd-DirCbx $w]
$data(w:dirlist) config -command [list tixDirSelectBox:Cmd-DirList $w]\
-browsecmd [list tixDirSelectBox:Browse-DirList $w]
}
#----------------------------------------------------------------------
# Incoming event: User
#----------------------------------------------------------------------
# User activates the FileComboBox
#
#
proc tixDirSelectBox:Cmd-DirCbx {w args} {
upvar #0 $w data
set fInfo [tixEvent value]
set path [lindex $fInfo 0]
if {![file exists $path]} {
# 1.1 Check for validity. The pathname cannot contain invalid chars
#
if {![tixFSIsValid $path]} {
tk_messageBox -title "Invalid Directory" \
-type ok -icon error \
-message "\"$path\" is not a valid directory name"
$data(w:dircbx) config \
-text [tixFSDisplayName [file normalize $data(-value)]] \
-directory $data(-value)
return
}
# 1.2 Prompt for creation
#
set choice [tk_messageBox -title "Create Directory?" \
-type yesno -icon question \
-message "Directory \"$path\" does not exist.\
\nDo you want to create it?"]
if {$choice eq "yes"
&& [catch {file mkdir [file dirname $path]} err]} {
tk_messageBox -title "Error Creating Directory" \
-icon error -type ok \
-message "Cannot create directory \"$path\":\n$err"
set choice "no"
}
if {$choice eq "no"} {
$data(w:dircbx) config \
-text [tixFSDisplayName [file normalize $data(-value)]] \
-directory $data(-value)
return
}
tixDirSelectBox:SetValue $w $path 1 1
} elseif {![file isdirectory $path]} {
# 2.1: Can't choose a non-directory file
#
tk_messageBox -title "Invalid Directory" \
-type ok -icon error \
-message "\"$path\" is not a directory"
$data(w:dircbx) config \
-text [tixFSDisplayName [file normalize $data(-value)]] \
-directory $data(-value)
return
} else {
# OK. It is an existing directory
#
tixDirSelectBox:SetValue $w $path 1 1
}
}
# User activates the dir list
#
#
proc tixDirSelectBox:Cmd-DirList {w args} {
upvar #0 $w data
set dir $data(-value)
catch {set dir [tixEvent flag V]}
set dir [tixFSNormalize $dir]
tixDirSelectBox:SetValue $w $dir 0 0
}
# User browses the dir list
#
#
proc tixDirSelectBox:Browse-DirList {w args} {
upvar #0 $w data
set dir $data(-value)
catch {set dir [tixEvent flag V]}
set dir [tixFSNormalize $dir]
tixDirSelectBox:SetValue $w $dir 0 0
}
#----------------------------------------------------------------------
# Incoming event: Application
#----------------------------------------------------------------------
proc tixDirSelectBox:config-value {w value} {
upvar #0 $w data
set value [tixFSNormalize $value]
tixDirSelectBox:SetValue $w $value 1 1
return $value
}
proc tixDirSelectBox:config-label {w value} {
upvar #0 $w data
$data(w:dircbx) subwidget combo config -label $value
}
#----------------------------------------------------------------------
#
# Internal functions
#
#----------------------------------------------------------------------
# Arguments:
# callback:Bool Should we invoke the the -command.
# setlist:Bool Should we set the -value of the DirList subwidget.
#
proc tixDirSelectBox:SetValue {w dir callback setlist} {
upvar #0 $w data
set data(-value) $dir
$data(w:dircbx) config -text [tixFSDisplayName $dir] -directory $dir
if {$setlist && [file isdirectory $dir]} {
tixSetSilent $data(w:dirlist) $dir
}
if {$callback} {
if {!$data(-disablecallback) && [llength $data(-command)]} {
set bind(specs) {%V}
set bind(%V) $data(-value)
tixEvalCmdBinding $w $data(-command) bind $data(-value)
}
}
}

190
amd64/lib/tix8.4.3/DirDlg.tcl
View File

@@ -1,95 +1,95 @@
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: DirDlg.tcl,v 1.3 2001/12/09 05:04:02 idiscovery Exp $
#
# DirDlg.tcl --
#
# Implements the Directory Selection Dialog 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.
#
tixWidgetClass tixDirSelectDialog {
-classname TixDirSelectDialog
-superclass tixDialogShell
-method {}
-flag {
-command
}
-configspec {
{-command command Command ""}
{-title title Title "Select A Directory"}
}
-default {
{*ok.text "OK"}
{*ok.underline 0}
{*ok.width 6}
{*cancel.text "Cancel"}
{*cancel.underline 0}
{*cancel.width 6}
{*dirbox.borderWidth 1}
{*dirbox.relief raised}
}
}
proc tixDirSelectDialog:ConstructWidget {w} {
upvar #0 $w data
tixChainMethod $w ConstructWidget
# the buttons
frame $w.f -relief raised -bd 1
set data(w:ok) [button $w.f.ok -command \
"tixDirSelectDialog:OK $w"]
set data(w:cancel) [button $w.f.cancel -command \
"tixDirSelectDialog:Cancel $w"]
pack $data(w:ok) $data(w:cancel) -side left -expand yes -padx 10 -pady 8
pack $w.f -side bottom -fill x
# the dir select box
set data(w:dirbox) [tixDirSelectBox $w.dirbox \
-command [list tixDirSelectDialog:DirBoxCmd $w]]
pack $data(w:dirbox) -expand yes -fill both
}
proc tixDirSelectDialog:SetBindings {w} {
upvar #0 $w data
tixChainMethod $w SetBindings
bind $w <Alt-Key-d> "focus [$data(w:dirbox) subwidget dircbx]"
}
proc tixDirSelectDialog:OK {w} {
upvar #0 $w data
wm withdraw $w
$data(w:dirbox) subwidget dircbx invoke
}
proc tixDirSelectDialog:DirBoxCmd {w args} {
upvar #0 $w data
set value [tixEvent flag V]
wm withdraw $w
tixDirSelectDialog:CallCmd $w $value
}
proc tixDirSelectDialog:CallCmd {w value} {
upvar #0 $w data
if {$data(-command) != ""} {
set bind(specs) "%V"
set bind(%V) $value
tixEvalCmdBinding $w $data(-command) bind $value
}
}
proc tixDirSelectDialog:Cancel {w} {
wm withdraw $w
}
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: DirDlg.tcl,v 1.3 2001/12/09 05:04:02 idiscovery Exp $
#
# DirDlg.tcl --
#
# Implements the Directory Selection Dialog 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.
#
tixWidgetClass tixDirSelectDialog {
-classname TixDirSelectDialog
-superclass tixDialogShell
-method {}
-flag {
-command
}
-configspec {
{-command command Command ""}
{-title title Title "Select A Directory"}
}
-default {
{*ok.text "OK"}
{*ok.underline 0}
{*ok.width 6}
{*cancel.text "Cancel"}
{*cancel.underline 0}
{*cancel.width 6}
{*dirbox.borderWidth 1}
{*dirbox.relief raised}
}
}
proc tixDirSelectDialog:ConstructWidget {w} {
upvar #0 $w data
tixChainMethod $w ConstructWidget
# the buttons
frame $w.f -relief raised -bd 1
set data(w:ok) [button $w.f.ok -command \
"tixDirSelectDialog:OK $w"]
set data(w:cancel) [button $w.f.cancel -command \
"tixDirSelectDialog:Cancel $w"]
pack $data(w:ok) $data(w:cancel) -side left -expand yes -padx 10 -pady 8
pack $w.f -side bottom -fill x
# the dir select box
set data(w:dirbox) [tixDirSelectBox $w.dirbox \
-command [list tixDirSelectDialog:DirBoxCmd $w]]
pack $data(w:dirbox) -expand yes -fill both
}
proc tixDirSelectDialog:SetBindings {w} {
upvar #0 $w data
tixChainMethod $w SetBindings
bind $w <Alt-Key-d> "focus [$data(w:dirbox) subwidget dircbx]"
}
proc tixDirSelectDialog:OK {w} {
upvar #0 $w data
wm withdraw $w
$data(w:dirbox) subwidget dircbx invoke
}
proc tixDirSelectDialog:DirBoxCmd {w args} {
upvar #0 $w data
set value [tixEvent flag V]
wm withdraw $w
tixDirSelectDialog:CallCmd $w $value
}
proc tixDirSelectDialog:CallCmd {w value} {
upvar #0 $w data
if {$data(-command) != ""} {
set bind(specs) "%V"
set bind(%V) $value
tixEvalCmdBinding $w $data(-command) bind $value
}
}
proc tixDirSelectDialog:Cancel {w} {
wm withdraw $w
}

544
amd64/lib/tix8.4.3/DirList.tcl
View File

@@ -1,272 +1,272 @@
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: DirList.tcl,v 1.5 2004/03/28 02:44:57 hobbs Exp $
#
# DirList.tcl --
#
# Implements the tixDirList widget.
#
# - overrides the -browsecmd and -command options of the
# HList subwidget
#
# 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 tixDirList {
-classname TixDirList
-superclass tixScrolledHList
-method {
chdir
}
-flag {
-browsecmd -command -dircmd -disablecallback
-root -rootname -showhidden -value
}
-configspec {
{-browsecmd browseCmd BrowseCmd ""}
{-command command Command ""}
{-dircmd dirCmd DirCmd ""}
{-disablecallback disableCallback DisableCallback 0 tixVerifyBoolean}
{-root root Root ""}
{-rootname rootName RootName ""}
{-showhidden showHidden ShowHidden 0 tixVerifyBoolean}
{-value value Value ""}
}
-default {
{.scrollbar auto}
{*borderWidth 1}
{*hlist.background #c3c3c3}
{*hlist.indent 7}
{*hlist.relief sunken}
{*hlist.height 10}
{*hlist.width 20}
{*hlist.padX 2}
{*hlist.padY 0}
{*hlist.wideSelection 0}
{*hlist.drawBranch 0}
{*hlist.highlightBackground #d9d9d9}
{*hlist.itemType imagetext}
{*hlist.takeFocus 1}
}
-forcecall {
-value
}
}
# Important data members:
#
# data(vpath)
# The currently selected vpath. This internal variable is useful on
# the Win95 platform, where an directory may correspond to more than
# one node in the hierarchy. For example, C:\Windows\Desktop\Foo
# can appead as "Desktop\Foo" and
# "Desktop\My Computer\C:\Windows\Desktop\Foo". This variable tells us
# which icon should we show given the same DOS pathname.
#
proc tixDirList:InitWidgetRec {w} {
upvar #0 $w data
tixChainMethod $w InitWidgetRec
}
proc tixDirList:ConstructWidget {w} {
upvar #0 $w data
tixChainMethod $w ConstructWidget
$data(w:hlist) config -separator [tixFSSep] -selectmode "single"
}
proc tixDirList:SetBindings {w} {
upvar #0 $w data
tixChainMethod $w SetBindings
$data(w:hlist) config \
-browsecmd [list tixDirList:Browse $w] \
-command [list tixDirList:Command $w]
if {$data(-value) eq ""
|| [catch {set data(-value) [tixFSNormalize $data(-value)]}]} {
set data(-value) [pwd]
}
set data(vpath) [tixFSInternal $data(-value)]
}
#----------------------------------------------------------------------
# Incoming-Events
#----------------------------------------------------------------------
proc tixDirList:Browse {w args} {
upvar #0 $w data
set vpath [tixEvent flag V]
set value [$data(w:hlist) info data $vpath]
tixDirList:HighLight $w $vpath
set data(vpath) $vpath
set data(-value) [tixFSExternal $value]
tixDirList:CallBrowseCmd $w $data(-value)
}
proc tixDirList:Command {w args} {
upvar #0 $w data
set vpath [tixEvent value]
set value [$data(w:hlist) info data $vpath]
set data(-value) [tixFSExternal $value]
tixDirList:LoadDir $w [tixFSNativeNorm $value] $vpath
tixDirList:HighLight $w $vpath
set data(vpath) $vpath
tixDirList:CallCommand $w $data(-value)
}
#----------------------------------------------------------------------
# Outgoing-Events
#----------------------------------------------------------------------
proc tixDirList:CallBrowseCmd {w npath} {
upvar #0 $w data
if {[llength $data(-browsecmd)]} {
set bind(specs) "%V"
set bind(%V) $npath
tixEvalCmdBinding $w $data(-browsecmd) bind $npath
}
}
proc tixDirList:CallCommand {w npath} {
upvar #0 $w data
if {[llength $data(-command)] && !$data(-disablecallback)} {
set bind(specs) "%V"
set bind(%V) $npath
tixEvalCmdBinding $w $data(-command) bind $npath
}
}
#----------------------------------------------------------------------
# Directory loading
#----------------------------------------------------------------------
proc tixDirList:LoadDir {w {npath ""} {vpath ""}} {
upvar #0 $w data
tixBusy $w on $data(w:hlist)
$data(w:hlist) delete all
if {$npath eq ""} {
set npath [tixFSNativeNorm $data(-value)]
set vpath [tixFSInternal $npath]
}
tixDirList:ListHierachy $w $npath $vpath
tixDirList:ListSubDirs $w $npath $vpath
tixWidgetDoWhenIdle tixBusy $w off $data(w:hlist)
}
proc tixDirList:ListHierachy {w npath vpath} {
upvar #0 $w data
set img [tix getimage openfold]
set curpath ""
foreach part [tixFSAncestors $npath] {
set curpath [file join $curpath $part]
set text [tixFSDisplayFileName $curpath]
set vpath [tixFSInternal $curpath]
$data(w:hlist) add $vpath -text $text -data $curpath -image $img
}
}
proc tixDirList:ListSubDirs {w npath vpath} {
upvar #0 $w data
$data(w:hlist) entryconfig $vpath -image [tix getimage act_fold]
set img [tix getimage folder]
foreach ent [tixFSListDir $npath 1 0 0 $data(-showhidden)] {
set curpath [file join $npath $ent]
set vp [tixFSInternal $curpath]
if {![$data(w:hlist) info exists $vp]} {
$data(w:hlist) add $vp -text $ent -data $curpath -image $img
}
}
}
proc tixDirList:SetValue {w npath vpath {flag ""}} {
upvar #0 $w data
if {$flag eq "reload" || ![$data(w:hlist) info exists $vpath]} {
tixDirList:LoadDir $w $npath $vpath
}
tixDirList:HighLight $w $vpath
set data(-value) [tixFSNativeNorm $npath]
set data(vpath) $vpath
tixDirList:CallCommand $w $data(-value)
}
proc tixDirList:HighLight {w vpath} {
upvar #0 $w data
if {$data(vpath) ne $vpath} {
set old $data(vpath)
if {[$data(w:hlist) info exists $old]} {
# Un-highlight the originally selected entry by changing its
# folder image
if {[llength [$data(w:hlist) info children $old]]} {
set img [tix getimage openfold]
} else {
set img [tix getimage folder]
}
$data(w:hlist) entryconfig $old -image $img
}
}
# Highlight the newly selected entry
#
$data(w:hlist) entryconfig $vpath -image [tix getimage act_fold]
$data(w:hlist) anchor set $vpath
$data(w:hlist) select clear
$data(w:hlist) select set $vpath
$data(w:hlist) see $vpath
}
#----------------------------------------------------------------------
# Config options
#----------------------------------------------------------------------
proc tixDirList:config-value {w value} {
upvar #0 $w data
tixDirList:chdir $w $value
return $data(-value)
}
proc tixDirList:config-showhidden {w value} {
upvar #0 $w data
tixWidgetDoWhenIdle tixDirList:LoadDir $w
}
#----------------------------------------------------------------------
# Public methods
#----------------------------------------------------------------------
proc tixDirList:chdir {w value} {
upvar #0 $w data
set npath [tixFSNativeNorm $value]
tixDirList:SetValue $w $npath [tixFSInternal $npath]
}
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: DirList.tcl,v 1.5 2004/03/28 02:44:57 hobbs Exp $
#
# DirList.tcl --
#
# Implements the tixDirList widget.
#
# - overrides the -browsecmd and -command options of the
# HList subwidget
#
# 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 tixDirList {
-classname TixDirList
-superclass tixScrolledHList
-method {
chdir
}
-flag {
-browsecmd -command -dircmd -disablecallback
-root -rootname -showhidden -value
}
-configspec {
{-browsecmd browseCmd BrowseCmd ""}
{-command command Command ""}
{-dircmd dirCmd DirCmd ""}
{-disablecallback disableCallback DisableCallback 0 tixVerifyBoolean}
{-root root Root ""}
{-rootname rootName RootName ""}
{-showhidden showHidden ShowHidden 0 tixVerifyBoolean}
{-value value Value ""}
}
-default {
{.scrollbar auto}
{*borderWidth 1}
{*hlist.background #c3c3c3}
{*hlist.indent 7}
{*hlist.relief sunken}
{*hlist.height 10}
{*hlist.width 20}
{*hlist.padX 2}
{*hlist.padY 0}
{*hlist.wideSelection 0}
{*hlist.drawBranch 0}
{*hlist.highlightBackground #d9d9d9}
{*hlist.itemType imagetext}
{*hlist.takeFocus 1}
}
-forcecall {
-value
}
}
# Important data members:
#
# data(vpath)
# The currently selected vpath. This internal variable is useful on
# the Win95 platform, where an directory may correspond to more than
# one node in the hierarchy. For example, C:\Windows\Desktop\Foo
# can appead as "Desktop\Foo" and
# "Desktop\My Computer\C:\Windows\Desktop\Foo". This variable tells us
# which icon should we show given the same DOS pathname.
#
proc tixDirList:InitWidgetRec {w} {
upvar #0 $w data
tixChainMethod $w InitWidgetRec
}
proc tixDirList:ConstructWidget {w} {
upvar #0 $w data
tixChainMethod $w ConstructWidget
$data(w:hlist) config -separator [tixFSSep] -selectmode "single"
}
proc tixDirList:SetBindings {w} {
upvar #0 $w data
tixChainMethod $w SetBindings
$data(w:hlist) config \
-browsecmd [list tixDirList:Browse $w] \
-command [list tixDirList:Command $w]
if {$data(-value) eq ""
|| [catch {set data(-value) [tixFSNormalize $data(-value)]}]} {
set data(-value) [pwd]
}
set data(vpath) [tixFSInternal $data(-value)]
}
#----------------------------------------------------------------------
# Incoming-Events
#----------------------------------------------------------------------
proc tixDirList:Browse {w args} {
upvar #0 $w data
set vpath [tixEvent flag V]
set value [$data(w:hlist) info data $vpath]
tixDirList:HighLight $w $vpath
set data(vpath) $vpath
set data(-value) [tixFSExternal $value]
tixDirList:CallBrowseCmd $w $data(-value)
}
proc tixDirList:Command {w args} {
upvar #0 $w data
set vpath [tixEvent value]
set value [$data(w:hlist) info data $vpath]
set data(-value) [tixFSExternal $value]
tixDirList:LoadDir $w [tixFSNativeNorm $value] $vpath
tixDirList:HighLight $w $vpath
set data(vpath) $vpath
tixDirList:CallCommand $w $data(-value)
}
#----------------------------------------------------------------------
# Outgoing-Events
#----------------------------------------------------------------------
proc tixDirList:CallBrowseCmd {w npath} {
upvar #0 $w data
if {[llength $data(-browsecmd)]} {
set bind(specs) "%V"
set bind(%V) $npath
tixEvalCmdBinding $w $data(-browsecmd) bind $npath
}
}
proc tixDirList:CallCommand {w npath} {
upvar #0 $w data
if {[llength $data(-command)] && !$data(-disablecallback)} {
set bind(specs) "%V"
set bind(%V) $npath
tixEvalCmdBinding $w $data(-command) bind $npath
}
}
#----------------------------------------------------------------------
# Directory loading
#----------------------------------------------------------------------
proc tixDirList:LoadDir {w {npath ""} {vpath ""}} {
upvar #0 $w data
tixBusy $w on $data(w:hlist)
$data(w:hlist) delete all
if {$npath eq ""} {
set npath [tixFSNativeNorm $data(-value)]
set vpath [tixFSInternal $npath]
}
tixDirList:ListHierachy $w $npath $vpath
tixDirList:ListSubDirs $w $npath $vpath
tixWidgetDoWhenIdle tixBusy $w off $data(w:hlist)
}
proc tixDirList:ListHierachy {w npath vpath} {
upvar #0 $w data
set img [tix getimage openfold]
set curpath ""
foreach part [tixFSAncestors $npath] {
set curpath [file join $curpath $part]
set text [tixFSDisplayFileName $curpath]
set vpath [tixFSInternal $curpath]
$data(w:hlist) add $vpath -text $text -data $curpath -image $img
}
}
proc tixDirList:ListSubDirs {w npath vpath} {
upvar #0 $w data
$data(w:hlist) entryconfig $vpath -image [tix getimage act_fold]
set img [tix getimage folder]
foreach ent [tixFSListDir $npath 1 0 0 $data(-showhidden)] {
set curpath [file join $npath $ent]
set vp [tixFSInternal $curpath]
if {![$data(w:hlist) info exists $vp]} {
$data(w:hlist) add $vp -text $ent -data $curpath -image $img
}
}
}
proc tixDirList:SetValue {w npath vpath {flag ""}} {
upvar #0 $w data
if {$flag eq "reload" || ![$data(w:hlist) info exists $vpath]} {
tixDirList:LoadDir $w $npath $vpath
}
tixDirList:HighLight $w $vpath
set data(-value) [tixFSNativeNorm $npath]
set data(vpath) $vpath
tixDirList:CallCommand $w $data(-value)
}
proc tixDirList:HighLight {w vpath} {
upvar #0 $w data
if {$data(vpath) ne $vpath} {
set old $data(vpath)
if {[$data(w:hlist) info exists $old]} {
# Un-highlight the originally selected entry by changing its
# folder image
if {[llength [$data(w:hlist) info children $old]]} {
set img [tix getimage openfold]
} else {
set img [tix getimage folder]
}
$data(w:hlist) entryconfig $old -image $img
}
}
# Highlight the newly selected entry
#
$data(w:hlist) entryconfig $vpath -image [tix getimage act_fold]
$data(w:hlist) anchor set $vpath
$data(w:hlist) select clear
$data(w:hlist) select set $vpath
$data(w:hlist) see $vpath
}
#----------------------------------------------------------------------
# Config options
#----------------------------------------------------------------------
proc tixDirList:config-value {w value} {
upvar #0 $w data
tixDirList:chdir $w $value
return $data(-value)
}
proc tixDirList:config-showhidden {w value} {
upvar #0 $w data
tixWidgetDoWhenIdle tixDirList:LoadDir $w
}
#----------------------------------------------------------------------
# Public methods
#----------------------------------------------------------------------
proc tixDirList:chdir {w value} {
upvar #0 $w data
set npath [tixFSNativeNorm $value]
tixDirList:SetValue $w $npath [tixFSInternal $npath]
}

700
amd64/lib/tix8.4.3/DirTree.tcl
View File

@@ -1,350 +1,350 @@
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: DirTree.tcl,v 1.4 2004/03/28 02:44:57 hobbs Exp $
#
# DirTree.tcl --
#
# Implements directory tree for Unix file systems
#
# What the indicators mean:
#
# (+): There are some subdirectories in this directory which are not
# currently visible.
# (-): This directory has some subdirectories and they are all visible
#
# none: The dir has no subdirectori(es).
#
# 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.
#
##
## The tixDirTree require special FS handling due to it's limited
## separator idea (instead of real tree).
##
tixWidgetClass tixDirTree {
-classname TixDirTree
-superclass tixVTree
-method {
activate chdir refresh
}
-flag {
-browsecmd -command -directory -disablecallback -showhidden -value
}
-configspec {
{-browsecmd browseCmd BrowseCmd ""}
{-command command Command ""}
{-disablecallback disableCallback DisableCallback 0 tixVerifyBoolean}
{-showhidden showHidden ShowHidden 0 tixVerifyBoolean}
{-value value Value ""}
}
-alias {
{-directory -value}
}
-default {
{.scrollbar auto}
{*Scrollbar.takeFocus 0}
{*borderWidth 1}
{*hlist.indicator 1}
{*hlist.background #c3c3c3}
{*hlist.drawBranch 1}
{*hlist.height 10}
{*hlist.highlightBackground #d9d9d9}
{*hlist.indent 20}
{*hlist.itemType imagetext}
{*hlist.padX 3}
{*hlist.padY 0}
{*hlist.relief sunken}
{*hlist.takeFocus 1}
{*hlist.wideSelection 0}
{*hlist.width 20}
}
}
proc tixDirTree:InitWidgetRec {w} {
upvar #0 $w data
tixChainMethod $w InitWidgetRec
if {$data(-value) == ""} {
set data(-value) [pwd]
}
tixDirTree:SetDir $w [file normalize $data(-value)]
}
proc tixDirTree:ConstructWidget {w} {
upvar #0 $w data
tixChainMethod $w ConstructWidget
tixDoWhenMapped $w [list tixDirTree:StartUp $w]
$data(w:hlist) config -separator [tixFSSep] \
-selectmode "single" -drawbranch 1
# We must creat an extra copy of these images to avoid flashes on
# the screen when user changes directory
#
set data(images) [image create compound -window $data(w:hlist)]
$data(images) add image -image [tix getimage act_fold]
$data(images) add image -image [tix getimage folder]
$data(images) add image -image [tix getimage openfold]
}
proc tixDirTree:SetBindings {w} {
upvar #0 $w data
tixChainMethod $w SetBindings
}
# Add one dir into the node (parent directory), sorted alphabetically
#
proc tixDirTree:AddToList {w fsdir image} {
upvar #0 $w data
set dir [tixFSInternal $fsdir]
if {[$data(w:hlist) info exists $dir]} { return }
set parent [file dirname $fsdir]
if {$fsdir eq $parent} {
# root node
set node ""
} else {
# regular node
set node [tixFSInternal $parent]
}
set added 0
set text [tixFSDisplayFileName $fsdir]
foreach sib [$data(w:hlist) info children $node] {
if {[string compare $dir $sib] < 0} {
$data(w:hlist) add $dir -before $sib -text $text -image $image
set added 1
break
}
}
if {!$added} {
$data(w:hlist) add $dir -text $text -image $image
}
# Check to see if we have children (%% optimize!)
if {[llength [tixFSListDir $fsdir 1 0 0 $data(-showhidden)]]} {
tixVTree:SetMode $w $dir open
}
}
proc tixDirTree:LoadDir {w fsdir {mode toggle}} {
if {![winfo exists $w]} { return }
upvar #0 $w data
# Add the directory and set it to the active directory
#
set fsdir [tixFSNormalize $fsdir]
set dir [tixFSInternal $fsdir]
if {![$data(w:hlist) info exists $dir]} {
# Add $dir and all ancestors of $dir into the HList widget
set fspath ""
set imgopenfold [tix getimage openfold]
foreach part [tixFSAncestors $fsdir] {
set fspath [file join $fspath $part]
tixDirTree:AddToList $w $fspath $imgopenfold
}
}
$data(w:hlist) entryconfig $dir -image [tix getimage act_fold]
if {$mode eq "toggle"} {
if {[llength [$data(w:hlist) info children $dir]]} {
set mode flatten
} else {
set mode expand
}
}
if {$mode eq "expand"} {
# Add all the sub directories of fsdir into the HList widget
tixBusy $w on $data(w:hlist)
set imgfolder [tix getimage folder]
foreach part [tixFSListDir $fsdir 1 0 0 $data(-showhidden)] {
tixDirTree:AddToList $w [file join $fsdir $part] $imgfolder
}
tixWidgetDoWhenIdle tixBusy $w off $data(w:hlist)
# correct indicator to represent children status (added above)
if {[llength [$data(w:hlist) info children $dir]]} {
tixVTree:SetMode $w $dir close
} else {
tixVTree:SetMode $w $dir none
}
} else {
$data(w:hlist) delete offsprings $dir
tixVTree:SetMode $w $dir open
}
}
proc tixDirTree:ToggleDir {w value mode} {
upvar #0 $w data
tixDirTree:LoadDir $w $value $mode
tixDirTree:CallCommand $w
}
proc tixDirTree:CallCommand {w} {
upvar #0 $w data
if {[llength $data(-command)] && !$data(-disablecallback)} {
set bind(specs) {%V}
set bind(%V) $data(-value)
tixEvalCmdBinding $w $data(-command) bind $data(-value)
}
}
proc tixDirTree:CallBrowseCmd {w ent} {
upvar #0 $w data
if {[llength $data(-browsecmd)] && !$data(-disablecallback)} {
set bind(specs) {%V}
set bind(%V) $data(-value)
tixEvalCmdBinding $w $data(-browsecmd) bind [list $data(-value)]
}
}
proc tixDirTree:StartUp {w} {
if {![winfo exists $w]} { return }
upvar #0 $w data
# make sure that all the basic volumes are listed
set imgopenfold [tix getimage openfold]
foreach fspath [tixFSVolumes] {
tixDirTree:AddToList $w $fspath $imgopenfold
}
tixDirTree:LoadDir $w [tixFSExternal $data(i-directory)]
}
proc tixDirTree:ChangeDir {w fsdir {forced 0}} {
upvar #0 $w data
set dir [tixFSInternal $fsdir]
if {!$forced && $data(i-directory) eq $dir} {
return
}
if {!$forced && [$data(w:hlist) info exists $dir]} {
# Set the old directory to "non active"
#
if {[$data(w:hlist) info exists $data(i-directory)]} {
$data(w:hlist) entryconfig $data(i-directory) \
-image [tix getimage folder]
}
$data(w:hlist) entryconfig $dir -image [tix getimage act_fold]
} else {
if {$forced} {
if {[llength [$data(w:hlist) info children $dir]]} {
set mode expand
} else {
set mode flatten
}
} else {
set mode toggle
}
tixDirTree:LoadDir $w $fsdir $mode
tixDirTree:CallCommand $w
}
tixDirTree:SetDir $w $fsdir
}
proc tixDirTree:SetDir {w path} {
upvar #0 $w data
set data(i-directory) [tixFSInternal $path]
set data(-value) [tixFSNativeNorm $path]
}
#----------------------------------------------------------------------
#
# Virtual Methods
#
#----------------------------------------------------------------------
proc tixDirTree:OpenCmd {w ent} {
set fsdir [tixFSExternal $ent]
tixDirTree:ToggleDir $w $fsdir expand
tixDirTree:ChangeDir $w $fsdir
tixDirTree:CallBrowseCmd $w $fsdir
}
proc tixDirTree:CloseCmd {w ent} {
set fsdir [tixFSExternal $ent]
tixDirTree:ToggleDir $w $fsdir flatten
tixDirTree:ChangeDir $w $fsdir
tixDirTree:CallBrowseCmd $w $fsdir
}
proc tixDirTree:Command {w B} {
upvar #0 $w data
upvar $B bind
set ent [tixEvent flag V]
tixChainMethod $w Command $B
if {[llength $data(-command)]} {
set fsdir [tixFSExternal $ent]
tixEvalCmdBinding $w $data(-command) bind $fsdir
}
}
# This is a virtual method
#
proc tixDirTree:BrowseCmd {w B} {
upvar #0 $w data
upvar 1 $B bind
set ent [tixEvent flag V]
set fsdir [tixFSExternal $ent]
# This is a hack because %V may have been modified by callbrowsecmd
set fsdir [file normalize $fsdir]
tixDirTree:ChangeDir $w $fsdir
tixDirTree:CallBrowseCmd $w $fsdir
}
#----------------------------------------------------------------------
#
# Public Methods
#
#----------------------------------------------------------------------
proc tixDirTree:chdir {w value} {
tixDirTree:ChangeDir $w [file normalize $value]
}
proc tixDirTree:refresh {w {dir ""}} {
upvar #0 $w data
if {$dir eq ""} {
set dir $data(-value)
}
set dir [file normalize $dir]
tixDirTree:ChangeDir $w $dir 1
# Delete any stale directories that no longer exist
#
foreach child [$data(w:hlist) info children [tixFSInternal $dir]] {
if {![file exists [tixFSExternal $child]]} {
$data(w:hlist) delete entry $child
}
}
}
proc tixDirTree:config-directory {w value} {
tixDirTree:ChangeDir $w [file normalize $value]
}
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: DirTree.tcl,v 1.4 2004/03/28 02:44:57 hobbs Exp $
#
# DirTree.tcl --
#
# Implements directory tree for Unix file systems
#
# What the indicators mean:
#
# (+): There are some subdirectories in this directory which are not
# currently visible.
# (-): This directory has some subdirectories and they are all visible
#
# none: The dir has no subdirectori(es).
#
# 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.
#
##
## The tixDirTree require special FS handling due to it's limited
## separator idea (instead of real tree).
##
tixWidgetClass tixDirTree {
-classname TixDirTree
-superclass tixVTree
-method {
activate chdir refresh
}
-flag {
-browsecmd -command -directory -disablecallback -showhidden -value
}
-configspec {
{-browsecmd browseCmd BrowseCmd ""}
{-command command Command ""}
{-disablecallback disableCallback DisableCallback 0 tixVerifyBoolean}
{-showhidden showHidden ShowHidden 0 tixVerifyBoolean}
{-value value Value ""}
}
-alias {
{-directory -value}
}
-default {
{.scrollbar auto}
{*Scrollbar.takeFocus 0}
{*borderWidth 1}
{*hlist.indicator 1}
{*hlist.background #c3c3c3}
{*hlist.drawBranch 1}
{*hlist.height 10}
{*hlist.highlightBackground #d9d9d9}
{*hlist.indent 20}
{*hlist.itemType imagetext}
{*hlist.padX 3}
{*hlist.padY 0}
{*hlist.relief sunken}
{*hlist.takeFocus 1}
{*hlist.wideSelection 0}
{*hlist.width 20}
}
}
proc tixDirTree:InitWidgetRec {w} {
upvar #0 $w data
tixChainMethod $w InitWidgetRec
if {$data(-value) == ""} {
set data(-value) [pwd]
}
tixDirTree:SetDir $w [file normalize $data(-value)]
}
proc tixDirTree:ConstructWidget {w} {
upvar #0 $w data
tixChainMethod $w ConstructWidget
tixDoWhenMapped $w [list tixDirTree:StartUp $w]
$data(w:hlist) config -separator [tixFSSep] \
-selectmode "single" -drawbranch 1
# We must creat an extra copy of these images to avoid flashes on
# the screen when user changes directory
#
set data(images) [image create compound -window $data(w:hlist)]
$data(images) add image -image [tix getimage act_fold]
$data(images) add image -image [tix getimage folder]
$data(images) add image -image [tix getimage openfold]
}
proc tixDirTree:SetBindings {w} {
upvar #0 $w data
tixChainMethod $w SetBindings
}
# Add one dir into the node (parent directory), sorted alphabetically
#
proc tixDirTree:AddToList {w fsdir image} {
upvar #0 $w data
set dir [tixFSInternal $fsdir]
if {[$data(w:hlist) info exists $dir]} { return }
set parent [file dirname $fsdir]
if {$fsdir eq $parent} {
# root node
set node ""
} else {
# regular node
set node [tixFSInternal $parent]
}
set added 0
set text [tixFSDisplayFileName $fsdir]
foreach sib [$data(w:hlist) info children $node] {
if {[string compare $dir $sib] < 0} {
$data(w:hlist) add $dir -before $sib -text $text -image $image
set added 1
break
}
}
if {!$added} {
$data(w:hlist) add $dir -text $text -image $image
}
# Check to see if we have children (%% optimize!)
if {[llength [tixFSListDir $fsdir 1 0 0 $data(-showhidden)]]} {
tixVTree:SetMode $w $dir open
}
}
proc tixDirTree:LoadDir {w fsdir {mode toggle}} {
if {![winfo exists $w]} { return }
upvar #0 $w data
# Add the directory and set it to the active directory
#
set fsdir [tixFSNormalize $fsdir]
set dir [tixFSInternal $fsdir]
if {![$data(w:hlist) info exists $dir]} {
# Add $dir and all ancestors of $dir into the HList widget
set fspath ""
set imgopenfold [tix getimage openfold]
foreach part [tixFSAncestors $fsdir] {
set fspath [file join $fspath $part]
tixDirTree:AddToList $w $fspath $imgopenfold
}
}
$data(w:hlist) entryconfig $dir -image [tix getimage act_fold]
if {$mode eq "toggle"} {
if {[llength [$data(w:hlist) info children $dir]]} {
set mode flatten
} else {
set mode expand
}
}
if {$mode eq "expand"} {
# Add all the sub directories of fsdir into the HList widget
tixBusy $w on $data(w:hlist)
set imgfolder [tix getimage folder]
foreach part [tixFSListDir $fsdir 1 0 0 $data(-showhidden)] {
tixDirTree:AddToList $w [file join $fsdir $part] $imgfolder
}
tixWidgetDoWhenIdle tixBusy $w off $data(w:hlist)
# correct indicator to represent children status (added above)
if {[llength [$data(w:hlist) info children $dir]]} {
tixVTree:SetMode $w $dir close
} else {
tixVTree:SetMode $w $dir none
}
} else {
$data(w:hlist) delete offsprings $dir
tixVTree:SetMode $w $dir open
}
}
proc tixDirTree:ToggleDir {w value mode} {
upvar #0 $w data
tixDirTree:LoadDir $w $value $mode
tixDirTree:CallCommand $w
}
proc tixDirTree:CallCommand {w} {
upvar #0 $w data
if {[llength $data(-command)] && !$data(-disablecallback)} {
set bind(specs) {%V}
set bind(%V) $data(-value)
tixEvalCmdBinding $w $data(-command) bind $data(-value)
}
}
proc tixDirTree:CallBrowseCmd {w ent} {
upvar #0 $w data
if {[llength $data(-browsecmd)] && !$data(-disablecallback)} {
set bind(specs) {%V}
set bind(%V) $data(-value)
tixEvalCmdBinding $w $data(-browsecmd) bind [list $data(-value)]
}
}
proc tixDirTree:StartUp {w} {
if {![winfo exists $w]} { return }
upvar #0 $w data
# make sure that all the basic volumes are listed
set imgopenfold [tix getimage openfold]
foreach fspath [tixFSVolumes] {
tixDirTree:AddToList $w $fspath $imgopenfold
}
tixDirTree:LoadDir $w [tixFSExternal $data(i-directory)]
}
proc tixDirTree:ChangeDir {w fsdir {forced 0}} {
upvar #0 $w data
set dir [tixFSInternal $fsdir]
if {!$forced && $data(i-directory) eq $dir} {
return
}
if {!$forced && [$data(w:hlist) info exists $dir]} {
# Set the old directory to "non active"
#
if {[$data(w:hlist) info exists $data(i-directory)]} {
$data(w:hlist) entryconfig $data(i-directory) \
-image [tix getimage folder]
}
$data(w:hlist) entryconfig $dir -image [tix getimage act_fold]
} else {
if {$forced} {
if {[llength [$data(w:hlist) info children $dir]]} {
set mode expand
} else {
set mode flatten
}
} else {
set mode toggle
}
tixDirTree:LoadDir $w $fsdir $mode
tixDirTree:CallCommand $w
}
tixDirTree:SetDir $w $fsdir
}
proc tixDirTree:SetDir {w path} {
upvar #0 $w data
set data(i-directory) [tixFSInternal $path]
set data(-value) [tixFSNativeNorm $path]
}
#----------------------------------------------------------------------
#
# Virtual Methods
#
#----------------------------------------------------------------------
proc tixDirTree:OpenCmd {w ent} {
set fsdir [tixFSExternal $ent]
tixDirTree:ToggleDir $w $fsdir expand
tixDirTree:ChangeDir $w $fsdir
tixDirTree:CallBrowseCmd $w $fsdir
}
proc tixDirTree:CloseCmd {w ent} {
set fsdir [tixFSExternal $ent]
tixDirTree:ToggleDir $w $fsdir flatten
tixDirTree:ChangeDir $w $fsdir
tixDirTree:CallBrowseCmd $w $fsdir
}
proc tixDirTree:Command {w B} {
upvar #0 $w data
upvar $B bind
set ent [tixEvent flag V]
tixChainMethod $w Command $B
if {[llength $data(-command)]} {
set fsdir [tixFSExternal $ent]
tixEvalCmdBinding $w $data(-command) bind $fsdir
}
}
# This is a virtual method
#
proc tixDirTree:BrowseCmd {w B} {
upvar #0 $w data
upvar 1 $B bind
set ent [tixEvent flag V]
set fsdir [tixFSExternal $ent]
# This is a hack because %V may have been modified by callbrowsecmd
set fsdir [file normalize $fsdir]
tixDirTree:ChangeDir $w $fsdir
tixDirTree:CallBrowseCmd $w $fsdir
}
#----------------------------------------------------------------------
#
# Public Methods
#
#----------------------------------------------------------------------
proc tixDirTree:chdir {w value} {
tixDirTree:ChangeDir $w [file normalize $value]
}
proc tixDirTree:refresh {w {dir ""}} {
upvar #0 $w data
if {$dir eq ""} {
set dir $data(-value)
}
set dir [file normalize $dir]
tixDirTree:ChangeDir $w $dir 1
# Delete any stale directories that no longer exist
#
foreach child [$data(w:hlist) info children [tixFSInternal $dir]] {
if {![file exists [tixFSExternal $child]]} {
$data(w:hlist) delete entry $child
}
}
}
proc tixDirTree:config-directory {w value} {
tixDirTree:ChangeDir $w [file normalize $value]
}

332
amd64/lib/tix8.4.3/DragDrop.tcl
View File

@@ -1,166 +1,166 @@
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: DragDrop.tcl,v 1.4 2001/12/09 05:04:02 idiscovery Exp $
#
# DragDrop.tcl ---
#
# Implements drag+drop for Tix widgets.
#
# 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.
#
tixClass tixDragDropContext {
-superclass {}
-classname TixDragDropContext
-method {
cget configure drag drop set startdrag
}
-flag {
-command -source
}
-configspec {
{-command ""}
{-source ""}
}
}
proc tixDragDropContext:Constructor {w} {
upvar #0 $w data
}
#----------------------------------------------------------------------
# Private methods
#
#----------------------------------------------------------------------
proc tixDragDropContext:CallCommand {w target command X Y} {
upvar #0 $w data
set x [expr $X-[winfo rootx $target]]
set y [expr $Y-[winfo rooty $target]]
regsub %x $command $x command
regsub %y $command $y command
regsub %X $command $X command
regsub %Y $command $Y command
regsub %W $command $target command
regsub %S $command [list $data(-command)] command
eval $command
}
proc tixDragDropContext:Send {w target event X Y} {
upvar #0 $w data
global tixDrop
foreach tag [tixDropBindTags $target] {
if {[info exists tixDrop($tag,$event)]} {
tixDragDropContext:CallCommand $w $target \
$tixDrop($tag,$event) $X $Y
}
}
}
#----------------------------------------------------------------------
# set --
#
# Set the "small data" of the type supported by the source widget
#----------------------------------------------------------------------
proc tixDragDropContext:set {w type data} {
}
#----------------------------------------------------------------------
# startdrag --
#
# Start the dragging action
#----------------------------------------------------------------------
proc tixDragDropContext:startdrag {w x y} {
upvar #0 $w data
set data(oldTarget) ""
$data(-source) config -cursor "[tix getbitmap drop] black"
tixDragDropContext:drag $w $x $y
}
#----------------------------------------------------------------------
# drag --
#
# Continue the dragging action
#----------------------------------------------------------------------
proc tixDragDropContext:drag {w X Y} {
upvar #0 $w data
global tixDrop
set target [winfo containing -displayof $w $X $Y]
if {$target != $data(oldTarget)} {
if {$data(oldTarget) != ""} {
tixDragDropContext:Send $w $data(oldTarget) <Out> $X $Y
}
if {$target != ""} {
tixDragDropContext:Send $w $target <In> $X $Y
}
set data(oldTarget) $target
}
if {$target != ""} {
tixDragDropContext:Send $w $target <Over> $X $Y
}
}
proc tixDragDropContext:drop {w X Y} {
upvar #0 $w data
global tixDrop
set target [winfo containing -displayof $w $X $Y]
if {$target != ""} {
tixDragDropContext:Send $w $target <Drop> $X $Y
}
if {$data(-source) != ""} {
$data(-source) config -cursor ""
}
set data(-source) ""
}
#----------------------------------------------------------------------
# Public Procedures -- This is NOT a member of the tixDragDropContext
# class!
#
# parameters :
# $w: who wants to start dragging? (currently ignored)
#----------------------------------------------------------------------
proc tixGetDragDropContext {w} {
global tixDD
if {[info exists tixDD]} {
return tixDD
}
return [tixDragDropContext tixDD]
}
proc tixDropBind {w event command} {
global tixDrop
set tixDrop($w) 1
set tixDrop($w,$event) $command
}
proc tixDropBindTags {w args} {
global tixDropTags
if {$args == ""} {
if {[info exists tixDropTags($w)]} {
return $tixDropTags($w)
} else {
return [list [winfo class $w] $w]
}
} else {
set tixDropTags($w) $args
}
}
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: DragDrop.tcl,v 1.4 2001/12/09 05:04:02 idiscovery Exp $
#
# DragDrop.tcl ---
#
# Implements drag+drop for Tix widgets.
#
# 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.
#
tixClass tixDragDropContext {
-superclass {}
-classname TixDragDropContext
-method {
cget configure drag drop set startdrag
}
-flag {
-command -source
}
-configspec {
{-command ""}
{-source ""}
}
}
proc tixDragDropContext:Constructor {w} {
upvar #0 $w data
}
#----------------------------------------------------------------------
# Private methods
#
#----------------------------------------------------------------------
proc tixDragDropContext:CallCommand {w target command X Y} {
upvar #0 $w data
set x [expr $X-[winfo rootx $target]]
set y [expr $Y-[winfo rooty $target]]
regsub %x $command $x command
regsub %y $command $y command
regsub %X $command $X command
regsub %Y $command $Y command
regsub %W $command $target command
regsub %S $command [list $data(-command)] command
eval $command
}
proc tixDragDropContext:Send {w target event X Y} {
upvar #0 $w data
global tixDrop
foreach tag [tixDropBindTags $target] {
if {[info exists tixDrop($tag,$event)]} {
tixDragDropContext:CallCommand $w $target \
$tixDrop($tag,$event) $X $Y
}
}
}
#----------------------------------------------------------------------
# set --
#
# Set the "small data" of the type supported by the source widget
#----------------------------------------------------------------------
proc tixDragDropContext:set {w type data} {
}
#----------------------------------------------------------------------
# startdrag --
#
# Start the dragging action
#----------------------------------------------------------------------
proc tixDragDropContext:startdrag {w x y} {
upvar #0 $w data
set data(oldTarget) ""
$data(-source) config -cursor "[tix getbitmap drop] black"
tixDragDropContext:drag $w $x $y
}
#----------------------------------------------------------------------
# drag --
#
# Continue the dragging action
#----------------------------------------------------------------------
proc tixDragDropContext:drag {w X Y} {
upvar #0 $w data
global tixDrop
set target [winfo containing -displayof $w $X $Y]
if {$target != $data(oldTarget)} {
if {$data(oldTarget) != ""} {
tixDragDropContext:Send $w $data(oldTarget) <Out> $X $Y
}
if {$target != ""} {
tixDragDropContext:Send $w $target <In> $X $Y
}
set data(oldTarget) $target
}
if {$target != ""} {
tixDragDropContext:Send $w $target <Over> $X $Y
}
}
proc tixDragDropContext:drop {w X Y} {
upvar #0 $w data
global tixDrop
set target [winfo containing -displayof $w $X $Y]
if {$target != ""} {
tixDragDropContext:Send $w $target <Drop> $X $Y
}
if {$data(-source) != ""} {
$data(-source) config -cursor ""
}
set data(-source) ""
}
#----------------------------------------------------------------------
# Public Procedures -- This is NOT a member of the tixDragDropContext
# class!
#
# parameters :
# $w: who wants to start dragging? (currently ignored)
#----------------------------------------------------------------------
proc tixGetDragDropContext {w} {
global tixDD
if {[info exists tixDD]} {
return tixDD
}
return [tixDragDropContext tixDD]
}
proc tixDropBind {w event command} {
global tixDrop
set tixDrop($w) 1
set tixDrop($w,$event) $command
}
proc tixDropBindTags {w args} {
global tixDropTags
if {$args == ""} {
if {[info exists tixDropTags($w)]} {
return $tixDropTags($w)
} else {
return [list [winfo class $w] $w]
}
} else {
set tixDropTags($w) $args
}
}

98
amd64/lib/tix8.4.3/DtlList.tcl
View File

@@ -1,49 +1,49 @@
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: DtlList.tcl,v 1.2 2001/12/09 05:04:02 idiscovery Exp $
#
# DtlList.tcl --
#
# This file implements DetailList widgets
#
# 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.
#
tixWidgetClass tixDetailList {
-classname TixDetailList
-superclass tixScrolledGrid
-method {
}
-flag {
-hdrbackground
}
-configspec {
{-hdrbackground hdrBackground HdrBackground #606060}
}
-alias {
{-hdrbg -hdrbackground}
}
-default {
{*grid.topMargin 1}
{*grid.leftMargin 0}
}
}
proc tixDetailList:FormatCmd {w area x1 y1 x2 y2} {
upvar #0 $w data
case $area {
main {
}
default {
$data(w:grid) format border $x1 $y1 $x2 $y2 \
-filled 1 \
-relief raised -bd 1 -bg $data(-hdrbackground)
}
}
}
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: DtlList.tcl,v 1.2 2001/12/09 05:04:02 idiscovery Exp $
#
# DtlList.tcl --
#
# This file implements DetailList widgets
#
# 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.
#
tixWidgetClass tixDetailList {
-classname TixDetailList
-superclass tixScrolledGrid
-method {
}
-flag {
-hdrbackground
}
-configspec {
{-hdrbackground hdrBackground HdrBackground #606060}
}
-alias {
{-hdrbg -hdrbackground}
}
-default {
{*grid.topMargin 1}
{*grid.leftMargin 0}
}
}
proc tixDetailList:FormatCmd {w area x1 y1 x2 y2} {
upvar #0 $w data
case $area {
main {
}
default {
$data(w:grid) format border $x1 $y1 $x2 $y2 \
-filled 1 \
-relief raised -bd 1 -bg $data(-hdrbackground)
}
}
}

872
amd64/lib/tix8.4.3/EFileBox.tcl
View File

@@ -1,436 +1,436 @@
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: EFileBox.tcl,v 1.5 2004/03/28 02:44:57 hobbs Exp $
#
# EFileBox.tcl --
#
# Implements the Extended File Selection Box widget.
#
# 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.
#
#
# ToDo
# (1) If user has entered an invalid directory, give an error dialog
#
tixWidgetClass tixExFileSelectBox {
-classname TixExFileSelectBox
-superclass tixPrimitive
-method {
filter invoke
}
-flag {
-browsecmd -command -dialog -dir -dircmd -directory
-disablecallback -filetypes -pattern -selection -showhidden -value
}
-forcecall {
-filetypes
}
-configspec {
{-browsecmd browseCmd BrowseCmd ""}
{-command command Command ""}
{-dialog dialog Dialog ""}
{-dircmd dirCmd DirCmd ""}
{-directory directory Directory ""}
{-disablecallback disableCallback DisableCallback 0 tixVerifyBoolean}
{-filetypes fileTypes FileTypes ""}
{-pattern pattern Pattern *}
{-showhidden showHidden ShowHidden 0 tixVerifyBoolean}
{-value value Value ""}
}
-alias {
{-dir -directory}
{-selection -value}
}
-default {
{*dir.label {Directories:}}
{*dir.editable true}
{*dir.history true}
{*dir*listbox.height 5}
{*file.label Files:}
{*file.editable true}
{*file.history false}
{*file*listbox.height 5}
{*types.label {List Files of Type:}}
{*types*listbox.height 3}
{*TixComboBox.labelSide top}
{*TixComboBox*Label.anchor w}
{*dir.label.underline 0}
{*file.label.underline 0}
{*types.label.underline 14}
{*TixComboBox.anchor e}
{*TixHList.height 7}
{*filelist*listbox.height 7}
{*hidden.wrapLength 3c}
{*hidden.justify left}
}
}
proc tixExFileSelectBox:InitWidgetRec {w} {
upvar #0 $w data
global env
tixChainMethod $w InitWidgetRec
if {$data(-directory) eq ""} {
set data(-directory) [pwd]
}
set data(oldDir) ""
set data(flag) 0
}
#----------------------------------------------------------------------
# Construct widget
#----------------------------------------------------------------------
proc tixExFileSelectBox:ConstructWidget {w} {
upvar #0 $w data
tixChainMethod $w ConstructWidget
# listbox frame
set lf [frame $w.lf]
# The pane that contains the two listboxes
#
set pane [tixPanedWindow $lf.pane -orientation horizontal]
set dpane [$pane add 1 -size 160]
set fpane [$pane add 2 -size 160]
$dpane config -relief flat
$fpane config -relief flat
# The File List Pane
#
set data(w:file) [tixComboBox $fpane.file\
-command [list tixExFileSelectBox:Cmd-FileCombo $w]\
-prunehistory true \
-options {
label.anchor w
}]
set data(w:filelist) \
[tixScrolledListBox $fpane.filelist \
-command [list tixExFileSelectBox:Cmd-FileList $w 1] \
-browsecmd [list tixExFileSelectBox:Cmd-FileList $w 0]]
pack $data(w:file) -padx 8 -pady 4 -side top -fill x
pack $data(w:filelist) -padx 8 -pady 4 -side top -fill both -expand yes
# The Directory Pane
#
set data(w:dir) [tixComboBox $dpane.dir \
-command [list tixExFileSelectBox:Cmd-DirCombo $w]\
-prunehistory true \
-options {
label.anchor w
}]
set data(w:dirlist) \
[tixDirList $dpane.dirlist \
-command [list tixExFileSelectBox:Cmd-DirList $w]\
-browsecmd [list tixExFileSelectBox:Browse-DirList $w]]
pack $data(w:dir) -padx 8 -pady 4 -side top -fill x
pack $data(w:dirlist) -padx 8 -pady 4 -side top -fill both -expand yes
# The file types listbox
#
set data(w:types) [tixComboBox $lf.types\
-command [list tixExFileSelectBox:Cmd-TypeCombo $w]\
-options {
label.anchor w
}]
pack $data(w:types) -padx 12 -pady 4 -side bottom -fill x -anchor w
pack $pane -side top -padx 4 -pady 4 -expand yes -fill both
# Buttons to the right
#
set bf [frame $w.bf]
set data(w:ok) [button $bf.ok -text Ok -width 6 \
-underline 0 -command [list tixExFileSelectBox:Ok $w]]
set data(w:cancel) [button $bf.cancel -text Cancel -width 6 \
-underline 0 -command [list tixExFileSelectBox:Cancel $w]]
set data(w:hidden) [checkbutton $bf.hidden -text "Show Hidden Files"\
-underline 0\
-variable [format %s(-showhidden) $w] -onvalue 1 -offvalue 0\
-command [list tixExFileSelectBox:SetShowHidden $w]]
pack $data(w:ok) $data(w:cancel) $data(w:hidden)\
-side top -fill x -padx 6 -pady 3
pack $bf -side right -fill y -pady 6
pack $lf -side left -expand yes -fill both
tixDoWhenMapped $w [list tixExFileSelectBox:Map $w]
if {$data(-filetypes) == ""} {
$data(w:types) config -state disabled
}
}
#----------------------------------------------------------------------
# Configuration
#----------------------------------------------------------------------
proc tixExFileSelectBox:config-showhidden {w value} {
upvar #0 $w data
set data(-showhidden) $value
tixExFileSelectBox:SetShowHidden $w
}
# Update both DirList and {file list and dir combo}
#
proc tixExFileSelectBox:config-directory {w value} {
upvar #0 $w data
set data(-directory) [tixFSNormalize $value]
tixSetSilent $data(w:dirlist) $data(-directory)
tixSetSilent $data(w:dir) $data(-directory)
tixWidgetDoWhenIdle tixExFileSelectBox:LoadFiles $w reload
return $data(-directory)
}
proc tixExFileSelectBox:config-filetypes {w value} {
upvar #0 $w data
$data(w:types) subwidget listbox delete 0 end
foreach name [array names data] {
if {[string match type,* $name]} {
catch {unset data($name)}
}
}
if {$value == ""} {
$data(w:types) config -state disabled
} else {
$data(w:types) config -state normal
foreach type $value {
$data(w:types) insert end [lindex $type 1]
set data(type,[lindex $type 1]) [lindex $type 0]
}
tixSetSilent $data(w:types) ""
}
}
#----------------------------------------------------------------------
# MISC Methods
#----------------------------------------------------------------------
proc tixExFileSelectBox:SetShowHidden {w} {
upvar #0 $w data
$data(w:dirlist) config -showhidden $data(-showhidden)
tixWidgetDoWhenIdle tixExFileSelectBox:LoadFiles $w reload
}
# User activates the dir combobox
#
#
proc tixExFileSelectBox:Cmd-DirCombo {w args} {
upvar #0 $w data
set dir [tixEvent flag V]
set dir [tixFSExternal $dir]
if {![file isdirectory $dir]} {
return
}
set dir [tixFSNormalize $dir]
$data(w:dirlist) config -value $dir
set data(-directory) $dir
}
# User activates the dir list
#
#
proc tixExFileSelectBox:Cmd-DirList {w args} {
upvar #0 $w data
set dir $data(-directory)
catch {set dir [tixEvent flag V]}
set dir [tixFSNormalize [tixFSExternal $dir]]
tixSetSilent $data(w:dir) $dir
set data(-directory) $dir
tixWidgetDoWhenIdle tixExFileSelectBox:LoadFiles $w noreload
}
# User activates the dir list
#
#
proc tixExFileSelectBox:Browse-DirList {w args} {
upvar #0 $w data
set dir [tixEvent flag V]
set dir [tixFSNormalize [tixFSExternal $dir]]
tixExFileSelectBox:Cmd-DirList $w $dir
}
proc tixExFileSelectBox:IsPattern {w string} {
return [regexp "\[\[\\\{\\*\\?\]" $string]
}
proc tixExFileSelectBox:Cmd-FileCombo {w value} {
upvar #0 $w data
if {[tixEvent type] eq "<Return>"} {
tixExFileSelectBox:Ok $w
}
}
proc tixExFileSelectBox:Ok {w} {
upvar #0 $w data
set value [string trim [$data(w:file) subwidget entry get]]
if {$value == ""} {
set value $data(-pattern)
}
tixSetSilent $data(w:file) $value
if {[tixExFileSelectBox:IsPattern $w $value]} {
set data(-pattern) $value
tixWidgetDoWhenIdle tixExFileSelectBox:LoadFiles $w reload
} else {
# ensure absolute path
set value [file join $data(-directory) $value]; # native
set data(-value) [tixFSNativeNorm $value]
tixExFileSelectBox:Invoke $w
}
}
proc tixExFileSelectBox:Cancel {w} {
upvar #0 $w data
if {$data(-dialog) != ""} {
eval $data(-dialog) popdown
}
}
proc tixExFileSelectBox:Invoke {w} {
upvar #0 $w data
# Save some old history
#
$data(w:dir) addhistory [$data(w:dir) cget -value]
$data(w:file) addhistory $data(-pattern)
$data(w:file) addhistory $data(-value)
if {$data(-dialog) != ""} {
eval $data(-dialog) popdown
}
if {$data(-command) != "" && !$data(-disablecallback)} {
set bind(specs) "%V"
set bind(%V) $data(-value)
tixEvalCmdBinding $w $data(-command) bind $data(-value)
}
}
proc tixExFileSelectBox:Cmd-FileList {w invoke args} {
upvar #0 $w data
set index [lindex [$data(w:filelist) subwidget listbox curselection] 0]
if {$index == ""} {
set index 0
}
set file [$data(w:filelist) subwidget listbox get $index]
tixSetSilent $data(w:file) $file
set value [file join $data(-directory) $file]
set data(-value) [tixFSNativeNorm $value]
if {$invoke == 1} {
tixExFileSelectBox:Invoke $w
} elseif {$data(-browsecmd) != ""} {
tixEvalCmdBinding $w $data(-browsecmd) "" $data(-value)
}
}
proc tixExFileSelectBox:Cmd-TypeCombo {w args} {
upvar #0 $w data
set value [tixEvent flag V]
if {[info exists data(type,$value)]} {
set data(-pattern) $data(type,$value)
tixSetSilent $data(w:file) $data(-pattern)
tixWidgetDoWhenIdle tixExFileSelectBox:LoadFiles $w reload
}
}
proc tixExFileSelectBox:LoadFiles {w flag} {
upvar #0 $w data
if {$flag ne "reload" && $data(-directory) eq $data(oldDir)} {
return
}
if {![winfo ismapped [winfo toplevel $w]]} {
tixDoWhenMapped [winfo toplevel $w] \
[list tixExFileSelectBox:LoadFiles $w $flag]
return
}
set listbox [$data(w:filelist) subwidget listbox]
$listbox delete 0 end
set data(-value) ""
tixBusy $w on [$data(w:dirlist) subwidget hlist]
# wrap in a catch so you can't get stuck in a Busy state
if {[catch {
foreach name [tixFSListDir $data(-directory) 0 1 0 \
$data(-showhidden) $data(-pattern)] {
$listbox insert end $name
}
if {$data(oldDir) ne $data(-directory)} {
# Otherwise if the user has already selected a file and then
# presses "show hidden", the selection won't be wiped out.
tixSetSilent $data(w:file) $data(-pattern)
}
} err]} {
tixDebug "tixExFileSelectBox:LoadFiles error for $w\n$err"
}
set data(oldDir) $data(-directory)
tixWidgetDoWhenIdle tixBusy $w off [$data(w:dirlist) subwidget hlist]
}
#
# Called when thd listbox is first mapped
proc tixExFileSelectBox:Map {w} {
if {![winfo exists $w]} {
return
}
upvar #0 $w data
set bind(specs) "%V"
set bind(%V) $data(-value)
tixEvalCmdBinding $w bind \
[list tixExFileSelectBox:Cmd-DirList $w] $data(-directory)
}
#----------------------------------------------------------------------
# Public commands
#
#----------------------------------------------------------------------
proc tixExFileSelectBox:invoke {w} {
tixExFileSelectBox:Invoke $w
}
proc tixExFileSelectBox:filter {w} {
tixExFileSelectBox:LoadFiles $w reload
}
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: EFileBox.tcl,v 1.5 2004/03/28 02:44:57 hobbs Exp $
#
# EFileBox.tcl --
#
# Implements the Extended File Selection Box widget.
#
# 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.
#
#
# ToDo
# (1) If user has entered an invalid directory, give an error dialog
#
tixWidgetClass tixExFileSelectBox {
-classname TixExFileSelectBox
-superclass tixPrimitive
-method {
filter invoke
}
-flag {
-browsecmd -command -dialog -dir -dircmd -directory
-disablecallback -filetypes -pattern -selection -showhidden -value
}
-forcecall {
-filetypes
}
-configspec {
{-browsecmd browseCmd BrowseCmd ""}
{-command command Command ""}
{-dialog dialog Dialog ""}
{-dircmd dirCmd DirCmd ""}
{-directory directory Directory ""}
{-disablecallback disableCallback DisableCallback 0 tixVerifyBoolean}
{-filetypes fileTypes FileTypes ""}
{-pattern pattern Pattern *}
{-showhidden showHidden ShowHidden 0 tixVerifyBoolean}
{-value value Value ""}
}
-alias {
{-dir -directory}
{-selection -value}
}
-default {
{*dir.label {Directories:}}
{*dir.editable true}
{*dir.history true}
{*dir*listbox.height 5}
{*file.label Files:}
{*file.editable true}
{*file.history false}
{*file*listbox.height 5}
{*types.label {List Files of Type:}}
{*types*listbox.height 3}
{*TixComboBox.labelSide top}
{*TixComboBox*Label.anchor w}
{*dir.label.underline 0}
{*file.label.underline 0}
{*types.label.underline 14}
{*TixComboBox.anchor e}
{*TixHList.height 7}
{*filelist*listbox.height 7}
{*hidden.wrapLength 3c}
{*hidden.justify left}
}
}
proc tixExFileSelectBox:InitWidgetRec {w} {
upvar #0 $w data
global env
tixChainMethod $w InitWidgetRec
if {$data(-directory) eq ""} {
set data(-directory) [pwd]
}
set data(oldDir) ""
set data(flag) 0
}
#----------------------------------------------------------------------
# Construct widget
#----------------------------------------------------------------------
proc tixExFileSelectBox:ConstructWidget {w} {
upvar #0 $w data
tixChainMethod $w ConstructWidget
# listbox frame
set lf [frame $w.lf]
# The pane that contains the two listboxes
#
set pane [tixPanedWindow $lf.pane -orientation horizontal]
set dpane [$pane add 1 -size 160]
set fpane [$pane add 2 -size 160]
$dpane config -relief flat
$fpane config -relief flat
# The File List Pane
#
set data(w:file) [tixComboBox $fpane.file\
-command [list tixExFileSelectBox:Cmd-FileCombo $w]\
-prunehistory true \
-options {
label.anchor w
}]
set data(w:filelist) \
[tixScrolledListBox $fpane.filelist \
-command [list tixExFileSelectBox:Cmd-FileList $w 1] \
-browsecmd [list tixExFileSelectBox:Cmd-FileList $w 0]]
pack $data(w:file) -padx 8 -pady 4 -side top -fill x
pack $data(w:filelist) -padx 8 -pady 4 -side top -fill both -expand yes
# The Directory Pane
#
set data(w:dir) [tixComboBox $dpane.dir \
-command [list tixExFileSelectBox:Cmd-DirCombo $w]\
-prunehistory true \
-options {
label.anchor w
}]
set data(w:dirlist) \
[tixDirList $dpane.dirlist \
-command [list tixExFileSelectBox:Cmd-DirList $w]\
-browsecmd [list tixExFileSelectBox:Browse-DirList $w]]
pack $data(w:dir) -padx 8 -pady 4 -side top -fill x
pack $data(w:dirlist) -padx 8 -pady 4 -side top -fill both -expand yes
# The file types listbox
#
set data(w:types) [tixComboBox $lf.types\
-command [list tixExFileSelectBox:Cmd-TypeCombo $w]\
-options {
label.anchor w
}]
pack $data(w:types) -padx 12 -pady 4 -side bottom -fill x -anchor w
pack $pane -side top -padx 4 -pady 4 -expand yes -fill both
# Buttons to the right
#
set bf [frame $w.bf]
set data(w:ok) [button $bf.ok -text Ok -width 6 \
-underline 0 -command [list tixExFileSelectBox:Ok $w]]
set data(w:cancel) [button $bf.cancel -text Cancel -width 6 \
-underline 0 -command [list tixExFileSelectBox:Cancel $w]]
set data(w:hidden) [checkbutton $bf.hidden -text "Show Hidden Files"\
-underline 0\
-variable [format %s(-showhidden) $w] -onvalue 1 -offvalue 0\
-command [list tixExFileSelectBox:SetShowHidden $w]]
pack $data(w:ok) $data(w:cancel) $data(w:hidden)\
-side top -fill x -padx 6 -pady 3
pack $bf -side right -fill y -pady 6
pack $lf -side left -expand yes -fill both
tixDoWhenMapped $w [list tixExFileSelectBox:Map $w]
if {$data(-filetypes) == ""} {
$data(w:types) config -state disabled
}
}
#----------------------------------------------------------------------
# Configuration
#----------------------------------------------------------------------
proc tixExFileSelectBox:config-showhidden {w value} {
upvar #0 $w data
set data(-showhidden) $value
tixExFileSelectBox:SetShowHidden $w
}
# Update both DirList and {file list and dir combo}
#
proc tixExFileSelectBox:config-directory {w value} {
upvar #0 $w data
set data(-directory) [tixFSNormalize $value]
tixSetSilent $data(w:dirlist) $data(-directory)
tixSetSilent $data(w:dir) $data(-directory)
tixWidgetDoWhenIdle tixExFileSelectBox:LoadFiles $w reload
return $data(-directory)
}
proc tixExFileSelectBox:config-filetypes {w value} {
upvar #0 $w data
$data(w:types) subwidget listbox delete 0 end
foreach name [array names data] {
if {[string match type,* $name]} {
catch {unset data($name)}
}
}
if {$value == ""} {
$data(w:types) config -state disabled
} else {
$data(w:types) config -state normal
foreach type $value {
$data(w:types) insert end [lindex $type 1]
set data(type,[lindex $type 1]) [lindex $type 0]
}
tixSetSilent $data(w:types) ""
}
}
#----------------------------------------------------------------------
# MISC Methods
#----------------------------------------------------------------------
proc tixExFileSelectBox:SetShowHidden {w} {
upvar #0 $w data
$data(w:dirlist) config -showhidden $data(-showhidden)
tixWidgetDoWhenIdle tixExFileSelectBox:LoadFiles $w reload
}
# User activates the dir combobox
#
#
proc tixExFileSelectBox:Cmd-DirCombo {w args} {
upvar #0 $w data
set dir [tixEvent flag V]
set dir [tixFSExternal $dir]
if {![file isdirectory $dir]} {
return
}
set dir [tixFSNormalize $dir]
$data(w:dirlist) config -value $dir
set data(-directory) $dir
}
# User activates the dir list
#
#
proc tixExFileSelectBox:Cmd-DirList {w args} {
upvar #0 $w data
set dir $data(-directory)
catch {set dir [tixEvent flag V]}
set dir [tixFSNormalize [tixFSExternal $dir]]
tixSetSilent $data(w:dir) $dir
set data(-directory) $dir
tixWidgetDoWhenIdle tixExFileSelectBox:LoadFiles $w noreload
}
# User activates the dir list
#
#
proc tixExFileSelectBox:Browse-DirList {w args} {
upvar #0 $w data
set dir [tixEvent flag V]
set dir [tixFSNormalize [tixFSExternal $dir]]
tixExFileSelectBox:Cmd-DirList $w $dir
}
proc tixExFileSelectBox:IsPattern {w string} {
return [regexp "\[\[\\\{\\*\\?\]" $string]
}
proc tixExFileSelectBox:Cmd-FileCombo {w value} {
upvar #0 $w data
if {[tixEvent type] eq "<Return>"} {
tixExFileSelectBox:Ok $w
}
}
proc tixExFileSelectBox:Ok {w} {
upvar #0 $w data
set value [string trim [$data(w:file) subwidget entry get]]
if {$value == ""} {
set value $data(-pattern)
}
tixSetSilent $data(w:file) $value
if {[tixExFileSelectBox:IsPattern $w $value]} {
set data(-pattern) $value
tixWidgetDoWhenIdle tixExFileSelectBox:LoadFiles $w reload
} else {
# ensure absolute path
set value [file join $data(-directory) $value]; # native
set data(-value) [tixFSNativeNorm $value]
tixExFileSelectBox:Invoke $w
}
}
proc tixExFileSelectBox:Cancel {w} {
upvar #0 $w data
if {$data(-dialog) != ""} {
eval $data(-dialog) popdown
}
}
proc tixExFileSelectBox:Invoke {w} {
upvar #0 $w data
# Save some old history
#
$data(w:dir) addhistory [$data(w:dir) cget -value]
$data(w:file) addhistory $data(-pattern)
$data(w:file) addhistory $data(-value)
if {$data(-dialog) != ""} {
eval $data(-dialog) popdown
}
if {$data(-command) != "" && !$data(-disablecallback)} {
set bind(specs) "%V"
set bind(%V) $data(-value)
tixEvalCmdBinding $w $data(-command) bind $data(-value)
}
}
proc tixExFileSelectBox:Cmd-FileList {w invoke args} {
upvar #0 $w data
set index [lindex [$data(w:filelist) subwidget listbox curselection] 0]
if {$index == ""} {
set index 0
}
set file [$data(w:filelist) subwidget listbox get $index]
tixSetSilent $data(w:file) $file
set value [file join $data(-directory) $file]
set data(-value) [tixFSNativeNorm $value]
if {$invoke == 1} {
tixExFileSelectBox:Invoke $w
} elseif {$data(-browsecmd) != ""} {
tixEvalCmdBinding $w $data(-browsecmd) "" $data(-value)
}
}
proc tixExFileSelectBox:Cmd-TypeCombo {w args} {
upvar #0 $w data
set value [tixEvent flag V]
if {[info exists data(type,$value)]} {
set data(-pattern) $data(type,$value)
tixSetSilent $data(w:file) $data(-pattern)
tixWidgetDoWhenIdle tixExFileSelectBox:LoadFiles $w reload
}
}
proc tixExFileSelectBox:LoadFiles {w flag} {
upvar #0 $w data
if {$flag ne "reload" && $data(-directory) eq $data(oldDir)} {
return
}
if {![winfo ismapped [winfo toplevel $w]]} {
tixDoWhenMapped [winfo toplevel $w] \
[list tixExFileSelectBox:LoadFiles $w $flag]
return
}
set listbox [$data(w:filelist) subwidget listbox]
$listbox delete 0 end
set data(-value) ""
tixBusy $w on [$data(w:dirlist) subwidget hlist]
# wrap in a catch so you can't get stuck in a Busy state
if {[catch {
foreach name [tixFSListDir $data(-directory) 0 1 0 \
$data(-showhidden) $data(-pattern)] {
$listbox insert end $name
}
if {$data(oldDir) ne $data(-directory)} {
# Otherwise if the user has already selected a file and then
# presses "show hidden", the selection won't be wiped out.
tixSetSilent $data(w:file) $data(-pattern)
}
} err]} {
tixDebug "tixExFileSelectBox:LoadFiles error for $w\n$err"
}
set data(oldDir) $data(-directory)
tixWidgetDoWhenIdle tixBusy $w off [$data(w:dirlist) subwidget hlist]
}
#
# Called when thd listbox is first mapped
proc tixExFileSelectBox:Map {w} {
if {![winfo exists $w]} {
return
}
upvar #0 $w data
set bind(specs) "%V"
set bind(%V) $data(-value)
tixEvalCmdBinding $w bind \
[list tixExFileSelectBox:Cmd-DirList $w] $data(-directory)
}
#----------------------------------------------------------------------
# Public commands
#
#----------------------------------------------------------------------
proc tixExFileSelectBox:invoke {w} {
tixExFileSelectBox:Invoke $w
}
proc tixExFileSelectBox:filter {w} {
tixExFileSelectBox:LoadFiles $w reload
}

130
amd64/lib/tix8.4.3/EFileDlg.tcl
View File

@@ -1,65 +1,65 @@
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: EFileDlg.tcl,v 1.3 2002/01/24 09:13:58 idiscovery Exp $
#
# EFileDlg.tcl --
#
# Implements the Extended File Selection Dialog 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.
#
foreach fun {tkButtonInvoke} {
if {![llength [info commands $fun]]} {
tk::unsupported::ExposePrivateCommand $fun
}
}
unset fun
tixWidgetClass tixExFileSelectDialog {
-classname TixExFileSelectDialog
-superclass tixDialogShell
-method {}
-flag {
-command
}
-configspec {
{-command command Command ""}
{-title title Title "Select A File"}
}
}
proc tixExFileSelectDialog:ConstructWidget {w} {
upvar #0 $w data
tixChainMethod $w ConstructWidget
set data(w:fsbox) [tixExFileSelectBox $w.fsbox -dialog $w \
-command $data(-command)]
pack $data(w:fsbox) -expand yes -fill both
}
proc tixExFileSelectDialog:config-command {w value} {
upvar #0 $w data
$data(w:fsbox) config -command $value
}
proc tixExFileSelectDialog:SetBindings {w} {
upvar #0 $w data
tixChainMethod $w SetBindings
bind $w <Alt-Key-f> "focus [$data(w:fsbox) subwidget file]"
bind $w <Alt-Key-t> "focus [$data(w:fsbox) subwidget types]"
bind $w <Alt-Key-d> "focus [$data(w:fsbox) subwidget dir]"
bind $w <Alt-Key-o> "tkButtonInvoke [$data(w:fsbox) subwidget ok]"
bind $w <Alt-Key-c> "tkButtonInvoke [$data(w:fsbox) subwidget cancel]"
bind $w <Alt-Key-s> "tkButtonInvoke [$data(w:fsbox) subwidget hidden]"
}
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: EFileDlg.tcl,v 1.3 2002/01/24 09:13:58 idiscovery Exp $
#
# EFileDlg.tcl --
#
# Implements the Extended File Selection Dialog 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.
#
foreach fun {tkButtonInvoke} {
if {![llength [info commands $fun]]} {
tk::unsupported::ExposePrivateCommand $fun
}
}
unset fun
tixWidgetClass tixExFileSelectDialog {
-classname TixExFileSelectDialog
-superclass tixDialogShell
-method {}
-flag {
-command
}
-configspec {
{-command command Command ""}
{-title title Title "Select A File"}
}
}
proc tixExFileSelectDialog:ConstructWidget {w} {
upvar #0 $w data
tixChainMethod $w ConstructWidget
set data(w:fsbox) [tixExFileSelectBox $w.fsbox -dialog $w \
-command $data(-command)]
pack $data(w:fsbox) -expand yes -fill both
}
proc tixExFileSelectDialog:config-command {w value} {
upvar #0 $w data
$data(w:fsbox) config -command $value
}
proc tixExFileSelectDialog:SetBindings {w} {
upvar #0 $w data
tixChainMethod $w SetBindings
bind $w <Alt-Key-f> "focus [$data(w:fsbox) subwidget file]"
bind $w <Alt-Key-t> "focus [$data(w:fsbox) subwidget types]"
bind $w <Alt-Key-d> "focus [$data(w:fsbox) subwidget dir]"
bind $w <Alt-Key-o> "tkButtonInvoke [$data(w:fsbox) subwidget ok]"
bind $w <Alt-Key-c> "tkButtonInvoke [$data(w:fsbox) subwidget cancel]"
bind $w <Alt-Key-s> "tkButtonInvoke [$data(w:fsbox) subwidget hidden]"
}

434
amd64/lib/tix8.4.3/Event.tcl
View File

@@ -1,217 +1,217 @@
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: Event.tcl,v 1.6 2004/04/09 21:37:01 hobbs Exp $
#
# Event.tcl --
#
# Handles the event bindings of the -command and -browsecmd options
# (and various of others such as -validatecmd).
#
# 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.
#
#----------------------------------------------------------------------
# Evaluate high-level bindings (-command, -browsecmd, etc):
# with % subsitution or without (compatibility mode)
#
#
# BUG : if a -command is intercepted by a hook, the hook must use
# the same record name as the issuer of the -command. For the time
# being, you must use the name "bind" as the record name!!!!!
#
#----------------------------------------------------------------------
namespace eval ::tix {
variable event_flags ""
set evs [list % \# a b c d f h k m o p s t w x y A B E K N R S T W X Y]
foreach ev $evs {
lappend event_flags "%$ev"
}
# This is a "name stack" for storing the "bind" structures
#
# The bottom of the event stack is usually a raw event (generated by
# tixBind) but it may also be a programatically triggered (caused by
# tixEvalCmdBinding)
variable EVENT
set EVENT(nameStack) ""
set EVENT(stackLevel) 0
}
proc tixBind {tag event action} {
set cmd [linsert $::tix::event_flags 0 _tixRecordFlags $event]
append cmd "; $action; _tixDeleteFlags;"
bind $tag $event $cmd
}
proc tixPushEventStack {} {
variable ::tix::EVENT
set lastEvent [lindex $EVENT(nameStack) 0]
incr EVENT(stackLevel)
set thisEvent ::tix::_event$EVENT(stackLevel)
set EVENT(nameStack) [list $thisEvent $EVENT(nameStack)]
if {$lastEvent == ""} {
upvar #0 $thisEvent this
set this(type) <Application>
} else {
upvar #0 $lastEvent last
upvar #0 $thisEvent this
foreach name [array names last] {
set this($name) $last($name)
}
}
return $thisEvent
}
proc tixPopEventStack {varName} {
variable ::tix::EVENT
if {$varName ne [lindex $EVENT(nameStack) 0]} {
error "unmatched tixPushEventStack and tixPopEventStack calls"
}
incr EVENT(stackLevel) -1
set EVENT(nameStack) [lindex $EVENT(nameStack) 1]
global $varName
unset $varName
}
# Events triggered by tixBind
#
proc _tixRecordFlags [concat event $::tix::event_flags] {
set thisName [tixPushEventStack]; upvar #0 $thisName this
set this(type) $event
foreach f $::tix::event_flags {
set this($f) [set $f]
}
}
proc _tixDeleteFlags {} {
variable ::tix::EVENT
tixPopEventStack [lindex $EVENT(nameStack) 0]
}
# programatically trigged events
#
proc tixEvalCmdBinding {w cmd {subst ""} args} {
global tixPriv tix
variable ::tix::EVENT
set thisName [tixPushEventStack]; upvar #0 $thisName this
if {$subst != ""} {
upvar $subst bind
if {[info exists bind(specs)]} {
foreach spec $bind(specs) {
set this($spec) $bind($spec)
}
}
if {[info exists bind(type)]} {
set this(type) $bind(type)
}
}
if {[catch {
if {![info exists tix(-extracmdargs)]
|| [string is true -strict $tix(-extracmdargs)]} {
# Compatibility mode
set ret [uplevel \#0 $cmd $args]
} else {
set ret [uplevel 1 $cmd]
}
} error]} {
if {[catch {tixCmdErrorHandler $error} error]} {
# double fault: just print out
tixBuiltInCmdErrorHandler $error
}
tixPopEventStack $thisName
return ""
} else {
tixPopEventStack $thisName
return $ret
}
}
proc tixEvent {option args} {
global tixPriv
variable ::tix::EVENT
set varName [lindex $EVENT(nameStack) 0]
if {$varName == ""} {
error "tixEvent called when no event is being processed"
} else {
upvar #0 $varName event
}
switch -exact -- $option {
type {
return $event(type)
}
value {
if {[info exists event(%V)]} {
return $event(%V)
} else {
return ""
}
}
flag {
set f %[lindex $args 0]
if {[info exists event($f)]} {
return $event($f)
}
error "The flag \"[lindex $args 0]\" does not exist"
}
match {
return [string match [lindex $args 0] $event(type)]
}
default {
error "unknown option \"$option\""
}
}
}
# tixBuiltInCmdErrorHandler --
#
# Default method to report command handler errors. This procedure is
# also called if double-fault happens (command handler causes error,
# then tixCmdErrorHandler causes error).
#
proc tixBuiltInCmdErrorHandler {errorMsg} {
global errorInfo tcl_platform
if {![info exists errorInfo]} {
set errorInfo "???"
}
if {$tcl_platform(platform) eq "windows"} {
bgerror "Tix Error: $errorMsg"
} else {
puts "Error:\n $errorMsg\n$errorInfo"
}
}
# tixCmdErrorHandler --
#
# You can redefine this command to handle the errors that occur
# in the command handlers. See the programmer's documentation
# for details
#
if {![llength [info commands tixCmdErrorHandler]]} {
proc tixCmdErrorHandler {errorMsg} {
tixBuiltInCmdErrorHandler $errorMsg
}
}
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: Event.tcl,v 1.6 2004/04/09 21:37:01 hobbs Exp $
#
# Event.tcl --
#
# Handles the event bindings of the -command and -browsecmd options
# (and various of others such as -validatecmd).
#
# 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.
#
#----------------------------------------------------------------------
# Evaluate high-level bindings (-command, -browsecmd, etc):
# with % subsitution or without (compatibility mode)
#
#
# BUG : if a -command is intercepted by a hook, the hook must use
# the same record name as the issuer of the -command. For the time
# being, you must use the name "bind" as the record name!!!!!
#
#----------------------------------------------------------------------
namespace eval ::tix {
variable event_flags ""
set evs [list % \# a b c d f h k m o p s t w x y A B E K N R S T W X Y]
foreach ev $evs {
lappend event_flags "%$ev"
}
# This is a "name stack" for storing the "bind" structures
#
# The bottom of the event stack is usually a raw event (generated by
# tixBind) but it may also be a programatically triggered (caused by
# tixEvalCmdBinding)
variable EVENT
set EVENT(nameStack) ""
set EVENT(stackLevel) 0
}
proc tixBind {tag event action} {
set cmd [linsert $::tix::event_flags 0 _tixRecordFlags $event]
append cmd "; $action; _tixDeleteFlags;"
bind $tag $event $cmd
}
proc tixPushEventStack {} {
variable ::tix::EVENT
set lastEvent [lindex $EVENT(nameStack) 0]
incr EVENT(stackLevel)
set thisEvent ::tix::_event$EVENT(stackLevel)
set EVENT(nameStack) [list $thisEvent $EVENT(nameStack)]
if {$lastEvent == ""} {
upvar #0 $thisEvent this
set this(type) <Application>
} else {
upvar #0 $lastEvent last
upvar #0 $thisEvent this
foreach name [array names last] {
set this($name) $last($name)
}
}
return $thisEvent
}
proc tixPopEventStack {varName} {
variable ::tix::EVENT
if {$varName ne [lindex $EVENT(nameStack) 0]} {
error "unmatched tixPushEventStack and tixPopEventStack calls"
}
incr EVENT(stackLevel) -1
set EVENT(nameStack) [lindex $EVENT(nameStack) 1]
global $varName
unset $varName
}
# Events triggered by tixBind
#
proc _tixRecordFlags [concat event $::tix::event_flags] {
set thisName [tixPushEventStack]; upvar #0 $thisName this
set this(type) $event
foreach f $::tix::event_flags {
set this($f) [set $f]
}
}
proc _tixDeleteFlags {} {
variable ::tix::EVENT
tixPopEventStack [lindex $EVENT(nameStack) 0]
}
# programatically trigged events
#
proc tixEvalCmdBinding {w cmd {subst ""} args} {
global tixPriv tix
variable ::tix::EVENT
set thisName [tixPushEventStack]; upvar #0 $thisName this
if {$subst != ""} {
upvar $subst bind
if {[info exists bind(specs)]} {
foreach spec $bind(specs) {
set this($spec) $bind($spec)
}
}
if {[info exists bind(type)]} {
set this(type) $bind(type)
}
}
if {[catch {
if {![info exists tix(-extracmdargs)]
|| [string is true -strict $tix(-extracmdargs)]} {
# Compatibility mode
set ret [uplevel \#0 $cmd $args]
} else {
set ret [uplevel 1 $cmd]
}
} error]} {
if {[catch {tixCmdErrorHandler $error} error]} {
# double fault: just print out
tixBuiltInCmdErrorHandler $error
}
tixPopEventStack $thisName
return ""
} else {
tixPopEventStack $thisName
return $ret
}
}
proc tixEvent {option args} {
global tixPriv
variable ::tix::EVENT
set varName [lindex $EVENT(nameStack) 0]
if {$varName == ""} {
error "tixEvent called when no event is being processed"
} else {
upvar #0 $varName event
}
switch -exact -- $option {
type {
return $event(type)
}
value {
if {[info exists event(%V)]} {
return $event(%V)
} else {
return ""
}
}
flag {
set f %[lindex $args 0]
if {[info exists event($f)]} {
return $event($f)
}
error "The flag \"[lindex $args 0]\" does not exist"
}
match {
return [string match [lindex $args 0] $event(type)]
}
default {
error "unknown option \"$option\""
}
}
}
# tixBuiltInCmdErrorHandler --
#
# Default method to report command handler errors. This procedure is
# also called if double-fault happens (command handler causes error,
# then tixCmdErrorHandler causes error).
#
proc tixBuiltInCmdErrorHandler {errorMsg} {
global errorInfo tcl_platform
if {![info exists errorInfo]} {
set errorInfo "???"
}
if {$tcl_platform(platform) eq "windows"} {
bgerror "Tix Error: $errorMsg"
} else {
puts "Error:\n $errorMsg\n$errorInfo"
}
}
# tixCmdErrorHandler --
#
# You can redefine this command to handle the errors that occur
# in the command handlers. See the programmer's documentation
# for details
#
if {![llength [info commands tixCmdErrorHandler]]} {
proc tixCmdErrorHandler {errorMsg} {
tixBuiltInCmdErrorHandler $errorMsg
}
}

1136
amd64/lib/tix8.4.3/FileBox.tcl
View File

File diff suppressed because it is too large Load Diff

216
amd64/lib/tix8.4.3/FileCbx.tcl
View File

@@ -1,108 +1,108 @@
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: FileCbx.tcl,v 1.5 2004/03/28 02:44:57 hobbs Exp $
#
# tixFileCombobox --
#
# A combobox widget for entering file names, directory names, file
# patterns, etc.
#
#
# 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.
# tixFileComboBox displays and accepts the DOS pathnames only. It doesn't
# recognize UNC file names or Tix VPATHS.
#
tixWidgetClass tixFileComboBox {
-classname TixFileComboBox
-superclass tixPrimitive
-method {
invoke
}
-flag {
-command -defaultfile -directory -text
}
-forcecall {
-directory
}
-configspec {
{-defaultfile defaultFile DefaultFile ""}
{-directory directory Directory ""}
{-command command Command ""}
{-text text Text ""}
}
-default {
}
}
proc tixFileComboBox:InitWidgetRec {w} {
upvar #0 $w data
tixChainMethod $w InitWidgetRec
if {$data(-directory) eq ""} {
set data(-directory) [pwd]
}
}
proc tixFileComboBox:ConstructWidget {w} {
upvar #0 $w data
tixChainMethod $w ConstructWidget
set data(w:combo) [tixComboBox $w.combo -editable true -dropdown true]
pack $data(w:combo) -expand yes -fill both
}
proc tixFileComboBox:SetBindings {w} {
upvar #0 $w data
tixChainMethod $w SetBindings
$data(w:combo) config -command [list tixFileComboBox:OnComboCmd $w]
}
proc tixFileComboBox:OnComboCmd {w args} {
upvar #0 $w data
set text [string trim [tixEvent value]]
set path [tixFSJoin $data(-directory) $text]
if {[file isdirectory $path]} {
set path [tixFSJoin $path $data(-defaultfile)]
set tail $data(-defaultfile)
} else {
set tail [file tail $path]
}
set norm [tixFSNormalize $path]
tixSetSilent $data(w:combo) $norm
if {[llength $data(-command)]} {
set bind(specs) {%V}
set bind(%V) [list $norm $path $tail ""]
tixEvalCmdBinding $w $data(-command) bind $bind(%V)
}
}
proc tixFileComboBox:config-text {w val} {
upvar #0 $w data
tixSetSilent $data(w:combo) $val
}
proc tixFileComboBox:config-directory {w val} {
upvar #0 $w data
set data(-directory) [tixFSNormalize $val]
return $data(-directory)
}
proc tixFileComboBox:invoke {w} {
upvar #0 $w data
$data(w:combo) invoke
}
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: FileCbx.tcl,v 1.5 2004/03/28 02:44:57 hobbs Exp $
#
# tixFileCombobox --
#
# A combobox widget for entering file names, directory names, file
# patterns, etc.
#
#
# 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.
# tixFileComboBox displays and accepts the DOS pathnames only. It doesn't
# recognize UNC file names or Tix VPATHS.
#
tixWidgetClass tixFileComboBox {
-classname TixFileComboBox
-superclass tixPrimitive
-method {
invoke
}
-flag {
-command -defaultfile -directory -text
}
-forcecall {
-directory
}
-configspec {
{-defaultfile defaultFile DefaultFile ""}
{-directory directory Directory ""}
{-command command Command ""}
{-text text Text ""}
}
-default {
}
}
proc tixFileComboBox:InitWidgetRec {w} {
upvar #0 $w data
tixChainMethod $w InitWidgetRec
if {$data(-directory) eq ""} {
set data(-directory) [pwd]
}
}
proc tixFileComboBox:ConstructWidget {w} {
upvar #0 $w data
tixChainMethod $w ConstructWidget
set data(w:combo) [tixComboBox $w.combo -editable true -dropdown true]
pack $data(w:combo) -expand yes -fill both
}
proc tixFileComboBox:SetBindings {w} {
upvar #0 $w data
tixChainMethod $w SetBindings
$data(w:combo) config -command [list tixFileComboBox:OnComboCmd $w]
}
proc tixFileComboBox:OnComboCmd {w args} {
upvar #0 $w data
set text [string trim [tixEvent value]]
set path [tixFSJoin $data(-directory) $text]
if {[file isdirectory $path]} {
set path [tixFSJoin $path $data(-defaultfile)]
set tail $data(-defaultfile)
} else {
set tail [file tail $path]
}
set norm [tixFSNormalize $path]
tixSetSilent $data(w:combo) $norm
if {[llength $data(-command)]} {
set bind(specs) {%V}
set bind(%V) [list $norm $path $tail ""]
tixEvalCmdBinding $w $data(-command) bind $bind(%V)
}
}
proc tixFileComboBox:config-text {w val} {
upvar #0 $w data
tixSetSilent $data(w:combo) $val
}
proc tixFileComboBox:config-directory {w val} {
upvar #0 $w data
set data(-directory) [tixFSNormalize $val]
return $data(-directory)
}
proc tixFileComboBox:invoke {w} {
upvar #0 $w data
$data(w:combo) invoke
}

150
amd64/lib/tix8.4.3/FileDlg.tcl
View File

@@ -1,75 +1,75 @@
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: FileDlg.tcl,v 1.3 2001/12/09 05:04:02 idiscovery Exp $
#
# FileDlg.tcl --
#
# Implements the File Selection Dialog 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.
#
tixWidgetClass tixFileSelectDialog {
-classname TixFileSelectDialog
-superclass tixStdDialogShell
-method {
}
-flag {
-command
}
-configspec {
{-command command Command ""}
{-title title Title "Select A File"}
}
}
proc tixFileSelectDialog:ConstructTopFrame {w frame} {
upvar #0 $w data
tixChainMethod $w ConstructTopFrame $frame
set data(w:fsbox) [tixFileSelectBox $frame.fsbox \
-command [list tixFileSelectDialog:Invoke $w]]
pack $data(w:fsbox) -expand yes -fill both
}
proc tixFileSelectDialog:SetBindings {w} {
upvar #0 $w data
tixChainMethod $w SetBindings
$data(w:btns) subwidget ok config -command "$data(w:fsbox) invoke" \
-underline 0
$data(w:btns) subwidget apply config -command "$data(w:fsbox) filter" \
-text Filter -underline 0
$data(w:btns) subwidget cancel config -command "wm withdraw $w" \
-underline 0
$data(w:btns) subwidget help config -underline 0
bind $w <Alt-Key-l> "focus [$data(w:fsbox) subwidget filelist]"
bind $w <Alt-Key-d> "focus [$data(w:fsbox) subwidget dirlist]"
bind $w <Alt-Key-s> "focus [$data(w:fsbox) subwidget selection]"
bind $w <Alt-Key-t> "focus [$data(w:fsbox) subwidget filter]"
bind $w <Alt-Key-o> "tkButtonInvoke [$data(w:btns) subwidget ok]"
bind $w <Alt-Key-f> "tkButtonInvoke [$data(w:btns) subwidget apply]"
bind $w <Alt-Key-c> "tkButtonInvoke [$data(w:btns) subwidget cancel]"
bind $w <Alt-Key-h> "tkButtonInvoke [$data(w:btns) subwidget help]"
}
proc tixFileSelectDialog:Invoke {w filename} {
upvar #0 $w data
wm withdraw $w
if {$data(-command) != ""} {
set bind(specs) "%V"
set bind(%V) $filename
tixEvalCmdBinding $w $data(-command) bind $filename
}
}
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: FileDlg.tcl,v 1.3 2001/12/09 05:04:02 idiscovery Exp $
#
# FileDlg.tcl --
#
# Implements the File Selection Dialog 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.
#
tixWidgetClass tixFileSelectDialog {
-classname TixFileSelectDialog
-superclass tixStdDialogShell
-method {
}
-flag {
-command
}
-configspec {
{-command command Command ""}
{-title title Title "Select A File"}
}
}
proc tixFileSelectDialog:ConstructTopFrame {w frame} {
upvar #0 $w data
tixChainMethod $w ConstructTopFrame $frame
set data(w:fsbox) [tixFileSelectBox $frame.fsbox \
-command [list tixFileSelectDialog:Invoke $w]]
pack $data(w:fsbox) -expand yes -fill both
}
proc tixFileSelectDialog:SetBindings {w} {
upvar #0 $w data
tixChainMethod $w SetBindings
$data(w:btns) subwidget ok config -command "$data(w:fsbox) invoke" \
-underline 0
$data(w:btns) subwidget apply config -command "$data(w:fsbox) filter" \
-text Filter -underline 0
$data(w:btns) subwidget cancel config -command "wm withdraw $w" \
-underline 0
$data(w:btns) subwidget help config -underline 0
bind $w <Alt-Key-l> "focus [$data(w:fsbox) subwidget filelist]"
bind $w <Alt-Key-d> "focus [$data(w:fsbox) subwidget dirlist]"
bind $w <Alt-Key-s> "focus [$data(w:fsbox) subwidget selection]"
bind $w <Alt-Key-t> "focus [$data(w:fsbox) subwidget filter]"
bind $w <Alt-Key-o> "tkButtonInvoke [$data(w:btns) subwidget ok]"
bind $w <Alt-Key-f> "tkButtonInvoke [$data(w:btns) subwidget apply]"
bind $w <Alt-Key-c> "tkButtonInvoke [$data(w:btns) subwidget cancel]"
bind $w <Alt-Key-h> "tkButtonInvoke [$data(w:btns) subwidget help]"
}
proc tixFileSelectDialog:Invoke {w filename} {
upvar #0 $w data
wm withdraw $w
if {$data(-command) != ""} {
set bind(specs) "%V"
set bind(%V) $filename
tixEvalCmdBinding $w $data(-command) bind $filename
}
}

540
amd64/lib/tix8.4.3/FileEnt.tcl
View File

@@ -1,270 +1,270 @@
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: FileEnt.tcl,v 1.7 2004/03/28 02:44:57 hobbs Exp $
#
# FileEnt.tcl --
#
# TixFileEntry Widget: an entry box for entering filenames.
#
# 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 tixFileEntry {
-classname TixFileEntry
-superclass tixLabelWidget
-method {
invoke filedialog update
}
-flag {
-activatecmd -command -dialogtype -disablecallback -disabledforeground
-filebitmap -selectmode -state -validatecmd -value -variable
}
-forcecall {
-variable
}
-static {
-filebitmap
}
-configspec {
{-activatecmd activateCmd ActivateCmd ""}
{-command command Command ""}
{-dialogtype dialogType DialogType ""}
{-disablecallback disableCallback DisableCallback 0 tixVerifyBoolean}
{-disabledforeground disabledForeground DisabledForeground #303030}
{-filebitmap fileBitmap FileBitmap ""}
{-selectmode selectMode SelectMode normal}
{-state state State normal}
{-validatecmd validateCmd ValidateCmd ""}
{-value value Value ""}
{-variable variable Variable ""}
}
-default {
{*frame.borderWidth 2}
{*frame.relief sunken}
{*Button.highlightThickness 0}
{*Entry.highlightThickness 0}
{*Entry.borderWidth 0}
}
}
proc tixFileEntry:InitWidgetRec {w} {
upvar #0 $w data
tixChainMethod $w InitWidgetRec
set data(varInited) 0
if {$data(-filebitmap) eq ""} {
set data(-filebitmap) [tix getbitmap openfile]
}
}
proc tixFileEntry:ConstructFramedWidget {w frame} {
upvar #0 $w data
tixChainMethod $w ConstructFramedWidget $frame
set data(w:entry) [entry $frame.entry]
set data(w:button) [button $frame.button -bitmap $data(-filebitmap) \
-takefocus 0]
set data(entryfg) [$data(w:entry) cget -fg]
pack $data(w:button) -side right -fill both
pack $data(w:entry) -side left -expand yes -fill both
}
proc tixFileEntry:SetBindings {w} {
upvar #0 $w data
tixChainMethod $w SetBindings
$data(w:button) config -command [list tixFileEntry:OpenFile $w]
tixSetMegaWidget $data(w:entry) $w
# If user press <return>, verify the value and call the -command
#
bind $data(w:entry) <Return> [list tixFileEntry:invoke $w]
bind $data(w:entry) <KeyPress> {
if {[set [tixGetMegaWidget %W](-selectmode)] eq "immediate"} {
tixFileEntry:invoke [tixGetMegaWidget %W]
}
}
bind $data(w:entry) <FocusOut> {
if {"%d" eq "NotifyNonlinear" || "%d" eq "NotifyNonlinearVirtual"} {
tixFileEntry:invoke [tixGetMegaWidget %W]
}
}
bind $w <FocusIn> [list focus $data(w:entry)]
}
#----------------------------------------------------------------------
# CONFIG OPTIONS
#----------------------------------------------------------------------
proc tixFileEntry:config-state {w value} {
upvar #0 $w data
if {$value eq "normal"} {
$data(w:button) config -state $value
$data(w:entry) config -state $value -fg $data(entryfg)
catch {$data(w:label) config -fg $data(entryfg)}
} else {
$data(w:button) config -state $value
$data(w:entry) config -state $value -fg $data(-disabledforeground)
catch {$data(w:label) config -fg $data(-disabledforeground)}
}
return ""
}
proc tixFileEntry:config-value {w value} {
tixFileEntry:SetValue $w $value
}
proc tixFileEntry:config-variable {w arg} {
upvar #0 $w data
if {[tixVariable:ConfigVariable $w $arg]} {
# The value of data(-value) is changed if tixVariable:ConfigVariable
# returns true
tixFileEntry:SetValue $w $data(-value)
}
catch {
unset data(varInited)
}
set data(-variable) $arg
}
#----------------------------------------------------------------------
# User Commands
#----------------------------------------------------------------------
proc tixFileEntry:invoke {w} {
upvar #0 $w data
if {![catch {$data(w:entry) index sel.first}]} {
# THIS ENTRY OWNS SELECTION --> TURN IT OFF
#
$data(w:entry) select from end
$data(w:entry) select to end
}
tixFileEntry:SetValue $w [$data(w:entry) get]
}
proc tixFileEntry:filedialog {w args} {
upvar #0 $w data
if {[llength $args]} {
return [eval [tix filedialog $data(-dialogtype)] $args]
} else {
return [tix filedialog $data(-dialogtype)]
}
}
proc tixFileEntry:update {w} {
upvar #0 $w data
if {[$data(w:entry) get] ne $data(-value)} {
tixFileEntry:invoke $w
}
}
#----------------------------------------------------------------------
# Internal Commands
#----------------------------------------------------------------------
proc tixFileEntry:OpenFile {w} {
upvar #0 $w data
if {$data(-activatecmd) != ""} {
uplevel #0 $data(-activatecmd)
}
switch -- $data(-dialogtype) tk_chooseDirectory {
set args [list -parent [winfo toplevel $w]]
if {[set initial $data(-value)] != ""} {
lappend args -initialdir $data(value)
}
set retval [eval [linsert $args 0 tk_chooseDirectory]]
if {$retval != ""} {tixFileEntry:SetValue $w [tixFSNative $retval]}
} tk_getOpenFile - tk_getSaveFile {
set args [list -parent [winfo toplevel $w]]
if {[set initial [$data(w:entry) get]] != ""} {
switch -glob -- $initial *.py {
set types [list {"Python Files" {.py .pyw}} {"All Files" *}]
} *.txt {
set types [list {"Text Files" .txt} {"All Files" *}]
} *.tcl {
set types [list {"Tcl Files" .tcl} {"All Files" *}]
} * - default {
set types [list {"All Files" *}]
}
if {[file isfile $initial]} {
lappend args -initialdir [file dir $initial] \
-initialfile $initial
} elseif {[file isdir $initial]} {
lappend args -initialdir $initial
}
} else {
set types [list {"All Files" *}]
}
lappend args -filetypes $types
set retval [eval $data(-dialogtype) $args]
if {$retval != ""} {tixFileEntry:SetValue $w [tixFSNative $retval]}
} default {
set filedlg [tix filedialog $data(-dialogtype)]
$filedlg config -parent [winfo toplevel $w] \
-command [list tixFileEntry:FileDlgCallback $w]
focus $data(w:entry)
$filedlg popup
}
}
proc tixFileEntry:FileDlgCallback {w args} {
set filename [tixEvent flag V]
tixFileEntry:SetValue $w $filename
}
proc tixFileEntry:SetValue {w value} {
upvar #0 $w data
if {[llength $data(-validatecmd)]} {
set value [tixEvalCmdBinding $w $data(-validatecmd) "" $value]
}
if {$data(-state) eq "normal"} {
$data(w:entry) delete 0 end
$data(w:entry) insert 0 $value
$data(w:entry) xview end
}
set data(-value) $value
tixVariable:UpdateVariable $w
if {[llength $data(-command)] && !$data(-disablecallback)} {
if {![info exists data(varInited)]} {
set bind(specs) ""
tixEvalCmdBinding $w $data(-command) bind $value
}
}
}
proc tixFileEntry:Destructor {w} {
upvar #0 $w data
tixUnsetMegaWidget $data(w:entry)
tixVariable:DeleteVariable $w
# Chain this to the superclass
#
tixChainMethod $w Destructor
}
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: FileEnt.tcl,v 1.7 2004/03/28 02:44:57 hobbs Exp $
#
# FileEnt.tcl --
#
# TixFileEntry Widget: an entry box for entering filenames.
#
# 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 tixFileEntry {
-classname TixFileEntry
-superclass tixLabelWidget
-method {
invoke filedialog update
}
-flag {
-activatecmd -command -dialogtype -disablecallback -disabledforeground
-filebitmap -selectmode -state -validatecmd -value -variable
}
-forcecall {
-variable
}
-static {
-filebitmap
}
-configspec {
{-activatecmd activateCmd ActivateCmd ""}
{-command command Command ""}
{-dialogtype dialogType DialogType ""}
{-disablecallback disableCallback DisableCallback 0 tixVerifyBoolean}
{-disabledforeground disabledForeground DisabledForeground #303030}
{-filebitmap fileBitmap FileBitmap ""}
{-selectmode selectMode SelectMode normal}
{-state state State normal}
{-validatecmd validateCmd ValidateCmd ""}
{-value value Value ""}
{-variable variable Variable ""}
}
-default {
{*frame.borderWidth 2}
{*frame.relief sunken}
{*Button.highlightThickness 0}
{*Entry.highlightThickness 0}
{*Entry.borderWidth 0}
}
}
proc tixFileEntry:InitWidgetRec {w} {
upvar #0 $w data
tixChainMethod $w InitWidgetRec
set data(varInited) 0
if {$data(-filebitmap) eq ""} {
set data(-filebitmap) [tix getbitmap openfile]
}
}
proc tixFileEntry:ConstructFramedWidget {w frame} {
upvar #0 $w data
tixChainMethod $w ConstructFramedWidget $frame
set data(w:entry) [entry $frame.entry]
set data(w:button) [button $frame.button -bitmap $data(-filebitmap) \
-takefocus 0]
set data(entryfg) [$data(w:entry) cget -fg]
pack $data(w:button) -side right -fill both
pack $data(w:entry) -side left -expand yes -fill both
}
proc tixFileEntry:SetBindings {w} {
upvar #0 $w data
tixChainMethod $w SetBindings
$data(w:button) config -command [list tixFileEntry:OpenFile $w]
tixSetMegaWidget $data(w:entry) $w
# If user press <return>, verify the value and call the -command
#
bind $data(w:entry) <Return> [list tixFileEntry:invoke $w]
bind $data(w:entry) <KeyPress> {
if {[set [tixGetMegaWidget %W](-selectmode)] eq "immediate"} {
tixFileEntry:invoke [tixGetMegaWidget %W]
}
}
bind $data(w:entry) <FocusOut> {
if {"%d" eq "NotifyNonlinear" || "%d" eq "NotifyNonlinearVirtual"} {
tixFileEntry:invoke [tixGetMegaWidget %W]
}
}
bind $w <FocusIn> [list focus $data(w:entry)]
}
#----------------------------------------------------------------------
# CONFIG OPTIONS
#----------------------------------------------------------------------
proc tixFileEntry:config-state {w value} {
upvar #0 $w data
if {$value eq "normal"} {
$data(w:button) config -state $value
$data(w:entry) config -state $value -fg $data(entryfg)
catch {$data(w:label) config -fg $data(entryfg)}
} else {
$data(w:button) config -state $value
$data(w:entry) config -state $value -fg $data(-disabledforeground)
catch {$data(w:label) config -fg $data(-disabledforeground)}
}
return ""
}
proc tixFileEntry:config-value {w value} {
tixFileEntry:SetValue $w $value
}
proc tixFileEntry:config-variable {w arg} {
upvar #0 $w data
if {[tixVariable:ConfigVariable $w $arg]} {
# The value of data(-value) is changed if tixVariable:ConfigVariable
# returns true
tixFileEntry:SetValue $w $data(-value)
}
catch {
unset data(varInited)
}
set data(-variable) $arg
}
#----------------------------------------------------------------------
# User Commands
#----------------------------------------------------------------------
proc tixFileEntry:invoke {w} {
upvar #0 $w data
if {![catch {$data(w:entry) index sel.first}]} {
# THIS ENTRY OWNS SELECTION --> TURN IT OFF
#
$data(w:entry) select from end
$data(w:entry) select to end
}
tixFileEntry:SetValue $w [$data(w:entry) get]
}
proc tixFileEntry:filedialog {w args} {
upvar #0 $w data
if {[llength $args]} {
return [eval [tix filedialog $data(-dialogtype)] $args]
} else {
return [tix filedialog $data(-dialogtype)]
}
}
proc tixFileEntry:update {w} {
upvar #0 $w data
if {[$data(w:entry) get] ne $data(-value)} {
tixFileEntry:invoke $w
}
}
#----------------------------------------------------------------------
# Internal Commands
#----------------------------------------------------------------------
proc tixFileEntry:OpenFile {w} {
upvar #0 $w data
if {$data(-activatecmd) != ""} {
uplevel #0 $data(-activatecmd)
}
switch -- $data(-dialogtype) tk_chooseDirectory {
set args [list -parent [winfo toplevel $w]]
if {[set initial $data(-value)] != ""} {
lappend args -initialdir $data(value)
}
set retval [eval [linsert $args 0 tk_chooseDirectory]]
if {$retval != ""} {tixFileEntry:SetValue $w [tixFSNative $retval]}
} tk_getOpenFile - tk_getSaveFile {
set args [list -parent [winfo toplevel $w]]
if {[set initial [$data(w:entry) get]] != ""} {
switch -glob -- $initial *.py {
set types [list {"Python Files" {.py .pyw}} {"All Files" *}]
} *.txt {
set types [list {"Text Files" .txt} {"All Files" *}]
} *.tcl {
set types [list {"Tcl Files" .tcl} {"All Files" *}]
} * - default {
set types [list {"All Files" *}]
}
if {[file isfile $initial]} {
lappend args -initialdir [file dir $initial] \
-initialfile $initial
} elseif {[file isdir $initial]} {
lappend args -initialdir $initial
}
} else {
set types [list {"All Files" *}]
}
lappend args -filetypes $types
set retval [eval $data(-dialogtype) $args]
if {$retval != ""} {tixFileEntry:SetValue $w [tixFSNative $retval]}
} default {
set filedlg [tix filedialog $data(-dialogtype)]
$filedlg config -parent [winfo toplevel $w] \
-command [list tixFileEntry:FileDlgCallback $w]
focus $data(w:entry)
$filedlg popup
}
}
proc tixFileEntry:FileDlgCallback {w args} {
set filename [tixEvent flag V]
tixFileEntry:SetValue $w $filename
}
proc tixFileEntry:SetValue {w value} {
upvar #0 $w data
if {[llength $data(-validatecmd)]} {
set value [tixEvalCmdBinding $w $data(-validatecmd) "" $value]
}
if {$data(-state) eq "normal"} {
$data(w:entry) delete 0 end
$data(w:entry) insert 0 $value
$data(w:entry) xview end
}
set data(-value) $value
tixVariable:UpdateVariable $w
if {[llength $data(-command)] && !$data(-disablecallback)} {
if {![info exists data(varInited)]} {
set bind(specs) ""
tixEvalCmdBinding $w $data(-command) bind $value
}
}
}
proc tixFileEntry:Destructor {w} {
upvar #0 $w data
tixUnsetMegaWidget $data(w:entry)
tixVariable:DeleteVariable $w
# Chain this to the superclass
#
tixChainMethod $w Destructor
}

264
amd64/lib/tix8.4.3/FloatEnt.tcl
View File

@@ -1,132 +1,132 @@
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: FloatEnt.tcl,v 1.4 2004/03/28 02:44:57 hobbs Exp $
#
# FloatEnt.tcl --
#
# An entry widget that can be attached on top of any widget to
# provide dynamic editing. It is used to provide dynamic editing
# for the tixGrid widget, among other things.
#
# 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 tixFloatEntry {
-classname TixFloatEntry
-superclass tixPrimitive
-method {
invoke post unpost
}
-flag {
-command -value
}
-configspec {
{-value value Value ""}
{-command command Command ""}
}
-default {
{.entry.highlightThickness 0}
}
}
#----------------------------------------------------------------------
#
# Initialization bindings
#
#----------------------------------------------------------------------
proc tixFloatEntry:InitWidgetRec {w} {
upvar #0 $w data
tixChainMethod $w InitWidgetRec
}
proc tixFloatEntry:ConstructWidget {w} {
upvar #0 $w data
tixChainMethod $w ConstructWidget
set data(w:entry) [entry $w.entry]
pack $data(w:entry) -expand yes -fill both
}
proc tixFloatEntry:SetBindings {w} {
upvar #0 $w data
tixChainMethod $w SetBindings
tixBind $data(w:entry) <Return> [list tixFloatEntry:invoke $w]
}
#----------------------------------------------------------------------
#
# Class bindings
#
#----------------------------------------------------------------------
proc tixFloatEntryBind {} {
tixBind TixFloatEntry <FocusIn> {
if {[focus -displayof [set %W(w:entry)]] ne [set %W(w:entry)]} {
focus [%W subwidget entry]
[set %W(w:entry)] selection from 0
[set %W(w:entry)] selection to end
[set %W(w:entry)] icursor end
}
}
}
#----------------------------------------------------------------------
#
# Public methods
#
#----------------------------------------------------------------------
proc tixFloatEntry:post {w x y {width ""} {height ""}} {
upvar #0 $w data
if {$width == ""} {
set width [winfo reqwidth $data(w:entry)]
}
if {$height == ""} {
set height [winfo reqheight $data(w:entry)]
}
place $w -x $x -y $y -width $width -height $height -bordermode ignore
raise $w
focus $data(w:entry)
}
proc tixFloatEntry:unpost {w} {
upvar #0 $w data
place forget $w
}
proc tixFloatEntry:config-value {w val} {
upvar #0 $w data
$data(w:entry) delete 0 end
$data(w:entry) insert 0 $val
$data(w:entry) selection from 0
$data(w:entry) selection to end
$data(w:entry) icursor end
}
#----------------------------------------------------------------------
#
# Private methods
#
#----------------------------------------------------------------------
proc tixFloatEntry:invoke {w} {
upvar #0 $w data
if {[llength $data(-command)]} {
set bind(specs) {%V}
set bind(%V) [$data(w:entry) get]
tixEvalCmdBinding $w $data(-command) bind $bind(%V)
}
}
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: FloatEnt.tcl,v 1.4 2004/03/28 02:44:57 hobbs Exp $
#
# FloatEnt.tcl --
#
# An entry widget that can be attached on top of any widget to
# provide dynamic editing. It is used to provide dynamic editing
# for the tixGrid widget, among other things.
#
# 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 tixFloatEntry {
-classname TixFloatEntry
-superclass tixPrimitive
-method {
invoke post unpost
}
-flag {
-command -value
}
-configspec {
{-value value Value ""}
{-command command Command ""}
}
-default {
{.entry.highlightThickness 0}
}
}
#----------------------------------------------------------------------
#
# Initialization bindings
#
#----------------------------------------------------------------------
proc tixFloatEntry:InitWidgetRec {w} {
upvar #0 $w data
tixChainMethod $w InitWidgetRec
}
proc tixFloatEntry:ConstructWidget {w} {
upvar #0 $w data
tixChainMethod $w ConstructWidget
set data(w:entry) [entry $w.entry]
pack $data(w:entry) -expand yes -fill both
}
proc tixFloatEntry:SetBindings {w} {
upvar #0 $w data
tixChainMethod $w SetBindings
tixBind $data(w:entry) <Return> [list tixFloatEntry:invoke $w]
}
#----------------------------------------------------------------------
#
# Class bindings
#
#----------------------------------------------------------------------
proc tixFloatEntryBind {} {
tixBind TixFloatEntry <FocusIn> {
if {[focus -displayof [set %W(w:entry)]] ne [set %W(w:entry)]} {
focus [%W subwidget entry]
[set %W(w:entry)] selection from 0
[set %W(w:entry)] selection to end
[set %W(w:entry)] icursor end
}
}
}
#----------------------------------------------------------------------
#
# Public methods
#
#----------------------------------------------------------------------
proc tixFloatEntry:post {w x y {width ""} {height ""}} {
upvar #0 $w data
if {$width == ""} {
set width [winfo reqwidth $data(w:entry)]
}
if {$height == ""} {
set height [winfo reqheight $data(w:entry)]
}
place $w -x $x -y $y -width $width -height $height -bordermode ignore
raise $w
focus $data(w:entry)
}
proc tixFloatEntry:unpost {w} {
upvar #0 $w data
place forget $w
}
proc tixFloatEntry:config-value {w val} {
upvar #0 $w data
$data(w:entry) delete 0 end
$data(w:entry) insert 0 $val
$data(w:entry) selection from 0
$data(w:entry) selection to end
$data(w:entry) icursor end
}
#----------------------------------------------------------------------
#
# Private methods
#
#----------------------------------------------------------------------
proc tixFloatEntry:invoke {w} {
upvar #0 $w data
if {[llength $data(-command)]} {
set bind(specs) {%V}
set bind(%V) [$data(w:entry) get]
tixEvalCmdBinding $w $data(-command) bind $bind(%V)
}
}

2244
amd64/lib/tix8.4.3/Grid.tcl
View File

File diff suppressed because it is too large Load Diff

1834
amd64/lib/tix8.4.3/HList.tcl
View File

File diff suppressed because it is too large Load Diff

408
amd64/lib/tix8.4.3/HListDD.tcl
View File

@@ -1,204 +1,204 @@
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: HListDD.tcl,v 1.3 2001/12/09 05:04:02 idiscovery Exp $
#
# HListDD.tcl --
#
# !!! PRE-ALPHA CODE, NOT USED, DON'T USE !!!
#
# This file implements drag+drop for HList.
#
# 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.
#
#
# events
#
#
proc tixHListSingle:DragTimer {w ent} {
case [tixHListSingle:GetState $w] {
{1} {
# fire up
}
}
}
#----------------------------------------------------------------------
#
# Drag + Drop Bindings
#
#----------------------------------------------------------------------
#----------------------------------------#
# Sending Actions #
#----------------------------------------#
#----------------------------------------------------------------------
# tixHListSingle:Send:WaitDrag --
#
# Sender wait for dragging action
#----------------------------------------------------------------------
proc tixHListSingle:Send:WaitDrag {w x y} {
global tixPriv
set ent [tixHListSingle:GetNearest $w $y]
if {$ent != ""} {
$w anchor set $ent
$w select clear
$w select set $ent
set tixPriv(dd,$w:moved) 0
set tixPriv(dd,$w:entry) $ent
# set browsecmd [$w cget -browsecmd]
# if {$browsecmd != "" && $ent != ""} {
# eval $browsecmd $ent
# }
}
}
proc tixHListSingle:Send:StartDrag {w x y} {
global tixPriv
set dd [tixGetDragDropContext $w]
if {![info exists tixPriv(dd,$w:entry)]} {
return
}
if {$tixPriv(dd,$w:entry) == ""} {
return
}
if {$tixPriv(dd,$w:moved) == 0} {
$w dragsite set $tixPriv(dd,$w:entry)
set tixPriv(dd,$w:moved) 1
$dd config -source $w -command [list tixHListSingle:Send:Cmd $w]
$dd startdrag $X $Y
} else {
$dd drag $X $Y
}
}
proc tixHListSingle:Send:DoneDrag {w x y} {
global tixPriv
global moved
if {![info exists tixPriv(dd,$w:entry)]} {
return
}
if {$tixPriv(dd,$w:entry) == ""} {
return
}
if {$tixPriv(dd,$w:moved) == 1} {
set dd [tixGetDragDropContext $w]
$dd drop $X $Y
}
$w dragsite clear
catch {unset tixPriv(dd,$w:moved)}
catch {unset tixPriv(dd,$w:entry)}
}
proc tixHListSingle:Send:Cmd {w option args} {
set dragCmd [$w cget -dragcmd]
if {$dragCmd != ""} {
return [eval $dragCmd $option $args]
}
# Perform the default action
#
case "$option" {
who {
return $w
}
types {
return {data text}
}
get {
global tixPriv
if {[lindex $args 0] == "text"} {
if {$tixPriv(dd,$w:entry) != ""} {
return [$w entrycget $tixPriv(dd,$w:entry) -text]
}
}
if {[lindex $args 0] == "data"} {
if {$tixPriv(dd,$w:entry) != ""} {
return [$w entrycget $tixPriv(dd,$w:entry) -data]
}
}
}
}
}
#----------------------------------------#
# Receiving Actions #
#----------------------------------------#
proc tixHListSingle:Rec:DragOver {w sender x y} {
if {[$w cget -selectmode] != "dragdrop"} {
return
}
set ent [tixHListSingle:GetNearest $w $y]
if {$ent != ""} {
$w dropsite set $ent
} else {
$w dropsite clear
}
}
proc tixHListSingle:Rec:DragIn {w sender x y} {
if {[$w cget -selectmode] != "dragdrop"} {
return
}
set ent [tixHListSingle:GetNearest $w $y]
if {$ent != ""} {
$w dropsite set $ent
} else {
$w dropsite clear
}
}
proc tixHListSingle:Rec:DragOut {w sender x y} {
if {[$w cget -selectmode] != "dragdrop"} {
return
}
$w dropsite clear
}
proc tixHListSingle:Rec:Drop {w sender x y} {
if {[$w cget -selectmode] != "dragdrop"} {
return
}
$w dropsite clear
set ent [tixHListSingle:GetNearest $w $y]
if {$ent != ""} {
$w anchor set $ent
$w select clear
$w select set $ent
}
set dropCmd [$w cget -dropcmd]
if {$dropCmd != ""} {
eval $dropCmd $sender $x $y
return
}
# set browsecmd [$w cget -browsecmd]
# if {$browsecmd != "" && $ent != ""} {
# eval $browsecmd [list $ent]
# }
}
tixDropBind TixHListSingle <In> "tixHListSingle:Rec:DragIn %W %S %x %y"
tixDropBind TixHListSingle <Over> "tixHListSingle:Rec:DragOver %W %S %x %y"
tixDropBind TixHListSingle <Out> "tixHListSingle:Rec:DragOut %W %S %x %y"
tixDropBind TixHListSingle <Drop> "tixHListSingle:Rec:Drop %W %S %x %y"
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: HListDD.tcl,v 1.3 2001/12/09 05:04:02 idiscovery Exp $
#
# HListDD.tcl --
#
# !!! PRE-ALPHA CODE, NOT USED, DON'T USE !!!
#
# This file implements drag+drop for HList.
#
# 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.
#
#
# events
#
#
proc tixHListSingle:DragTimer {w ent} {
case [tixHListSingle:GetState $w] {
{1} {
# fire up
}
}
}
#----------------------------------------------------------------------
#
# Drag + Drop Bindings
#
#----------------------------------------------------------------------
#----------------------------------------#
# Sending Actions #
#----------------------------------------#
#----------------------------------------------------------------------
# tixHListSingle:Send:WaitDrag --
#
# Sender wait for dragging action
#----------------------------------------------------------------------
proc tixHListSingle:Send:WaitDrag {w x y} {
global tixPriv
set ent [tixHListSingle:GetNearest $w $y]
if {$ent != ""} {
$w anchor set $ent
$w select clear
$w select set $ent
set tixPriv(dd,$w:moved) 0
set tixPriv(dd,$w:entry) $ent
# set browsecmd [$w cget -browsecmd]
# if {$browsecmd != "" && $ent != ""} {
# eval $browsecmd $ent
# }
}
}
proc tixHListSingle:Send:StartDrag {w x y} {
global tixPriv
set dd [tixGetDragDropContext $w]
if {![info exists tixPriv(dd,$w:entry)]} {
return
}
if {$tixPriv(dd,$w:entry) == ""} {
return
}
if {$tixPriv(dd,$w:moved) == 0} {
$w dragsite set $tixPriv(dd,$w:entry)
set tixPriv(dd,$w:moved) 1
$dd config -source $w -command [list tixHListSingle:Send:Cmd $w]
$dd startdrag $X $Y
} else {
$dd drag $X $Y
}
}
proc tixHListSingle:Send:DoneDrag {w x y} {
global tixPriv
global moved
if {![info exists tixPriv(dd,$w:entry)]} {
return
}
if {$tixPriv(dd,$w:entry) == ""} {
return
}
if {$tixPriv(dd,$w:moved) == 1} {
set dd [tixGetDragDropContext $w]
$dd drop $X $Y
}
$w dragsite clear
catch {unset tixPriv(dd,$w:moved)}
catch {unset tixPriv(dd,$w:entry)}
}
proc tixHListSingle:Send:Cmd {w option args} {
set dragCmd [$w cget -dragcmd]
if {$dragCmd != ""} {
return [eval $dragCmd $option $args]
}
# Perform the default action
#
case "$option" {
who {
return $w
}
types {
return {data text}
}
get {
global tixPriv
if {[lindex $args 0] == "text"} {
if {$tixPriv(dd,$w:entry) != ""} {
return [$w entrycget $tixPriv(dd,$w:entry) -text]
}
}
if {[lindex $args 0] == "data"} {
if {$tixPriv(dd,$w:entry) != ""} {
return [$w entrycget $tixPriv(dd,$w:entry) -data]
}
}
}
}
}
#----------------------------------------#
# Receiving Actions #
#----------------------------------------#
proc tixHListSingle:Rec:DragOver {w sender x y} {
if {[$w cget -selectmode] != "dragdrop"} {
return
}
set ent [tixHListSingle:GetNearest $w $y]
if {$ent != ""} {
$w dropsite set $ent
} else {
$w dropsite clear
}
}
proc tixHListSingle:Rec:DragIn {w sender x y} {
if {[$w cget -selectmode] != "dragdrop"} {
return
}
set ent [tixHListSingle:GetNearest $w $y]
if {$ent != ""} {
$w dropsite set $ent
} else {
$w dropsite clear
}
}
proc tixHListSingle:Rec:DragOut {w sender x y} {
if {[$w cget -selectmode] != "dragdrop"} {
return
}
$w dropsite clear
}
proc tixHListSingle:Rec:Drop {w sender x y} {
if {[$w cget -selectmode] != "dragdrop"} {
return
}
$w dropsite clear
set ent [tixHListSingle:GetNearest $w $y]
if {$ent != ""} {
$w anchor set $ent
$w select clear
$w select set $ent
}
set dropCmd [$w cget -dropcmd]
if {$dropCmd != ""} {
eval $dropCmd $sender $x $y
return
}
# set browsecmd [$w cget -browsecmd]
# if {$browsecmd != "" && $ent != ""} {
# eval $browsecmd [list $ent]
# }
}
tixDropBind TixHListSingle <In> "tixHListSingle:Rec:DragIn %W %S %x %y"
tixDropBind TixHListSingle <Over> "tixHListSingle:Rec:DragOver %W %S %x %y"
tixDropBind TixHListSingle <Out> "tixHListSingle:Rec:DragOut %W %S %x %y"
tixDropBind TixHListSingle <Drop> "tixHListSingle:Rec:Drop %W %S %x %y"

544
amd64/lib/tix8.4.3/IconView.tcl
View File

@@ -1,272 +1,272 @@
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: IconView.tcl,v 1.2 2001/12/09 05:04:02 idiscovery Exp $
#
# IconView.tcl --
#
# This file implements the Icon View widget: the "icon" view mode of
# the MultiView widget. It implements:
#
# (1) Creation of the icons in the canvas subwidget.
# (2) Automatic arrangement of the objects
#
# 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.
#
tixWidgetClass tixIconView {
-classname TixIconView
-superclass tixCObjView
-method {
add arrange
}
-flag {
-autoarrange
}
-static {
}
-configspec {
{-autoarrange autoArrange AutoArrange 0 tixVerifyBoolean}
}
-default {
{.scrollbar auto}
{*borderWidth 1}
{*canvas.background #c3c3c3}
{*canvas.highlightBackground #d9d9d9}
{*canvas.relief sunken}
{*canvas.takeFocus 1}
{*Scrollbar.takeFocus 0}
}
-forcecall {
}
}
proc tixIconView:ConstructWidget {w} {
upvar #0 $w data
tixChainMethod $w ConstructWidget
}
proc tixIconView:SetBindings {w} {
upvar #0 $w data
tixChainMethod $w SetBindings
set c $data(w:canvas)
bind $c <1> "tixIconView:StartDrag $w %x %y"
bind $c <B1-Motion> "tixIconView:Drag $w %x %y"
bind $c <ButtonRelease-1> "tixIconView:EndDrag $w"
}
proc tixIconView:StartDrag {w x y} {
upvar #0 $w data
global lastX lastY
set c $data(w:canvas)
$c raise current
set lastX [$c canvasx $x]
set lastY [$c canvasy $y]
}
proc tixIconView:Drag {w x y} {
upvar #0 $w data
global lastX lastY
set c $data(w:canvas)
set x [$c canvasx $x]
set y [$c canvasy $y]
$c move current [expr $x-$lastX] [expr $y-$lastY]
set lastX $x
set lastY $y
}
proc tixIconView:EndDrag {w} {
upvar #0 $w data
tixCallMethod $w adjustscrollregion
}
#----------------------------------------------------------------------
#
# option configs
#----------------------------------------------------------------------
proc tixIconView:add {w tag image text} {
upvar #0 $w data
set cmp [image create compound -window $data(w:canvas)]
$cmp add image -image $image
$cmp add line
$cmp add text -text $text
set id [$data(w:canvas) create image 0 0 -image $cmp -anchor nw]
$data(w:canvas) addtag $tag withtag $id
if {$data(-autoarrange)} {
tixWidgetDoWhenIdle tixIconView:Arrange $w 1
}
}
# Do it in an idle handler, so that Arrange is not called before the window
# is properly mapped.
#
proc tixIconView:arrange {w} {
tixWidgetDoWhenIdle tixIconView:Arrange $w 1
}
proc tixIconView:PackOneRow {w row y maxH bd padX padY} {
upvar #0 $w data
set iX [expr $bd+$padX]
foreach i $row {
set box [$data(w:canvas) bbox $i]
set W [expr [lindex $box 2]-[lindex $box 0]+1]
set H [expr [lindex $box 3]-[lindex $box 1]+1]
set iY [expr $y + $maxH - $H]
$data(w:canvas) coords $i $iX $iY
incr iX [expr $W+$padX]
}
}
# virtual method
#
proc tixIconView:PlaceWindow {w} {
upvar #0 $w data
if {$data(-autoarrange)} {
tixWidgetDoWhenIdle tixIconView:Arrange $w 0
}
tixChainMethod $w PlaceWindow
}
proc tixIconView:Arrange {w adjust} {
upvar #0 $w data
set padX 2
set padY 2
tixIconView:ArrangeGrid $w $padX $padY
if {$adjust} {
tixCallMethod $w adjustscrollregion
}
}
# the items are not packed
#
proc tixIconView:ArrangeGrid {w padX padY} {
upvar #0 $w data
set maxW 0
set maxH 0
foreach item [$data(w:canvas) find all] {
set box [$data(w:canvas) bbox $item]
set itemW [expr [lindex $box 2]-[lindex $box 0]+1]
set itemH [expr [lindex $box 3]-[lindex $box 1]+1]
if {$maxW < $itemW} {
set maxW $itemW
}
if {$maxH < $itemH} {
set maxH $itemH
}
}
if {$maxW == 0 || $maxH == 0} {
return
}
set winW [tixWinWidth $data(w:canvas)]
set bd [expr [$data(w:canvas) cget -bd]+\
[$data(w:canvas) cget -highlightthickness]]
set cols [expr $winW / ($maxW+$padX)]
if {$cols < 1} {
set cols 1
}
set y $bd
set c 0
set x $bd
foreach item [$data(w:canvas) find all] {
set box [$data(w:canvas) bbox $item]
set itemW [expr [lindex $box 2]-[lindex $box 0]+1]
set itemH [expr [lindex $box 3]-[lindex $box 1]+1]
set iX [expr $x + $padX + ($maxW-$itemW)/2]
set iY [expr $y + $padY + ($maxH-$itemH) ]
$data(w:canvas) coords $item $iX $iY
incr c
incr x [expr $maxW + $padY]
if {$c == $cols} {
set c 0
incr y [expr $maxH + $padY]
set x $bd
}
}
}
# the items are packed
#
proc tixIconView:ArrangePack {w padX padY} {
upvar #0 $w data
set winW [tixWinWidth $data(w:canvas)]
set bd [expr [$data(w:canvas) cget -bd]+\
[$data(w:canvas) cget -highlightthickness]]
set y [expr $bd + $padY]
set maxH 0
set usedW $padX
set row ""
foreach item [$data(w:canvas) find all] {
set box [$data(w:canvas) bbox $item]
set itemW [expr [lindex $box 2]-[lindex $box 0]+1]
set itemH [expr [lindex $box 3]-[lindex $box 1]+1]
if {[expr $usedW + $itemW] > $winW} {
if {$row == ""} {
# only one item in this row
#
$data(w:canvas) coords $item [expr $bd + $padX] $y
incr y [expr $itemH+$padY]
continue
} else {
# this item is not in this row. Arrange the previous items
# first
#
tixIconView:PackOneRow $w $row $y $maxH $bd $padX $padY
incr y $maxH
set row ""
set maxH 0
set usedW $padX
}
}
lappend row $item
if {$maxH < $itemH} {
set maxH $itemH
}
incr usedW [expr $padX+$itemW]
}
if {$row != ""} {
tixIconView:PackOneRow $w $row $y $maxH $bd $padX $padY
}
}
#----------------------------------------------------------------------
#
# Widget commands
#----------------------------------------------------------------------
#----------------------------------------------------------------------
#
# Private Methods
#----------------------------------------------------------------------
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: IconView.tcl,v 1.2 2001/12/09 05:04:02 idiscovery Exp $
#
# IconView.tcl --
#
# This file implements the Icon View widget: the "icon" view mode of
# the MultiView widget. It implements:
#
# (1) Creation of the icons in the canvas subwidget.
# (2) Automatic arrangement of the objects
#
# 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.
#
tixWidgetClass tixIconView {
-classname TixIconView
-superclass tixCObjView
-method {
add arrange
}
-flag {
-autoarrange
}
-static {
}
-configspec {
{-autoarrange autoArrange AutoArrange 0 tixVerifyBoolean}
}
-default {
{.scrollbar auto}
{*borderWidth 1}
{*canvas.background #c3c3c3}
{*canvas.highlightBackground #d9d9d9}
{*canvas.relief sunken}
{*canvas.takeFocus 1}
{*Scrollbar.takeFocus 0}
}
-forcecall {
}
}
proc tixIconView:ConstructWidget {w} {
upvar #0 $w data
tixChainMethod $w ConstructWidget
}
proc tixIconView:SetBindings {w} {
upvar #0 $w data
tixChainMethod $w SetBindings
set c $data(w:canvas)
bind $c <1> "tixIconView:StartDrag $w %x %y"
bind $c <B1-Motion> "tixIconView:Drag $w %x %y"
bind $c <ButtonRelease-1> "tixIconView:EndDrag $w"
}
proc tixIconView:StartDrag {w x y} {
upvar #0 $w data
global lastX lastY
set c $data(w:canvas)
$c raise current
set lastX [$c canvasx $x]
set lastY [$c canvasy $y]
}
proc tixIconView:Drag {w x y} {
upvar #0 $w data
global lastX lastY
set c $data(w:canvas)
set x [$c canvasx $x]
set y [$c canvasy $y]
$c move current [expr $x-$lastX] [expr $y-$lastY]
set lastX $x
set lastY $y
}
proc tixIconView:EndDrag {w} {
upvar #0 $w data
tixCallMethod $w adjustscrollregion
}
#----------------------------------------------------------------------
#
# option configs
#----------------------------------------------------------------------
proc tixIconView:add {w tag image text} {
upvar #0 $w data
set cmp [image create compound -window $data(w:canvas)]
$cmp add image -image $image
$cmp add line
$cmp add text -text $text
set id [$data(w:canvas) create image 0 0 -image $cmp -anchor nw]
$data(w:canvas) addtag $tag withtag $id
if {$data(-autoarrange)} {
tixWidgetDoWhenIdle tixIconView:Arrange $w 1
}
}
# Do it in an idle handler, so that Arrange is not called before the window
# is properly mapped.
#
proc tixIconView:arrange {w} {
tixWidgetDoWhenIdle tixIconView:Arrange $w 1
}
proc tixIconView:PackOneRow {w row y maxH bd padX padY} {
upvar #0 $w data
set iX [expr $bd+$padX]
foreach i $row {
set box [$data(w:canvas) bbox $i]
set W [expr [lindex $box 2]-[lindex $box 0]+1]
set H [expr [lindex $box 3]-[lindex $box 1]+1]
set iY [expr $y + $maxH - $H]
$data(w:canvas) coords $i $iX $iY
incr iX [expr $W+$padX]
}
}
# virtual method
#
proc tixIconView:PlaceWindow {w} {
upvar #0 $w data
if {$data(-autoarrange)} {
tixWidgetDoWhenIdle tixIconView:Arrange $w 0
}
tixChainMethod $w PlaceWindow
}
proc tixIconView:Arrange {w adjust} {
upvar #0 $w data
set padX 2
set padY 2
tixIconView:ArrangeGrid $w $padX $padY
if {$adjust} {
tixCallMethod $w adjustscrollregion
}
}
# the items are not packed
#
proc tixIconView:ArrangeGrid {w padX padY} {
upvar #0 $w data
set maxW 0
set maxH 0
foreach item [$data(w:canvas) find all] {
set box [$data(w:canvas) bbox $item]
set itemW [expr [lindex $box 2]-[lindex $box 0]+1]
set itemH [expr [lindex $box 3]-[lindex $box 1]+1]
if {$maxW < $itemW} {
set maxW $itemW
}
if {$maxH < $itemH} {
set maxH $itemH
}
}
if {$maxW == 0 || $maxH == 0} {
return
}
set winW [tixWinWidth $data(w:canvas)]
set bd [expr [$data(w:canvas) cget -bd]+\
[$data(w:canvas) cget -highlightthickness]]
set cols [expr $winW / ($maxW+$padX)]
if {$cols < 1} {
set cols 1
}
set y $bd
set c 0
set x $bd
foreach item [$data(w:canvas) find all] {
set box [$data(w:canvas) bbox $item]
set itemW [expr [lindex $box 2]-[lindex $box 0]+1]
set itemH [expr [lindex $box 3]-[lindex $box 1]+1]
set iX [expr $x + $padX + ($maxW-$itemW)/2]
set iY [expr $y + $padY + ($maxH-$itemH) ]
$data(w:canvas) coords $item $iX $iY
incr c
incr x [expr $maxW + $padY]
if {$c == $cols} {
set c 0
incr y [expr $maxH + $padY]
set x $bd
}
}
}
# the items are packed
#
proc tixIconView:ArrangePack {w padX padY} {
upvar #0 $w data
set winW [tixWinWidth $data(w:canvas)]
set bd [expr [$data(w:canvas) cget -bd]+\
[$data(w:canvas) cget -highlightthickness]]
set y [expr $bd + $padY]
set maxH 0
set usedW $padX
set row ""
foreach item [$data(w:canvas) find all] {
set box [$data(w:canvas) bbox $item]
set itemW [expr [lindex $box 2]-[lindex $box 0]+1]
set itemH [expr [lindex $box 3]-[lindex $box 1]+1]
if {[expr $usedW + $itemW] > $winW} {
if {$row == ""} {
# only one item in this row
#
$data(w:canvas) coords $item [expr $bd + $padX] $y
incr y [expr $itemH+$padY]
continue
} else {
# this item is not in this row. Arrange the previous items
# first
#
tixIconView:PackOneRow $w $row $y $maxH $bd $padX $padY
incr y $maxH
set row ""
set maxH 0
set usedW $padX
}
}
lappend row $item
if {$maxH < $itemH} {
set maxH $itemH
}
incr usedW [expr $padX+$itemW]
}
if {$row != ""} {
tixIconView:PackOneRow $w $row $y $maxH $bd $padX $padY
}
}
#----------------------------------------------------------------------
#
# Widget commands
#----------------------------------------------------------------------
#----------------------------------------------------------------------
#
# Private Methods
#----------------------------------------------------------------------

464
amd64/lib/tix8.4.3/Init.tcl
View File

@@ -1,232 +1,232 @@
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: Init.tcl,v 1.18 2008/02/28 04:35:16 hobbs Exp $
#
# Init.tcl --
#
# Initializes the Tix library and performes version checking to ensure
# the Tcl, Tk and Tix script libraries loaded matches with the binary
# of the respective packages.
#
# 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.
#
namespace eval ::tix {
}
proc tixScriptVersion {} { return $::tix_version }
proc tixScriptPatchLevel {} { return $::tix_patchLevel }
proc ::tix::Init {dir} {
global tix env tix_library tcl_platform auto_path
if {[info exists tix(initialized)]} {
return
}
if {![info exists tix_library]} {
# we're running from stand-alone module.
set tix_library ""
} elseif {[file isdir $tix_library]} {
if {![info exists auto_path] ||
[lsearch $auto_path $tix_library] == -1} {
lappend auto_path $tix_library
}
}
# STEP 1: Version checking
#
#
package require Tcl 8.4
package require -exact Tix 8.4.3
# STEP 2: Initialize file compatibility modules
#
foreach file {
fs.tcl
Tix.tcl Event.tcl
Balloon.tcl BtnBox.tcl
CObjView.tcl ChkList.tcl
ComboBox.tcl Compat.tcl
Console.tcl Control.tcl
DefSchm.tcl DialogS.tcl
DirBox.tcl DirDlg.tcl
DirList.tcl DirTree.tcl
DragDrop.tcl DtlList.tcl
EFileBox.tcl EFileDlg.tcl
FileBox.tcl FileCbx.tcl
FileDlg.tcl FileEnt.tcl
FloatEnt.tcl
Grid.tcl HList.tcl
HListDD.tcl IconView.tcl
LabEntry.tcl LabFrame.tcl
LabWidg.tcl ListNBk.tcl
Meter.tcl MultView.tcl
NoteBook.tcl OldUtil.tcl
OptMenu.tcl PanedWin.tcl
PopMenu.tcl Primitiv.tcl
ResizeH.tcl SGrid.tcl
SHList.tcl SListBox.tcl
STList.tcl SText.tcl
SWidget.tcl SWindow.tcl
Select.tcl Shell.tcl
SimpDlg.tcl StackWin.tcl
StatBar.tcl StdBBox.tcl
StdShell.tcl TList.tcl
Tree.tcl
Utils.tcl VResize.tcl
VStack.tcl VTree.tcl
Variable.tcl WInfo.tcl
} {
uplevel \#0 [list source [file join $dir $file]]
}
# STEP 3: Initialize the Tix application context
#
tixAppContext tix
# DO NOT DO THIS HERE !!
# This causes the global defaults to be altered, which may not
# be desirable. The user can call this after requiring Tix if
# they wish to use different defaults.
#
#tix initstyle
# STEP 4: Initialize the bindings for widgets that are implemented in C
#
foreach w {
HList TList Grid ComboBox Control FloatEntry
LabelEntry ScrolledGrid ScrolledListBox
} {
tix${w}Bind
}
rename ::tix::Init ""
}
# tixWidgetClassEx --
#
# This procedure is similar to tixWidgetClass, except it
# performs a [subst] on the class declaration before evaluating
# it. This gives us a chance to specify platform-specific widget
# default without using a lot of ugly double quotes.
#
# The use of subst'able entries in the class declaration should
# be restrained to widget default values only to avoid producing
# unreadable code.
#
# Arguments:
# name - The name of the class to declare.
# classDecl - Various declarations about the class. See documentation
# of tixWidgetClass for details.
proc tixWidgetClassEx {name classDecl} {
tixWidgetClass $name [uplevel [list subst $classDecl]]
}
#
# Deprecated tix* functions
#
interp alias {} tixFileJoin {} file join
interp alias {} tixStrEq {} string equal
proc tixTrue {args} { return 1 }
proc tixFalse {args} { return 0 }
proc tixStringSub {var fromStr toStr} {
upvar 1 var var
set var [string map $var [list $fromStr $toStr]]
}
proc tixGetBoolean {args} {
set len [llength [info level 0]]
set nocomplain 0
if {$len == 3} {
if {[lindex $args 0] ne "-nocomplain"} {
return -code error "wrong \# args:\
must be [lindex [info level 0] 0] ?-nocomplain? string"
}
set nocomplain 1
set val [lindex $args 1]
} elseif {$len != 2} {
return -code error "wrong \# args:\
must be [lindex [info level 0] 0] ?-nocomplain? string"
} else {
set val [lindex $args 0]
}
if {[string is boolean -strict $val] || $nocomplain} {
return [string is true -strict $val]
} elseif {$nocomplain} {
return 0
} else {
return -code error "\"$val\" is not a valid boolean"
}
}
interp alias {} tixVerifyBoolean {} tixGetBoolean
proc tixGetInt {args} {
set len [llength [info level 0]]
set nocomplain 0
set trunc 0
for {set i 1} {$i < $len-1} {incr i} {
set arg [lindex $args 0]
if {$arg eq "-nocomplain"} {
set nocomplain 1
} elseif {$arg eq "-trunc"} {
set trunc 1
} else {
return -code error "wrong \# args: must be\
[lindex [info level 0] 0] ?-nocomplain? ?-trunc? string"
}
}
if {$i != $len-1} {
return -code error "wrong \# args: must be\
[lindex [info level 0] 0] ?-nocomplain? ?-trunc? string"
}
set val [lindex $args end]
set code [catch {expr {round($val)}} res]
if {$code} {
if {$nocomplain} {
return 0
} else {
return -code error "\"$val\" cannot be converted to integer"
}
}
if {$trunc} {
return [expr {int($val)}]
} else {
return $res
}
}
proc tixFile {option filename} {
set len [string length $option]
if {$len > 1 && [string equal -length $len $option "tildesubst"]} {
set code [catch {file normalize $filename} res]
if {$code == 0} {
set filename $res
}
} elseif {$len > 1 && [string equal -length $len $option "trimslash"]} {
# normalize extra slashes
set filename [file join $filename]
if {$filename ne "/"} {
set filename [string trimright $filename "/"]
}
} else {
return -code error "unknown option \"$option\",\
must be tildesubst or trimslash"
}
return $filename
}
interp alias {} tixRaiseWindow {} raise
#proc tixUnmapWindow {w} { }
#
# if tix_library is not defined, we're running in SAM mode. ::tix::Init
# will be called later by the Tix_Init() C code.
#
if {[info exists tix_library]} {
::tix::Init [file dirname [info script]]
}
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: Init.tcl,v 1.18 2008/02/28 04:35:16 hobbs Exp $
#
# Init.tcl --
#
# Initializes the Tix library and performes version checking to ensure
# the Tcl, Tk and Tix script libraries loaded matches with the binary
# of the respective packages.
#
# 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.
#
namespace eval ::tix {
}
proc tixScriptVersion {} { return $::tix_version }
proc tixScriptPatchLevel {} { return $::tix_patchLevel }
proc ::tix::Init {dir} {
global tix env tix_library tcl_platform auto_path
if {[info exists tix(initialized)]} {
return
}
if {![info exists tix_library]} {
# we're running from stand-alone module.
set tix_library ""
} elseif {[file isdir $tix_library]} {
if {![info exists auto_path] ||
[lsearch $auto_path $tix_library] == -1} {
lappend auto_path $tix_library
}
}
# STEP 1: Version checking
#
#
package require Tcl 8.4
package require -exact Tix 8.4.3
# STEP 2: Initialize file compatibility modules
#
foreach file {
fs.tcl
Tix.tcl Event.tcl
Balloon.tcl BtnBox.tcl
CObjView.tcl ChkList.tcl
ComboBox.tcl Compat.tcl
Console.tcl Control.tcl
DefSchm.tcl DialogS.tcl
DirBox.tcl DirDlg.tcl
DirList.tcl DirTree.tcl
DragDrop.tcl DtlList.tcl
EFileBox.tcl EFileDlg.tcl
FileBox.tcl FileCbx.tcl
FileDlg.tcl FileEnt.tcl
FloatEnt.tcl
Grid.tcl HList.tcl
HListDD.tcl IconView.tcl
LabEntry.tcl LabFrame.tcl
LabWidg.tcl ListNBk.tcl
Meter.tcl MultView.tcl
NoteBook.tcl OldUtil.tcl
OptMenu.tcl PanedWin.tcl
PopMenu.tcl Primitiv.tcl
ResizeH.tcl SGrid.tcl
SHList.tcl SListBox.tcl
STList.tcl SText.tcl
SWidget.tcl SWindow.tcl
Select.tcl Shell.tcl
SimpDlg.tcl StackWin.tcl
StatBar.tcl StdBBox.tcl
StdShell.tcl TList.tcl
Tree.tcl
Utils.tcl VResize.tcl
VStack.tcl VTree.tcl
Variable.tcl WInfo.tcl
} {
uplevel \#0 [list source [file join $dir $file]]
}
# STEP 3: Initialize the Tix application context
#
tixAppContext tix
# DO NOT DO THIS HERE !!
# This causes the global defaults to be altered, which may not
# be desirable. The user can call this after requiring Tix if
# they wish to use different defaults.
#
#tix initstyle
# STEP 4: Initialize the bindings for widgets that are implemented in C
#
foreach w {
HList TList Grid ComboBox Control FloatEntry
LabelEntry ScrolledGrid ScrolledListBox
} {
tix${w}Bind
}
rename ::tix::Init ""
}
# tixWidgetClassEx --
#
# This procedure is similar to tixWidgetClass, except it
# performs a [subst] on the class declaration before evaluating
# it. This gives us a chance to specify platform-specific widget
# default without using a lot of ugly double quotes.
#
# The use of subst'able entries in the class declaration should
# be restrained to widget default values only to avoid producing
# unreadable code.
#
# Arguments:
# name - The name of the class to declare.
# classDecl - Various declarations about the class. See documentation
# of tixWidgetClass for details.
proc tixWidgetClassEx {name classDecl} {
tixWidgetClass $name [uplevel [list subst $classDecl]]
}
#
# Deprecated tix* functions
#
interp alias {} tixFileJoin {} file join
interp alias {} tixStrEq {} string equal
proc tixTrue {args} { return 1 }
proc tixFalse {args} { return 0 }
proc tixStringSub {var fromStr toStr} {
upvar 1 var var
set var [string map $var [list $fromStr $toStr]]
}
proc tixGetBoolean {args} {
set len [llength [info level 0]]
set nocomplain 0
if {$len == 3} {
if {[lindex $args 0] ne "-nocomplain"} {
return -code error "wrong \# args:\
must be [lindex [info level 0] 0] ?-nocomplain? string"
}
set nocomplain 1
set val [lindex $args 1]
} elseif {$len != 2} {
return -code error "wrong \# args:\
must be [lindex [info level 0] 0] ?-nocomplain? string"
} else {
set val [lindex $args 0]
}
if {[string is boolean -strict $val] || $nocomplain} {
return [string is true -strict $val]
} elseif {$nocomplain} {
return 0
} else {
return -code error "\"$val\" is not a valid boolean"
}
}
interp alias {} tixVerifyBoolean {} tixGetBoolean
proc tixGetInt {args} {
set len [llength [info level 0]]
set nocomplain 0
set trunc 0
for {set i 1} {$i < $len-1} {incr i} {
set arg [lindex $args 0]
if {$arg eq "-nocomplain"} {
set nocomplain 1
} elseif {$arg eq "-trunc"} {
set trunc 1
} else {
return -code error "wrong \# args: must be\
[lindex [info level 0] 0] ?-nocomplain? ?-trunc? string"
}
}
if {$i != $len-1} {
return -code error "wrong \# args: must be\
[lindex [info level 0] 0] ?-nocomplain? ?-trunc? string"
}
set val [lindex $args end]
set code [catch {expr {round($val)}} res]
if {$code} {
if {$nocomplain} {
return 0
} else {
return -code error "\"$val\" cannot be converted to integer"
}
}
if {$trunc} {
return [expr {int($val)}]
} else {
return $res
}
}
proc tixFile {option filename} {
set len [string length $option]
if {$len > 1 && [string equal -length $len $option "tildesubst"]} {
set code [catch {file normalize $filename} res]
if {$code == 0} {
set filename $res
}
} elseif {$len > 1 && [string equal -length $len $option "trimslash"]} {
# normalize extra slashes
set filename [file join $filename]
if {$filename ne "/"} {
set filename [string trimright $filename "/"]
}
} else {
return -code error "unknown option \"$option\",\
must be tildesubst or trimslash"
}
return $filename
}
interp alias {} tixRaiseWindow {} raise
#proc tixUnmapWindow {w} { }
#
# if tix_library is not defined, we're running in SAM mode. ::tix::Init
# will be called later by the Tix_Init() C code.
#
if {[info exists tix_library]} {
::tix::Init [file dirname [info script]]
}

172
amd64/lib/tix8.4.3/LabEntry.tcl
View File

@@ -1,86 +1,86 @@
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: LabEntry.tcl,v 1.4 2004/03/28 02:44:57 hobbs Exp $
#
# LabEntry.tcl --
#
# TixLabelEntry Widget: an entry box with a label
#
# 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.
#
tixWidgetClass tixLabelEntry {
-classname TixLabelEntry
-superclass tixLabelWidget
-method {
}
-flag {
-disabledforeground -state
}
-forcecall {
-state
}
-static {
}
-configspec {
{-disabledforeground disabledForeground DisabledForeground #303030}
{-state state State normal}
}
-default {
{.borderWidth 0}
{*entry.relief sunken}
{*entry.width 7}
{*label.anchor e}
{*label.borderWidth 0}
}
}
proc tixLabelEntry:ConstructFramedWidget {w frame} {
upvar #0 $w data
tixChainMethod $w ConstructFramedWidget $frame
set data(w:entry) [entry $frame.entry]
pack $data(w:entry) -side left -expand yes -fill both
# This value is used to configure the disable/normal fg of the ebtry
#
set data(entryfg) [$data(w:entry) cget -fg]
set data(labelfg) [$data(w:label) cget -fg]
}
proc tixLabelEntryBind {} {
tixBind TixLabelEntry <FocusIn> {
if {[focus -displayof [set %W(w:entry)]] ne [set %W(w:entry)]} {
focus [%W subwidget entry]
[set %W(w:entry)] selection from 0
[set %W(w:entry)] selection to end
[set %W(w:entry)] icursor end
}
}
}
#----------------------------------------------------------------------
# CONFIG OPTIONS
#----------------------------------------------------------------------
proc tixLabelEntry:config-state {w value} {
upvar #0 $w data
if {$value == "normal"} {
catch {
$data(w:label) config -fg $data(labelfg)
}
$data(w:entry) config -state $value -fg $data(entryfg)
} else {
catch {
$data(w:label) config -fg $data(-disabledforeground)
}
$data(w:entry) config -state $value -fg $data(-disabledforeground)
}
}
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: LabEntry.tcl,v 1.4 2004/03/28 02:44:57 hobbs Exp $
#
# LabEntry.tcl --
#
# TixLabelEntry Widget: an entry box with a label
#
# 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.
#
tixWidgetClass tixLabelEntry {
-classname TixLabelEntry
-superclass tixLabelWidget
-method {
}
-flag {
-disabledforeground -state
}
-forcecall {
-state
}
-static {
}
-configspec {
{-disabledforeground disabledForeground DisabledForeground #303030}
{-state state State normal}
}
-default {
{.borderWidth 0}
{*entry.relief sunken}
{*entry.width 7}
{*label.anchor e}
{*label.borderWidth 0}
}
}
proc tixLabelEntry:ConstructFramedWidget {w frame} {
upvar #0 $w data
tixChainMethod $w ConstructFramedWidget $frame
set data(w:entry) [entry $frame.entry]
pack $data(w:entry) -side left -expand yes -fill both
# This value is used to configure the disable/normal fg of the ebtry
#
set data(entryfg) [$data(w:entry) cget -fg]
set data(labelfg) [$data(w:label) cget -fg]
}
proc tixLabelEntryBind {} {
tixBind TixLabelEntry <FocusIn> {
if {[focus -displayof [set %W(w:entry)]] ne [set %W(w:entry)]} {
focus [%W subwidget entry]
[set %W(w:entry)] selection from 0
[set %W(w:entry)] selection to end
[set %W(w:entry)] icursor end
}
}
}
#----------------------------------------------------------------------
# CONFIG OPTIONS
#----------------------------------------------------------------------
proc tixLabelEntry:config-state {w value} {
upvar #0 $w data
if {$value == "normal"} {
catch {
$data(w:label) config -fg $data(labelfg)
}
$data(w:entry) config -state $value -fg $data(entryfg)
} else {
catch {
$data(w:label) config -fg $data(-disabledforeground)
}
$data(w:entry) config -state $value -fg $data(-disabledforeground)
}
}

98
amd64/lib/tix8.4.3/LabFrame.tcl
View File

@@ -1,49 +1,49 @@
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: LabFrame.tcl,v 1.2 2001/12/09 05:04:02 idiscovery Exp $
#
# LabFrame.tcl --
#
# TixLabelFrame Widget: a frame box with a label
#
# 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.
#
tixWidgetClass tixLabelFrame {
-classname TixLabelFrame
-superclass tixLabelWidget
-method {
frame
}
-flag {}
-static {}
-configspec {
{-labelside labelSide LabelSide acrosstop}
{-padx padX Pad 2}
{-pady padY Pad 2}
}
-alias {}
-default {
{*Label.anchor c}
{.frame.borderWidth 2}
{.frame.relief groove}
{.border.borderWidth 2}
{.border.relief groove}
{.borderWidth 2}
{.padX 2}
{.padY 2}
{.anchor sw}
}
}
#----------------------------------------------------------------------
# Public methods
#----------------------------------------------------------------------
proc tixLabelFrame:frame {w args} {
return [eval tixCallMethod $w subwidget frame $args]
}
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: LabFrame.tcl,v 1.2 2001/12/09 05:04:02 idiscovery Exp $
#
# LabFrame.tcl --
#
# TixLabelFrame Widget: a frame box with a label
#
# 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.
#
tixWidgetClass tixLabelFrame {
-classname TixLabelFrame
-superclass tixLabelWidget
-method {
frame
}
-flag {}
-static {}
-configspec {
{-labelside labelSide LabelSide acrosstop}
{-padx padX Pad 2}
{-pady padY Pad 2}
}
-alias {}
-default {
{*Label.anchor c}
{.frame.borderWidth 2}
{.frame.relief groove}
{.border.borderWidth 2}
{.border.relief groove}
{.borderWidth 2}
{.padX 2}
{.padY 2}
{.anchor sw}
}
}
#----------------------------------------------------------------------
# Public methods
#----------------------------------------------------------------------
proc tixLabelFrame:frame {w args} {
return [eval tixCallMethod $w subwidget frame $args]
}

314
amd64/lib/tix8.4.3/LabWidg.tcl
View File

@@ -1,157 +1,157 @@
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: LabWidg.tcl,v 1.3 2001/12/09 05:04:02 idiscovery Exp $
#
# LabWidg.tcl --
#
# TixLabelWidget: Virtual base class. Do not instantiate
#
# This widget class is the base class for all widgets that has a
# label. Most Tix compound widgets will have a label so that
# the app programmer doesn't need to add labels themselvel.
#
#
# 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.
#
# LabelSide : top, left, right, bottom, none, acrosstop
#
# public widgets:
# frame, label
#
tixWidgetClass tixLabelWidget {
-superclass tixPrimitive
-classname TixLabelWidget
-flag {
-label -labelside -padx -pady
}
-static {-labelside}
-configspec {
{-label label Label ""}
{-labelside labelSide LabelSide left}
{-padx padX Pad 0}
{-pady padY Pad 0}
}
}
proc tixLabelWidget:ConstructWidget {w} {
upvar #0 $w data
tixChainMethod $w ConstructWidget
if {$data(-labelside) != "acrosstop"} {
set data(w:frame) [frame $w.frame]
} else {
set data(pw:border) [frame $w.border]
set data(pw:pad) [frame $w.border.pad]
set data(w:frame) [frame $w.border.frame]
}
if {$data(-labelside) != "none"} {
set data(w:label) [label $w.label -text $data(-label)]
}
tixLabelWidget:Pack $w
tixCallMethod $w ConstructFramedWidget $data(w:frame)
}
proc tixLabelWidget:ConstructFramedWidget {w frame} {
# Do nothing
}
proc tixLabelWidget:Pack {w} {
upvar #0 $w data
if {[catch {tixLabelWidget:Pack-$data(-labelside) $w}]} {
error "unknown -labelside option \"$data(-labelside)\""
}
}
proc tixLabelWidget:Pack-acrosstop {w} {
upvar #0 $w data
set labHalfHeight [expr [winfo reqheight $data(w:label)] / 2]
set padHeight [expr $labHalfHeight - [$data(pw:border) cget -bd]]
if {$padHeight < 0} {
set padHeight 0
}
tixForm $data(w:label) -top 0 -left 4\
-padx [expr $data(-padx) +4] -pady $data(-pady)
tixForm $data(pw:border) -top $labHalfHeight -bottom -1 \
-left 0 -right -1 -padx $data(-padx) -pady $data(-pady)
tixForm $data(pw:pad) -left 0 -right -1 \
-top 0 -bottom $padHeight
tixForm $data(w:frame) -top $data(pw:pad) -bottom -1 \
-left 0 -right -1
}
proc tixLabelWidget:Pack-top {w} {
upvar #0 $w data
pack $data(w:label) -side top \
-padx $data(-padx) -pady $data(-pady) \
-fill x
pack $data(w:frame) -side top \
-padx $data(-padx) -pady $data(-pady) \
-expand yes -fill both
}
proc tixLabelWidget:Pack-bottom {w} {
upvar #0 $w data
pack $data(w:label) -side bottom \
-padx $data(-padx) -pady $data(-pady) \
-fill x
pack $data(w:frame) -side bottom \
-padx $data(-padx) -pady $data(-pady) \
-expand yes -fill both
}
proc tixLabelWidget:Pack-left {w} {
upvar #0 $w data
pack $data(w:label) -side left \
-padx $data(-padx) -pady $data(-pady) \
-fill y
pack $data(w:frame) -side left \
-padx $data(-padx) -pady $data(-pady) \
-expand yes -fill both
}
proc tixLabelWidget:Pack-right {w} {
upvar #0 $w data
pack $data(w:label) -side right \
-padx $data(-padx) -pady $data(-pady) \
-fill x
pack $data(w:frame) -side right \
-padx $data(-padx) -pady $data(-pady) \
-expand yes -fill both
}
proc tixLabelWidget:Pack-none {w} {
upvar #0 $w data
pack $data(w:frame)\
-padx $data(-padx) -pady $data(-pady) \
-expand yes -fill both
}
#----------------------------------------------------------------------
# CONFIG OPTIONS
#----------------------------------------------------------------------
proc tixLabelWidget:config-label {w value} {
upvar #0 $w data
$data(w:label) config -text $value
if {$data(-labelside) == "acrosstop"} {
tixLabelWidget:Pack-acrosstop $w
}
}
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: LabWidg.tcl,v 1.3 2001/12/09 05:04:02 idiscovery Exp $
#
# LabWidg.tcl --
#
# TixLabelWidget: Virtual base class. Do not instantiate
#
# This widget class is the base class for all widgets that has a
# label. Most Tix compound widgets will have a label so that
# the app programmer doesn't need to add labels themselvel.
#
#
# 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.
#
# LabelSide : top, left, right, bottom, none, acrosstop
#
# public widgets:
# frame, label
#
tixWidgetClass tixLabelWidget {
-superclass tixPrimitive
-classname TixLabelWidget
-flag {
-label -labelside -padx -pady
}
-static {-labelside}
-configspec {
{-label label Label ""}
{-labelside labelSide LabelSide left}
{-padx padX Pad 0}
{-pady padY Pad 0}
}
}
proc tixLabelWidget:ConstructWidget {w} {
upvar #0 $w data
tixChainMethod $w ConstructWidget
if {$data(-labelside) != "acrosstop"} {
set data(w:frame) [frame $w.frame]
} else {
set data(pw:border) [frame $w.border]
set data(pw:pad) [frame $w.border.pad]
set data(w:frame) [frame $w.border.frame]
}
if {$data(-labelside) != "none"} {
set data(w:label) [label $w.label -text $data(-label)]
}
tixLabelWidget:Pack $w
tixCallMethod $w ConstructFramedWidget $data(w:frame)
}
proc tixLabelWidget:ConstructFramedWidget {w frame} {
# Do nothing
}
proc tixLabelWidget:Pack {w} {
upvar #0 $w data
if {[catch {tixLabelWidget:Pack-$data(-labelside) $w}]} {
error "unknown -labelside option \"$data(-labelside)\""
}
}
proc tixLabelWidget:Pack-acrosstop {w} {
upvar #0 $w data
set labHalfHeight [expr [winfo reqheight $data(w:label)] / 2]
set padHeight [expr $labHalfHeight - [$data(pw:border) cget -bd]]
if {$padHeight < 0} {
set padHeight 0
}
tixForm $data(w:label) -top 0 -left 4\
-padx [expr $data(-padx) +4] -pady $data(-pady)
tixForm $data(pw:border) -top $labHalfHeight -bottom -1 \
-left 0 -right -1 -padx $data(-padx) -pady $data(-pady)
tixForm $data(pw:pad) -left 0 -right -1 \
-top 0 -bottom $padHeight
tixForm $data(w:frame) -top $data(pw:pad) -bottom -1 \
-left 0 -right -1
}
proc tixLabelWidget:Pack-top {w} {
upvar #0 $w data
pack $data(w:label) -side top \
-padx $data(-padx) -pady $data(-pady) \
-fill x
pack $data(w:frame) -side top \
-padx $data(-padx) -pady $data(-pady) \
-expand yes -fill both
}
proc tixLabelWidget:Pack-bottom {w} {
upvar #0 $w data
pack $data(w:label) -side bottom \
-padx $data(-padx) -pady $data(-pady) \
-fill x
pack $data(w:frame) -side bottom \
-padx $data(-padx) -pady $data(-pady) \
-expand yes -fill both
}
proc tixLabelWidget:Pack-left {w} {
upvar #0 $w data
pack $data(w:label) -side left \
-padx $data(-padx) -pady $data(-pady) \
-fill y
pack $data(w:frame) -side left \
-padx $data(-padx) -pady $data(-pady) \
-expand yes -fill both
}
proc tixLabelWidget:Pack-right {w} {
upvar #0 $w data
pack $data(w:label) -side right \
-padx $data(-padx) -pady $data(-pady) \
-fill x
pack $data(w:frame) -side right \
-padx $data(-padx) -pady $data(-pady) \
-expand yes -fill both
}
proc tixLabelWidget:Pack-none {w} {
upvar #0 $w data
pack $data(w:frame)\
-padx $data(-padx) -pady $data(-pady) \
-expand yes -fill both
}
#----------------------------------------------------------------------
# CONFIG OPTIONS
#----------------------------------------------------------------------
proc tixLabelWidget:config-label {w value} {
upvar #0 $w data
$data(w:label) config -text $value
if {$data(-labelside) == "acrosstop"} {
tixLabelWidget:Pack-acrosstop $w
}
}

306
amd64/lib/tix8.4.3/ListNBk.tcl
View File

@@ -1,153 +1,153 @@
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: ListNBk.tcl,v 1.5 2004/03/28 02:44:57 hobbs Exp $
#
# ListNBk.tcl --
#
# "List NoteBook" widget. Acts similarly to the notebook but uses a
# HList widget to represent the pages.
#
# 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 tixListNoteBook {
-classname TixListNoteBook
-superclass tixVStack
-method {
}
-flag {
-height -width
}
-configspec {
{-width width Width 0}
{-height height Height 0}
}
-forcecall {
-dynamicgeometry -width -height
}
-default {
{*Orientation horizontal}
}
}
proc tixListNoteBook:ConstructWidget {w} {
upvar #0 $w data
tixChainMethod $w ConstructWidget
set data(w_pane) [tixPanedWindow $w.pane -panerelief flat]
set p1 [$data(w_pane) add p1 -expand 0]
set p2 [$data(w_pane) add p2 -expand 1]
set data(w_p2) $p2
set data(w:shlist) [tixScrolledHList $p1.shlist]
set data(w:hlist) [$data(w:shlist) subwidget hlist]
if {[$data(w_pane) cget -orientation] eq "vertical"} {
pack $data(w:shlist) -expand yes -fill both -padx 2 -pady 3
} else {
pack $data(w:shlist) -expand yes -fill both -padx 3 -pady 2
}
$data(w:hlist) config \
-command [list tixListNoteBook:Choose $w] \
-browsecmd [list tixListNoteBook:Choose $w] \
-selectmode single
pack $data(w_pane) -expand yes -fill both
}
proc tixListNoteBook:add {w child args} {
upvar #0 $w data
if {[string match *.* $child]} {
error "the name of the page cannot contain the \".\" character"
}
return [eval tixChainMethod $w add $child $args]
}
#----------------------------------------------------------------------
# Virtual Methods
#----------------------------------------------------------------------
proc tixListNoteBook:InitGeometryManager {w} {
tixWidgetDoWhenIdle tixListNoteBook:InitialRaise $w
}
proc tixListNoteBook:InitialRaise {w} {
upvar #0 $w data
if {$data(topchild) eq ""} {
set top [lindex $data(windows) 0]
} else {
set top $data(topchild)
}
if {$top ne ""} {
tixCallMethod $w raise $top
}
}
proc tixListNoteBook:CreateChildFrame {w child} {
upvar #0 $w data
return [frame $data(w_p2).$child]
}
proc tixListNoteBook:RaiseChildFrame {w child} {
upvar #0 $w data
if {$data(topchild) ne $child} {
if {$data(topchild) ne ""} {
pack forget $data(w:$data(topchild))
}
pack $data(w:$child) -expand yes -fill both
}
}
#
#----------------------------------------------------------------------
#
proc tixListNoteBook:config-dynamicgeometry {w value} {
upvar #0 $w data
$data(w_pane) config -dynamicgeometry $value
}
proc tixListNoteBook:config-width {w value} {
upvar #0 $w data
if {$value != 0} {
$data(w_pane) config -width $value
}
}
proc tixListNoteBook:config-height {w value} {
upvar #0 $w data
if {$value != 0} {
$data(w_pane) config -height $value
}
}
proc tixListNoteBook:raise {w child} {
upvar #0 $w data
$data(w:hlist) selection clear
$data(w:hlist) selection set $child
$data(w:hlist) anchor set $child
tixChainMethod $w raise $child
}
proc tixListNoteBook:Choose {w args} {
upvar #0 $w data
set entry [tixEvent flag V]
if {[lsearch $data(windows) $entry] != -1} {
tixCallMethod $w raise $entry
}
}
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: ListNBk.tcl,v 1.5 2004/03/28 02:44:57 hobbs Exp $
#
# ListNBk.tcl --
#
# "List NoteBook" widget. Acts similarly to the notebook but uses a
# HList widget to represent the pages.
#
# 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 tixListNoteBook {
-classname TixListNoteBook
-superclass tixVStack
-method {
}
-flag {
-height -width
}
-configspec {
{-width width Width 0}
{-height height Height 0}
}
-forcecall {
-dynamicgeometry -width -height
}
-default {
{*Orientation horizontal}
}
}
proc tixListNoteBook:ConstructWidget {w} {
upvar #0 $w data
tixChainMethod $w ConstructWidget
set data(w_pane) [tixPanedWindow $w.pane -panerelief flat]
set p1 [$data(w_pane) add p1 -expand 0]
set p2 [$data(w_pane) add p2 -expand 1]
set data(w_p2) $p2
set data(w:shlist) [tixScrolledHList $p1.shlist]
set data(w:hlist) [$data(w:shlist) subwidget hlist]
if {[$data(w_pane) cget -orientation] eq "vertical"} {
pack $data(w:shlist) -expand yes -fill both -padx 2 -pady 3
} else {
pack $data(w:shlist) -expand yes -fill both -padx 3 -pady 2
}
$data(w:hlist) config \
-command [list tixListNoteBook:Choose $w] \
-browsecmd [list tixListNoteBook:Choose $w] \
-selectmode single
pack $data(w_pane) -expand yes -fill both
}
proc tixListNoteBook:add {w child args} {
upvar #0 $w data
if {[string match *.* $child]} {
error "the name of the page cannot contain the \".\" character"
}
return [eval tixChainMethod $w add $child $args]
}
#----------------------------------------------------------------------
# Virtual Methods
#----------------------------------------------------------------------
proc tixListNoteBook:InitGeometryManager {w} {
tixWidgetDoWhenIdle tixListNoteBook:InitialRaise $w
}
proc tixListNoteBook:InitialRaise {w} {
upvar #0 $w data
if {$data(topchild) eq ""} {
set top [lindex $data(windows) 0]
} else {
set top $data(topchild)
}
if {$top ne ""} {
tixCallMethod $w raise $top
}
}
proc tixListNoteBook:CreateChildFrame {w child} {
upvar #0 $w data
return [frame $data(w_p2).$child]
}
proc tixListNoteBook:RaiseChildFrame {w child} {
upvar #0 $w data
if {$data(topchild) ne $child} {
if {$data(topchild) ne ""} {
pack forget $data(w:$data(topchild))
}
pack $data(w:$child) -expand yes -fill both
}
}
#
#----------------------------------------------------------------------
#
proc tixListNoteBook:config-dynamicgeometry {w value} {
upvar #0 $w data
$data(w_pane) config -dynamicgeometry $value
}
proc tixListNoteBook:config-width {w value} {
upvar #0 $w data
if {$value != 0} {
$data(w_pane) config -width $value
}
}
proc tixListNoteBook:config-height {w value} {
upvar #0 $w data
if {$value != 0} {
$data(w_pane) config -height $value
}
}
proc tixListNoteBook:raise {w child} {
upvar #0 $w data
$data(w:hlist) selection clear
$data(w:hlist) selection set $child
$data(w:hlist) anchor set $child
tixChainMethod $w raise $child
}
proc tixListNoteBook:Choose {w args} {
upvar #0 $w data
set entry [tixEvent flag V]
if {[lsearch $data(windows) $entry] != -1} {
tixCallMethod $w raise $entry
}
}

274
amd64/lib/tix8.4.3/Meter.tcl
View File

@@ -1,137 +1,137 @@
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: Meter.tcl,v 1.3 2001/12/09 05:04:02 idiscovery Exp $
#
# Meter.tcl --
#
# Implements the tixMeter 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.
#
tixWidgetClass tixMeter {
-classname TixMeter
-superclass tixPrimitive
-method {
}
-flag {
-foreground -text -value
}
-configspec {
{-fillcolor fillColor FillColor #8080ff}
{-foreground foreground Foreground black}
{-text text Text ""}
{-value value Value 0}
}
-default {
{.relief sunken}
{.borderWidth 2}
{.width 150}
}
}
proc tixMeter:InitWidgetRec {w} {
upvar #0 $w data
global env
tixChainMethod $w InitWidgetRec
}
#----------------------------------------------------------------------
# Construct widget
#----------------------------------------------------------------------
proc tixMeter:ConstructWidget {w} {
upvar #0 $w data
tixChainMethod $w ConstructWidget
set data(w:canvas) [canvas $w.canvas]
pack $data(w:canvas) -expand yes -fill both
tixMeter:Update $w
}
proc tixMeter:SetBindings {w} {
upvar #0 $w data
tixChainMethod $w SetBindings
}
proc tixMeter:Update {w} {
upvar #0 $w data
# set the width of the canvas
set W [expr $data(-width)-\
([$data(w:root) cget -bd]+[$data(w:root) cget -highlightthickness]*2)]
$data(w:canvas) config -width $W
if {$data(-text) == ""} {
set text [format "%d%%" [expr int($data(-value)*100)]]
} else {
set text $data(-text)
}
# (Create/Modify) the text item.
#
if {![info exists data(text)]} {
set data(text) [$data(w:canvas) create text 0 0 -text $text]
} else {
$data(w:canvas) itemconfig $data(text) -text $text
}
set bbox [$data(w:canvas) bbox $data(text)]
set itemW [expr [lindex $bbox 2]-[lindex $bbox 0]]
set itemH [expr [lindex $bbox 3]-[lindex $bbox 1]]
$data(w:canvas) coord $data(text) [expr $W/2] [expr $itemH/2+4]
set H [expr $itemH + 4]
$data(w:canvas) config -height [expr $H]
set rectW [expr int($W*$data(-value))]
if {![info exists data(rect)]} {
set data(rect) [$data(w:canvas) create rectangle 0 0 $rectW 1000]
} else {
$data(w:canvas) coord $data(rect) 0 0 $rectW 1000
}
$data(w:canvas) itemconfig $data(rect) \
-fill $data(-fillcolor) -outline $data(-fillcolor)
$data(w:canvas) raise $data(text)
}
#----------------------------------------------------------------------
# Configuration
#----------------------------------------------------------------------
proc tixMeter:config-value {w value} {
upvar #0 $w data
set data(-value) $value
tixMeter:Update $w
}
proc tixMeter:config-text {w value} {
upvar #0 $w data
set data(-text) $value
tixMeter:Update $w
}
proc tixMeter:config-fillcolor {w value} {
upvar #0 $w data
set data(-fillcolor) $value
tixMeter:Update $w
}
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: Meter.tcl,v 1.3 2001/12/09 05:04:02 idiscovery Exp $
#
# Meter.tcl --
#
# Implements the tixMeter 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.
#
tixWidgetClass tixMeter {
-classname TixMeter
-superclass tixPrimitive
-method {
}
-flag {
-foreground -text -value
}
-configspec {
{-fillcolor fillColor FillColor #8080ff}
{-foreground foreground Foreground black}
{-text text Text ""}
{-value value Value 0}
}
-default {
{.relief sunken}
{.borderWidth 2}
{.width 150}
}
}
proc tixMeter:InitWidgetRec {w} {
upvar #0 $w data
global env
tixChainMethod $w InitWidgetRec
}
#----------------------------------------------------------------------
# Construct widget
#----------------------------------------------------------------------
proc tixMeter:ConstructWidget {w} {
upvar #0 $w data
tixChainMethod $w ConstructWidget
set data(w:canvas) [canvas $w.canvas]
pack $data(w:canvas) -expand yes -fill both
tixMeter:Update $w
}
proc tixMeter:SetBindings {w} {
upvar #0 $w data
tixChainMethod $w SetBindings
}
proc tixMeter:Update {w} {
upvar #0 $w data
# set the width of the canvas
set W [expr $data(-width)-\
([$data(w:root) cget -bd]+[$data(w:root) cget -highlightthickness]*2)]
$data(w:canvas) config -width $W
if {$data(-text) == ""} {
set text [format "%d%%" [expr int($data(-value)*100)]]
} else {
set text $data(-text)
}
# (Create/Modify) the text item.
#
if {![info exists data(text)]} {
set data(text) [$data(w:canvas) create text 0 0 -text $text]
} else {
$data(w:canvas) itemconfig $data(text) -text $text
}
set bbox [$data(w:canvas) bbox $data(text)]
set itemW [expr [lindex $bbox 2]-[lindex $bbox 0]]
set itemH [expr [lindex $bbox 3]-[lindex $bbox 1]]
$data(w:canvas) coord $data(text) [expr $W/2] [expr $itemH/2+4]
set H [expr $itemH + 4]
$data(w:canvas) config -height [expr $H]
set rectW [expr int($W*$data(-value))]
if {![info exists data(rect)]} {
set data(rect) [$data(w:canvas) create rectangle 0 0 $rectW 1000]
} else {
$data(w:canvas) coord $data(rect) 0 0 $rectW 1000
}
$data(w:canvas) itemconfig $data(rect) \
-fill $data(-fillcolor) -outline $data(-fillcolor)
$data(w:canvas) raise $data(text)
}
#----------------------------------------------------------------------
# Configuration
#----------------------------------------------------------------------
proc tixMeter:config-value {w value} {
upvar #0 $w data
set data(-value) $value
tixMeter:Update $w
}
proc tixMeter:config-text {w value} {
upvar #0 $w data
set data(-text) $value
tixMeter:Update $w
}
proc tixMeter:config-fillcolor {w value} {
upvar #0 $w data
set data(-fillcolor) $value
tixMeter:Update $w
}

314
amd64/lib/tix8.4.3/MultView.tcl
View File

@@ -1,157 +1,157 @@
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: MultView.tcl,v 1.3 2001/12/09 05:04:02 idiscovery Exp $
#
# MultView.tcl --
#
# Implements the multi-view 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.
#
tixWidgetClass tixMultiView {
-classname TixMultiView
-superclass tixPrimitive
-method {
add
}
-flag {
-browsecmd -command -view
}
-forcecall {
-view
}
-configspec {
{-browsecmd browseCmd BrowseCmd ""}
{-command command Command ""}
{-view view View icon tixMultiView:VerifyView}
}
-alias {
}
-default {
}
}
proc tixMultiView:InitWidgetRec {w} {
upvar #0 $w data
global env
tixChainMethod $w InitWidgetRec
}
#----------------------------------------------------------------------
# Construct widget
#----------------------------------------------------------------------
proc tixMultiView:ConstructWidget {w} {
upvar #0 $w data
tixChainMethod $w ConstructWidget
set data(w:stlist) [tixScrolledTList $w.stlist]
set data(w:sgrid) [tixScrolledGrid $w.sgrid]
set data(w:icon) [tixIconView $w.icon]
set data(w:tlist) [$data(w:stlist) subwidget tlist]
set data(w:grid) [$data(w:sgrid) subwidget grid]
$data(w:grid) config -formatcmd [list tixMultiView:GridFormat $w] \
-leftmargin 0 -topmargin 1
}
proc tixMultiView:SetBindings {w} {
upvar #0 $w data
tixChainMethod $w SetBindings
}
proc tixMultiView:GetWid {w which} {
upvar #0 $w data
case $which {
list {
return $data(w:stlist)
}
icon {
return $data(w:icon)
}
detail {
return $data(w:sgrid)
}
}
}
#----------------------------------------------------------------------
# Configuration
#----------------------------------------------------------------------
proc tixMultiView:config-view {w value} {
upvar #0 $w data
if {$data(-view) != ""} {
pack forget [tixMultiView:GetWid $w $data(-view)]
}
pack [tixMultiView:GetWid $w $value] -expand yes -fill both
}
#----------------------------------------------------------------------
# Private methods
#----------------------------------------------------------------------
proc tixMultiView:GridFormat {w area x1 y1 x2 y2} {
upvar #0 $w data
case $area {
main {
}
{x-margin y-margin s-margin} {
# cborder specifies consecutive 3d borders
#
$data(w:grid) format cborder $x1 $y1 $x2 $y2 \
-fill 1 -relief raised -bd 2 -bg gray60 \
-selectbackground gray80
}
}
}
#----------------------------------------------------------------------
# Public methods
#----------------------------------------------------------------------
# Return value is the index of "$name" in the grid subwidget
#
#
proc tixMultiView:add {w name args} {
upvar #0 $w data
set validOptions {-image -text}
set opt(-image) ""
set opt(-text) ""
tixHandleOptions -nounknown opt $validOptions $args
$data(w:icon) add $name $opt(-image) $opt(-text)
$data(w:tlist) insert end -itemtype imagetext \
-image $opt(-image) -text $opt(-text)
$data(w:grid) set 0 end -itemtype imagetext \
-image $opt(-image) -text $opt(-text)
return max
}
#----------------------------------------------------------------------
# checker
#----------------------------------------------------------------------
proc tixMultiView:VerifyView {value} {
case $value {
{icon list detail} {
return $value
}
}
error "bad view \"$value\", must be detail, icon or list"
}
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: MultView.tcl,v 1.3 2001/12/09 05:04:02 idiscovery Exp $
#
# MultView.tcl --
#
# Implements the multi-view 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.
#
tixWidgetClass tixMultiView {
-classname TixMultiView
-superclass tixPrimitive
-method {
add
}
-flag {
-browsecmd -command -view
}
-forcecall {
-view
}
-configspec {
{-browsecmd browseCmd BrowseCmd ""}
{-command command Command ""}
{-view view View icon tixMultiView:VerifyView}
}
-alias {
}
-default {
}
}
proc tixMultiView:InitWidgetRec {w} {
upvar #0 $w data
global env
tixChainMethod $w InitWidgetRec
}
#----------------------------------------------------------------------
# Construct widget
#----------------------------------------------------------------------
proc tixMultiView:ConstructWidget {w} {
upvar #0 $w data
tixChainMethod $w ConstructWidget
set data(w:stlist) [tixScrolledTList $w.stlist]
set data(w:sgrid) [tixScrolledGrid $w.sgrid]
set data(w:icon) [tixIconView $w.icon]
set data(w:tlist) [$data(w:stlist) subwidget tlist]
set data(w:grid) [$data(w:sgrid) subwidget grid]
$data(w:grid) config -formatcmd [list tixMultiView:GridFormat $w] \
-leftmargin 0 -topmargin 1
}
proc tixMultiView:SetBindings {w} {
upvar #0 $w data
tixChainMethod $w SetBindings
}
proc tixMultiView:GetWid {w which} {
upvar #0 $w data
case $which {
list {
return $data(w:stlist)
}
icon {
return $data(w:icon)
}
detail {
return $data(w:sgrid)
}
}
}
#----------------------------------------------------------------------
# Configuration
#----------------------------------------------------------------------
proc tixMultiView:config-view {w value} {
upvar #0 $w data
if {$data(-view) != ""} {
pack forget [tixMultiView:GetWid $w $data(-view)]
}
pack [tixMultiView:GetWid $w $value] -expand yes -fill both
}
#----------------------------------------------------------------------
# Private methods
#----------------------------------------------------------------------
proc tixMultiView:GridFormat {w area x1 y1 x2 y2} {
upvar #0 $w data
case $area {
main {
}
{x-margin y-margin s-margin} {
# cborder specifies consecutive 3d borders
#
$data(w:grid) format cborder $x1 $y1 $x2 $y2 \
-fill 1 -relief raised -bd 2 -bg gray60 \
-selectbackground gray80
}
}
}
#----------------------------------------------------------------------
# Public methods
#----------------------------------------------------------------------
# Return value is the index of "$name" in the grid subwidget
#
#
proc tixMultiView:add {w name args} {
upvar #0 $w data
set validOptions {-image -text}
set opt(-image) ""
set opt(-text) ""
tixHandleOptions -nounknown opt $validOptions $args
$data(w:icon) add $name $opt(-image) $opt(-text)
$data(w:tlist) insert end -itemtype imagetext \
-image $opt(-image) -text $opt(-text)
$data(w:grid) set 0 end -itemtype imagetext \
-image $opt(-image) -text $opt(-text)
return max
}
#----------------------------------------------------------------------
# checker
#----------------------------------------------------------------------
proc tixMultiView:VerifyView {value} {
case $value {
{icon list detail} {
return $value
}
}
error "bad view \"$value\", must be detail, icon or list"
}

494
amd64/lib/tix8.4.3/NoteBook.tcl
View File

@@ -1,247 +1,247 @@
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: NoteBook.tcl,v 1.7 2004/03/28 02:44:57 hobbs Exp $
#
# NoteBook.tcl --
#
# tixNoteBook: NoteBook type of window.
#
# 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 tixNoteBook {
-classname TixNoteBook
-superclass tixVStack
-method {
}
-flag {
}
-configspec {
{-takefocus takeFocus TakeFocus 0 tixVerifyBoolean}
}
-default {
{.nbframe.tabPadX 8}
{.nbframe.tabPadY 5}
{.nbframe.borderWidth 2}
{*nbframe.relief raised}
}
}
proc tixNoteBook:InitWidgetRec {w} {
upvar #0 $w data
tixChainMethod $w InitWidgetRec
set data(pad-x1) 0
set data(pad-x2) 0
set data(pad-y1) 20
set data(pad-y2) 0
}
proc tixNoteBook:ConstructWidget {w} {
upvar #0 $w data
tixChainMethod $w ConstructWidget
set data(w:top) [tixNoteBookFrame $w.nbframe -slave 1 -takefocus 1]
set data(w:nbframe) $data(w:top)
bind $data(w:top) <ButtonPress-1> [list tixNoteBook:MouseDown $w %x %y]
bind $data(w:top) <ButtonRelease-1> [list tixNoteBook:MouseUp $w %x %y]
bind $data(w:top) <B1-Motion> [list tixNoteBook:MouseDown $w %x %y]
bind $data(w:top) <Left> [list tixNoteBook:FocusNext $w prev]
bind $data(w:top) <Right> [list tixNoteBook:FocusNext $w next]
bind $data(w:top) <Return> [list tixNoteBook:SetFocusByKey $w]
bind $data(w:top) <space> [list tixNoteBook:SetFocusByKey $w]
}
#----------------------------------------------------------------------
# Public methods
#----------------------------------------------------------------------
proc tixNoteBook:add {w child args} {
upvar #0 $w data
set ret [eval tixChainMethod $w add $child $args]
set new_args ""
foreach {flag value} $args {
if {$flag ne "-createcmd" && $flag ne "-raisecmd"} {
lappend new_args $flag
lappend new_args $value
}
}
eval [linsert $new_args 0 $data(w:top) add $child]
return $ret
}
proc tixNoteBook:raise {w child} {
upvar #0 $w data
tixChainMethod $w raise $child
if {[$data(w:top) pagecget $child -state] eq "normal"} {
$data(w:top) activate $child
}
}
proc tixNoteBook:delete {w child} {
upvar #0 $w data
tixChainMethod $w delete $child
$data(w:top) delete $child
}
#----------------------------------------------------------------------
# Private methods
#----------------------------------------------------------------------
proc tixNoteBook:Resize {w} {
upvar #0 $w data
# We have to take care of the size of the tabs so that
#
set rootReq [$data(w:top) geometryinfo]
set tW [lindex $rootReq 0]
set tH [lindex $rootReq 1]
set data(pad-x1) 2
set data(pad-x2) 2
set data(pad-y1) [expr {$tH + $data(-ipadx) + 1}]
set data(pad-y2) 2
set data(minW) [expr {$tW}]
set data(minH) [expr {$tH}]
# Now that we know data(pad-y1), we can chain the call
#
tixChainMethod $w Resize
}
proc tixNoteBook:MouseDown {w x y} {
upvar #0 $w data
focus $data(w:top)
set name [$data(w:top) identify $x $y]
$data(w:top) focus $name
set data(w:down) $name
}
proc tixNoteBook:MouseUp {w x y} {
upvar #0 $w data
#it could happen (using the tk/menu) that a MouseUp
#proceeds without a MouseDown event!!
if {![info exists data(w:down)] || ![info exists data(w:top)]} {
return
}
set name [$data(w:top) identify $x $y]
if {$name ne "" && $name eq $data(w:down)
&& [$data(w:top) pagecget $name -state] eq "normal"} {
$data(w:top) activate $name
tixCallMethod $w raise $name
} else {
$data(w:top) focus ""
}
}
#----------------------------------------------------------------------
#
# Section for keyboard bindings
#
#----------------------------------------------------------------------
proc tixNoteBook:FocusNext {w dir} {
upvar #0 $w data
if {[$data(w:top) info focus] == ""} {
set name [$data(w:top) info active]
$data(w:top) focus $name
if {$name ne ""} {
return
}
} else {
set name [$data(w:top) info focus$dir]
$data(w:top) focus $name
}
}
proc tixNoteBook:SetFocusByKey {w} {
upvar #0 $w data
set name [$data(w:top) info focus]
if {$name ne "" && [$data(w:top) pagecget $name -state] eq "normal"} {
tixCallMethod $w raise $name
$data(w:top) activate $name
}
}
#----------------------------------------------------------------------
# Automatic bindings for alt keys
#----------------------------------------------------------------------
proc tixNoteBookFind {w char} {
set char [string tolower $char]
foreach child [winfo child $w] {
if {![winfo ismapped $w]} {
continue
}
switch -exact -- [winfo class $child] {
Toplevel { continue }
TixNoteBook {
set nbframe [$child subwidget nbframe]
foreach page [$nbframe info pages] {
set char2 [string index [$nbframe pagecget $page -label] \
[$nbframe pagecget $page -underline]]
if {($char eq [string tolower $char2] || $char eq "")
&& [$nbframe pagecget $page -state] ne "disabled"} {
return [list $child $page]
}
}
}
}
# Well, this notebook doesn't match with the key, but maybe
# it contains a "subnotebook" that will match ..
set match [tixNoteBookFind $child $char]
if {$match ne ""} {
return $match
}
}
return ""
}
proc tixTraverseToNoteBook {w char} {
if {$char eq ""} {
return 0
}
if {![winfo exists $w]} {
return 0
}
set list [tixNoteBookFind [winfo toplevel $w] $char]
if {$list ne ""} {
[lindex $list 0] raise [lindex $list 1]
return 1
}
return 0
}
#----------------------------------------------------------------------
# Set default class bindings
#----------------------------------------------------------------------
bind all <Alt-KeyPress> "+tixTraverseToNoteBook %W %A"
bind all <Meta-KeyPress> "+tixTraverseToNoteBook %W %A"
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: NoteBook.tcl,v 1.7 2004/03/28 02:44:57 hobbs Exp $
#
# NoteBook.tcl --
#
# tixNoteBook: NoteBook type of window.
#
# 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 tixNoteBook {
-classname TixNoteBook
-superclass tixVStack
-method {
}
-flag {
}
-configspec {
{-takefocus takeFocus TakeFocus 0 tixVerifyBoolean}
}
-default {
{.nbframe.tabPadX 8}
{.nbframe.tabPadY 5}
{.nbframe.borderWidth 2}
{*nbframe.relief raised}
}
}
proc tixNoteBook:InitWidgetRec {w} {
upvar #0 $w data
tixChainMethod $w InitWidgetRec
set data(pad-x1) 0
set data(pad-x2) 0
set data(pad-y1) 20
set data(pad-y2) 0
}
proc tixNoteBook:ConstructWidget {w} {
upvar #0 $w data
tixChainMethod $w ConstructWidget
set data(w:top) [tixNoteBookFrame $w.nbframe -slave 1 -takefocus 1]
set data(w:nbframe) $data(w:top)
bind $data(w:top) <ButtonPress-1> [list tixNoteBook:MouseDown $w %x %y]
bind $data(w:top) <ButtonRelease-1> [list tixNoteBook:MouseUp $w %x %y]
bind $data(w:top) <B1-Motion> [list tixNoteBook:MouseDown $w %x %y]
bind $data(w:top) <Left> [list tixNoteBook:FocusNext $w prev]
bind $data(w:top) <Right> [list tixNoteBook:FocusNext $w next]
bind $data(w:top) <Return> [list tixNoteBook:SetFocusByKey $w]
bind $data(w:top) <space> [list tixNoteBook:SetFocusByKey $w]
}
#----------------------------------------------------------------------
# Public methods
#----------------------------------------------------------------------
proc tixNoteBook:add {w child args} {
upvar #0 $w data
set ret [eval tixChainMethod $w add $child $args]
set new_args ""
foreach {flag value} $args {
if {$flag ne "-createcmd" && $flag ne "-raisecmd"} {
lappend new_args $flag
lappend new_args $value
}
}
eval [linsert $new_args 0 $data(w:top) add $child]
return $ret
}
proc tixNoteBook:raise {w child} {
upvar #0 $w data
tixChainMethod $w raise $child
if {[$data(w:top) pagecget $child -state] eq "normal"} {
$data(w:top) activate $child
}
}
proc tixNoteBook:delete {w child} {
upvar #0 $w data
tixChainMethod $w delete $child
$data(w:top) delete $child
}
#----------------------------------------------------------------------
# Private methods
#----------------------------------------------------------------------
proc tixNoteBook:Resize {w} {
upvar #0 $w data
# We have to take care of the size of the tabs so that
#
set rootReq [$data(w:top) geometryinfo]
set tW [lindex $rootReq 0]
set tH [lindex $rootReq 1]
set data(pad-x1) 2
set data(pad-x2) 2
set data(pad-y1) [expr {$tH + $data(-ipadx) + 1}]
set data(pad-y2) 2
set data(minW) [expr {$tW}]
set data(minH) [expr {$tH}]
# Now that we know data(pad-y1), we can chain the call
#
tixChainMethod $w Resize
}
proc tixNoteBook:MouseDown {w x y} {
upvar #0 $w data
focus $data(w:top)
set name [$data(w:top) identify $x $y]
$data(w:top) focus $name
set data(w:down) $name
}
proc tixNoteBook:MouseUp {w x y} {
upvar #0 $w data
#it could happen (using the tk/menu) that a MouseUp
#proceeds without a MouseDown event!!
if {![info exists data(w:down)] || ![info exists data(w:top)]} {
return
}
set name [$data(w:top) identify $x $y]
if {$name ne "" && $name eq $data(w:down)
&& [$data(w:top) pagecget $name -state] eq "normal"} {
$data(w:top) activate $name
tixCallMethod $w raise $name
} else {
$data(w:top) focus ""
}
}
#----------------------------------------------------------------------
#
# Section for keyboard bindings
#
#----------------------------------------------------------------------
proc tixNoteBook:FocusNext {w dir} {
upvar #0 $w data
if {[$data(w:top) info focus] == ""} {
set name [$data(w:top) info active]
$data(w:top) focus $name
if {$name ne ""} {
return
}
} else {
set name [$data(w:top) info focus$dir]
$data(w:top) focus $name
}
}
proc tixNoteBook:SetFocusByKey {w} {
upvar #0 $w data
set name [$data(w:top) info focus]
if {$name ne "" && [$data(w:top) pagecget $name -state] eq "normal"} {
tixCallMethod $w raise $name
$data(w:top) activate $name
}
}
#----------------------------------------------------------------------
# Automatic bindings for alt keys
#----------------------------------------------------------------------
proc tixNoteBookFind {w char} {
set char [string tolower $char]
foreach child [winfo child $w] {
if {![winfo ismapped $w]} {
continue
}
switch -exact -- [winfo class $child] {
Toplevel { continue }
TixNoteBook {
set nbframe [$child subwidget nbframe]
foreach page [$nbframe info pages] {
set char2 [string index [$nbframe pagecget $page -label] \
[$nbframe pagecget $page -underline]]
if {($char eq [string tolower $char2] || $char eq "")
&& [$nbframe pagecget $page -state] ne "disabled"} {
return [list $child $page]
}
}
}
}
# Well, this notebook doesn't match with the key, but maybe
# it contains a "subnotebook" that will match ..
set match [tixNoteBookFind $child $char]
if {$match ne ""} {
return $match
}
}
return ""
}
proc tixTraverseToNoteBook {w char} {
if {$char eq ""} {
return 0
}
if {![winfo exists $w]} {
return 0
}
set list [tixNoteBookFind [winfo toplevel $w] $char]
if {$list ne ""} {
[lindex $list 0] raise [lindex $list 1]
return 1
}
return 0
}
#----------------------------------------------------------------------
# Set default class bindings
#----------------------------------------------------------------------
bind all <Alt-KeyPress> "+tixTraverseToNoteBook %W %A"
bind all <Meta-KeyPress> "+tixTraverseToNoteBook %W %A"

216
amd64/lib/tix8.4.3/OldUtil.tcl
View File

@@ -1,108 +1,108 @@
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: OldUtil.tcl,v 1.5 2004/03/28 02:44:57 hobbs Exp $
#
# OldUtil.tcl -
#
# This is an undocumented file.
# Are these features used in Tix : NO.
# Should I use these features : NO.
#
# 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.
#
proc setenv {name args} {
global env
if {[llength $args] == 1} {
return [set env($name) [lindex $args 0]]
} else {
if {[info exists env($ename)] == 0} {
bgerror "Error in setenv: "
"environment variable \"$name\" does not exist"
} else {
return $env($name)
}
}
}
#----------------------------------------------------------------------
#
#
# U T I L I T Y F U N C T I O N S F O R T I X
#
#
#----------------------------------------------------------------------
# RESET THE STRING IN THE ENTRY
proc tixSetEntry {entry string} {
set oldstate [lindex [$entry config -state] 4]
$entry config -state normal
$entry delete 0 end
$entry insert 0 $string
$entry config -state $oldstate
}
# GET THE FIRST SELECTED ITEM IN A LIST
proc tixListGetSingle {lst} {
set indices [$lst curselection]
if {$indices != ""} {
return [$lst get [lindex $indices 0]]
} else {
return ""
}
}
#----------------------------------------------------------------------
# RECORD A DIALOG'S POSITION AND RESTORE IT THE NEXT TIME IT IS OPENED
#----------------------------------------------------------------------
proc tixDialogRestore {w {flag -geometry}} {
global tixDPos
if {[info exists tixDPos($w)]} {
if {![winfo ismapped $w]} {
wm geometry $w $tixDPos($w)
wm deiconify $w
}
} elseif {$flag eq "-geometry"} {
update
set tixDPos($w) [winfo geometry $w]
} else {
update
set tixDPos($w) +[winfo rootx $w]+[winfo rooty $w]
}
}
#----------------------------------------------------------------------
# RECORD A DIALOG'S POSITION AND RESTORE IT THE NEXT TIME IT IS OPENED
#----------------------------------------------------------------------
proc tixDialogWithdraw {w {flag -geometry}} {
global tixDPos
if {[winfo ismapped $w]} {
if {$flag eq "-geometry"} {
set tixDPos($w) [winfo geometry $w]
} else {
set tixDPos($w) +[winfo rootx $w]+[winfo rooty $w]
}
wm withdraw $w
}
}
#----------------------------------------------------------------------
# RECORD A DIALOG'S POSITION AND RESTORE IT THE NEXT TIME IT IS OPENED
#----------------------------------------------------------------------
proc tixDialogDestroy {w {flag -geometry}} {
global tixDPos
if {[winfo ismapped $w]} {
if {$flag eq "-geometry"} {
set tixDPos($w) [winfo geometry $w]
} else {
set tixDPos($w) +[winfo rootx $w]+[winfo rooty $w]
}
}
destroy $w
}
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: OldUtil.tcl,v 1.5 2004/03/28 02:44:57 hobbs Exp $
#
# OldUtil.tcl -
#
# This is an undocumented file.
# Are these features used in Tix : NO.
# Should I use these features : NO.
#
# 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.
#
proc setenv {name args} {
global env
if {[llength $args] == 1} {
return [set env($name) [lindex $args 0]]
} else {
if {[info exists env($ename)] == 0} {
bgerror "Error in setenv: "
"environment variable \"$name\" does not exist"
} else {
return $env($name)
}
}
}
#----------------------------------------------------------------------
#
#
# U T I L I T Y F U N C T I O N S F O R T I X
#
#
#----------------------------------------------------------------------
# RESET THE STRING IN THE ENTRY
proc tixSetEntry {entry string} {
set oldstate [lindex [$entry config -state] 4]
$entry config -state normal
$entry delete 0 end
$entry insert 0 $string
$entry config -state $oldstate
}
# GET THE FIRST SELECTED ITEM IN A LIST
proc tixListGetSingle {lst} {
set indices [$lst curselection]
if {$indices != ""} {
return [$lst get [lindex $indices 0]]
} else {
return ""
}
}
#----------------------------------------------------------------------
# RECORD A DIALOG'S POSITION AND RESTORE IT THE NEXT TIME IT IS OPENED
#----------------------------------------------------------------------
proc tixDialogRestore {w {flag -geometry}} {
global tixDPos
if {[info exists tixDPos($w)]} {
if {![winfo ismapped $w]} {
wm geometry $w $tixDPos($w)
wm deiconify $w
}
} elseif {$flag eq "-geometry"} {
update
set tixDPos($w) [winfo geometry $w]
} else {
update
set tixDPos($w) +[winfo rootx $w]+[winfo rooty $w]
}
}
#----------------------------------------------------------------------
# RECORD A DIALOG'S POSITION AND RESTORE IT THE NEXT TIME IT IS OPENED
#----------------------------------------------------------------------
proc tixDialogWithdraw {w {flag -geometry}} {
global tixDPos
if {[winfo ismapped $w]} {
if {$flag eq "-geometry"} {
set tixDPos($w) [winfo geometry $w]
} else {
set tixDPos($w) +[winfo rootx $w]+[winfo rooty $w]
}
wm withdraw $w
}
}
#----------------------------------------------------------------------
# RECORD A DIALOG'S POSITION AND RESTORE IT THE NEXT TIME IT IS OPENED
#----------------------------------------------------------------------
proc tixDialogDestroy {w {flag -geometry}} {
global tixDPos
if {[winfo ismapped $w]} {
if {$flag eq "-geometry"} {
set tixDPos($w) [winfo geometry $w]
} else {
set tixDPos($w) +[winfo rootx $w]+[winfo rooty $w]
}
}
destroy $w
}

788
amd64/lib/tix8.4.3/OptMenu.tcl
View File

@@ -1,394 +1,394 @@
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: OptMenu.tcl,v 1.3 2001/12/09 05:04:02 idiscovery Exp $
#
# OptMenu.tcl --
#
# This file implements the TixOptionMenu 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.
#
tixWidgetClass tixOptionMenu {
-classname TixOptionMenu
-superclass tixLabelWidget
-method {
add delete disable enable entrycget entryconfigure entries
}
-flag {
-command -disablecallback -dynamicgeometry -value -variable
-validatecmd -state
}
-forcecall {
-variable -state
}
-configspec {
{-command command Command ""}
{-disablecallback disableCallback DisableCallback 0 tixVerifyBoolean}
{-dynamicgeometry dynamicGeometry DynamicGeometry 0 tixVerifyBoolean}
{-state state State normal}
{-value value Value ""}
{-validatecmd validateCmd ValidateCmd ""}
{-variable variable Variable ""}
}
-default {
{.highlightThickness 0}
{.takeFocus 0}
{.frame.menubutton.relief raised}
{.frame.menubutton.borderWidth 2}
{.frame.menubutton.anchor w}
{.frame.menubutton.highlightThickness 2}
{.frame.menubutton.takeFocus 1}
}
}
proc tixOptionMenu:InitWidgetRec {w} {
upvar #0 $w data
tixChainMethod $w InitWidgetRec
set data(nItems) 0
set data(items) ""
set data(posted) 0
set data(varInited) 0
set data(maxWidth) 0
}
proc tixOptionMenu:ConstructFramedWidget {w frame} {
upvar #0 $w data
tixChainMethod $w ConstructFramedWidget $frame
set data(w:menubutton) [menubutton $frame.menubutton -indicatoron 1]
set data(w:menu) [menu $frame.menubutton.menu -tearoff 0]
pack $data(w:menubutton) -side left -expand yes -fill both
$data(w:menubutton) config -menu $data(w:menu)
bind $data(w:menubutton) <Up> [bind Menubutton <space>]
bind $data(w:menubutton) <Down> [bind Menubutton <space>]
tixSetMegaWidget $data(w:menubutton) $w
}
proc tixOptionMenu:SetBindings {w} {
upvar #0 $w data
tixChainMethod $w SetBindings
}
#----------------------------------------------------------------------
# Private methods
#----------------------------------------------------------------------
proc tixOptionMenu:Invoke {w name} {
upvar #0 $w data
if {"$data(-state)" == "normal"} {
tixOptionMenu:SetValue $w $name
}
}
proc tixOptionMenu:SetValue {w value {noUpdate 0}} {
upvar #0 $w data
if {$data(-validatecmd) != ""} {
set value [tixEvalCmdBinding $w $data(-validatecmd) "" $value]
}
set name $value
if {$name == "" || [info exists data(varInited)]} {
# variable may contain a bogus value
if {![info exists data($name,index)]} {
set data(-value) ""
tixVariable:UpdateVariable $w
$data(w:menubutton) config -text ""
return
}
}
if {[info exists data($name,index)]} {
$data(w:menubutton) config -text $data($name,label)
set data(-value) $value
if {! $noUpdate} {
tixVariable:UpdateVariable $w
}
if {$data(-command) != "" && !$data(-disablecallback)} {
if {![info exists data(varInited)]} {
set bind(specs) ""
tixEvalCmdBinding $w $data(-command) bind $value
}
}
} else {
error "item \"$value\" does not exist"
}
}
proc tixOptionMenu:SetMaxWidth {w} {
upvar #0 $w data
foreach name $data(items) {
set len [string length $data($name,label)]
if {$data(maxWidth) < $len} {
set data(maxWidth) $len
}
}
if {$data(maxWidth) > 0} {
$data(w:menubutton) config -width $data(maxWidth)
}
}
#----------------------------------------------------------------------
# Configuration
#----------------------------------------------------------------------
proc tixOptionMenu:config-state {w value} {
upvar #0 $w data
if {![info exists data(w:label)]} {
return
}
if {$value == "normal"} {
catch {
$data(w:label) config -fg \
[$data(w:menubutton) cget -foreground]
}
$data(w:menubutton) config -state $value
} else {
catch {
$data(w:label) config -fg \
[$data(w:menubutton) cget -disabledforeground]
}
$data(w:menubutton) config -state $value
}
}
proc tixOptionMenu:config-value {w value} {
upvar #0 $w data
tixOptionMenu:SetValue $w $value
# This will tell the Intrinsics: "Please use this value"
# because "value" might be altered by SetValues
#
return $data(-value)
}
proc tixOptionMenu:config-variable {w arg} {
upvar #0 $w data
if {[tixVariable:ConfigVariable $w $arg]} {
# The value of data(-value) is changed if tixVariable:ConfigVariable
# returns true
tixOptionMenu:SetValue $w $data(-value) 1
}
catch {
unset data(varInited)
}
set data(-variable) $arg
}
#----------------------------------------------------------------------
# Public Methdos
#----------------------------------------------------------------------
proc tixOptionMenu:add {w type name args} {
upvar #0 $w data
if {[info exists data($name,index)]} {
error "item $name already exists in the option menu $w"
}
case $type {
"command" {
set validOptions {
-command -label
}
set opt(-command) ""
set opt(-label) $name
tixHandleOptions -nounknown opt $validOptions $args
if {$opt(-command) != ""} {
error "option -command cannot be specified"
}
# Create a new item inside the menu
#
eval $data(w:menu) add command $args \
[list -label $opt(-label) \
-command "tixOptionMenu:Invoke $w \{$name\}"]
set index $data(nItems)
# Store info about this item
#
set data($index,name) $name
set data($name,type) cmd
set data($name,label) $opt(-label)
set data($name,index) $index
if {$index == 0} {
$data(w:menubutton) config -text $data($name,label)
tixOptionMenu:SetValue $w $name
}
incr data(nItems)
lappend data(items) $name
if $data(-dynamicgeometry) {
tixOptionMenu:SetMaxWidth $w
}
}
"separator" {
$data(w:menu) add separator
set index $data(nItems)
# Store info about this item
#
set data($index,name) $name
set data($name,type) sep
set data($name,label) ""
set data($name,index) $index
incr data(nItems)
lappend data(items) $name
}
default {
error "only types \"separator\" and \"command\" are allowed"
}
}
return ""
}
proc tixOptionMenu:delete {w item} {
upvar #0 $w data
if {![info exists data($item,index)]} {
error "item $item does not exist in $w"
}
# Rehash the item list
set newItems ""
set oldIndex 0
set newIndex 0
foreach name $data(items) {
if {$item == $name} {
unset data($name,label)
unset data($name,index)
unset data($name,type)
$data(w:menu) delete $oldIndex
} else {
set data($name,index) $newIndex
set data($newIndex,name) $name
incr newIndex
lappend newItems $name
}
incr oldIndex
}
incr oldIndex -1; unset data($oldIndex,name)
set data(nItems) $newIndex
set data(items) $newItems
if {$data(-value) == $item} {
set newVal ""
foreach item $data(items) {
if {$data($item,type) == "cmd"} {
set newVal $item
}
}
tixOptionMenu:SetValue $w $newVal
}
return ""
}
proc tixOptionMenu:disable {w item} {
upvar #0 $w data
if {![info exists data($item,index)]} {
error "item $item does not exist in $w"
} else {
catch {$data(w:menu) entryconfig $data($item,index) -state disabled}
}
}
proc tixOptionMenu:enable {w item} {
upvar #0 $w data
if {![info exists data($item,index)]} {
error "item $item does not exist in $w"
} else {
catch {$data(w:menu) entryconfig $data($item,index) -state normal}
}
}
proc tixOptionMenu:entryconfigure {w item args} {
upvar #0 $w data
if {![info exists data($item,index)]} {
error "item $item does not exist in $w"
} else {
return [eval $data(w:menu) entryconfig $data($item,index) $args]
}
}
proc tixOptionMenu:entrycget {w item arg} {
upvar #0 $w data
if {![info exists data($item,index)]} {
error "item $item does not exist in $w"
} else {
return [$data(w:menu) entrycget $data($item,index) $arg]
}
}
proc tixOptionMenu:entries {w} {
upvar #0 $w data
return $data(items)
}
proc tixOptionMenu:Destructor {w} {
tixVariable:DeleteVariable $w
# Chain this to the superclass
#
tixChainMethod $w Destructor
}
#----------------------------------------------------------------------
# Obsolete
# These have been replaced by new commands in Tk 4.0
#
proc tixOptionMenu:Post {w} {
upvar #0 $w data
set rootx [winfo rootx $data(w:frame)]
set rooty [winfo rooty $data(w:frame)]
# adjust for the border of the menu and frame
#
incr rootx [lindex [$data(w:menu) config -border] 4]
incr rooty [lindex [$data(w:frame) config -border] 4]
incr rooty [lindex [$data(w:menu) config -border] 4]
set value $data(-value)
set y [$data(w:menu) yposition $data($value,index)]
$data(w:menu) post $rootx [expr $rooty - $y]
$data(w:menu) activate $data($value,index)
grab -global $data(w:menubutton)
set data(posted) 1
}
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: OptMenu.tcl,v 1.3 2001/12/09 05:04:02 idiscovery Exp $
#
# OptMenu.tcl --
#
# This file implements the TixOptionMenu 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.
#
tixWidgetClass tixOptionMenu {
-classname TixOptionMenu
-superclass tixLabelWidget
-method {
add delete disable enable entrycget entryconfigure entries
}
-flag {
-command -disablecallback -dynamicgeometry -value -variable
-validatecmd -state
}
-forcecall {
-variable -state
}
-configspec {
{-command command Command ""}
{-disablecallback disableCallback DisableCallback 0 tixVerifyBoolean}
{-dynamicgeometry dynamicGeometry DynamicGeometry 0 tixVerifyBoolean}
{-state state State normal}
{-value value Value ""}
{-validatecmd validateCmd ValidateCmd ""}
{-variable variable Variable ""}
}
-default {
{.highlightThickness 0}
{.takeFocus 0}
{.frame.menubutton.relief raised}
{.frame.menubutton.borderWidth 2}
{.frame.menubutton.anchor w}
{.frame.menubutton.highlightThickness 2}
{.frame.menubutton.takeFocus 1}
}
}
proc tixOptionMenu:InitWidgetRec {w} {
upvar #0 $w data
tixChainMethod $w InitWidgetRec
set data(nItems) 0
set data(items) ""
set data(posted) 0
set data(varInited) 0
set data(maxWidth) 0
}
proc tixOptionMenu:ConstructFramedWidget {w frame} {
upvar #0 $w data
tixChainMethod $w ConstructFramedWidget $frame
set data(w:menubutton) [menubutton $frame.menubutton -indicatoron 1]
set data(w:menu) [menu $frame.menubutton.menu -tearoff 0]
pack $data(w:menubutton) -side left -expand yes -fill both
$data(w:menubutton) config -menu $data(w:menu)
bind $data(w:menubutton) <Up> [bind Menubutton <space>]
bind $data(w:menubutton) <Down> [bind Menubutton <space>]
tixSetMegaWidget $data(w:menubutton) $w
}
proc tixOptionMenu:SetBindings {w} {
upvar #0 $w data
tixChainMethod $w SetBindings
}
#----------------------------------------------------------------------
# Private methods
#----------------------------------------------------------------------
proc tixOptionMenu:Invoke {w name} {
upvar #0 $w data
if {"$data(-state)" == "normal"} {
tixOptionMenu:SetValue $w $name
}
}
proc tixOptionMenu:SetValue {w value {noUpdate 0}} {
upvar #0 $w data
if {$data(-validatecmd) != ""} {
set value [tixEvalCmdBinding $w $data(-validatecmd) "" $value]
}
set name $value
if {$name == "" || [info exists data(varInited)]} {
# variable may contain a bogus value
if {![info exists data($name,index)]} {
set data(-value) ""
tixVariable:UpdateVariable $w
$data(w:menubutton) config -text ""
return
}
}
if {[info exists data($name,index)]} {
$data(w:menubutton) config -text $data($name,label)
set data(-value) $value
if {! $noUpdate} {
tixVariable:UpdateVariable $w
}
if {$data(-command) != "" && !$data(-disablecallback)} {
if {![info exists data(varInited)]} {
set bind(specs) ""
tixEvalCmdBinding $w $data(-command) bind $value
}
}
} else {
error "item \"$value\" does not exist"
}
}
proc tixOptionMenu:SetMaxWidth {w} {
upvar #0 $w data
foreach name $data(items) {
set len [string length $data($name,label)]
if {$data(maxWidth) < $len} {
set data(maxWidth) $len
}
}
if {$data(maxWidth) > 0} {
$data(w:menubutton) config -width $data(maxWidth)
}
}
#----------------------------------------------------------------------
# Configuration
#----------------------------------------------------------------------
proc tixOptionMenu:config-state {w value} {
upvar #0 $w data
if {![info exists data(w:label)]} {
return
}
if {$value == "normal"} {
catch {
$data(w:label) config -fg \
[$data(w:menubutton) cget -foreground]
}
$data(w:menubutton) config -state $value
} else {
catch {
$data(w:label) config -fg \
[$data(w:menubutton) cget -disabledforeground]
}
$data(w:menubutton) config -state $value
}
}
proc tixOptionMenu:config-value {w value} {
upvar #0 $w data
tixOptionMenu:SetValue $w $value
# This will tell the Intrinsics: "Please use this value"
# because "value" might be altered by SetValues
#
return $data(-value)
}
proc tixOptionMenu:config-variable {w arg} {
upvar #0 $w data
if {[tixVariable:ConfigVariable $w $arg]} {
# The value of data(-value) is changed if tixVariable:ConfigVariable
# returns true
tixOptionMenu:SetValue $w $data(-value) 1
}
catch {
unset data(varInited)
}
set data(-variable) $arg
}
#----------------------------------------------------------------------
# Public Methdos
#----------------------------------------------------------------------
proc tixOptionMenu:add {w type name args} {
upvar #0 $w data
if {[info exists data($name,index)]} {
error "item $name already exists in the option menu $w"
}
case $type {
"command" {
set validOptions {
-command -label
}
set opt(-command) ""
set opt(-label) $name
tixHandleOptions -nounknown opt $validOptions $args
if {$opt(-command) != ""} {
error "option -command cannot be specified"
}
# Create a new item inside the menu
#
eval $data(w:menu) add command $args \
[list -label $opt(-label) \
-command "tixOptionMenu:Invoke $w \{$name\}"]
set index $data(nItems)
# Store info about this item
#
set data($index,name) $name
set data($name,type) cmd
set data($name,label) $opt(-label)
set data($name,index) $index
if {$index == 0} {
$data(w:menubutton) config -text $data($name,label)
tixOptionMenu:SetValue $w $name
}
incr data(nItems)
lappend data(items) $name
if $data(-dynamicgeometry) {
tixOptionMenu:SetMaxWidth $w
}
}
"separator" {
$data(w:menu) add separator
set index $data(nItems)
# Store info about this item
#
set data($index,name) $name
set data($name,type) sep
set data($name,label) ""
set data($name,index) $index
incr data(nItems)
lappend data(items) $name
}
default {
error "only types \"separator\" and \"command\" are allowed"
}
}
return ""
}
proc tixOptionMenu:delete {w item} {
upvar #0 $w data
if {![info exists data($item,index)]} {
error "item $item does not exist in $w"
}
# Rehash the item list
set newItems ""
set oldIndex 0
set newIndex 0
foreach name $data(items) {
if {$item == $name} {
unset data($name,label)
unset data($name,index)
unset data($name,type)
$data(w:menu) delete $oldIndex
} else {
set data($name,index) $newIndex
set data($newIndex,name) $name
incr newIndex
lappend newItems $name
}
incr oldIndex
}
incr oldIndex -1; unset data($oldIndex,name)
set data(nItems) $newIndex
set data(items) $newItems
if {$data(-value) == $item} {
set newVal ""
foreach item $data(items) {
if {$data($item,type) == "cmd"} {
set newVal $item
}
}
tixOptionMenu:SetValue $w $newVal
}
return ""
}
proc tixOptionMenu:disable {w item} {
upvar #0 $w data
if {![info exists data($item,index)]} {
error "item $item does not exist in $w"
} else {
catch {$data(w:menu) entryconfig $data($item,index) -state disabled}
}
}
proc tixOptionMenu:enable {w item} {
upvar #0 $w data
if {![info exists data($item,index)]} {
error "item $item does not exist in $w"
} else {
catch {$data(w:menu) entryconfig $data($item,index) -state normal}
}
}
proc tixOptionMenu:entryconfigure {w item args} {
upvar #0 $w data
if {![info exists data($item,index)]} {
error "item $item does not exist in $w"
} else {
return [eval $data(w:menu) entryconfig $data($item,index) $args]
}
}
proc tixOptionMenu:entrycget {w item arg} {
upvar #0 $w data
if {![info exists data($item,index)]} {
error "item $item does not exist in $w"
} else {
return [$data(w:menu) entrycget $data($item,index) $arg]
}
}
proc tixOptionMenu:entries {w} {
upvar #0 $w data
return $data(items)
}
proc tixOptionMenu:Destructor {w} {
tixVariable:DeleteVariable $w
# Chain this to the superclass
#
tixChainMethod $w Destructor
}
#----------------------------------------------------------------------
# Obsolete
# These have been replaced by new commands in Tk 4.0
#
proc tixOptionMenu:Post {w} {
upvar #0 $w data
set rootx [winfo rootx $data(w:frame)]
set rooty [winfo rooty $data(w:frame)]
# adjust for the border of the menu and frame
#
incr rootx [lindex [$data(w:menu) config -border] 4]
incr rooty [lindex [$data(w:frame) config -border] 4]
incr rooty [lindex [$data(w:menu) config -border] 4]
set value $data(-value)
set y [$data(w:menu) yposition $data($value,index)]
$data(w:menu) post $rootx [expr $rooty - $y]
$data(w:menu) activate $data($value,index)
grab -global $data(w:menubutton)
set data(posted) 1
}

2430
amd64/lib/tix8.4.3/PanedWin.tcl
View File

File diff suppressed because it is too large Load Diff

478
amd64/lib/tix8.4.3/PopMenu.tcl
View File

@@ -1,239 +1,239 @@
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: PopMenu.tcl,v 1.7 2004/03/28 02:44:57 hobbs Exp $
#
# PopMenu.tcl --
#
# This file implements the TixPopupMenu 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.
#
global tkPriv
if {![llength [info globals tkPriv]]} {
tk::unsupported::ExposePrivateVariable tkPriv
}
#--------------------------------------------------------------------------
# tkPriv elements used in this file:
#
# inMenubutton -
#--------------------------------------------------------------------------
#
foreach fun {tkMenuUnpost tkMbButtonUp tkMbEnter tkMbPost} {
if {![llength [info commands $fun]]} {
tk::unsupported::ExposePrivateCommand $fun
}
}
unset fun
tixWidgetClass tixPopupMenu {
-classname TixPopupMenu
-superclass tixShell
-method {
bind post unbind
}
-flag {
-buttons -installcolormap -postcmd -spring -state -title
}
-configspec {
{-buttons buttons Buttons {{3 {Any}}}}
{-installcolormap installColormap InstallColormap false}
{-postcmd postCmd PostCmd ""}
{-spring spring Spring 1 tixVerifyBoolean}
{-state state State normal}
{-cursor corsor Cursor arrow}
}
-static {
-buttons
}
-default {
{*Menu.tearOff 0}
}
}
proc tixPopupMenu:InitWidgetRec {w} {
upvar #0 $w data
tixChainMethod $w InitWidgetRec
set data(g:clients) ""
}
proc tixPopupMenu:ConstructWidget {w} {
upvar #0 $w data
tixChainMethod $w ConstructWidget
wm overrideredirect $w 1
wm withdraw $w
set data(w:menubutton) [menubutton $w.menubutton -text $data(-title) \
-menu $w.menubutton.menu -anchor w]
set data(w:menu) [menu $w.menubutton.menu]
pack $data(w:menubutton) -expand yes -fill both
}
proc tixPopupMenu:SetBindings {w} {
upvar #0 $w data
tixChainMethod $w SetBindings
foreach elm $data(-buttons) {
set btn [lindex $elm 0]
foreach mod [lindex $elm 1] {
tixBind TixPopupMenu:MB:$w <$mod-ButtonPress-$btn> \
"tixPopupMenu:Unpost $w"
tixBind TixPopupMenu:$w <$mod-ButtonPress-$btn> \
"tixPopupMenu:post $w %W %x %y"
}
tixBind TixPopupMenu:MB:$w <ButtonRelease-$btn> \
"tixPopupMenu:BtnRelease $w %X %Y"
tixBind TixPopupMenu:M:$w <Unmap> \
"tixPopupMenu:Unmap $w"
tixBind TixPopupMenu:$w <ButtonRelease-$btn> \
"tixPopupMenu:BtnRelease $w %X %Y"
tixAddBindTag $data(w:menubutton) TixPopupMenu:MB:$w
tixAddBindTag $data(w:menu) TixPopupMenu:M:$w
}
}
#----------------------------------------------------------------------
# PrivateMethods:
#----------------------------------------------------------------------
proc tixPopupMenu:Unpost {w} {
upvar #0 $w data
catch {
tkMenuUnpost ""
}
# tkMbButtonUp $data(w:menubutton)
}
proc tixPopupMenu:BtnRelease {w rootX rootY} {
upvar #0 $w data
set cW [winfo containing -displayof $w $rootX $rootY]
if {$data(-spring)} {
tixPopupMenu:Unpost $w
}
}
proc tixPopupMenu:Unmap {w} {
upvar #0 $w data
wm withdraw $w
}
proc tixPopupMenu:Destructor {w} {
upvar #0 $w data
foreach client $data(g:clients) {
if {[winfo exists $client]} {
tixDeleteBindTag $client TixPopupMenu:$w
}
}
# delete the extra bindings
#
foreach tag [list TixPopupMenu:MB:$w TixPopupMenu:M:$w] {
foreach e [bind $tag] {
bind $tag $e ""
}
}
tixChainMethod $w Destructor
}
proc tixPopupMenu:config-title {w value} {
upvar #0 $w data
$data(w:menubutton) config -text $value
}
#----------------------------------------------------------------------
# PublicMethods:
#----------------------------------------------------------------------
proc tixPopupMenu:bind {w args} {
upvar #0 $w data
foreach client $args {
if {[lsearch $data(g:clients) $client] == -1} {
lappend data(g:clients) $client
tixAppendBindTag $client TixPopupMenu:$w
}
}
}
proc tixPopupMenu:unbind {w args} {
upvar #0 $w data
foreach client $args {
if {[winfo exists $client]} {
set index [lsearch $data(g:clients) $client]
if {$index != -1} {
tixDeleteBindTag $client TixPopupMenu:$w
set data(g:clients) [lreplace $data(g:clients) $index $index]
}
}
}
}
proc tixPopupMenu:post {w client x y} {
upvar #0 $w data
global tkPriv
if {$data(-state) == "disabled"} {
return
}
set rootx [expr $x + [winfo rootx $client]]
set rooty [expr $y + [winfo rooty $client]]
if {$data(-postcmd) != ""} {
set ret [tixEvalCmdBinding $w $data(-postcmd) "" $rootx $rooty]
if {![tixGetBoolean $ret]} {
return
}
}
if {[string is true -strict $data(-installcolormap)]} {
wm colormapwindows . $w
}
set menuWidth [winfo reqwidth $data(w:menu)]
set width [winfo reqwidth $w]
set height [winfo reqheight $w]
if {$width < $menuWidth} {
set width $menuWidth
}
set wx $rootx
set wy $rooty
# trick: the following lines allow the popup menu
# acquire a stable width and height when it is finally
# put on the visible screen. Advoid flashing
#
wm geometry $w +10000+10000
wm deiconify $w
raise $w
update
wm geometry $w ${width}x${height}+${wx}+${wy}
update
tkMbEnter $data(w:menubutton)
tkMbPost $tkPriv(inMenubutton) $rootx $rooty
}
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: PopMenu.tcl,v 1.7 2004/03/28 02:44:57 hobbs Exp $
#
# PopMenu.tcl --
#
# This file implements the TixPopupMenu 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.
#
global tkPriv
if {![llength [info globals tkPriv]]} {
tk::unsupported::ExposePrivateVariable tkPriv
}
#--------------------------------------------------------------------------
# tkPriv elements used in this file:
#
# inMenubutton -
#--------------------------------------------------------------------------
#
foreach fun {tkMenuUnpost tkMbButtonUp tkMbEnter tkMbPost} {
if {![llength [info commands $fun]]} {
tk::unsupported::ExposePrivateCommand $fun
}
}
unset fun
tixWidgetClass tixPopupMenu {
-classname TixPopupMenu
-superclass tixShell
-method {
bind post unbind
}
-flag {
-buttons -installcolormap -postcmd -spring -state -title
}
-configspec {
{-buttons buttons Buttons {{3 {Any}}}}
{-installcolormap installColormap InstallColormap false}
{-postcmd postCmd PostCmd ""}
{-spring spring Spring 1 tixVerifyBoolean}
{-state state State normal}
{-cursor corsor Cursor arrow}
}
-static {
-buttons
}
-default {
{*Menu.tearOff 0}
}
}
proc tixPopupMenu:InitWidgetRec {w} {
upvar #0 $w data
tixChainMethod $w InitWidgetRec
set data(g:clients) ""
}
proc tixPopupMenu:ConstructWidget {w} {
upvar #0 $w data
tixChainMethod $w ConstructWidget
wm overrideredirect $w 1
wm withdraw $w
set data(w:menubutton) [menubutton $w.menubutton -text $data(-title) \
-menu $w.menubutton.menu -anchor w]
set data(w:menu) [menu $w.menubutton.menu]
pack $data(w:menubutton) -expand yes -fill both
}
proc tixPopupMenu:SetBindings {w} {
upvar #0 $w data
tixChainMethod $w SetBindings
foreach elm $data(-buttons) {
set btn [lindex $elm 0]
foreach mod [lindex $elm 1] {
tixBind TixPopupMenu:MB:$w <$mod-ButtonPress-$btn> \
"tixPopupMenu:Unpost $w"
tixBind TixPopupMenu:$w <$mod-ButtonPress-$btn> \
"tixPopupMenu:post $w %W %x %y"
}
tixBind TixPopupMenu:MB:$w <ButtonRelease-$btn> \
"tixPopupMenu:BtnRelease $w %X %Y"
tixBind TixPopupMenu:M:$w <Unmap> \
"tixPopupMenu:Unmap $w"
tixBind TixPopupMenu:$w <ButtonRelease-$btn> \
"tixPopupMenu:BtnRelease $w %X %Y"
tixAddBindTag $data(w:menubutton) TixPopupMenu:MB:$w
tixAddBindTag $data(w:menu) TixPopupMenu:M:$w
}
}
#----------------------------------------------------------------------
# PrivateMethods:
#----------------------------------------------------------------------
proc tixPopupMenu:Unpost {w} {
upvar #0 $w data
catch {
tkMenuUnpost ""
}
# tkMbButtonUp $data(w:menubutton)
}
proc tixPopupMenu:BtnRelease {w rootX rootY} {
upvar #0 $w data
set cW [winfo containing -displayof $w $rootX $rootY]
if {$data(-spring)} {
tixPopupMenu:Unpost $w
}
}
proc tixPopupMenu:Unmap {w} {
upvar #0 $w data
wm withdraw $w
}
proc tixPopupMenu:Destructor {w} {
upvar #0 $w data
foreach client $data(g:clients) {
if {[winfo exists $client]} {
tixDeleteBindTag $client TixPopupMenu:$w
}
}
# delete the extra bindings
#
foreach tag [list TixPopupMenu:MB:$w TixPopupMenu:M:$w] {
foreach e [bind $tag] {
bind $tag $e ""
}
}
tixChainMethod $w Destructor
}
proc tixPopupMenu:config-title {w value} {
upvar #0 $w data
$data(w:menubutton) config -text $value
}
#----------------------------------------------------------------------
# PublicMethods:
#----------------------------------------------------------------------
proc tixPopupMenu:bind {w args} {
upvar #0 $w data
foreach client $args {
if {[lsearch $data(g:clients) $client] == -1} {
lappend data(g:clients) $client
tixAppendBindTag $client TixPopupMenu:$w
}
}
}
proc tixPopupMenu:unbind {w args} {
upvar #0 $w data
foreach client $args {
if {[winfo exists $client]} {
set index [lsearch $data(g:clients) $client]
if {$index != -1} {
tixDeleteBindTag $client TixPopupMenu:$w
set data(g:clients) [lreplace $data(g:clients) $index $index]
}
}
}
}
proc tixPopupMenu:post {w client x y} {
upvar #0 $w data
global tkPriv
if {$data(-state) == "disabled"} {
return
}
set rootx [expr $x + [winfo rootx $client]]
set rooty [expr $y + [winfo rooty $client]]
if {$data(-postcmd) != ""} {
set ret [tixEvalCmdBinding $w $data(-postcmd) "" $rootx $rooty]
if {![tixGetBoolean $ret]} {
return
}
}
if {[string is true -strict $data(-installcolormap)]} {
wm colormapwindows . $w
}
set menuWidth [winfo reqwidth $data(w:menu)]
set width [winfo reqwidth $w]
set height [winfo reqheight $w]
if {$width < $menuWidth} {
set width $menuWidth
}
set wx $rootx
set wy $rooty
# trick: the following lines allow the popup menu
# acquire a stable width and height when it is finally
# put on the visible screen. Advoid flashing
#
wm geometry $w +10000+10000
wm deiconify $w
raise $w
update
wm geometry $w ${width}x${height}+${wx}+${wy}
update
tkMbEnter $data(w:menubutton)
tkMbPost $tkPriv(inMenubutton) $rootx $rooty
}

856
amd64/lib/tix8.4.3/Primitiv.tcl
View File

@@ -1,428 +1,428 @@
# -*- 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}
}
# -*- 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}
}

1010
amd64/lib/tix8.4.3/ResizeH.tcl
View File

File diff suppressed because it is too large Load Diff

486
amd64/lib/tix8.4.3/SGrid.tcl
View File

@@ -1,243 +1,243 @@
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: SGrid.tcl,v 1.6 2002/01/24 09:13:58 idiscovery Exp $
#
# SGrid.tcl --
#
# This file implements Scrolled Grid widgets
#
# 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.
#
global tkPriv
if {![llength [info globals tkPriv]]} {
tk::unsupported::ExposePrivateVariable tkPriv
}
#--------------------------------------------------------------------------
# tkPriv elements used in this file:
#
# x -
# y -
# X -
# Y -
#--------------------------------------------------------------------------
#
tixWidgetClass tixScrolledGrid {
-classname TixScrolledGrid
-superclass tixScrolledWidget
-method {
}
-flag {
}
-configspec {
}
-default {
{.scrollbar auto}
{*grid.borderWidth 1}
{*grid.Background #c3c3c3}
{*grid.highlightBackground #d9d9d9}
{*grid.relief sunken}
{*grid.takeFocus 1}
{*Scrollbar.takeFocus 0}
}
}
proc tixScrolledGrid:ConstructWidget {w} {
upvar #0 $w data
tixChainMethod $w ConstructWidget
set data(w:grid) [tixGrid $w.grid]
set data(w:hsb) \
[scrollbar $w.hsb -orient horizontal -takefocus 0]
set data(w:vsb) \
[scrollbar $w.vsb -orient vertical -takefocus 0]
set data(pw:client) $data(w:grid)
pack $data(w:grid) -expand yes -fill both -padx 0 -pady 0
}
proc tixScrolledGrid:SetBindings {w} {
upvar #0 $w data
tixChainMethod $w SetBindings
$data(w:grid) config \
-xscrollcommand "$data(w:hsb) set"\
-yscrollcommand "$data(w:vsb) set"\
-sizecmd [list tixScrolledWidget:Configure $w] \
-formatcmd "tixCallMethod $w FormatCmd"
$data(w:hsb) config -command "$data(w:grid) xview"
$data(w:vsb) config -command "$data(w:grid) yview"
bindtags $data(w:grid) \
"$data(w:grid) TixSGrid TixGrid [winfo toplevel $data(w:grid)] all"
tixSetMegaWidget $data(w:grid) $w
}
#----------------------------------------------------------------------
# RAW event bindings
#----------------------------------------------------------------------
proc tixScrolledGridBind {} {
tixBind TixScrolledGrid <ButtonPress-1> {
tixScrolledGrid:Button-1 [tixGetMegaWidget %W] %x %y
}
tixBind TixScrolledGrid <Shift-ButtonPress-1> {
tixScrolledGrid:Shift-Button-1 %W %x %y
}
tixBind TixScrolledGrid <Control-ButtonPress-1> {
tixScrolledGrid:Control-Button-1 %W %x %y
}
tixBind TixScrolledGrid <ButtonRelease-1> {
tixScrolledGrid:ButtonRelease-1 %W %x %y
}
tixBind TixScrolledGrid <Double-ButtonPress-1> {
tixScrolledGrid:Double-1 %W %x %y
}
tixBind TixScrolledGrid <B1-Motion> {
set tkPriv(x) %x
set tkPriv(y) %y
set tkPriv(X) %X
set tkPriv(Y) %Y
tixScrolledGrid:B1-Motion %W %x %y
}
tixBind TixScrolledGrid <Control-B1-Motion> {
set tkPriv(x) %x
set tkPriv(y) %y
set tkPriv(X) %X
set tkPriv(Y) %Y
tixScrolledGrid:Control-B1-Motion %W %x %y
}
tixBind TixScrolledGrid <B1-Leave> {
set tkPriv(x) %x
set tkPriv(y) %y
set tkPriv(X) %X
set tkPriv(Y) %Y
tixScrolledGrid:B1-Leave %W
}
tixBind TixScrolledGrid <B1-Enter> {
tixScrolledGrid:B1-Enter %W %x %y
}
tixBind TixScrolledGrid <Control-B1-Leave> {
set tkPriv(x) %x
set tkPriv(y) %y
set tkPriv(X) %X
set tkPriv(Y) %Y
tixScrolledGrid:Control-B1-Leave %W
}
tixBind TixScrolledGrid <Control-B1-Enter> {
tixScrolledGrid:Control-B1-Enter %W %x %y
}
# Keyboard bindings
#
tixBind TixScrolledGrid <Up> {
tixScrolledGrid:DirKey %W up
}
tixBind TixScrolledGrid <Down> {
tixScrolledGrid:DirKey %W down
}
tixBind TixScrolledGrid <Left> {
tixScrolledGrid:DirKey %W left
}
tixBind TixScrolledGrid <Right> {
tixScrolledGrid:DirKey %W right
}
tixBind TixScrolledGrid <Prior> {
%W yview scroll -1 pages
}
tixBind TixScrolledGrid <Next> {
%W yview scroll 1 pages
}
tixBind TixScrolledGrid <Return> {
tixScrolledGrid:Return %W
}
tixBind TixScrolledGrid <space> {
tixScrolledGrid:Space %W
}
}
#----------------------------------------------------------------------
#
#
# Mouse bindings
#
#
#----------------------------------------------------------------------
proc tixScrolledGrid:Button-1 {w x y} {
if {[$w cget -state] == "disabled"} {
return
}
if {[$w cget -takefocus]} {
focus $w
}
case [tixScrolled:GetState $w] {
{0} {
tixScrolledGrid:GoState s1 $w $x $y
}
{b0} {
tixScrolledGrid:GoState b1 $w $x $y
}
{m0} {
tixScrolledGrid:GoState m1 $w $x $y
}
{e0} {
tixScrolledGrid:GoState e1 $w $x $y
}
}
}
#----------------------------------------------------------------------
#
# option configs
#----------------------------------------------------------------------
#----------------------------------------------------------------------
#
# Widget commands
#----------------------------------------------------------------------
#----------------------------------------------------------------------
#
# Private Methods
#----------------------------------------------------------------------
#----------------------------------------------------------------------
# Virtual Methods
#----------------------------------------------------------------------
proc tixScrolledGrid:FormatCmd {w area x1 y1 x2 y2} {
# do nothing
}
#----------------------------------------------------------------------
# virtual functions to query the client window's scroll requirement
#----------------------------------------------------------------------
proc tixScrolledGrid:GeometryInfo {w mW mH} {
upvar #0 $w data
if {$mW < 1} {
set mW 1
}
if {$mH < 1} {
set mH 1
}
return [$data(w:grid) geometryinfo $mW $mH]
}
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: SGrid.tcl,v 1.6 2002/01/24 09:13:58 idiscovery Exp $
#
# SGrid.tcl --
#
# This file implements Scrolled Grid widgets
#
# 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.
#
global tkPriv
if {![llength [info globals tkPriv]]} {
tk::unsupported::ExposePrivateVariable tkPriv
}
#--------------------------------------------------------------------------
# tkPriv elements used in this file:
#
# x -
# y -
# X -
# Y -
#--------------------------------------------------------------------------
#
tixWidgetClass tixScrolledGrid {
-classname TixScrolledGrid
-superclass tixScrolledWidget
-method {
}
-flag {
}
-configspec {
}
-default {
{.scrollbar auto}
{*grid.borderWidth 1}
{*grid.Background #c3c3c3}
{*grid.highlightBackground #d9d9d9}
{*grid.relief sunken}
{*grid.takeFocus 1}
{*Scrollbar.takeFocus 0}
}
}
proc tixScrolledGrid:ConstructWidget {w} {
upvar #0 $w data
tixChainMethod $w ConstructWidget
set data(w:grid) [tixGrid $w.grid]
set data(w:hsb) \
[scrollbar $w.hsb -orient horizontal -takefocus 0]
set data(w:vsb) \
[scrollbar $w.vsb -orient vertical -takefocus 0]
set data(pw:client) $data(w:grid)
pack $data(w:grid) -expand yes -fill both -padx 0 -pady 0
}
proc tixScrolledGrid:SetBindings {w} {
upvar #0 $w data
tixChainMethod $w SetBindings
$data(w:grid) config \
-xscrollcommand "$data(w:hsb) set"\
-yscrollcommand "$data(w:vsb) set"\
-sizecmd [list tixScrolledWidget:Configure $w] \
-formatcmd "tixCallMethod $w FormatCmd"
$data(w:hsb) config -command "$data(w:grid) xview"
$data(w:vsb) config -command "$data(w:grid) yview"
bindtags $data(w:grid) \
"$data(w:grid) TixSGrid TixGrid [winfo toplevel $data(w:grid)] all"
tixSetMegaWidget $data(w:grid) $w
}
#----------------------------------------------------------------------
# RAW event bindings
#----------------------------------------------------------------------
proc tixScrolledGridBind {} {
tixBind TixScrolledGrid <ButtonPress-1> {
tixScrolledGrid:Button-1 [tixGetMegaWidget %W] %x %y
}
tixBind TixScrolledGrid <Shift-ButtonPress-1> {
tixScrolledGrid:Shift-Button-1 %W %x %y
}
tixBind TixScrolledGrid <Control-ButtonPress-1> {
tixScrolledGrid:Control-Button-1 %W %x %y
}
tixBind TixScrolledGrid <ButtonRelease-1> {
tixScrolledGrid:ButtonRelease-1 %W %x %y
}
tixBind TixScrolledGrid <Double-ButtonPress-1> {
tixScrolledGrid:Double-1 %W %x %y
}
tixBind TixScrolledGrid <B1-Motion> {
set tkPriv(x) %x
set tkPriv(y) %y
set tkPriv(X) %X
set tkPriv(Y) %Y
tixScrolledGrid:B1-Motion %W %x %y
}
tixBind TixScrolledGrid <Control-B1-Motion> {
set tkPriv(x) %x
set tkPriv(y) %y
set tkPriv(X) %X
set tkPriv(Y) %Y
tixScrolledGrid:Control-B1-Motion %W %x %y
}
tixBind TixScrolledGrid <B1-Leave> {
set tkPriv(x) %x
set tkPriv(y) %y
set tkPriv(X) %X
set tkPriv(Y) %Y
tixScrolledGrid:B1-Leave %W
}
tixBind TixScrolledGrid <B1-Enter> {
tixScrolledGrid:B1-Enter %W %x %y
}
tixBind TixScrolledGrid <Control-B1-Leave> {
set tkPriv(x) %x
set tkPriv(y) %y
set tkPriv(X) %X
set tkPriv(Y) %Y
tixScrolledGrid:Control-B1-Leave %W
}
tixBind TixScrolledGrid <Control-B1-Enter> {
tixScrolledGrid:Control-B1-Enter %W %x %y
}
# Keyboard bindings
#
tixBind TixScrolledGrid <Up> {
tixScrolledGrid:DirKey %W up
}
tixBind TixScrolledGrid <Down> {
tixScrolledGrid:DirKey %W down
}
tixBind TixScrolledGrid <Left> {
tixScrolledGrid:DirKey %W left
}
tixBind TixScrolledGrid <Right> {
tixScrolledGrid:DirKey %W right
}
tixBind TixScrolledGrid <Prior> {
%W yview scroll -1 pages
}
tixBind TixScrolledGrid <Next> {
%W yview scroll 1 pages
}
tixBind TixScrolledGrid <Return> {
tixScrolledGrid:Return %W
}
tixBind TixScrolledGrid <space> {
tixScrolledGrid:Space %W
}
}
#----------------------------------------------------------------------
#
#
# Mouse bindings
#
#
#----------------------------------------------------------------------
proc tixScrolledGrid:Button-1 {w x y} {
if {[$w cget -state] == "disabled"} {
return
}
if {[$w cget -takefocus]} {
focus $w
}
case [tixScrolled:GetState $w] {
{0} {
tixScrolledGrid:GoState s1 $w $x $y
}
{b0} {
tixScrolledGrid:GoState b1 $w $x $y
}
{m0} {
tixScrolledGrid:GoState m1 $w $x $y
}
{e0} {
tixScrolledGrid:GoState e1 $w $x $y
}
}
}
#----------------------------------------------------------------------
#
# option configs
#----------------------------------------------------------------------
#----------------------------------------------------------------------
#
# Widget commands
#----------------------------------------------------------------------
#----------------------------------------------------------------------
#
# Private Methods
#----------------------------------------------------------------------
#----------------------------------------------------------------------
# Virtual Methods
#----------------------------------------------------------------------
proc tixScrolledGrid:FormatCmd {w area x1 y1 x2 y2} {
# do nothing
}
#----------------------------------------------------------------------
# virtual functions to query the client window's scroll requirement
#----------------------------------------------------------------------
proc tixScrolledGrid:GeometryInfo {w mW mH} {
upvar #0 $w data
if {$mW < 1} {
set mW 1
}
if {$mH < 1} {
set mH 1
}
return [$data(w:grid) geometryinfo $mW $mH]
}

280
amd64/lib/tix8.4.3/SHList.tcl
View File

@@ -1,140 +1,140 @@
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: SHList.tcl,v 1.7 2004/04/09 21:37:33 hobbs Exp $
#
# SHList.tcl --
#
# This file implements Scrolled HList widgets
#
# 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 tixScrolledHList {
-classname TixScrolledHList
-superclass tixScrolledWidget
-method {
}
-flag {
-highlightbackground -highlightcolor -highlightthickness
}
-configspec {
{-highlightbackground -highlightBackground HighlightBackground #d9d9d9}
{-highlightcolor -highlightColor HighlightColor black}
{-highlightthickness -highlightThickness HighlightThickness 2}
}
-default {
{.scrollbar auto}
{*f1.borderWidth 1}
{*hlist.Background #c3c3c3}
{*hlist.highlightBackground #d9d9d9}
{*hlist.relief sunken}
{*hlist.takeFocus 1}
{*Scrollbar.takeFocus 0}
}
-forcecall {
-highlightbackground -highlightcolor -highlightthickness
}
}
proc tixScrolledHList:ConstructWidget {w} {
upvar #0 $w data
tixChainMethod $w ConstructWidget
set data(pw:f1) [frame $w.f1 -takefocus 0]
set data(w:hlist) \
[tixHList $w.f1.hlist -bd 0 -takefocus 1 -highlightthickness 0]
pack $data(w:hlist) -in $data(pw:f1) -expand yes -fill both -padx 0 -pady 0
set data(w:hsb) [scrollbar $w.hsb -orient horizontal -takefocus 0]
set data(w:vsb) [scrollbar $w.vsb -orient vertical -takefocus 0]
set data(pw:client) $data(pw:f1)
}
proc tixScrolledHList:SetBindings {w} {
upvar #0 $w data
tixChainMethod $w SetBindings
$data(w:hlist) config \
-xscrollcommand [list $data(w:hsb) set] \
-yscrollcommand [list $data(w:vsb) set] \
-sizecmd [list tixScrolledWidget:Configure $w]
$data(w:hsb) config -command [list $data(w:hlist) xview]
$data(w:vsb) config -command [list $data(w:hlist) yview]
}
#----------------------------------------------------------------------
#
# option configs
#----------------------------------------------------------------------
proc tixScrolledHList:config-takefocus {w value} {
upvar #0 $w data
$data(w:hlist) config -takefocus $value
}
proc tixScrolledHList:config-highlightbackground {w value} {
upvar #0 $w data
$data(pw:f1) config -highlightbackground $value
}
proc tixScrolledHList:config-highlightcolor {w value} {
upvar #0 $w data
$data(pw:f1) config -highlightcolor $value
}
proc tixScrolledHList:config-highlightthickness {w value} {
upvar #0 $w data
$data(pw:f1) config -highlightthickness $value
}
#----------------------------------------------------------------------
#
# Widget commands
#----------------------------------------------------------------------
#----------------------------------------------------------------------
#
# Private Methods
#----------------------------------------------------------------------
# virtual
#
proc tixScrolledHList:RepackHook {w} {
upvar #0 $w data
tixChainMethod $w RepackHook
}
#----------------------------------------------------------------------
# virtual functions to query the client window's scroll requirement
#----------------------------------------------------------------------
proc tixScrolledHList:GeometryInfo {w mW mH} {
upvar #0 $w data
if {[winfo class $w.f1] eq "Frame"} {
set extra [expr {[$w.f1 cget -bd]+[$w.f1 cget -highlightthickness]}]
} else {
set extra 0
}
set mW [expr {$mW - $extra*2}]
set mH [expr {$mH - $extra*2}]
if {$mW < 1} {
set mW 1
}
if {$mH < 1} {
set mH 1
}
return [$data(w:hlist) geometryinfo $mW $mH]
}
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: SHList.tcl,v 1.7 2004/04/09 21:37:33 hobbs Exp $
#
# SHList.tcl --
#
# This file implements Scrolled HList widgets
#
# 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 tixScrolledHList {
-classname TixScrolledHList
-superclass tixScrolledWidget
-method {
}
-flag {
-highlightbackground -highlightcolor -highlightthickness
}
-configspec {
{-highlightbackground -highlightBackground HighlightBackground #d9d9d9}
{-highlightcolor -highlightColor HighlightColor black}
{-highlightthickness -highlightThickness HighlightThickness 2}
}
-default {
{.scrollbar auto}
{*f1.borderWidth 1}
{*hlist.Background #c3c3c3}
{*hlist.highlightBackground #d9d9d9}
{*hlist.relief sunken}
{*hlist.takeFocus 1}
{*Scrollbar.takeFocus 0}
}
-forcecall {
-highlightbackground -highlightcolor -highlightthickness
}
}
proc tixScrolledHList:ConstructWidget {w} {
upvar #0 $w data
tixChainMethod $w ConstructWidget
set data(pw:f1) [frame $w.f1 -takefocus 0]
set data(w:hlist) \
[tixHList $w.f1.hlist -bd 0 -takefocus 1 -highlightthickness 0]
pack $data(w:hlist) -in $data(pw:f1) -expand yes -fill both -padx 0 -pady 0
set data(w:hsb) [scrollbar $w.hsb -orient horizontal -takefocus 0]
set data(w:vsb) [scrollbar $w.vsb -orient vertical -takefocus 0]
set data(pw:client) $data(pw:f1)
}
proc tixScrolledHList:SetBindings {w} {
upvar #0 $w data
tixChainMethod $w SetBindings
$data(w:hlist) config \
-xscrollcommand [list $data(w:hsb) set] \
-yscrollcommand [list $data(w:vsb) set] \
-sizecmd [list tixScrolledWidget:Configure $w]
$data(w:hsb) config -command [list $data(w:hlist) xview]
$data(w:vsb) config -command [list $data(w:hlist) yview]
}
#----------------------------------------------------------------------
#
# option configs
#----------------------------------------------------------------------
proc tixScrolledHList:config-takefocus {w value} {
upvar #0 $w data
$data(w:hlist) config -takefocus $value
}
proc tixScrolledHList:config-highlightbackground {w value} {
upvar #0 $w data
$data(pw:f1) config -highlightbackground $value
}
proc tixScrolledHList:config-highlightcolor {w value} {
upvar #0 $w data
$data(pw:f1) config -highlightcolor $value
}
proc tixScrolledHList:config-highlightthickness {w value} {
upvar #0 $w data
$data(pw:f1) config -highlightthickness $value
}
#----------------------------------------------------------------------
#
# Widget commands
#----------------------------------------------------------------------
#----------------------------------------------------------------------
#
# Private Methods
#----------------------------------------------------------------------
# virtual
#
proc tixScrolledHList:RepackHook {w} {
upvar #0 $w data
tixChainMethod $w RepackHook
}
#----------------------------------------------------------------------
# virtual functions to query the client window's scroll requirement
#----------------------------------------------------------------------
proc tixScrolledHList:GeometryInfo {w mW mH} {
upvar #0 $w data
if {[winfo class $w.f1] eq "Frame"} {
set extra [expr {[$w.f1 cget -bd]+[$w.f1 cget -highlightthickness]}]
} else {
set extra 0
}
set mW [expr {$mW - $extra*2}]
set mH [expr {$mH - $extra*2}]
if {$mW < 1} {
set mW 1
}
if {$mH < 1} {
set mH 1
}
return [$data(w:hlist) geometryinfo $mW $mH]
}

590
amd64/lib/tix8.4.3/SListBox.tcl
View File

@@ -1,295 +1,295 @@
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: SListBox.tcl,v 1.5 2004/03/28 02:44:57 hobbs Exp $
#
# SListBox.tcl --
#
# This file implements Scrolled Listbox widgets
#
# 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.
#
# ToDo:
# -anchor (none)
#
tixWidgetClass tixScrolledListBox {
-classname TixScrolledListBox
-superclass tixScrolledWidget
-method {
}
-flag {
-anchor -browsecmd -command -state
}
-static {
-anchor
}
-configspec {
{-anchor anchor Anchor w}
{-browsecmd browseCmd BrowseCmd ""}
{-command command Command ""}
{-state state State normal}
{-takefocus takeFocus TakeFocus 1 tixVerifyBoolean}
}
-default {
{.scrollbar auto}
{*borderWidth 1}
{*listbox.highlightBackground #d9d9d9}
{*listbox.relief sunken}
{*listbox.background #c3c3c3}
{*listbox.takeFocus 1}
{*Scrollbar.takeFocus 0}
}
}
proc tixScrolledListBox:InitWidgetRec {w} {
upvar #0 $w data
tixChainMethod $w InitWidgetRec
set data(x-first) 0
set data(x-last) 1
set data(y-first) 0
set data(y-last) 1
}
proc tixScrolledListBox:ConstructWidget {w} {
upvar #0 $w data
tixChainMethod $w ConstructWidget
set data(w:listbox) \
[listbox $w.listbox]
set data(w:hsb) \
[scrollbar $w.hsb -orient horizontal]
set data(w:vsb) \
[scrollbar $w.vsb -orient vertical ]
set data(pw:client) $data(w:listbox)
}
proc tixScrolledListBox:SetBindings {w} {
upvar #0 $w data
tixChainMethod $w SetBindings
$data(w:listbox) config \
-xscrollcommand "tixScrolledListBox:XView $w"\
-yscrollcommand "tixScrolledListBox:YView $w"
$data(w:hsb) config -command "$data(w:listbox) xview"
$data(w:vsb) config -command "$data(w:listbox) yview"
bind $w <Configure> "+tixScrolledListBox:Configure $w"
bind $w <FocusIn> "focus $data(w:listbox)"
bindtags $data(w:listbox) \
"$data(w:listbox) TixListboxState Listbox TixListbox [winfo toplevel $data(w:listbox)] all"
tixSetMegaWidget $data(w:listbox) $w
}
proc tixScrolledListBoxBind {} {
tixBind TixListboxState <1> {
if {[set [tixGetMegaWidget %W](-state)] eq "disabled"} {
break
}
}
tixBind TixListbox <1> {
if {[string is true -strict [%W cget -takefocus]]} {
focus %W
}
tixScrolledListBox:Browse [tixGetMegaWidget %W]
}
tixBind TixListboxState <B1-Motion> {
if {[set [tixGetMegaWidget %W](-state)] eq "disabled"} {
break
}
}
tixBind TixListbox <B1-Motion> {
tixScrolledListBox:Browse [tixGetMegaWidget %W]
}
tixBind TixListboxState <Up> {
if {[set [tixGetMegaWidget %W](-state)] eq "disabled"} {
break
}
}
tixBind TixListbox <Up> {
tixScrolledListBox:KeyBrowse [tixGetMegaWidget %W]
}
tixBind TixListboxState <Down> {
if {[set [tixGetMegaWidget %W](-state)] eq "disabled"} {
break
}
}
tixBind TixListbox <Down> {
tixScrolledListBox:KeyBrowse [tixGetMegaWidget %W]
}
tixBind TixListboxState <Return> {
if {[set [tixGetMegaWidget %W](-state)] eq "disabled"} {
break
}
}
tixBind TixListbox <Return> {
tixScrolledListBox:KeyInvoke [tixGetMegaWidget %W]
}
tixBind TixListboxState <Double-1> {
if {[set [tixGetMegaWidget %W](-state)] eq "disabled"} {
break
}
}
tixBind TixListbox <Double-1> {
tixScrolledListBox:Invoke [tixGetMegaWidget %W]
}
tixBind TixListboxState <ButtonRelease-1> {
if {[set [tixGetMegaWidget %W](-state)] eq "disabled"} {
break
}
}
tixBind TixListbox <ButtonRelease-1> {
tixScrolledListBox:Browse [tixGetMegaWidget %W]
}
}
proc tixScrolledListBox:Browse {w} {
upvar #0 $w data
if {$data(-browsecmd) != ""} {
set bind(specs) {%V}
set bind(%V) [$data(w:listbox) get \
[$data(w:listbox) nearest [tixEvent flag y]]]
tixEvalCmdBinding $w $data(-browsecmd) bind
}
}
proc tixScrolledListBox:KeyBrowse {w} {
upvar #0 $w data
if {$data(-browsecmd) != ""} {
set bind(specs) {%V}
set bind(%V) [$data(w:listbox) get active]
tixEvalCmdBinding $w $data(-browsecmd) bind
}
}
# tixScrolledListBox:Invoke --
#
# The user has invoked the listbox by pressing either the <Returh>
# key or double-clicking. Call the user-supplied -command function.
#
# For both -browsecmd and -command, it is the responsibility of the
# user-supplied function to determine the current selection of the listbox
#
proc tixScrolledListBox:Invoke {w} {
upvar #0 $w data
if {$data(-command) != ""} {
set bind(specs) {%V}
set bind(%V) [$data(w:listbox) get \
[$data(w:listbox) nearest [tixEvent flag y]]]
tixEvalCmdBinding $w $data(-command) bind
}
}
proc tixScrolledListBox:KeyInvoke {w} {
upvar #0 $w data
if {$data(-command) != ""} {
set bind(specs) {%V}
set bind(%V) [$data(w:listbox) get active]
tixEvalCmdBinding $w $data(-command) bind
}
}
#----------------------------------------------------------------------
#
# option configs
#----------------------------------------------------------------------
proc tixScrolledListBox:config-takefocus {w value} {
upvar #0 $w data
$data(w:listbox) config -takefocus $value
}
#----------------------------------------------------------------------
#
# Widget commands
#----------------------------------------------------------------------
#----------------------------------------------------------------------
#
# Private Methods
#----------------------------------------------------------------------
proc tixScrolledListBox:XView {w first last} {
upvar #0 $w data
set data(x-first) $first
set data(x-last) $last
$data(w:hsb) set $first $last
tixWidgetDoWhenIdle tixScrolledWidget:Configure $w
}
proc tixScrolledListBox:YView {w first last} {
upvar #0 $w data
set data(y-first) $first
set data(y-last) $last
$data(w:vsb) set $first $last
tixWidgetDoWhenIdle tixScrolledWidget:Configure $w
# Somehow an update here must be used to advoid osscilation
#
update idletasks
}
#
#----------------------------------------------------------------------
# virtual functions to query the client window's scroll requirement
#----------------------------------------------------------------------
proc tixScrolledListBox:GeometryInfo {w mW mH} {
upvar #0 $w data
return [list \
[list $data(x-first) $data(x-last)]\
[list $data(y-first) $data(y-last)]]
}
proc tixScrolledListBox:Configure {w} {
upvar #0 $w data
tixWidgetDoWhenIdle tixScrolledListBox:TrickScrollbar $w
if {$data(-anchor) eq "e"} {
$data(w:listbox) xview 100000
}
}
# This procedure is necessary because listbox does not call x,y scroll command
# when its size is changed
#
proc tixScrolledListBox:TrickScrollbar {w} {
upvar #0 $w data
set inc [$data(w:listbox) select include 0]
$data(w:listbox) select set 0
if {!$inc} {
$data(w:listbox) select clear 0
}
}
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: SListBox.tcl,v 1.5 2004/03/28 02:44:57 hobbs Exp $
#
# SListBox.tcl --
#
# This file implements Scrolled Listbox widgets
#
# 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.
#
# ToDo:
# -anchor (none)
#
tixWidgetClass tixScrolledListBox {
-classname TixScrolledListBox
-superclass tixScrolledWidget
-method {
}
-flag {
-anchor -browsecmd -command -state
}
-static {
-anchor
}
-configspec {
{-anchor anchor Anchor w}
{-browsecmd browseCmd BrowseCmd ""}
{-command command Command ""}
{-state state State normal}
{-takefocus takeFocus TakeFocus 1 tixVerifyBoolean}
}
-default {
{.scrollbar auto}
{*borderWidth 1}
{*listbox.highlightBackground #d9d9d9}
{*listbox.relief sunken}
{*listbox.background #c3c3c3}
{*listbox.takeFocus 1}
{*Scrollbar.takeFocus 0}
}
}
proc tixScrolledListBox:InitWidgetRec {w} {
upvar #0 $w data
tixChainMethod $w InitWidgetRec
set data(x-first) 0
set data(x-last) 1
set data(y-first) 0
set data(y-last) 1
}
proc tixScrolledListBox:ConstructWidget {w} {
upvar #0 $w data
tixChainMethod $w ConstructWidget
set data(w:listbox) \
[listbox $w.listbox]
set data(w:hsb) \
[scrollbar $w.hsb -orient horizontal]
set data(w:vsb) \
[scrollbar $w.vsb -orient vertical ]
set data(pw:client) $data(w:listbox)
}
proc tixScrolledListBox:SetBindings {w} {
upvar #0 $w data
tixChainMethod $w SetBindings
$data(w:listbox) config \
-xscrollcommand "tixScrolledListBox:XView $w"\
-yscrollcommand "tixScrolledListBox:YView $w"
$data(w:hsb) config -command "$data(w:listbox) xview"
$data(w:vsb) config -command "$data(w:listbox) yview"
bind $w <Configure> "+tixScrolledListBox:Configure $w"
bind $w <FocusIn> "focus $data(w:listbox)"
bindtags $data(w:listbox) \
"$data(w:listbox) TixListboxState Listbox TixListbox [winfo toplevel $data(w:listbox)] all"
tixSetMegaWidget $data(w:listbox) $w
}
proc tixScrolledListBoxBind {} {
tixBind TixListboxState <1> {
if {[set [tixGetMegaWidget %W](-state)] eq "disabled"} {
break
}
}
tixBind TixListbox <1> {
if {[string is true -strict [%W cget -takefocus]]} {
focus %W
}
tixScrolledListBox:Browse [tixGetMegaWidget %W]
}
tixBind TixListboxState <B1-Motion> {
if {[set [tixGetMegaWidget %W](-state)] eq "disabled"} {
break
}
}
tixBind TixListbox <B1-Motion> {
tixScrolledListBox:Browse [tixGetMegaWidget %W]
}
tixBind TixListboxState <Up> {
if {[set [tixGetMegaWidget %W](-state)] eq "disabled"} {
break
}
}
tixBind TixListbox <Up> {
tixScrolledListBox:KeyBrowse [tixGetMegaWidget %W]
}
tixBind TixListboxState <Down> {
if {[set [tixGetMegaWidget %W](-state)] eq "disabled"} {
break
}
}
tixBind TixListbox <Down> {
tixScrolledListBox:KeyBrowse [tixGetMegaWidget %W]
}
tixBind TixListboxState <Return> {
if {[set [tixGetMegaWidget %W](-state)] eq "disabled"} {
break
}
}
tixBind TixListbox <Return> {
tixScrolledListBox:KeyInvoke [tixGetMegaWidget %W]
}
tixBind TixListboxState <Double-1> {
if {[set [tixGetMegaWidget %W](-state)] eq "disabled"} {
break
}
}
tixBind TixListbox <Double-1> {
tixScrolledListBox:Invoke [tixGetMegaWidget %W]
}
tixBind TixListboxState <ButtonRelease-1> {
if {[set [tixGetMegaWidget %W](-state)] eq "disabled"} {
break
}
}
tixBind TixListbox <ButtonRelease-1> {
tixScrolledListBox:Browse [tixGetMegaWidget %W]
}
}
proc tixScrolledListBox:Browse {w} {
upvar #0 $w data
if {$data(-browsecmd) != ""} {
set bind(specs) {%V}
set bind(%V) [$data(w:listbox) get \
[$data(w:listbox) nearest [tixEvent flag y]]]
tixEvalCmdBinding $w $data(-browsecmd) bind
}
}
proc tixScrolledListBox:KeyBrowse {w} {
upvar #0 $w data
if {$data(-browsecmd) != ""} {
set bind(specs) {%V}
set bind(%V) [$data(w:listbox) get active]
tixEvalCmdBinding $w $data(-browsecmd) bind
}
}
# tixScrolledListBox:Invoke --
#
# The user has invoked the listbox by pressing either the <Returh>
# key or double-clicking. Call the user-supplied -command function.
#
# For both -browsecmd and -command, it is the responsibility of the
# user-supplied function to determine the current selection of the listbox
#
proc tixScrolledListBox:Invoke {w} {
upvar #0 $w data
if {$data(-command) != ""} {
set bind(specs) {%V}
set bind(%V) [$data(w:listbox) get \
[$data(w:listbox) nearest [tixEvent flag y]]]
tixEvalCmdBinding $w $data(-command) bind
}
}
proc tixScrolledListBox:KeyInvoke {w} {
upvar #0 $w data
if {$data(-command) != ""} {
set bind(specs) {%V}
set bind(%V) [$data(w:listbox) get active]
tixEvalCmdBinding $w $data(-command) bind
}
}
#----------------------------------------------------------------------
#
# option configs
#----------------------------------------------------------------------
proc tixScrolledListBox:config-takefocus {w value} {
upvar #0 $w data
$data(w:listbox) config -takefocus $value
}
#----------------------------------------------------------------------
#
# Widget commands
#----------------------------------------------------------------------
#----------------------------------------------------------------------
#
# Private Methods
#----------------------------------------------------------------------
proc tixScrolledListBox:XView {w first last} {
upvar #0 $w data
set data(x-first) $first
set data(x-last) $last
$data(w:hsb) set $first $last
tixWidgetDoWhenIdle tixScrolledWidget:Configure $w
}
proc tixScrolledListBox:YView {w first last} {
upvar #0 $w data
set data(y-first) $first
set data(y-last) $last
$data(w:vsb) set $first $last
tixWidgetDoWhenIdle tixScrolledWidget:Configure $w
# Somehow an update here must be used to advoid osscilation
#
update idletasks
}
#
#----------------------------------------------------------------------
# virtual functions to query the client window's scroll requirement
#----------------------------------------------------------------------
proc tixScrolledListBox:GeometryInfo {w mW mH} {
upvar #0 $w data
return [list \
[list $data(x-first) $data(x-last)]\
[list $data(y-first) $data(y-last)]]
}
proc tixScrolledListBox:Configure {w} {
upvar #0 $w data
tixWidgetDoWhenIdle tixScrolledListBox:TrickScrollbar $w
if {$data(-anchor) eq "e"} {
$data(w:listbox) xview 100000
}
}
# This procedure is necessary because listbox does not call x,y scroll command
# when its size is changed
#
proc tixScrolledListBox:TrickScrollbar {w} {
upvar #0 $w data
set inc [$data(w:listbox) select include 0]
$data(w:listbox) select set 0
if {!$inc} {
$data(w:listbox) select clear 0
}
}

186
amd64/lib/tix8.4.3/STList.tcl
View File

@@ -1,93 +1,93 @@
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: STList.tcl,v 1.4 2001/12/09 05:04:02 idiscovery Exp $
#
# STList.tcl --
#
# This file implements Scrolled TList widgets
#
# 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.
#
tixWidgetClass tixScrolledTList {
-classname TixScrolledTList
-superclass tixScrolledWidget
-method {
}
-flag {
}
-configspec {
}
-default {
{.scrollbar auto}
{*borderWidth 1}
{*tlist.background #c3c3c3}
{*tlist.highlightBackground #d9d9d9}
{*tlist.relief sunken}
{*tlist.takeFocus 1}
{*Scrollbar.takeFocus 0}
}
}
proc tixScrolledTList:ConstructWidget {w} {
upvar #0 $w data
tixChainMethod $w ConstructWidget
set data(w:tlist) \
[tixTList $w.tlist]
set data(w:hsb) \
[scrollbar $w.hsb -orient horizontal]
set data(w:vsb) \
[scrollbar $w.vsb -orient vertical ]
set data(pw:client) $data(w:tlist)
}
proc tixScrolledTList:SetBindings {w} {
upvar #0 $w data
tixChainMethod $w SetBindings
$data(w:tlist) config \
-xscrollcommand "$data(w:hsb) set"\
-yscrollcommand "$data(w:vsb) set"\
-sizecmd [list tixScrolledWidget:Configure $w]
$data(w:hsb) config -command "$data(w:tlist) xview"
$data(w:vsb) config -command "$data(w:tlist) yview"
}
#----------------------------------------------------------------------
#
# option configs
#----------------------------------------------------------------------
proc tixScrolledTList:config-takefocus {w value} {
upvar #0 $w data
$data(w:tlist) config -takefocus $value
}
#----------------------------------------------------------------------
#
# Widget commands
#----------------------------------------------------------------------
#----------------------------------------------------------------------
#
# Private Methods
#----------------------------------------------------------------------
#----------------------------------------------------------------------
# virtual functions to query the client window's scroll requirement
#----------------------------------------------------------------------
proc tixScrolledTList:GeometryInfo {w mW mH} {
upvar #0 $w data
return [$data(w:tlist) geometryinfo $mW $mH]
}
# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: STList.tcl,v 1.4 2001/12/09 05:04:02 idiscovery Exp $
#
# STList.tcl --
#
# This file implements Scrolled TList widgets
#
# 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.
#
tixWidgetClass tixScrolledTList {
-classname TixScrolledTList
-superclass tixScrolledWidget
-method {
}
-flag {
}
-configspec {
}
-default {
{.scrollbar auto}
{*borderWidth 1}
{*tlist.background #c3c3c3}
{*tlist.highlightBackground #d9d9d9}
{*tlist.relief sunken}
{*tlist.takeFocus 1}
{*Scrollbar.takeFocus 0}
}
}
proc tixScrolledTList:ConstructWidget {w} {
upvar #0 $w data
tixChainMethod $w ConstructWidget
set data(w:tlist) \
[tixTList $w.tlist]
set data(w:hsb) \
[scrollbar $w.hsb -orient horizontal]
set data(w:vsb) \
[scrollbar $w.vsb -orient vertical ]
set data(pw:client) $data(w:tlist)
}
proc tixScrolledTList:SetBindings {w} {
upvar #0 $w data
tixChainMethod $w SetBindings
$data(w:tlist) config \
-xscrollcommand "$data(w:hsb) set"\
-yscrollcommand "$data(w:vsb) set"\
-sizecmd [list tixScrolledWidget:Configure $w]
$data(w:hsb) config -command "$data(w:tlist) xview"
$data(w:vsb) config -command "$data(w:tlist) yview"
}
#----------------------------------------------------------------------
#
# option configs
#----------------------------------------------------------------------
proc tixScrolledTList:config-takefocus {w value} {
upvar #0 $w data
$data(w:tlist) config -takefocus $value
}
#----------------------------------------------------------------------
#
# Widget commands
#----------------------------------------------------------------------
#----------------------------------------------------------------------
#
# Private Methods
#----------------------------------------------------------------------
#----------------------------------------------------------------------
# virtual functions to query the client window's scroll requirement
#----------------------------------------------------------------------
proc tixScrolledTList:GeometryInfo {w mW mH} {
upvar #0 $w data
return [$data(w:tlist) geometryinfo $mW $mH]
}

Some files were not shown because too many files have changed in this diff Show More