| Current Path : /home/emeraadmin/public_html/4d695/ |
| Current File : /home/emeraadmin/public_html/4d695/tcl8.6.zip |
PK '�\��Ҽ� � Tix8.4.3/EFileDlg.tclnu �[��� # -*- 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]"
}
PK '�\5 o o Tix8.4.3/Event.tclnu �[��� # -*- 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
}
}
PK '�\-ϟ� 8 8 Tix8.4.3/FileBox.tclnu �[��� # -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: FileBox.tcl,v 1.5 2004/03/28 02:44:57 hobbs Exp $
#
# FileBox.tcl --
#
# Implements the 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 tixFileSelectBox {
-superclass tixPrimitive
-classname TixFileSelectBox
-method {
filter invoke
}
-flag {
-browsecmd -command -dir -directory -disablecallback
-grab -pattern -selection -value
}
-configspec {
{-browsecmd browseCmd BrowseCmd ""}
{-command command Command ""}
{-directory directory Directory ""}
{-disablecallback disableCallback DisableCallback 0 tixVerifyBoolean}
{-grab grab Grab global}
{-pattern pattern Pattern *}
{-value value Value ""}
}
-alias {
{-selection -value}
{-dir -directory}
}
-forcecall {
-value
}
-default {
{.relief raised}
{*filelist*Listbox.takeFocus true}
{.borderWidth 1}
{*Label.anchor w}
{*Label.borderWidth 0}
{*TixComboBox*scrollbar auto}
{*TixComboBox*Label.anchor w}
{*TixScrolledListBox.scrollbar auto}
{*Listbox.exportSelection false}
{*directory*Label.text "Directories:"}
{*directory*Label.underline 0}
{*file*Label.text "Files:"}
{*file*Label.underline 2}
{*filter.label "Filter:"}
{*filter*label.underline 3}
{*filter.labelSide top}
{*selection.label "Selection:"}
{*selection*label.underline 0}
{*selection.labelSide top}
}
}
proc tixFileSelectBox:InitWidgetRec {w} {
upvar #0 $w data
global env
tixChainMethod $w InitWidgetRec
if {$data(-directory) eq ""} {
set data(-directory) [pwd]
}
if {$data(-pattern) eq ""} {
set data(-pattern) "*"
}
tixFileSelectBox:SetPat $w $data(-pattern)
tixFileSelectBox:SetDir $w [tixFSNormalize $data(-directory)]
set data(flag) 0
set data(fakeDir) 0
}
#----------------------------------------------------------------------
# Construct widget
#----------------------------------------------------------------------
proc tixFileSelectBox:ConstructWidget {w} {
upvar #0 $w data
tixChainMethod $w ConstructWidget
set frame1 [tixFileSelectBox:CreateFrame1 $w]
set frame2 [tixFileSelectBox:CreateFrame2 $w]
set frame3 [tixFileSelectBox:CreateFrame3 $w]
pack $frame1 -in $w -side top -fill x
pack $frame3 -in $w -side bottom -fill x
pack $frame2 -in $w -side top -fill both -expand yes
}
proc tixFileSelectBox:CreateFrame1 {w} {
upvar #0 $w data
frame $w.f1 -border 10
tixComboBox $w.f1.filter -editable 1\
-command [list $w filter] -anchor e \
-options {
slistbox.scrollbar auto
listbox.height 5
label.anchor w
}
set data(w:filter) $w.f1.filter
pack $data(w:filter) -side top -expand yes -fill both
return $w.f1
}
proc tixFileSelectBox:CreateFrame2 {w} {
upvar #0 $w data
tixPanedWindow $w.f2 -orientation horizontal
# THE LEFT FRAME
#-----------------------
set dir [$w.f2 add directory -size 120]
$dir config -relief flat
label $dir.lab
set data(w:dirlist) [tixScrolledListBox $dir.dirlist\
-scrollbar auto\
-options {listbox.width 4 listbox.height 6}]
pack $dir.lab -side top -fill x -padx 10
pack $data(w:dirlist) -side bottom -expand yes -fill both -padx 10
# THE RIGHT FRAME
#-----------------------
set file [$w.f2 add file -size 160]
$file config -relief flat
label $file.lab
set data(w:filelist) [tixScrolledListBox $file.filelist \
-scrollbar auto\
-options {listbox.width 4 listbox.height 6}]
pack $file.lab -side top -fill x -padx 10
pack $data(w:filelist) -side bottom -expand yes -fill both -padx 10
return $w.f2
}
proc tixFileSelectBox:CreateFrame3 {w} {
upvar #0 $w data
frame $w.f3 -border 10
tixComboBox $w.f3.selection -editable 1\
-command [list tixFileSelectBox:SelInvoke $w] \
-anchor e \
-options {
slistbox.scrollbar auto
listbox.height 5
label.anchor w
}
set data(w:selection) $w.f3.selection
pack $data(w:selection) -side top -fill both
return $w.f3
}
proc tixFileSelectBox:SelInvoke {w args} {
upvar #0 $w data
set event [tixEvent type]
if {$event ne "<FocusOut>" && $event ne "<Tab>"} {
$w invoke
}
}
proc tixFileSelectBox:SetValue {w value} {
upvar #0 $w data
set data(i-value) $value
set data(-value) [tixFSNative $value]
}
proc tixFileSelectBox:SetDir {w value} {
upvar #0 $w data
set data(i-directory) $value
set data(-directory) [tixFSNative $value]
}
proc tixFileSelectBox:SetPat {w value} {
upvar #0 $w data
set data(i-pattern) $value
set data(-pattern) [tixFSNative $value]
}
#----------------------------------------------------------------------
# BINDINGS
#----------------------------------------------------------------------
proc tixFileSelectBox:SetBindings {w} {
upvar #0 $w data
tixChainMethod $w SetBindings
tixDoWhenMapped $w [list tixFileSelectBox:FirstMapped $w]
$data(w:dirlist) config \
-browsecmd [list tixFileSelectBox:SelectDir $w] \
-command [list tixFileSelectBox:InvokeDir $w]
$data(w:filelist) config \
-browsecmd [list tixFileSelectBox:SelectFile $w] \
-command [list tixFileSelectBox:InvokeFile $w]
}
#----------------------------------------------------------------------
# CONFIG OPTIONS
#----------------------------------------------------------------------
proc tixFileSelectBox:config-directory {w value} {
upvar #0 $w data
if {$value eq ""} {
set value [pwd]
}
tixFileSelectBox:SetDir $w [tixFSNormalize $value]
tixFileSelectBox:SetFilter $w $data(i-directory) $data(i-pattern)
$w filter
return $data(-directory)
}
proc tixFileSelectBox:config-pattern {w value} {
upvar #0 $w data
if {$value eq ""} {
set value "*"
}
tixFileSelectBox:SetPat $w $value
tixFileSelectBox:SetFilter $w $data(i-directory) $data(i-pattern)
# Returning a value means we have overridden the value and updated
# the widget record ourselves.
#
return $data(-pattern)
}
proc tixFileSelectBox:config-value {w value} {
upvar #0 $w data
tixFileSelectBox:SetValue $w [tixFSNormalize $value]
tixSetSilent $data(w:selection) $value
return $data(-value)
}
#----------------------------------------------------------------------
# PUBLIC METHODS
#----------------------------------------------------------------------
proc tixFileSelectBox:filter {w args} {
upvar #0 $w data
$data(w:filter) popdown
tixFileSelectBox:InterpFilter $w
tixFileSelectBox:LoadDir $w
}
proc tixFileSelectBox:invoke {w args} {
upvar #0 $w data
if {[$data(w:selection) cget -value] ne
[$data(w:selection) cget -selection]} {
# this will in turn call "invoke" again ...
#
$data(w:selection) invoke
return
}
# record the filter
#
set filter [tixFileSelectBox:InterpFilter $w]
$data(w:filter) addhistory $filter
# record the selection
#
set userInput [string trim [$data(w:selection) cget -value]]
tixFileSelectBox:SetValue $w \
[tixFSNormalize [file join $data(i-directory) $userInput]]
$data(w:selection) addhistory $data(-value)
$data(w:filter) align
$data(w:selection) align
if {[llength $data(-command)] && !$data(-disablecallback)} {
set bind(specs) "%V"
set bind(%V) $data(-value)
tixEvalCmdBinding $w $data(-command) bind $data(-value)
}
}
#----------------------------------------------------------------------
# INTERNAL METHODS
#----------------------------------------------------------------------
# InterpFilter:
# Interprets the value of the w:filter widget.
#
# Side effects:
# Changes the fields data(-directory) and data(-pattenn)
#
proc tixFileSelectBox:InterpFilter {w {filter ""}} {
upvar #0 $w data
if {$filter == ""} {
set filter [$data(w:filter) cget -selection]
if {$filter == ""} {
set filter [$data(w:filter) cget -value]
}
}
set i_filter [tixFSNormalize $filter]
if {[file isdirectory $filter]} {
tixFileSelectBox:SetDir $w $i_filter
tixFileSelectBox:SetPat $w "*"
} else {
set nDir [file dirname $filter]
if {$nDir eq "" || $nDir eq "."} {
tixFileSelectBox:SetDir $w [tixFSNormalize $data(i-directory)]
} else {
tixFileSelectBox:SetDir $w [tixFSNormalize $nDir]
}
tixFileSelectBox:SetPat $w [file tail $filter]
}
tixFileSelectBox:SetFilter $w $data(i-directory) $data(i-pattern)
return $data(filter)
}
proc tixFileSelectBox:SetFilter {w dir pattern} {
upvar #0 $w data
set data(filter) [file join $dir $pattern]
tixSetSilent $data(w:filter) $data(filter)
}
proc tixFileSelectBox:LoadDirIntoLists {w} {
upvar #0 $w data
$data(w:dirlist) subwidget listbox delete 0 end
$data(w:filelist) subwidget listbox delete 0 end
set dir $data(i-directory)
# (1) List the directories
#
set isDrive [expr {[llength [file split $dir]] == 1}]
foreach name [tixFSListDir $dir 1 0 1 1] {
if {".." eq $name && $isDrive} { continue }
$data(w:dirlist) subwidget listbox insert end $name
}
# (2) List the files
#
# %% UNIX'ISM:
# If the pattern is "*" force glob to list the .* files.
# However, since the user might not
# be interested in them, shift the listbox so that the "normal" files
# are seen first
#
# NOTE: if we pass $pat == "" but with $showHidden set to true,
# tixFSListDir will list "* .*" in Unix. See the comment on top of
# the tixFSListDir code.
#
if {$data(i-pattern) eq "*"} {
set pat ""
} else {
set pat $data(i-pattern)
}
set top 0
foreach name [tixFSListDir $dir 0 1 0 0 $pat] {
$data(w:filelist) subwidget listbox insert end $name
if {[string match .* $name]} {
incr top
}
}
$data(w:filelist) subwidget listbox yview $top
}
proc tixFileSelectBox:LoadDir {w} {
upvar #0 $w data
tixBusy $w on [$data(w:dirlist) subwidget listbox]
tixFileSelectBox:LoadDirIntoLists $w
if {[$data(w:dirlist) subwidget listbox size] == 0} {
# fail safe, just in case the user has inputed an errnoeuos
# directory
$data(w:dirlist) subwidget listbox insert 0 ".."
}
tixWidgetDoWhenIdle tixBusy $w off [$data(w:dirlist) subwidget listbox]
}
# User single clicks on the directory listbox
#
proc tixFileSelectBox:SelectDir {w} {
upvar #0 $w data
if {$data(fakeDir) > 0} {
incr data(fakeDir) -1
$data(w:dirlist) subwidget listbox select clear 0 end
$data(w:dirlist) subwidget listbox activate -1
return
}
if {$data(flag)} {
return
}
set data(flag) 1
set subdir [tixListboxGetCurrent [$data(w:dirlist) subwidget listbox]]
if {$subdir == ""} {
set subdir "."
}
tixFileSelectBox:SetFilter $w \
[tixFSNormalize [file join $data(i-directory) $subdir]] \
$data(i-pattern)
set data(flag) 0
}
proc tixFileSelectBox:InvokeDir {w} {
upvar #0 $w data
set theDir [$data(w:dirlist) subwidget listbox get active]
tixFileSelectBox:SetDir $w \
[tixFSNormalize [file join $data(i-directory) $theDir]]
$data(w:dirlist) subwidget listbox select clear 0 end
tixFileSelectBox:SetFilter $w $data(i-directory) $data(i-pattern)
tixFileSelectBox:InterpFilter $w [tixFSNativeNorm $data(filter)]
tixFileSelectBox:LoadDir $w
if {![tixEvent match <Return>]} {
incr data(fakeDir) 1
}
}
proc tixFileSelectBox:SelectFile {w} {
upvar #0 $w data
if {$data(flag)} {
return
}
set data(flag) 1
# Reset the "Filter:" box to the current directory:
#
$data(w:dirlist) subwidget listbox select clear 0 end
tixFileSelectBox:SetFilter $w $data(i-directory) $data(i-pattern)
# Now select the file
#
set selected [tixListboxGetCurrent [$data(w:filelist) subwidget listbox]]
if {$selected != ""} {
# Make sure that the selection is not empty!
#
tixFileSelectBox:SetValue $w \
[tixFSNormalize [file join $data(i-directory) $selected]]
tixSetSilent $data(w:selection) $data(-value)
if {[llength $data(-browsecmd)]} {
tixEvalCmdBinding $w $data(-browsecmd) "" $data(-value)
}
}
set data(flag) 0
}
proc tixFileSelectBox:InvokeFile {w} {
upvar #0 $w data
set selected [tixListboxGetCurrent [$data(w:filelist) subwidget listbox]]
if {$selected != ""} {
$w invoke
}
}
# This is only called the first this fileBox is mapped -- load the directory
#
proc tixFileSelectBox:FirstMapped {w} {
if {![winfo exists $w]} {
return
}
upvar #0 $w data
tixFileSelectBox:SetFilter $w $data(i-directory) $data(i-pattern)
tixFileSelectBox:LoadDir $w
$data(w:filter) align
}
#----------------------------------------------------------------------
#
#
# C O N V E N I E N C E R O U T I N E S
#
#
#----------------------------------------------------------------------
# This is obsolete. Use the widget tixFileSelectDialog instead
#
#
proc tixMkFileDialog {w args} {
set option(-okcmd) ""
set option(-helpcmd) ""
tixHandleOptions option {-okcmd -helpcmd} $args
toplevel $w
wm minsize $w 10 10
tixStdDlgBtns $w.btns
if {$option(-okcmd) != ""} {
tixFileSelectBox $w.fsb \
-command "[list wm withdraw $w]; $option(-okcmd)"
} else {
tixFileSelectBox $w.fsb -command [list wm withdraw $w]
}
$w.btns button ok config -command [list $w.fsb invoke]
$w.btns button apply config -command [list $w.fsb filter] -text Filter
$w.btns button cancel config -command [list wm withdraw $w]
if {$option(-helpcmd) == ""} {
$w.btns button help config -state disabled
} else {
$w.btns button help config -command $option(-helpcmd)
}
wm protocol $w WM_DELETE_WINDOW [list wm withdraw $w]
pack $w.btns -side bottom -fill both
pack $w.fsb -fill both -expand yes
return $w.fsb
}
PK '�\<K6=� � Tix8.4.3/FileCbx.tclnu �[��� # -*- 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
}
PK '�\0��� � Tix8.4.3/FileDlg.tclnu �[��� # -*- 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
}
}
PK '�\.˓v� � Tix8.4.3/FileEnt.tclnu �[��� # -*- 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
}
PK '�\�rh h Tix8.4.3/FloatEnt.tclnu �[��� # -*- 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)
}
}
PK '�\(Cf�T �T Tix8.4.3/Grid.tclnu �[��� # -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: Grid.tcl,v 1.6 2004/03/28 02:44:57 hobbs Exp $
#
# Grid.tcl --
#
# This file defines the default bindings for Tix Grid 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.
#
global tkPriv
if {![llength [info globals tkPriv]]} {
tk::unsupported::ExposePrivateVariable tkPriv
}
#--------------------------------------------------------------------------
# tkPriv elements used in this file:
#
# afterId - Token returned by "after" for autoscanning.
# fakeRelease - Cancel the ButtonRelease-1 after the user double click
#--------------------------------------------------------------------------
#
foreach fun {tkCancelRepeat} {
if {![llength [info commands $fun]]} {
tk::unsupported::ExposePrivateCommand $fun
}
}
unset fun
proc tixGridBind {} {
tixBind TixGrid <ButtonPress-1> {
tixGrid:Button-1 %W %x %y
}
tixBind TixGrid <Shift-ButtonPress-1> {
tixGrid:Shift-Button-1 %W %x %y
}
tixBind TixGrid <Control-ButtonPress-1> {
tixGrid:Control-Button-1 %W %x %y
}
tixBind TixGrid <ButtonRelease-1> {
tixGrid:ButtonRelease-1 %W %x %y
}
tixBind TixGrid <Double-ButtonPress-1> {
tixGrid:Double-1 %W %x %y
}
tixBind TixGrid <B1-Motion> {
set tkPriv(x) %x
set tkPriv(y) %y
set tkPriv(X) %X
set tkPriv(Y) %Y
tixGrid:B1-Motion %W %x %y
}
tixBind TixGrid <Control-B1-Motion> {
set tkPriv(x) %x
set tkPriv(y) %y
set tkPriv(X) %X
set tkPriv(Y) %Y
tixGrid:Control-B1-Motion %W %x %y
}
tixBind TixGrid <B1-Leave> {
set tkPriv(x) %x
set tkPriv(y) %y
set tkPriv(X) %X
set tkPriv(Y) %Y
tixGrid:B1-Leave %W
}
tixBind TixGrid <B1-Enter> {
tixGrid:B1-Enter %W %x %y
}
tixBind TixGrid <Control-B1-Leave> {
set tkPriv(x) %x
set tkPriv(y) %y
set tkPriv(X) %X
set tkPriv(Y) %Y
tixGrid:Control-B1-Leave %W
}
tixBind TixGrid <Control-B1-Enter> {
tixGrid:Control-B1-Enter %W %x %y
}
# Keyboard bindings
#
tixBind TixGrid <Up> {
tixGrid:DirKey %W up
}
tixBind TixGrid <Down> {
tixGrid:DirKey %W down
}
tixBind TixGrid <Left> {
tixGrid:DirKey %W left
}
tixBind TixGrid <Right> {
tixGrid:DirKey %W right
}
tixBind TixGrid <Prior> {
%W yview scroll -1 pages
}
tixBind TixGrid <Next> {
%W yview scroll 1 pages
}
tixBind TixGrid <Return> {
tixGrid:Return %W
}
tixBind TixGrid <space> {
tixGrid:Space %W
}
#
# Don't use tixBind because %A causes Tk 8.3.2 to crash
#
bind TixGrid <MouseWheel> {
%W yview scroll [expr {- (%D / 120) * 2}] units
}
}
#----------------------------------------------------------------------
#
#
# Mouse bindings
#
#
#----------------------------------------------------------------------
proc tixGrid:Button-1 {w x y} {
if {[$w cget -state] eq "disabled"} {
return
}
tixGrid:SetFocus $w
if {[tixGrid:GetState $w] == 0} {
tixGrid:GoState 1 $w $x $y
}
}
proc tixGrid:Shift-Button-1 {w x y} {
if {[$w cget -state] eq "disabled"} {
return
}
tixGrid:SetFocus $w
}
proc tixGrid:Control-Button-1 {w x y} {
if {[$w cget -state] eq "disabled"} {
return
}
tixGrid:SetFocus $w
case [tixGrid:GetState $w] {
{s0} {
tixGrid:GoState s1 $w $x $y
}
{b0} {
tixGrid:GoState b1 $w $x $y
}
{m0} {
tixGrid:GoState m1 $w $x $y
}
{e0} {
tixGrid:GoState e10 $w $x $y
}
}
}
proc tixGrid:ButtonRelease-1 {w x y} {
case [tixGrid:GetState $w] {
{2} {
tixGrid:GoState 5 $w $x $y
}
{4} {
tixGrid:GoState 3 $w $x $y
}
}
}
proc tixGrid:B1-Motion {w x y} {
case [tixGrid:GetState $w] {
{2 4} {
tixGrid:GoState 4 $w $x $y
}
}
}
proc tixGrid:Control-B1-Motion {w x y} {
case [tixGrid:GetState $w] {
{s2 s4} {
tixGrid:GoState s4 $w $x $y
}
{b2 b4} {
tixGrid:GoState b4 $w $x $y
}
{m2 m5} {
tixGrid:GoState m4 $w $x $y
}
}
}
proc tixGrid:Double-1 {w x y} {
case [tixGrid:GetState $w] {
{s0} {
tixGrid:GoState s7 $w $x $y
}
{b0} {
tixGrid:GoState b7 $w $x $y
}
}
}
proc tixGrid:B1-Leave {w} {
case [tixGrid:GetState $w] {
{s2 s4} {
tixGrid:GoState s5 $w
}
{b2 b4} {
tixGrid:GoState b5 $w
}
{m2 m5} {
tixGrid:GoState m8 $w
}
{e2 e5} {
tixGrid:GoState e8 $w
}
}
}
proc tixGrid:B1-Enter {w x y} {
case [tixGrid:GetState $w] {
{s5 s6} {
tixGrid:GoState s4 $w $x $y
}
{b5 b6} {
tixGrid:GoState b4 $w $x $y
}
{m8 m9} {
tixGrid:GoState m4 $w $x $y
}
{e8 e9} {
tixGrid:GoState e4 $w $x $y
}
}
}
proc tixGrid:Control-B1-Leave {w} {
case [tixGrid:GetState $w] {
{s2 s4} {
tixGrid:GoState s5 $w
}
{b2 b4} {
tixGrid:GoState b5 $w
}
{m2 m5} {
tixGrid:GoState m8 $w
}
}
}
proc tixGrid:Control-B1-Enter {w x y} {
case [tixGrid:GetState $w] {
{s5 s6} {
tixGrid:GoState s4 $w $x $y
}
{b5 b6} {
tixGrid:GoState b4 $w $x $y
}
{m8 m9} {
tixGrid:GoState m4 $w $x $y
}
}
}
proc tixGrid:AutoScan {w} {
case [tixGrid:GetState $w] {
{s5 s6} {
tixGrid:GoState s6 $w
}
{b5 b6} {
tixGrid:GoState b6 $w
}
{m8 m9} {
tixGrid:GoState m9 $w
}
{e8 e9} {
tixGrid:GoState e9 $w
}
}
}
#----------------------------------------------------------------------
#
#
# Key bindings
#
#
#----------------------------------------------------------------------
proc tixGrid:DirKey {w key} {
if {[$w cget -state] eq "disabled"} {
return
}
case [tixGrid:GetState $w] {
{s0} {
tixGrid:GoState s8 $w $key
}
{b0} {
tixGrid:GoState b8 $w $key
}
}
}
proc tixGrid:Return {w} {
if {[$w cget -state] eq "disabled"} {
return
}
case [tixGrid:GetState $w] {
{s0} {
tixGrid:GoState s9 $w
}
{b0} {
tixGrid:GoState b9 $w
}
}
}
proc tixGrid:Space {w} {
if {[$w cget -state] eq "disabled"} {
return
}
case [tixGrid:GetState $w] {
{s0} {
tixGrid:GoState s10 $w
}
{b0} {
tixGrid:GoState b10 $w
}
}
}
#----------------------------------------------------------------------
#
# STATE MANIPULATION
#
#
#----------------------------------------------------------------------
proc tixGrid:GetState {w} {
global $w:priv:state
if {![info exists $w:priv:state]} {
set $w:priv:state 0
}
return [set $w:priv:state]
}
proc tixGrid:SetState {w n} {
global $w:priv:state
set $w:priv:state $n
}
proc tixGrid:GoState {n w args} {
# puts "going from [tixGrid:GetState $w] --> $n"
tixGrid:SetState $w $n
eval tixGrid:GoState-$n $w $args
}
#----------------------------------------------------------------------
# SELECTION ROUTINES
#----------------------------------------------------------------------
proc tixGrid:SelectSingle {w ent} {
$w selection set [lindex $ent 0] [lindex $ent 1]
tixGrid:CallBrowseCmd $w $ent
}
#----------------------------------------------------------------------
# SINGLE SELECTION
#----------------------------------------------------------------------
proc tixGrid:GoState-0 {w} {
set list $w:_list
global $list
if {[info exists $list]} {
foreach cmd [set $list] {
uplevel #0 $cmd
}
if {[info exists $list]} {
unset $list
}
}
}
proc tixGrid:GoState-1 {w x y} {
set ent [$w nearest $x $y]
if {$ent != ""} {
tixGrid:SetAnchor $w $ent
}
tixGrid:CheckEdit $w
$w selection clear 0 0 max max
if {[$w cget -selectmode] ne "single"} {
tixGrid:SelectSingle $w $ent
}
tixGrid:GoState 2 $w
}
proc tixGrid:GoState-2 {w} {
}
proc tixGrid:GoState-3 {w x y} {
set ent [$w nearest $x $y]
if {$ent != ""} {
tixGrid:SelectSingle $w $ent
}
tixGrid:GoState 0 $w
}
proc tixGrid:GoState-5 {w x y} {
set ent [$w nearest $x $y]
if {$ent != ""} {
tixGrid:SelectSingle $w $ent
tixGrid:SetEdit $w $ent
}
tixGrid:GoState 0 $w
}
proc tixGrid:GoState-4 {w x y} {
set ent [$w nearest $x $y]
case [$w cget -selectmode] {
single {
tixGrid:SetAnchor $w $ent
}
browse {
tixGrid:SetAnchor $w $ent
$w selection clear 0 0 max max
tixGrid:SelectSingle $w $ent
}
{multiple extended} {
set anchor [$w anchor get]
$w selection adjust [lindex $anchor 0] [lindex $anchor 1] \
[lindex $ent 0] [lindex $ent 1]
}
}
}
proc tixGrid:GoState-s5 {w} {
tixGrid:StartScan $w
}
proc tixGrid:GoState-s6 {w} {
global tkPriv
tixGrid:DoScan $w
}
proc tixGrid:GoState-s7 {w x y} {
set ent [$w nearest $x $y]
if {$ent != ""} {
$w selection clear
$w selection set $ent
tixGrid:CallCommand $w $ent
}
tixGrid:GoState s0 $w
}
proc tixGrid:GoState-s8 {w key} {
set anchor [$w info anchor]
if {$anchor == ""} {
set anchor 0
} else {
set anchor [$w info $key $anchor]
}
$w anchor set $anchor
$w see $anchor
tixGrid:GoState s0 $w
}
proc tixGrid:GoState-s9 {w} {
set anchor [$w info anchor]
if {$anchor == ""} {
set anchor 0
$w anchor set $anchor
$w see $anchor
}
if {[$w info anchor] != ""} {
# ! may not have any elements
#
tixGrid:CallCommand $w [$w info anchor]
$w selection clear
$w selection set $anchor
}
tixGrid:GoState s0 $w
}
proc tixGrid:GoState-s10 {w} {
set anchor [$w info anchor]
if {$anchor == ""} {
set anchor 0
$w anchor set $anchor
$w see $anchor
}
if {[$w info anchor] != ""} {
# ! may not have any elements
#
tixGrid:CallBrowseCmd $w [$w info anchor]
$w selection clear
$w selection set $anchor
}
tixGrid:GoState s0 $w
}
#----------------------------------------------------------------------
# BROWSE SELECTION
#----------------------------------------------------------------------
proc tixGrid:GoState-b0 {w} {
}
proc tixGrid:GoState-b1 {w x y} {
set ent [$w nearest $x $y]
if {$ent != ""} {
$w anchor set $ent
$w selection clear
$w selection set $ent
tixGrid:CallBrowseCmd $w $ent
}
tixGrid:GoState b2 $w
}
proc tixGrid:GoState-b2 {w} {
}
proc tixGrid:GoState-b3 {w} {
set ent [$w info anchor]
if {$ent != ""} {
$w selection clear
$w selection set $ent
tixGrid:CallBrowseCmd $w $ent
}
tixGrid:GoState b0 $w
}
proc tixGrid:GoState-b4 {w x y} {
set ent [$w nearest $x $y]
if {$ent != ""} {
$w anchor set $ent
$w selection clear
$w selection set $ent
tixGrid:CallBrowseCmd $w $ent
}
}
proc tixGrid:GoState-b5 {w} {
tixGrid:StartScan $w
}
proc tixGrid:GoState-b6 {w} {
global tkPriv
tixGrid:DoScan $w
}
proc tixGrid:GoState-b7 {w x y} {
set ent [$w nearest $x $y]
if {$ent != ""} {
$w selection clear
$w selection set $ent
tixGrid:CallCommand $w $ent
}
tixGrid:GoState b0 $w
}
proc tixGrid:GoState-b8 {w key} {
set anchor [$w info anchor]
if {$anchor == ""} {
set anchor 0
} else {
set anchor [$w info $key $anchor]
}
$w anchor set $anchor
$w selection clear
$w selection set $anchor
$w see $anchor
tixGrid:CallBrowseCmd $w $anchor
tixGrid:GoState b0 $w
}
proc tixGrid:GoState-b9 {w} {
set anchor [$w info anchor]
if {$anchor == ""} {
set anchor 0
$w anchor set $anchor
$w see $anchor
}
if {[$w info anchor] != ""} {
# ! may not have any elements
#
tixGrid:CallCommand $w [$w info anchor]
$w selection clear
$w selection set $anchor
}
tixGrid:GoState b0 $w
}
proc tixGrid:GoState-b10 {w} {
set anchor [$w info anchor]
if {$anchor == ""} {
set anchor 0
$w anchor set $anchor
$w see $anchor
}
if {[$w info anchor] != ""} {
# ! may not have any elements
#
tixGrid:CallBrowseCmd $w [$w info anchor]
$w selection clear
$w selection set $anchor
}
tixGrid:GoState b0 $w
}
#----------------------------------------------------------------------
# MULTIPLE SELECTION
#----------------------------------------------------------------------
proc tixGrid:GoState-m0 {w} {
}
proc tixGrid:GoState-m1 {w x y} {
set ent [$w nearest $x $y]
if {$ent != ""} {
$w anchor set $ent
$w selection clear
$w selection set $ent
tixGrid:CallBrowseCmd $w $ent
}
tixGrid:GoState m2 $w
}
proc tixGrid:GoState-m2 {w} {
}
proc tixGrid:GoState-m3 {w} {
set ent [$w info anchor]
if {$ent != ""} {
tixGrid:CallBrowseCmd $w $ent
}
tixGrid:GoState m0 $w
}
proc tixGrid:GoState-m4 {w x y} {
set from [$w info anchor]
set to [$w nearest $x $y]
if {$to != ""} {
$w selection clear
$w selection set $from $to
tixGrid:CallBrowseCmd $w $to
}
tixGrid:GoState m5 $w
}
proc tixGrid:GoState-m5 {w} {
}
proc tixGrid:GoState-m6 {w x y} {
set ent [$w nearest $x $y]
if {$ent != ""} {
tixGrid:CallBrowseCmd $w $ent
}
tixGrid:GoState m0 $w
}
proc tixGrid:GoState-m7 {w x y} {
set from [$w info anchor]
set to [$w nearest $x $y]
if {$from == ""} {
set from $to
$w anchor set $from
}
if {$to != ""} {
$w selection clear
$w selection set $from $to
tixGrid:CallBrowseCmd $w $to
}
tixGrid:GoState m5 $w
}
proc tixGrid:GoState-m8 {w} {
tixGrid:StartScan $w
}
proc tixGrid:GoState-m9 {w} {
tixGrid:DoScan $w
}
proc tixGrid:GoState-xm7 {w x y} {
set ent [$w nearest $x $y]
if {$ent != ""} {
$w selection clear
$w selection set $ent
tixGrid:CallCommand $w $ent
}
tixGrid:GoState m0 $w
}
#----------------------------------------------------------------------
# EXTENDED SELECTION
#----------------------------------------------------------------------
proc tixGrid:GoState-e0 {w} {
}
proc tixGrid:GoState-e1 {w x y} {
set ent [$w nearest $x $y]
if {$ent != ""} {
$w anchor set $ent
$w selection clear
$w selection set $ent
tixGrid:CallBrowseCmd $w $ent
}
tixGrid:GoState e2 $w
}
proc tixGrid:GoState-e2 {w} {
}
proc tixGrid:GoState-e3 {w} {
set ent [$w info anchor]
if {$ent != ""} {
tixGrid:CallBrowseCmd $w $ent
}
tixGrid:GoState e0 $w
}
proc tixGrid:GoState-e4 {w x y} {
set from [$w info anchor]
set to [$w nearest $x $y]
if {$to != ""} {
$w selection clear
$w selection set $from $to
tixGrid:CallBrowseCmd $w $to
}
tixGrid:GoState e5 $w
}
proc tixGrid:GoState-e5 {w} {
}
proc tixGrid:GoState-e6 {w x y} {
set ent [$w nearest $x $y]
if {$ent != ""} {
tixGrid:CallBrowseCmd $w $ent
}
tixGrid:GoState e0 $w
}
proc tixGrid:GoState-e7 {w x y} {
set from [$w info anchor]
set to [$w nearest $x $y]
if {$from == ""} {
set from $to
$w anchor set $from
}
if {$to != ""} {
$w selection clear
$w selection set $from $to
tixGrid:CallBrowseCmd $w $to
}
tixGrid:GoState e5 $w
}
proc tixGrid:GoState-e8 {w} {
tixGrid:StartScan $w
}
proc tixGrid:GoState-e9 {w} {
tixGrid:DoScan $w
}
proc tixGrid:GoState-e10 {w x y} {
set ent [$w nearest $x $y]
if {$ent != ""} {
if {[$w info anchor] == ""} {
$w anchor set $ent
}
if {[$w selection includes $ent]} {
$w selection clear $ent
} else {
$w selection set $ent
}
tixGrid:CallBrowseCmd $w $ent
}
tixGrid:GoState e2 $w
}
proc tixGrid:GoState-xm7 {w x y} {
set ent [$w nearest $x $y]
if {$ent != ""} {
$w selection clear
$w selection set $ent
tixGrid:CallCommand $w $ent
}
tixGrid:GoState e0 $w
}
#----------------------------------------------------------------------
# HODGE PODGE
#----------------------------------------------------------------------
proc tixGrid:GoState-12 {w x y} {
tkCancelRepeat
tixGrid:GoState 5 $w $x $y
}
proc tixGrid:GoState-13 {w ent oldEnt} {
global tkPriv
set tkPriv(tix,indicator) $ent
set tkPriv(tix,oldEnt) $oldEnt
tixGrid:IndicatorCmd $w <Arm> $ent
}
proc tixGrid:GoState-14 {w x y} {
global tkPriv
if {[tixGrid:InsideArmedIndicator $w $x $y]} {
$w anchor set $tkPriv(tix,indicator)
$w select clear
$w select set $tkPriv(tix,indicator)
tixGrid:IndicatorCmd $w <Activate> $tkPriv(tix,indicator)
} else {
tixGrid:IndicatorCmd $w <Disarm> $tkPriv(tix,indicator)
}
unset tkPriv(tix,indicator)
tixGrid:GoState 0 $w
}
proc tixGrid:GoState-16 {w ent} {
if {$ent == ""} {
return
}
if {[$w cget -selectmode] ne "single"} {
tixGrid:Select $w $ent
tixGrid:Browse $w $ent
}
}
proc tixGrid:GoState-18 {w} {
global tkPriv
tkCancelRepeat
tixGrid:GoState 6 $w $tkPriv(x) $tkPriv(y)
}
proc tixGrid:GoState-20 {w x y} {
global tkPriv
if {![tixGrid:InsideArmedIndicator $w $x $y]} {
tixGrid:GoState 21 $w $x $y
} else {
tixGrid:IndicatorCmd $w <Arm> $tkPriv(tix,indicator)
}
}
proc tixGrid:GoState-21 {w x y} {
global tkPriv
if {[tixGrid:InsideArmedIndicator $w $x $y]} {
tixGrid:GoState 20 $w $x $y
} else {
tixGrid:IndicatorCmd $w <Disarm> $tkPriv(tix,indicator)
}
}
proc tixGrid:GoState-22 {w} {
global tkPriv
if {$tkPriv(tix,oldEnt) != ""} {
$w anchor set $tkPriv(tix,oldEnt)
} else {
$w anchor clear
}
tixGrid:GoState 0 $w
}
#----------------------------------------------------------------------
# callback actions
#----------------------------------------------------------------------
proc tixGrid:SetAnchor {w ent} {
if {$ent ne ""} {
$w anchor set [lindex $ent 0] [lindex $ent 1]
# $w see $ent
}
}
proc tixGrid:Select {w ent} {
$w selection clear
$w select set $ent
}
proc tixGrid:StartScan {w} {
global tkPriv
set tkPriv(afterId) [after 50 tixGrid:AutoScan $w]
}
proc tixGrid:DoScan {w} {
global tkPriv
set x $tkPriv(x)
set y $tkPriv(y)
set X $tkPriv(X)
set Y $tkPriv(Y)
set out 0
if {$y >= [winfo height $w]} {
$w yview scroll 1 units
set out 1
}
if {$y < 0} {
$w yview scroll -1 units
set out 1
}
if {$x >= [winfo width $w]} {
$w xview scroll 2 units
set out 1
}
if {$x < 0} {
$w xview scroll -2 units
set out 1
}
if {$out} {
set tkPriv(afterId) [after 50 tixGrid:AutoScan $w]
}
}
proc tixGrid:CallBrowseCmd {w ent} {
return
set browsecmd [$w cget -browsecmd]
if {$browsecmd != ""} {
set bind(specs) {%V}
set bind(%V) $ent
tixEvalCmdBinding $w $browsecmd bind $ent
}
}
proc tixGrid:CallCommand {w ent} {
set command [$w cget -command]
if {$command != ""} {
set bind(specs) {%V}
set bind(%V) $ent
tixEvalCmdBinding $w $command bind $ent
}
}
# tixGrid:EditCell --
#
# This command is called when "$w edit set $x $y" is called. It causes
# an SetEdit call when the grid's state is 0.
#
proc tixGrid:EditCell {w x y} {
set list $w:_list
global $list
if {[tixGrid:GetState $w] == 0} {
tixGrid:SetEdit $w [list $x $y]
} else {
lappend $list [list tixGrid:SetEdit $w [list $x $y]]
}
}
# tixGrid:EditApply --
#
# This command is called when "$w edit apply $x $y" is called. It causes
# an CheckEdit call when the grid's state is 0.
#
proc tixGrid:EditApply {w} {
set list $w:_list
global $list
if {[tixGrid:GetState $w] == 0} {
tixGrid:CheckEdit $w
} else {
lappend $list [list tixGrid:CheckEdit $w]
}
}
# tixGrid:CheckEdit --
#
# This procedure is called when the user sets the focus on a cell.
# If another cell is being edited, apply the changes of that cell.
#
proc tixGrid:CheckEdit {w} {
set edit $w.tixpriv__edit
if {[winfo exists $edit]} {
#
# If it -command is not empty, it is being used for another cell.
# Invoke it so that the other cell can be updated.
#
if {[$edit cget -command] ne ""} {
$edit invoke
}
}
}
# tixGrid:SetEdit --
#
# Puts a floatentry on top of an editable entry.
#
proc tixGrid:SetEdit {w ent} {
set edit $w.tixpriv__edit
tixGrid:CheckEdit $w
set editnotifycmd [$w cget -editnotifycmd]
if {$editnotifycmd eq ""} {
return
}
set px [lindex $ent 0]
set py [lindex $ent 1]
if {![uplevel #0 $editnotifycmd $px $py]} {
return
}
if {[$w info exists $px $py]} {
if [catch {
set oldValue [$w entrycget $px $py -text]
}] {
# The entry doesn't support -text option. Can't edit it.
#
# If the application wants to force editing of an entry, it could
# delete or replace the entry in the editnotifyCmd procedure.
#
return
}
} else {
set oldValue ""
}
set bbox [$w info bbox [lindex $ent 0] [lindex $ent 1]]
set x [lindex $bbox 0]
set y [lindex $bbox 1]
set W [lindex $bbox 2]
set H [lindex $bbox 3]
if {![winfo exists $edit]} {
tixFloatEntry $edit
}
$edit config -command "tixGrid:DoneEdit $w $ent"
$edit post $x $y $W $H
$edit config -value $oldValue
}
proc tixGrid:DoneEdit {w x y args} {
set edit $w.tixpriv__edit
$edit config -command ""
$edit unpost
set value [tixEvent value]
if {[$w info exists $x $y]} {
if [catch {
$w entryconfig $x $y -text $value
}] {
return
}
} elseif {$value ne ""} {
if {[catch {
# This needs to be catch'ed because the default itemtype may
# not support the -text option
#
$w set $x $y -text $value
}]} {
return
}
} else {
return
}
set editDoneCmd [$w cget -editdonecmd]
if {$editDoneCmd ne ""} {
uplevel #0 $editDoneCmd $x $y
}
}
proc tixGrid:SetFocus {w} {
if {[$w cget -takefocus] && ![string match $w.* [focus -displayof $w]]} {
focus $w
}
}
PK '�\-��F �F Tix8.4.3/HList.tclnu �[��� # -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: HList.tcl,v 1.6 2004/03/28 02:44:57 hobbs Exp $
#
# HList.tcl --
#
# This file defines the default bindings for Tix Hierarchical Listbox
# 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.
#
global tkPriv
if {![llength [info globals tkPriv]]} {
tk::unsupported::ExposePrivateVariable tkPriv
}
#--------------------------------------------------------------------------
# tkPriv elements used in this file:
#
# afterId - Token returned by "after" for autoscanning.
# fakeRelease - Cancel the ButtonRelease-1 after the user double click
#--------------------------------------------------------------------------
#
foreach fun {tkCancelRepeat} {
if {![llength [info commands $fun]]} {
tk::unsupported::ExposePrivateCommand $fun
}
}
unset fun
proc tixHListBind {} {
tixBind TixHList <ButtonPress-1> {
tixHList:Button-1 %W %x %y ""
}
tixBind TixHList <Shift-ButtonPress-1> {
tixHList:Button-1 %W %x %y s
}
tixBind TixHList <Control-ButtonPress-1> {
tixHList:Button-1 %W %x %y c
}
tixBind TixHList <ButtonRelease-1> {
tixHList:ButtonRelease-1 %W %x %y
}
tixBind TixHList <Double-ButtonPress-1> {
tixHList:Double-1 %W %x %y
}
tixBind TixHList <B1-Motion> {
set tkPriv(x) %x
set tkPriv(y) %y
set tkPriv(X) %X
set tkPriv(Y) %Y
tixHList:B1-Motion %W %x %y
}
tixBind TixHList <B1-Leave> {
set tkPriv(x) %x
set tkPriv(y) %y
set tkPriv(X) %X
set tkPriv(Y) %Y
tixHList:B1-Leave %W
}
tixBind TixHList <B1-Enter> {
tixHList:B1-Enter %W %x %y
}
# Keyboard bindings
#
tixBind TixHList <Up> {
tixHList:UpDown %W prev ""
}
tixBind TixHList <Down> {
tixHList:UpDown %W next ""
}
tixBind TixHList <Shift-Up> {
tixHList:UpDown %W prev s
}
tixBind TixHList <Shift-Down> {
tixHList:UpDown %W next s
}
tixBind TixHList <Left> {
tixHList:LeftRight %W left
}
tixBind TixHList <Right> {
tixHList:LeftRight %W right
}
tixBind TixHList <Prior> {
%W yview scroll -1 pages
}
tixBind TixHList <Next> {
%W yview scroll 1 pages
}
tixBind TixHList <Return> {
tixHList:Keyboard-Activate %W
}
tixBind TixHList <space> {
tixHList:Keyboard-Browse %W
}
# Under Windows <Home> moves up, clears the sel and sets the selection
# Under Windows <Control-Home> moves up, leaves the selection, and sets the anchor
tixBind TixHList <Home> {
set w %W
$w yview moveto 0; # $w xview moveto 0
set sel [lindex [$w info children] 0]
# should be first not disabled
$w anchor set $sel
tixHList:Keyboard-Browse $w
}
tixBind TixHList <End> {
set w %W
$w yview moveto 1; # $w xview moveto 0
$w select clear
# should be last not disabled
set sel [lindex [$w info children .] end]
while {[set next [$w info next $sel]] ne "" && \
![$w info hidden $next] && \
[llength [set kids [$w info child $sel]]]} {
set sel [lindex $kids end]
}
$w anchor set $sel
tixHList:Keyboard-Browse $w
}
tixBind TixHList <Control-Home> {
set w %W
$w yview moveto 0; # $w xview moveto 0
set sel [lindex [$w info children] 0]
# should be first not disabled
$w anchor set $sel
}
tixBind TixHList <Control-End> {
set w %W
$w yview moveto 1; # $w xview moveto 0
# should be last not disabled
set sel [lindex [$w info children .] end]
while {[set next [$w info next $sel]] ne "" && \
![$w info hidden $next] && \
[llength [set kids [$w info child $sel]]]} {
set sel [lindex $kids end]
}
$w anchor set $sel
}
#
# Don't use tixBind because %A causes Tk 8.3.2 to crash
#
bind TixHList <MouseWheel> {
%W yview scroll [expr {- (%D / 120) * 2}] units
}
}
#----------------------------------------------------------------------
#
#
# Key bindings
#
#
#----------------------------------------------------------------------
proc tixHList:Keyboard-Activate {w} {
if {[tixHList:GetState $w] != 0} {
return
}
set ent [$w info anchor]
if {$ent eq ""} {
return
}
if {[$w cget -selectmode] eq "single"} {
$w select clear
}
$w select set $ent
set command [$w cget -command]
if {$command ne ""} {
set bind(specs) {%V}
set bind(%V) $ent
tixEvalCmdBinding $w $command bind $ent
}
}
proc tixHList:Keyboard-Browse {w} {
if {[tixHList:GetState $w] != 0} {
return
}
set ent [$w info anchor]
if {$ent eq ""} {
return
}
if {[$w cget -selectmode] eq "single"} {
$w select clear
}
$w select set $ent
tixHList:Browse $w $ent
}
proc tixHList:LeftRight {w spec} {
catch {
uplevel #0 unset $w:priv:shiftanchor
}
if {[tixHList:GetState $w] != 0} {
return
}
set anchor [$w info anchor]
if {$anchor eq ""} {
set anchor [lindex [$w info children] 0]
}
if {$anchor eq ""} {
return
}
set ent $anchor
while {1} {
set e $ent
if {$spec eq "left"} {
set ent [$w info parent $e]
if {$ent eq "" || [$w entrycget $ent -state] eq "disabled"} {
set ent [$w info prev $e]
}
} else {
set ent [lindex [$w info children $e] 0]
if {$ent eq "" || [$w entrycget $ent -state] eq "disabled"} {
set ent [$w info next $e]
}
}
if {$ent eq ""} {
break
}
if {[$w entrycget $ent -state] eq "disabled"} {
continue
}
if {[$w info hidden $ent]} {
continue
}
break
}
if {$ent eq ""} {
return
}
$w anchor set $ent
$w see $ent
if {[$w cget -selectmode] ne "single"} {
$w select clear
$w selection set $ent
tixHList:Browse $w $ent
}
}
proc tixHList:UpDown {w spec mod} {
if {[tixHList:GetState $w] ne 0} {
return
}
set anchor [$w info anchor]
set done 0
if {$anchor eq ""} {
set anchor [lindex [$w info children] 0]
if {$anchor eq ""} {
return
}
if {[$w entrycget $anchor -state] ne "disabled"} {
# That's a good anchor
set done 1
} else {
# We search for the first non-disabled entry (downward)
set spec next
}
}
set ent $anchor
# mike - bulletproofing
if {![$w info exists $ent]} {return}
# Find the prev/next non-disabled entry
#
while {!$done} {
set ent [$w info $spec $ent]
if {$ent eq ""} {
break
}
if {[$w entrycget $ent -state] eq "disabled"} {
continue
}
if {[$w info hidden $ent]} {
continue
}
break
}
if {$ent eq ""} {
return
} else {
$w see $ent
$w anchor set $ent
set selMode [$w cget -selectmode]
if {$mod eq "s" && ($selMode eq "extended" || $selMode eq "multiple")} {
global $w:priv:shiftanchor
if {![info exists $w:priv:shiftanchor]} {
set $w:priv:shiftanchor $anchor
}
$w selection clear
# mike - bulletproofing
if {![catch {$w selection set $ent [set $w:priv:shiftanchor]}]} {
tixHList:Browse $w $ent
}
} else {
catch {
uplevel #0 unset $w:priv:shiftanchor
}
if {[$w cget -selectmode] ne "single"} {
$w select clear
$w selection set $ent
tixHList:Browse $w $ent
}
}
}
}
#----------------------------------------------------------------------
#
#
# Mouse bindings
#
#
#----------------------------------------------------------------------
proc tixHList:Button-1 {w x y mod} {
# if {[$w cget -state] eq "disabled"} {
# return
# }
if {[$w cget -takefocus]} {
focus $w
}
set selMode [$w cget -selectmode]
case [tixHList:GetState $w] {
{0} {
if {$mod eq "s" && $selMode eq "multiple"} {
tixHList:GoState 28 $w $x $y
return
}
if {$mod eq "s" && $selMode eq "extended"} {
tixHList:GoState 28 $w $x $y
return
}
if {$mod eq "c" && $selMode eq "extended"} {
tixHList:GoState 33 $w $x $y
return
}
tixHList:GoState 1 $w $x $y
}
}
}
proc tixHList:ButtonRelease-1 {w x y} {
case [tixHList:GetState $w] {
{5 16} {
tixHList:GoState 6 $w $x $y
}
{15} {
tixHList:GoState 17 $w $x $y
}
{10 11} {
tixHList:GoState 18 $w
}
{13 20} {
tixHList:GoState 14 $w $x $y
}
{21} {
tixHList:GoState 22 $w
}
{24} {
tixHList:GoState 25 $w
}
{26 28 33} {
tixHList:GoState 27 $w
}
{30} {
tixHList:GoState 32 $w
}
}
}
proc tixHList:Double-1 {w x y} {
case [tixHList:GetState $w] {
{0} {
tixHList:GoState 23 $w $x $y
}
}
}
proc tixHList:B1-Motion {w x y} {
case [tixHList:GetState $w] {
{1} {
tixHList:GoState 5 $w $x $y
}
{5 16} {
tixHList:GoState 5 $w $x $y
}
{13 20 21} {
tixHList:GoState 20 $w $x $y
}
{24 26 28} {
tixHList:GoState 26 $w $x $y
}
}
}
proc tixHList:B1-Leave {w} {
case [tixHList:GetState $w] {
{5} {
tixHList:GoState 10 $w
}
{26} {
tixHList:GoState 29 $w
}
}
}
proc tixHList:B1-Enter {w x y} {
case [tixHList:GetState $w] {
{10 11} {
tixHList:GoState 12 $w $x $y
}
{29 30} {
tixHList:GoState 31 $w $x $y
}
}
}
proc tixHList:AutoScan {w} {
case [tixHList:GetState $w] {
{29 30} {
tixHList:GoState 30 $w
}
}
}
#----------------------------------------------------------------------
#
# STATE MANIPULATION
#
#
#----------------------------------------------------------------------
proc tixHList:GetState {w} {
global $w:priv:state
if {![info exists $w:priv:state]} {
set $w:priv:state 0
}
return [set $w:priv:state]
}
proc tixHList:SetState {w n} {
global $w:priv:state
set $w:priv:state $n
}
proc tixHList:GoState {n w args} {
# puts "going from [tixHList:GetState $w] --> $n"
tixHList:SetState $w $n
eval tixHList:GoState-$n $w $args
}
#----------------------------------------------------------------------
# States
#----------------------------------------------------------------------
proc tixHList:GoState-0 {w} {
}
proc tixHList:GoState-1 {w x y} {
set oldEnt [$w info anchor]
set ent [tixHList:SetAnchor $w $x $y 1]
if {$ent eq ""} {
tixHList:GoState 0 $w
return
}
set info [$w info item $x $y]
if {[lindex $info 1] eq "indicator"} {
tixHList:GoState 13 $w $ent $oldEnt
} else {
if {[$w entrycget $ent -state] eq "disabled"} {
tixHList:GoState 0 $w
} else {
case [$w cget -selectmode] {
{single browse} {
tixHList:GoState 16 $w $ent
}
default {
tixHList:GoState 24 $w $ent
}
}
}
}
}
proc tixHList:GoState-5 {w x y} {
set oldEnt [$w info anchor]
set ent [tixHList:SetAnchor $w $x $y]
if {$ent eq "" || $oldEnt eq $ent} {
return
}
if {[$w cget -selectmode] ne "single"} {
tixHList:Select $w $ent
tixHList:Browse $w $ent
}
}
proc tixHList:GoState-6 {w x y} {
set ent [tixHList:SetAnchor $w $x $y]
if {$ent eq ""} {
tixHList:GoState 0 $w
return
}
tixHList:Select $w $ent
tixHList:Browse $w $ent
tixHList:GoState 0 $w
}
proc tixHList:GoState-10 {w} {
tixHList:StartScan $w
}
proc tixHList:GoState-11 {w} {
global tkPriv
tixHList:DoScan $w
set oldEnt [$w info anchor]
set ent [tixHList:SetAnchor $w $tkPriv(x) $tkPriv(y)]
if {$ent eq "" || $oldEnt eq $ent} {
return
}
if {[$w cget -selectmode] ne "single"} {
tixHList:Select $w $ent
tixHList:Browse $w $ent
}
}
proc tixHList:GoState-12 {w x y} {
tkCancelRepeat
tixHList:GoState 5 $w $x $y
}
proc tixHList:GoState-13 {w ent oldEnt} {
global tkPriv
set tkPriv(tix,indicator) $ent
set tkPriv(tix,oldEnt) $oldEnt
tixHList:CallIndicatorCmd $w <Arm> $ent
}
proc tixHList:GoState-14 {w x y} {
global tkPriv
if {[tixHList:InsideArmedIndicator $w $x $y]} {
$w anchor set $tkPriv(tix,indicator)
$w select clear
$w select set $tkPriv(tix,indicator)
tixHList:CallIndicatorCmd $w <Activate> $tkPriv(tix,indicator)
} else {
tixHList:CallIndicatorCmd $w <Disarm> $tkPriv(tix,indicator)
}
unset tkPriv(tix,indicator)
tixHList:GoState 0 $w
}
proc tixHList:GoState-16 {w ent} {
if {$ent ne "" && [$w cget -selectmode] ne "single"} {
tixHList:Select $w $ent
tixHList:Browse $w $ent
}
}
proc tixHList:GoState-18 {w} {
global tkPriv
tkCancelRepeat
tixHList:GoState 6 $w $tkPriv(x) $tkPriv(y)
}
proc tixHList:GoState-20 {w x y} {
global tkPriv
if {![tixHList:InsideArmedIndicator $w $x $y]} {
tixHList:GoState 21 $w $x $y
} else {
tixHList:CallIndicatorCmd $w <Arm> $tkPriv(tix,indicator)
}
}
proc tixHList:GoState-21 {w x y} {
global tkPriv
if {[tixHList:InsideArmedIndicator $w $x $y]} {
tixHList:GoState 20 $w $x $y
} else {
tixHList:CallIndicatorCmd $w <Disarm> $tkPriv(tix,indicator)
}
}
proc tixHList:GoState-22 {w} {
global tkPriv
if {$tkPriv(tix,oldEnt) ne ""} {
$w anchor set $tkPriv(tix,oldEnt)
} else {
$w anchor clear
}
tixHList:GoState 0 $w
}
proc tixHList:GoState-23 {w x y} {
set ent [tixHList:GetNearest $w $y]
if {$ent ne ""} {
set info [$w info item $x $y]
if {[lindex $info 1] eq "indicator"} {
tixHList:CallIndicatorCmd $w <Activate> $ent
} else {
$w select set $ent
set command [$w cget -command]
if {$command ne ""} {
set bind(specs) {%V}
set bind(%V) $ent
tixEvalCmdBinding $w $command bind $ent
}
}
}
tixHList:GoState 0 $w
}
proc tixHList:GoState-24 {w ent} {
if {$ent ne ""} {
tixHList:Select $w $ent
tixHList:Browse $w $ent
}
}
proc tixHList:GoState-25 {w} {
set ent [$w info anchor]
if {$ent ne ""} {
tixHList:Select $w $ent
tixHList:Browse $w $ent
}
tixHList:GoState 0 $w
}
proc tixHList:GoState-26 {w x y} {
set anchor [$w info anchor]
if {$anchor eq ""} {
set first [lindex [$w info children ""] 0]
if {$first ne ""} {
$w anchor set $first
set anchor $first
} else {
return
}
}
set ent [tixHList:GetNearest $w $y 1]
if {$ent ne ""} {
$w selection clear
$w selection set $anchor $ent
tixHList:Browse $w $ent
}
}
proc tixHList:GoState-27 {w} {
set ent [$w info anchor]
if {$ent ne ""} {
tixHList:Browse $w $ent
}
tixHList:GoState 0 $w
}
proc tixHList:GoState-28 {w x y} {
set anchor [$w info anchor]
if {$anchor eq ""} {
set first [lindex [$w info children ""] 0]
if {$first ne ""} {
$w anchor set $first
set anchor $first
} else {
return
}
}
set ent [tixHList:GetNearest $w $y 1]
if {$ent ne ""} {
$w selection clear
$w selection set $anchor $ent
tixHList:Browse $w $ent
}
}
proc tixHList:GoState-29 {w} {
tixHList:StartScan $w
}
proc tixHList:GoState-30 {w} {
global tkPriv
tixHList:DoScan $w
set anchor [$w info anchor]
if {$anchor eq ""} {
set first [lindex [$w info children ""] 0]
if {$first ne ""} {
$w anchor set $first
set anchor $first
} else {
return
}
}
set ent [tixHList:GetNearest $w $tkPriv(y) 1]
if {$ent ne ""} {
$w selection clear
$w selection set $anchor $ent
tixHList:Browse $w $ent
}
}
proc tixHList:GoState-31 {w x y} {
tkCancelRepeat
tixHList:GoState 26 $w $x $y
}
proc tixHList:GoState-32 {w} {
tkCancelRepeat
tixHList:GoState 0 $w
}
proc tixHList:GoState-33 {w x y} {
set ent [tixHList:GetNearest $w $y]
if {$ent ne ""} {
$w anchor set $ent
if {[lsearch [$w selection get] $ent] > -1} {
# This was missing - mike
$w selection clear $ent
} else {
$w selection set $ent
}
tixHList:Browse $w $ent
}
}
#----------------------------------------------------------------------
#
# Common actions
#
#----------------------------------------------------------------------
proc tixHList:GetNearest {w y {disableOK 0}} {
set ent [$w nearest $y]
if {$ent ne ""} {
if {!$disableOK && [$w entrycget $ent -state] eq "disabled"} {
return ""
}
}
return $ent
}
proc tixHList:SetAnchor {w x y {disableOK 0}} {
set ent [tixHList:GetNearest $w $y $disableOK]
if {$ent ne ""} {
if {[$w entrycget $ent -state] ne "disabled"} {
$w anchor set $ent
# mike This is non-standard and has a wierd effect: too much motion
# $w see $ent
return $ent
} elseif $disableOK {
return $ent
}
}
return ""
}
proc tixHList:Select {w ent} {
if {[$w info selection] ne $ent} {
$w selection clear
$w select set $ent
}
}
#----------------------------------------------------------------------
#
# Auto scan
#
#----------------------------------------------------------------------
proc tixHList:StartScan {w} {
global tkPriv
set tkPriv(afterId) [after 50 tixHList:AutoScan $w]
}
proc tixHList:DoScan {w} {
global tkPriv
set x $tkPriv(x)
set y $tkPriv(y)
set X $tkPriv(X)
set Y $tkPriv(Y)
if {$y >= [winfo height $w]} {
$w yview scroll 1 units
} elseif {$y < 0} {
$w yview scroll -1 units
} elseif {$x >= [winfo width $w]} {
$w xview scroll 2 units
} elseif {$x < 0} {
$w xview scroll -2 units
} else {
return
}
set tkPriv(afterId) [after 50 tixHList:AutoScan $w]
}
#----------------------------------------------------------------------
#
# Indicator handling
#
#----------------------------------------------------------------------
proc tixHList:CallIndicatorCmd {w event ent} {
set cmd [$w cget -indicatorcmd]
if {$cmd ne ""} {
set bind(type) $event
set bind(specs) {%V}
set bind(%V) $ent
tixEvalCmdBinding $w $cmd bind $ent
}
}
proc tixHList:InsideArmedIndicator {w x y} {
global tkPriv
set ent [tixHList:GetNearest $w $y 1]
if {$ent eq "" || $ent ne $tkPriv(tix,indicator)} {
return 0
}
set info [$w info item $x $y]
if {[lindex $info 1] eq "indicator"} {
return 1
} else {
return 0
}
}
proc tixHList:Browse {w ent} {
set browsecmd [$w cget -browsecmd]
if {$browsecmd ne ""} {
set bind(specs) {%V}
set bind(%V) $ent
tixEvalCmdBinding $w $browsecmd bind $ent
}
}
PK '�\ި��� � Tix8.4.3/HListDD.tclnu �[��� # -*- 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"
PK '�\iW�� � Tix8.4.3/IconView.tclnu �[��� # -*- 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
#----------------------------------------------------------------------
PK '�\X6�:7 7 Tix8.4.3/Init.tclnu �[��� # -*- 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]]
}
PK '�\��_ _ Tix8.4.3/LabEntry.tclnu �[��� # -*- 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)
}
}
PK '�\(�R=� � Tix8.4.3/LabFrame.tclnu �[��� # -*- 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]
}
PK '�\s��Po o Tix8.4.3/LabWidg.tclnu �[��� # -*- 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
}
}
PK '�\����
�
Tix8.4.3/ListNBk.tclnu �[��� # -*- 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
}
}
PK '�\ʯn�* * Tix8.4.3/Meter.tclnu �[��� # -*- 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
}
PK '�\�LmTx x Tix8.4.3/MultView.tclnu �[��� # -*- 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"
}
PK '�\`��[ Tix8.4.3/NoteBook.tclnu �[��� # -*- 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"
PK '�\J��� � Tix8.4.3/OldUtil.tclnu �[��� # -*- 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
}
PK '�\:�~�$ �$ Tix8.4.3/OptMenu.tclnu �[��� # -*- 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
}
PK '�\w_���n �n Tix8.4.3/PanedWin.tclnu �[��� # -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: PanedWin.tcl,v 1.7 2004/03/28 02:44:57 hobbs Exp $
#
# PanedWin.tcl --
#
# This file implements the TixPanedWindow 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 tixPanedWindow {
-classname TixPanedWindow
-superclass tixPrimitive
-method {
add delete forget manage panecget paneconfigure panes setsize
}
-flag {
-command -dynamicgeometry -handleactivebg -handlebg -orient
-orientation -panebd -paneborderwidth -panerelief
-separatoractivebg -separatorbg
}
-static {
-orientation
}
-configspec {
{-command command Command ""}
{-dynamicgeometry dynamicGeometry DynamicGeometry 1 tixVerifyBoolean}
{-handleactivebg handleActiveBg HandleActiveBg #ececec}
{-handlebg handleBg Background #d9d9d9}
{-orientation orientation Orientation vertical}
{-paneborderwidth paneBorderWidth PaneBorderWidth 1}
{-panerelief paneRelief PaneRelief raised}
{-separatoractivebg separatorActiveBg SeparatorActiveBg red}
{-separatorbg separatorBg Background #d9d9d9}
}
-alias {
{-panebd -paneborderwidth}
{-orient -orientation}
}
}
#----------------------------------------------------------------------
# ClassInitialization:
#----------------------------------------------------------------------
proc tixPanedWindow:InitWidgetRec {w} {
upvar #0 $w data
tixChainMethod $w InitWidgetRec
set data(items) ""
set data(nItems) 0
set data(totalsize) 0
set data(movePending) 0
set data(repack) 0
set data(counter) 0
set data(maxReqW) 1
set data(maxReqH) 1
}
proc tixPanedWindow:ConstructWidget {w} {
upvar #0 $w data
tixChainMethod $w ConstructWidget
# Do nothing
}
proc tixPanedWindow:SetBindings {w} {
upvar #0 $w data
tixChainMethod $w SetBindings
bind $w <Configure> [list tixPanedWindow:MasterGeomProc $w ""]
}
#----------------------------------------------------------------------
# ConfigOptions:
#----------------------------------------------------------------------
proc tixPanedWindow:config-handlebg {w arg} {
upvar #0 $w data
for {set i 1} {$i < $data(nItems)} {incr i} {
$data(btn,$i) config -bg $arg
}
}
#----------------------------------------------------------------------
# PublicMethods:
#----------------------------------------------------------------------
# method: add
#
# Adds a new pane into the PanedWindow.
#
# options -size -max -min -allowresize
#
proc tixPanedWindow:add {w name args} {
upvar #0 $w data
if {[winfo exists $w.$name] && !$data($name,forgotten)} {
error "Pane $name is already managed"
}
# Step 1: Parse the options to get the children's size options
# The default values
#
if {[info exists data($name,forgotten)]} {
set option(-size) $data($name,size)
set option(-min) $data($name,min)
set option(-max) $data($name,max)
set option(-allowresize) $data($name,allowresize)
set option(-expand) $data($name,expand)
} else {
set option(-size) 0
set option(-min) 0
set option(-max) 100000
set option(-allowresize) 1
set option(-expand) 0
}
set option(-before) ""
set option(-after) ""
set option(-at) ""
set validOpts {-after -allowresize -at -before -expand -max -min -size}
tixHandleOptions option $validOpts $args
set data($name,size) $option(-size)
set data($name,rsize) $option(-size)
set data($name,min) $option(-min)
set data($name,max) $option(-max)
set data($name,allowresize) $option(-allowresize)
set data($name,expand) $option(-expand)
set data($name,forgotten) 0
if {$data($name,expand) < 0} {
set data($name,expand) 0
}
# Step 2: Add the frame and the separator (if necessary)
#
if {![winfo exist $w.$name]} {
# need to check because the frame may have been "forget'ten"
#
frame $w.$name -bd $data(-paneborderwidth) -relief $data(-panerelief)
}
if {$option(-at) != ""} {
set at [tixGetInt $option(-at)]
if {$at < 0} {
set at 0
}
} elseif {$option(-after) != ""} {
set index [lsearch -exact $data(items) $option(-after)]
if {$index == -1} {
error "Pane $option(-after) doesn't exists"
} else {
set at [incr index]
}
} elseif {$option(-before) != ""} {
set index [lsearch -exact $data(items) $option(-before)]
if {$index == -1} {
error "Pane $option(-before) doesn't exists"
}
set at $index
} else {
set at end
}
set data(items) [linsert $data(items) $at $name]
incr data(nItems)
if {$data(nItems) > 1} {
tixPanedWindow:AddSeparator $w
}
set data(w:$name) $w.$name
# Step 3: Add the new frame. Adjust the window later (do when idle)
#
tixManageGeometry $w.$name [list tixPanedWindow:ClientGeomProc $w]
bind $w.$name <Configure> \
[list tixPanedWindow:ClientGeomProc $w "" $w.$name]
tixPanedWindow:RepackWhenIdle $w
return $w.$name
}
proc tixPanedWindow:manage {w name args} {
upvar #0 $w data
if {![winfo exists $w.$name]} {
error "Pane $name does not exist"
}
if {!$data($name,forgotten)} {
error "Pane $name is already managed"
}
tixMapWindow $data(w:$name)
eval tixPanedWindow:add $w [list $name] $args
}
proc tixPanedWindow:forget {w name} {
upvar #0 $w data
if {![winfo exists $w.$name]} {
error "Pane $name does not exist"
}
if $data($name,forgotten) {
# It has already been forgotten
#
return
}
set items ""
foreach item $data(items) {
if {$item != $name} {
lappend items $item
}
}
set data(items) $items
incr data(nItems) -1
set i $data(nItems)
if {$i > 0} {
destroy $data(btn,$i)
destroy $data(sep,$i)
unset data(btn,$i)
unset data(sep,$i)
}
set data($name,forgotten) 1
tixUnmapWindow $w.$name
tixPanedWindow:RepackWhenIdle $w
}
proc tixPanedWindow:delete {w name} {
upvar #0 $w data
if {![winfo exists $w.$name]} {
error "Pane $name does not exist"
}
if {!$data($name,forgotten)} {
set items ""
foreach item $data(items) {
if {$item != $name} {
lappend items $item
}
}
set data(items) $items
incr data(nItems) -1
set i $data(nItems)
if {$i > 0} {
destroy $data(btn,$i)
destroy $data(sep,$i)
unset data(btn,$i)
unset data(sep,$i)
}
}
unset data($name,allowresize)
unset data($name,expand)
unset data($name,forgotten)
unset data($name,max)
unset data($name,min)
unset data($name,rsize)
unset data($name,size)
unset data(w:$name)
destroy $w.$name
tixPanedWindow:RepackWhenIdle $w
}
proc tixPanedWindow:paneconfigure {w name args} {
upvar #0 $w data
if {![info exists data($name,size)]} {
error "pane \"$name\" does not exist in $w"
}
set len [llength $args]
if {$len == 0} {
set value [$data(w:$name) configure]
lappend value [list -allowresize "" "" "" $data($name,allowresize)]
lappend value [list -expand "" "" "" $data($name,expand)]
lappend value [list -max "" "" "" $data($name,max)]
lappend value [list -min "" "" "" $data($name,min)]
lappend value [list -size "" "" "" $data($name,size)]
return $value
}
if {$len == 1} {
case [lindex $args 0] {
-allowresize {
return [list -allowresize "" "" "" $data($name,allowresize)]
}
-expand {
return [list -expand "" "" "" $data($name,expand)]
}
-min {
return [list -min "" "" "" $data($name,min)]
}
-max {
return [list -max "" "" "" $data($name,max)]
}
-size {
return [list -size "" "" "" $data($name,size)]
}
default {
return [$data(w:$name) configure [lindex $args 0]]
}
}
}
# By default handle each of the options
#
set option(-allowresize) $data($name,allowresize)
set option(-expand) $data($name,expand)
set option(-min) $data($name,min)
set option(-max) $data($name,max)
set option(-size) $data($name,size)
tixHandleOptions -nounknown option {-allowresize -expand -max -min -size} \
$args
#
# the widget options
set new_args ""
foreach {flag value} $args {
case $flag {
{-expand -min -max -allowresize -size} {
}
default {
lappend new_args $flag
lappend new_args $value
}
}
}
if {[llength $new_args] >= 2} {
eval $data(w:$name) configure $new_args
}
#
# The add-on options
set data($name,allowresize) $option(-allowresize)
set data($name,expand) $option(-expand)
set data($name,max) $option(-max)
set data($name,min) $option(-min)
set data($name,rsize) $option(-size)
set data($name,size) $option(-size)
#
# Integrity check
if {$data($name,expand) < 0} {
set data($name,expand) 0
}
if {$data($name,size) < $data($name,min)} {
set data($name,size) $data($name,min)
}
if {$data($name,size) > $data($name,max)} {
set data($name,size) $data($name,max)
}
tixPanedWindow:RepackWhenIdle $w
return ""
}
proc tixPanedWindow:panecget {w name option} {
upvar #0 $w data
if {![info exists data($name,size)]} {
error "pane \"$name\" does not exist in $w"
}
case $option {
{-min -max -allowresize -size} {
regsub \\\- $option "" option
return "$data($name,$option)"
}
default {
return [$data(w:$name) cget $option]
}
}
}
# return the name of all panes
proc tixPanedWindow:panes {w} {
upvar #0 $w data
return $data(items)
}
# set the size of a pane, specifying which direction it should
# grow/shrink
proc tixPanedWindow:setsize {w item size {direction next}} {
upvar #0 $w data
set posn [lsearch $data(items) $item]
if {$posn == -1} {
error "pane \"$item\" does not exist"
}
set diff [expr {$size - $data($item,size)}]
if {$diff == 0} {
return
}
if {$posn == 0 && $direction eq "prev"} {
set direction next
}
if {$posn == $data(nItems)-1 && $direction eq "next"} {
set direction prev
}
if {$data(-orientation) eq "vertical"} {
set rx [winfo rooty $data(w:$item)]
} else {
set rx [winfo rootx $data(w:$item)]
}
if {$direction eq "prev"} {
set rx [expr {$rx - $diff}]
} elseif {$data(-orientation) eq "vertical"} {
set rx [expr {$rx + [winfo height $data(w:$item)] + $diff}]
incr posn
} else {
set rx [expr {$rx + [winfo width $data(w:$item)] + $diff}]
incr posn
}
# Set up the panedwin in a proper state
#
tixPanedWindow:BtnDown $w $posn 1
tixPanedWindow:BtnMove $w $posn $rx 1
tixPanedWindow:BtnUp $w $posn 1
return $data(items)
}
#----------------------------------------------------------------------
# PrivateMethods:
#----------------------------------------------------------------------
proc tixPanedWindow:AddSeparator {w} {
global tcl_platform
upvar #0 $w data
set n [expr {$data(nItems)-1}]
# CYGNUS: On Windows, use relief ridge and a thicker line.
if {$tcl_platform(platform) eq "windows"} then {
set relief "ridge"
set thickness 4
} else {
set relief "sunken"
set thickness 2
}
if {$data(-orientation) eq "vertical"} {
set data(sep,$n) [frame $w.sep$n -relief $relief \
-bd 1 -height $thickness -width 10000 -bg $data(-separatorbg)]
} else {
set data(sep,$n) [frame $w.sep$n -relief $relief \
-bd 1 -width $thickness -height 10000 -bg $data(-separatorbg)]
}
set data(btn,$n) [frame $w.btn$n -relief raised \
-bd 1 -width 9 -height 9 \
-bg $data(-handlebg)]
if {$data(-orientation) eq "vertical"} {
set cursor sb_v_double_arrow
} else {
set cursor sb_h_double_arrow
}
$data(sep,$n) config -cursor $cursor
$data(btn,$n) config -cursor $cursor
foreach wid [list $data(btn,$n) $data(sep,$n)] {
bind $wid \
<ButtonPress-1> [list tixPanedWindow:BtnDown $w $n]
bind $wid \
<ButtonRelease-1> [list tixPanedWindow:BtnUp $w $n]
bind $wid \
<Any-Enter> [list tixPanedWindow:HighlightBtn $w $n]
bind $wid \
<Any-Leave> [list tixPanedWindow:DeHighlightBtn $w $n]
}
if {$data(-orientation) eq "vertical"} {
bind $data(btn,$n) <B1-Motion> [list tixPanedWindow:BtnMove $w $n %Y]
} else {
bind $data(btn,$n) <B1-Motion> [list tixPanedWindow:BtnMove $w $n %X]
}
if {$data(-orientation) eq "vertical"} {
# place $data(btn,$n) -relx 0.90 -y [expr "$data(totalsize)-5"]
# place $data(sep,$n) -x 0 -y [expr "$data(totalsize)-1"] -relwidth 1
} else {
# place $data(btn,$n) -rely 0.90 -x [expr "$data(totalsize)-5"]
# place $data(sep,$n) -y 0 -x [expr "$data(totalsize)-1"] -relheight 1
}
}
proc tixPanedWindow:BtnDown {w item {fake 0}} {
upvar #0 $w data
if {$data(-orientation) eq "vertical"} {
set spec -height
} else {
set spec -width
}
if {!$fake} {
for {set i 1} {$i < $data(nItems)} {incr i} {
$data(sep,$i) config -bg $data(-separatoractivebg) $spec 1
}
update idletasks
$data(btn,$item) config -relief sunken
}
tixPanedWindow:GetMotionLimit $w $item $fake
if {!$fake} {
grab -global $data(btn,$item)
}
set data(movePending) 0
}
proc tixPanedWindow:Min2 {a b} {
if {$a < $b} {
return $a
} else {
return $b
}
}
proc tixPanedWindow:GetMotionLimit {w item fake} {
upvar #0 $w data
set curBefore 0
set minBefore 0
set maxBefore 0
for {set i 0} {$i < $item} {incr i} {
set name [lindex $data(items) $i]
incr curBefore $data($name,size)
incr minBefore $data($name,min)
incr maxBefore $data($name,max)
}
set curAfter 0
set minAfter 0
set maxAfter 0
while {$i < $data(nItems)} {
set name [lindex $data(items) $i]
incr curAfter $data($name,size)
incr minAfter $data($name,min)
incr maxAfter $data($name,max)
incr i
}
set beforeToGo [tixPanedWindow:Min2 \
[expr {$curBefore-$minBefore}] \
[expr {$maxAfter-$curAfter}]]
set afterToGo [tixPanedWindow:Min2 \
[expr {$curAfter-$minAfter}] \
[expr {$maxBefore-$curBefore}]]
set data(beforeLimit) [expr {$curBefore-$beforeToGo}]
set data(afterLimit) [expr {$curBefore+$afterToGo}]
set data(curSize) $curBefore
if {!$fake} {
tixPanedWindow:PlotHandles $w 1
}
}
# Compress the motion so that update is quick even on slow machines
#
# rootp = root position (either rootx or rooty)
proc tixPanedWindow:BtnMove {w item rootp {fake 0}} {
upvar #0 $w data
set data(rootp) $rootp
if {$fake} {
tixPanedWindow:BtnMoveCompressed $w $item $fake
} else {
if {$data(movePending) == 0} {
after 2 tixPanedWindow:BtnMoveCompressed $w $item
set data(movePending) 1
}
}
}
proc tixPanedWindow:BtnMoveCompressed {w item {fake 0}} {
if {![winfo exists $w]} {
return
}
upvar #0 $w data
if {$data(-orientation) eq "vertical"} {
set p [expr {$data(rootp)-[winfo rooty $w]}]
} else {
set p [expr {$data(rootp)-[winfo rootx $w]}]
}
if {$p == $data(curSize)} {
set data(movePending) 0
return
}
if {$p < $data(beforeLimit)} {
set p $data(beforeLimit)
}
if {$p >= $data(afterLimit)} {
set p $data(afterLimit)
}
tixPanedWindow:CalculateChange $w $item $p $fake
if {!$fake} {
# Force the redraw to happen
#
update idletasks
}
set data(movePending) 0
}
# Calculate the change in response to mouse motions
#
proc tixPanedWindow:CalculateChange {w item p {fake 0}} {
upvar #0 $w data
if {$p < $data(curSize)} {
tixPanedWindow:MoveBefore $w $item $p
} elseif {$p > $data(curSize)} {
tixPanedWindow:MoveAfter $w $item $p
}
if {!$fake} {
tixPanedWindow:PlotHandles $w 1
}
}
proc tixPanedWindow:MoveBefore {w item p} {
upvar #0 $w data
set n [expr {$data(curSize)-$p}]
# Shrink the frames before
#
set from [expr {$item-1}]
set to 0
tixPanedWindow:Iterate $w $from $to tixPanedWindow:Shrink $n
# Adjust the frames after
#
set from $item
set to [expr {$data(nItems)-1}]
tixPanedWindow:Iterate $w $from $to tixPanedWindow:Grow $n
set data(curSize) $p
}
proc tixPanedWindow:MoveAfter {w item p} {
upvar #0 $w data
set n [expr {$p-$data(curSize)}]
# Shrink the frames after
#
set from $item
set to [expr {$data(nItems)-1}]
tixPanedWindow:Iterate $w $from $to tixPanedWindow:Shrink $n
# Graw the frame before
#
set from [expr {$item-1}]
set to 0
tixPanedWindow:Iterate $w $from $to tixPanedWindow:Grow $n
set data(curSize) $p
}
proc tixPanedWindow:CancleLines {w} {
upvar #0 $w data
if {[info exists data(lines)]} {
foreach line $data(lines) {
set x1 [lindex $line 0]
set y1 [lindex $line 1]
set x2 [lindex $line 2]
set y2 [lindex $line 3]
tixTmpLine $x1 $y1 $x2 $y2 $w
}
catch {unset data(lines)}
}
}
proc tixPanedWindow:PlotHandles {w transient} {
global tcl_platform
upvar #0 $w data
set totalsize 0
set i 0
if {$data(-orientation) eq "vertical"} {
set btnp [expr {[winfo width $w]-13}]
} else {
set h [winfo height $w]
if {$h > 18} {
set btnp 9
} else {
set btnp [expr {$h-9}]
}
}
set firstpane [lindex $data(items) 0]
set totalsize $data($firstpane,size)
if {$transient} {
tixPanedWindow:CancleLines $w
set data(lines) ""
}
for {set i 1} {$i < $data(nItems)} {incr i} {
if {! $transient} {
if {$data(-orientation) eq "vertical"} {
place $data(btn,$i) -x $btnp -y [expr {$totalsize-4}]
place $data(sep,$i) -x 0 -y [expr {$totalsize-1}] -relwidth 1
} else {
place $data(btn,$i) -y $btnp -x [expr {$totalsize-5}]
place $data(sep,$i) -y 0 -x [expr {$totalsize-1}] -relheight 1
}
} else {
if {$data(-orientation) eq "vertical"} {
set x1 [winfo rootx $w]
set x2 [expr {$x1 + [winfo width $w]}]
set y [expr {$totalsize-1+[winfo rooty $w]}]
tixTmpLine $x1 $y $x2 $y $w
lappend data(lines) [list $x1 $y $x2 $y]
} else {
set y1 [winfo rooty $w]
set y2 [expr {$y1 + [winfo height $w]}]
set x [expr {$totalsize-1+[winfo rootx $w]}]
tixTmpLine $x $y1 $x $y2 $w
lappend data(lines) [list $x $y1 $x $y2]
}
}
set name [lindex $data(items) $i]
incr totalsize $data($name,size)
}
}
proc tixPanedWindow:BtnUp {w item {fake 0}} {
upvar #0 $w data
if {!$fake} {
tixPanedWindow:CancleLines $w
}
tixPanedWindow:UpdateSizes $w
if {!$fake} {
$data(btn,$item) config -relief raised
grab release $data(btn,$item)
}
}
proc tixPanedWindow:HighlightBtn {w item} {
upvar #0 $w data
$data(btn,$item) config -background $data(-handleactivebg)
}
proc tixPanedWindow:DeHighlightBtn {w item} {
upvar #0 $w data
$data(btn,$item) config -background $data(-handlebg)
}
#----------------------------------------------------------------------
#
#
# Geometry management routines
#
#
#----------------------------------------------------------------------
# update the sizes of each pane according to the data($name,size) variables
#
proc tixPanedWindow:UpdateSizes {w} {
global tcl_platform
upvar #0 $w data
set data(totalsize) 0
set mw [winfo width $w]
set mh [winfo height $w]
for {set i 0} {$i < $data(nItems)} {incr i} {
set name [lindex $data(items) $i]
if {$data($name,size) > 0} {
if {$data(-orientation) eq "vertical"} {
tixMoveResizeWindow $w.$name 0 $data(totalsize) \
$mw $data($name,size)
tixMapWindow $w.$name
raise $w.$name
} else {
tixMoveResizeWindow $w.$name $data(totalsize) 0 \
$data($name,size) $mh
tixMapWindow $w.$name
raise $w.$name
}
} else {
tixUnmapWindow $w.$name
}
incr data(totalsize) $data($name,size)
}
# Reset the color and width of the separator
#
if {$data(-orientation) eq "vertical"} {
set spec -height
} else {
set spec -width
}
# CYGNUS: On Windows, use a thicker line.
if {$tcl_platform(platform) eq "windows"} then {
set thickness 4
} else {
set thickness 2
}
for {set i 1} {$i < $data(nItems)} {incr i} {
$data(sep,$i) config -bg $data(-separatorbg) $spec $thickness
raise $data(sep,$i)
raise $data(btn,$i)
}
# Invoke the callback command
#
if {$data(-command) != ""} {
set sizes ""
foreach item $data(items) {
lappend sizes $data($item,size)
}
set bind(specs) ""
tixEvalCmdBinding $w $data(-command) bind [list $sizes]
}
}
proc tixPanedWindow:GetNaturalSizes {w} {
upvar #0 $w data
set data(totalsize) 0
set totalreq 0
if {$data(-orientation) eq "vertical"} {
set majorspec height
set minorspec width
} else {
set majorspec width
set minorspec height
}
set minorsize 0
foreach name $data(items) {
if {[winfo manager $w.$name] ne "tixGeometry"} {
error "Geometry management error: pane \"$w.$name\" cannot be managed by \"[winfo manager $w.$name]\"\nhint: delete the line \"[winfo manager $w.$name] $w.$name ...\" from your program"
}
# set the minor size
#
set req_minor [winfo req$minorspec $w.$name]
if {$req_minor > $minorsize} {
set minorsize $req_minor
}
# Check the natural size against the max, min requirements.
# Change the natural size if necessary
#
if {$data($name,size) <= 1} {
set data($name,size) [winfo req$majorspec $w.$name]
}
if {$data($name,size) > 1} {
# If we get zero maybe the widget was not initialized yet ...
#
# %% hazard : what if the window is really 1x1?
#
if {$data($name,size) < $data($name,min)} {
set data($name,size) $data($name,min)
}
if {$data($name,size) > $data($name,max)} {
set data($name,size) $data($name,max)
}
}
# kludge: because a frame always returns req size of {1,1} before
# the packer processes it, we do the following to mark the
# pane as "size unknown"
#
# if {$data($name,size) == 1 && ![winfo ismapped $w.$name]} {
# set data($name,size) 0
# }
# Add up the total size
#
incr data(totalsize) $data($name,size)
# Find out the request size
#
if {$data($name,rsize) == 0} {
set rsize [winfo req$majorspec $w.$name]
} else {
set rsize $data($name,rsize)
}
if {$rsize < $data($name,min)} {
set rsize $data($name,min)
}
if {$rsize > $data($name,max)} {
set rsize $data($name,max)
}
incr totalreq $rsize
}
if {$data(-orientation) eq "vertical"} {
return [list $minorsize $totalreq]
} else {
return [list $totalreq $minorsize]
}
}
#--------------------------------------------------
# Handling resize
#--------------------------------------------------
proc tixPanedWindow:ClientGeomProc {w type client} {
tixPanedWindow:RepackWhenIdle $w
}
#
# This monitor the sizes of the master window
#
proc tixPanedWindow:MasterGeomProc {w master} {
tixPanedWindow:RepackWhenIdle $w
}
proc tixPanedWindow:RepackWhenIdle {w} {
if {![winfo exist $w]} {
return
}
upvar #0 $w data
if {$data(repack) == 0} {
tixWidgetDoWhenIdle tixPanedWindow:Repack $w
set data(repack) 1
}
}
#
# This monitor the sizes of the master window
#
proc tixPanedWindow:Repack {w} {
upvar #0 $w data
# Calculate the desired size of the master
#
set dim [tixPanedWindow:GetNaturalSizes $w]
if {$data(-width) != 0} {
set mreqw $data(-width)
} else {
set mreqw [lindex $dim 0]
}
if {$data(-height) != 0} {
set mreqh $data(-height)
} else {
set mreqh [lindex $dim 1]
}
if !$data(-dynamicgeometry) {
if {$mreqw < $data(maxReqW)} {
set mreqw $data(maxReqW)
}
if {$mreqh < $data(maxReqH)} {
set mreqh $data(maxReqH)
}
set data(maxReqW) $mreqw
set data(maxReqH) $mreqh
}
if {$mreqw != [winfo reqwidth $w] || $mreqh != [winfo reqheight $w] } {
if {![info exists data(counter)]} {
set data(counter) 0
}
if {$data(counter) < 50} {
incr data(counter)
tixGeometryRequest $w $mreqw $mreqh
tixWidgetDoWhenIdle tixPanedWindow:Repack $w
set data(repack) 1
return
}
}
set data(counter) 0
if {$data(nItems) == 0} {
set data(repack) 0
return
}
tixWidgetDoWhenIdle tixPanedWindow:DoRepack $w
}
proc tixPanedWindow:DoRepack {w} {
upvar #0 $w data
if {$data(-orientation) eq "vertical"} {
set newSize [winfo height $w]
} else {
set newSize [winfo width $w]
}
if {$newSize <= 1} {
# Probably this window is too small to see anyway
# %%Kludge: I don't know if this always work.
#
set data(repack) 0
return
}
set totalExp 0
foreach name $data(items) {
set totalExp [expr {$totalExp + $data($name,expand)}]
}
if {$newSize > $data(totalsize)} {
# Grow
#
set toGrow [expr {$newSize-$data(totalsize)}]
set p [llength $data(items)]
foreach name $data(items) {
set toGrow [tixPanedWindow:xGrow $w $name $toGrow $totalExp $p]
if {$toGrow > 0} {
set totalExp [expr {$totalExp-$data($name,expand)}]
incr p -1
} else {
break
}
}
} else {
# Shrink
#
set toShrink [expr {$data(totalsize)-$newSize}]
set usedSize 0
foreach name $data(items) {
set toShrink [tixPanedWindow:xShrink $w $name $toShrink \
$totalExp $newSize $usedSize]
if {$toShrink > 0} {
set totalExp [expr {$totalExp-$data($name,expand)}]
incr usedSize $data($name,size)
} else {
break
}
}
}
tixPanedWindow:UpdateSizes $w
tixPanedWindow:PlotHandles $w 0
set data(repack) 0
}
#--------------------------------------------------
# Shrink and grow items
#--------------------------------------------------
#
# toGrow: how much free area to grow into
# p: == 1 if $name is the last in the list of items
# totalExp: used to calculate the amount of the free area that this
# window can grow into
#
proc tixPanedWindow:xGrow {w name toGrow totalExp p} {
upvar #0 $w data
if {$p == 1} {
set canGrow $toGrow
} else {
if {$totalExp == 0} {
set canGrow 0
} else {
set canGrow [expr {int($toGrow * $data($name,expand) / $totalExp)}]
}
}
if {($canGrow + $data($name,size)) > $data($name,max)} {
set canGrow [expr {$data($name,max) - $data($name,size)}]
}
incr data($name,size) $canGrow
incr toGrow -$canGrow
return $toGrow
}
proc tixPanedWindow:xShrink {w name toShrink totalExp newSize usedSize} {
upvar #0 $w data
if {$totalExp == 0} {
set canShrink 0
} else {
set canShrink [expr {int($toShrink * $data($name,expand) / $totalExp)}]
}
if {$data($name,size) - $canShrink < $data($name,min)} {
set canShrink [expr {$data($name,size) - $data($name,min)}]
}
if {$usedSize + $data($name,size) - $canShrink > $newSize} {
set data($name,size) [expr {$newSize - $usedSize}]
return 0
} else {
incr data($name,size) -$canShrink
incr toShrink -$canShrink
return $toShrink
}
}
#--------------------------------------------------
# Shrink and grow items
#--------------------------------------------------
proc tixPanedWindow:Shrink {w name n} {
upvar #0 $w data
set canShrink [expr {$data($name,size) - $data($name,min)}]
if {$canShrink > $n} {
incr data($name,size) -$n
return 0
} elseif {$canShrink > 0} {
set data($name,size) $data($name,min)
incr n -$canShrink
}
return $n
}
proc tixPanedWindow:Grow {w name n} {
upvar #0 $w data
set canGrow [expr {$data($name,max) - $data($name,size)}]
if {$canGrow > $n} {
incr data($name,size) $n
return 0
} elseif {$canGrow > 0} {
set data($name,size) $data($name,max)
incr n -$canGrow
}
return $n
}
proc tixPanedWindow:Iterate {w from to proc n} {
upvar #0 $w data
if {$from <= $to} {
for {set i $from} {$i <= $to} {incr i} {
set n [$proc $w [lindex $data(items) $i] $n]
if {$n == 0} {
break
}
}
} else {
for {set i $from} {$i >= $to} {incr i -1} {
set n [$proc $w [lindex $data(items) $i] $n]
if {$n == 0} {
break
}
}
}
}
PK '�\HEN�| | Tix8.4.3/PopMenu.tclnu �[��� # -*- 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
}
PK '�\��) ) Tix8.4.3/Primitiv.tclnu �[��� # -*- 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}
}
PK '�\��N� � Tix8.4.3/README.txtnu �[���
Tix 8.4.3 for Tcl 8.4+
Tix Documentation Master Index
This file is the master index of all the documentation included in
this package. For additional information about Tix, please visit the
Tix Home Page at
http://tix.sourceforge.net/
or join the mailing lists there.
* ABOUT.html A brief description of Tix.
* docs/Release.html Release notes on this version of Tix.
* unix/README.txt Compiling and installing Tix under Unix.
* win/README.txt Compiling and installing Tix under Windows.
* docs/html/TixUser/TixUser.html Tix Users's Guide.
* Programming with Tix:
+ Tix Programmer's Guide.
+ Using Tix Stand Alone Modules (SAM).
* docs/FAQ.html The Tix Frequent Asked Questions.
* ChangeLog.txt Changes made to Tix since the previous release.
* man/index.html Programmer's Reference Manual.
Versions of Tcl/Tk prior to 8.4 are no longer supported.
PK '�\qQe�3 �3 Tix8.4.3/ResizeH.tclnu �[��� # -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: ResizeH.tcl,v 1.3 2001/12/09 05:04:02 idiscovery Exp $
#
# ResizeH.tcl --
#
# tixResizeHandle: A general purpose "resizing handle"
# widget. You can use it to resize pictures, widgets, etc. When
# using it to resize a widget, you can use the "attachwidget"
# command to attach it to a widget and it will handle all the
# events for you.
#
# 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 tixResizeHandle {
-classname TixResizeHandle
-superclass tixVResize
-method {
attachwidget detachwidget hide show
}
-flag {
-command -cursorfg -cursorbg -handlesize -hintcolor -hintwidth -x -y
}
-configspec {
{-command command Command ""}
{-cursorfg cursorFg CursorColor white}
{-cursorbg cursorBg CursorColor red}
{-handlesize handleSize HandleSize 6}
{-hintcolor hintColor HintColor red}
{-hintwidth hintWidth HintWidth 1}
{-x x X 0}
{-y y Y 0}
}
}
proc tixResizeHandle:InitWidgetRec {w} {
upvar #0 $w data
tixChainMethod $w InitWidgetRec
set data(shown) 0
set data(widget) ""
}
proc tixResizeHandle:ConstructWidget {w} {
upvar #0 $w data
tixChainMethod $w ConstructWidget
# Create the hints
#
set data(w_ht) $w:tix_priv_ht
set data(w_hb) $w:tix_priv_hb
set data(w_hl) $w:tix_priv_hl
set data(w_hr) $w:tix_priv_hr
frame $data(w_ht) -height $data(-hintwidth) -bg $data(-background)
frame $data(w_hb) -height $data(-hintwidth) -bg $data(-background)
frame $data(w_hl) -width $data(-hintwidth) -bg $data(-background)
frame $data(w_hr) -width $data(-hintwidth) -bg $data(-background)
# Create the corner resize handles
#
set data(w_r00) $w
# Windows don't like this
# $data(rootCmd) config\
# -cursor "top_left_corner $data(-cursorbg) $data(-cursorfg)"
$data(rootCmd) config -cursor top_left_corner
set data(w_r01) $w:tix_priv_01
set data(w_r10) $w:tix_priv_10
set data(w_r11) $w:tix_priv_11
frame $data(w_r01) -relief $data(-relief) -bd $data(-borderwidth) \
-cursor "bottom_left_corner"\
-bg $data(-background)
frame $data(w_r10) -relief $data(-relief) -bd $data(-borderwidth) \
-cursor "top_right_corner"\
-bg $data(-background)
frame $data(w_r11) -relief $data(-relief) -bd $data(-borderwidth) \
-cursor "bottom_right_corner"\
-bg $data(-background)
# Create the border resize handles
#
set data(w_bt) $w:tix_priv_bt
set data(w_bb) $w:tix_priv_bb
set data(w_bl) $w:tix_priv_bl
set data(w_br) $w:tix_priv_br
frame $data(w_bt) -relief $data(-relief) -bd $data(-borderwidth) \
-cursor "top_side"\
-bg $data(-background)
frame $data(w_bb) -relief $data(-relief) -bd $data(-borderwidth) \
-cursor "bottom_side"\
-bg $data(-background)
frame $data(w_bl) -relief $data(-relief) -bd $data(-borderwidth) \
-cursor "left_side"\
-bg $data(-background)
frame $data(w_br) -relief $data(-relief) -bd $data(-borderwidth) \
-cursor "right_side"\
-bg $data(-background)
}
proc tixResizeHandle:SetBindings {w} {
upvar #0 $w data
tixChainMethod $w SetBindings
bind $data(w_r00) <1> \
"tixResizeHandle:dragstart $w $data(w_r00) 1 %X %Y {1 1 -1 -1}"
bind $data(w_r01) <1> \
"tixResizeHandle:dragstart $w $data(w_r01) 1 %X %Y {1 0 -1 1}"
bind $data(w_r10) <1> \
"tixResizeHandle:dragstart $w $data(w_r10) 1 %X %Y {0 1 1 -1}"
bind $data(w_r11) <1> \
"tixResizeHandle:dragstart $w $data(w_r11) 1 %X %Y {0 0 1 1}"
bind $data(w_bt) <1> \
"tixResizeHandle:dragstart $w $data(w_bt) 1 %X %Y {0 1 0 -1}"
bind $data(w_bb) <1> \
"tixResizeHandle:dragstart $w $data(w_bb) 1 %X %Y {0 0 0 1}"
bind $data(w_bl) <1> \
"tixResizeHandle:dragstart $w $data(w_bl) 1 %X %Y {1 0 -1 0}"
bind $data(w_br) <1> \
"tixResizeHandle:dragstart $w $data(w_br) 1 %X %Y {0 0 1 0}"
foreach win [list \
$data(w_r00)\
$data(w_r01)\
$data(w_r10)\
$data(w_r11)\
$data(w_bt)\
$data(w_bb)\
$data(w_bl)\
$data(w_br)\
] {
bind $win <B1-Motion> "tixVResize:drag $w %X %Y"
bind $win <ButtonRelease-1> "tixVResize:dragend $w $win 0 %X %Y"
bind $win <Any-Escape> "tixVResize:dragend $w $win 1 0 0"
}
}
#----------------------------------------------------------------------
# Config Methods
#----------------------------------------------------------------------
proc tixResizeHandle:config-width {w value} {
tixWidgetDoWhenIdle tixResizeHandle:ComposeWindow $w
}
proc tixResizeHandle:config-height {w value} {
tixWidgetDoWhenIdle tixResizeHandle:ComposeWindow $w
}
proc tixResizeHandle:config-x {w value} {
tixWidgetDoWhenIdle tixResizeHandle:ComposeWindow $w
}
proc tixResizeHandle:config-y {w value} {
tixWidgetDoWhenIdle tixResizeHandle:ComposeWindow $w
}
#----------------------------------------------------------------------
# Public Methods
#----------------------------------------------------------------------
proc tixResizeHandle:dragstart {w win depress rootx rooty mrect} {
upvar #0 $w data
set wx $data(-x)
set wy $data(-y)
set ww $data(-width)
set wh $data(-height)
tixVResize:dragstart $w $win $depress $rootx $rooty \
[list $wx $wy $ww $wh] $mrect
}
# tixDeleteBindTag --
#
# Delete the bindtag(s) in the args list from the bindtags of the widget
#
proc tixDeleteBindTag {w args} {
if {![winfo exists $w]} {
return
}
set newtags ""
foreach tag [bindtags $w] {
if {[lsearch $args $tag] == -1} {
lappend newtags $tag
}
}
bindtags $w $newtags
}
proc tixAddBindTag {w args} {
bindtags $w [concat [bindtags $w] $args]
}
proc tixResizeHandle:attachwidget {w widget args} {
upvar #0 $w data
set opt(-move) 0
tixHandleOptions opt {-move} $args
if {$data(widget) != ""} {
tixDeleteBindTag $data(widget) TixResizeHandleTag:$w
}
set data(widget) $widget
if {$data(widget) != ""} {
# Just in case TixResizeHandleTag was already there
tixDeleteBindTag $data(widget) TixResizeHandleTag:$w
tixAddBindTag $data(widget) TixResizeHandleTag:$w
set data(-x) [winfo x $data(widget)]
set data(-y) [winfo y $data(widget)]
set data(-width) [winfo width $data(widget)]
set data(-height) [winfo height $data(widget)]
tixResizeHandle:show $w
tixResizeHandle:ComposeWindow $w
# Now set the bindings
#
if {$opt(-move)} {
bind TixResizeHandleTag:$w <1> \
"tixResizeHandle:Attach $w %X %Y"
bind TixResizeHandleTag:$w <B1-Motion> \
"tixResizeHandle:BMotion $w %X %Y"
bind TixResizeHandleTag:$w <Any-Escape> \
"tixResizeHandle:BRelease $w 1 %X %Y"
bind TixResizeHandleTag:$w <ButtonRelease-1>\
"tixResizeHandle:BRelease $w 0 %X %Y"
} else {
# if "move" is false, then the widget won't be moved as a whole --
# ResizeHandle will only move its sides
bind TixResizeHandleTag:$w <1> {;}
bind TixResizeHandleTag:$w <B1-Motion> {;}
bind TixResizeHandleTag:$w <Any-Escape> {;}
bind TixResizeHandleTag:$w <ButtonRelease-1> {;}
}
}
}
proc tixResizeHandle:detachwidget {w} {
upvar #0 $w data
if {$data(widget) != ""} {
tixDeleteBindTag $data(widget) TixResizeHandleTag:$w
}
tixResizeHandle:hide $w
}
proc tixResizeHandle:show {w} {
upvar #0 $w data
set data(shown) 1
raise $data(w_ht)
raise $data(w_hb)
raise $data(w_hl)
raise $data(w_hr)
raise $data(w_r00)
raise $data(w_r01)
raise $data(w_r10)
raise $data(w_r11)
raise $data(w_bt)
raise $data(w_bb)
raise $data(w_bl)
raise $data(w_br)
# tixCancleIdleTask tixResizeHandle:ComposeWindow $w
tixResizeHandle:ComposeWindow $w
}
proc tixResizeHandle:hide {w} {
upvar #0 $w data
if {!$data(shown)} {
return
}
set data(shown) 0
place forget $data(w_r00)
place forget $data(w_r01)
place forget $data(w_r10)
place forget $data(w_r11)
place forget $data(w_bt)
place forget $data(w_bb)
place forget $data(w_bl)
place forget $data(w_br)
place forget $data(w_ht)
place forget $data(w_hb)
place forget $data(w_hl)
place forget $data(w_hr)
}
proc tixResizeHandle:Destructor {w} {
upvar #0 $w data
if {$data(widget) != ""} {
tixDeleteBindTag $data(widget) TixResizeHandleTag:$w
}
catch {destroy $data(w_r01)}
catch {destroy $data(w_r10)}
catch {destroy $data(w_r11)}
catch {destroy $data(w_bt)}
catch {destroy $data(w_bb)}
catch {destroy $data(w_bl)}
catch {destroy $data(w_br)}
catch {destroy $data(w_ht)}
catch {destroy $data(w_hb)}
catch {destroy $data(w_hl)}
catch {destroy $data(w_hr)}
tixChainMethod $w Destructor
}
#----------------------------------------------------------------------
# Private Methods Dealing With Attached Widgets
#----------------------------------------------------------------------
proc tixResizeHandle:Attach {w rx ry} {
upvar #0 $w data
tixResizeHandle:dragstart $w $data(widget) 0 $rx $ry {1 1 0 0}
}
proc tixResizeHandle:BMotion {w rx ry} {
tixVResize:drag $w $rx $ry
}
proc tixResizeHandle:BRelease {w isAbort rx ry} {
upvar #0 $w data
tixVResize:dragend $w $data(widget) $isAbort $rx $ry
}
#----------------------------------------------------------------------
# Private Methods
#----------------------------------------------------------------------
proc tixResizeHandle:DrawTmpLines {w} {
upvar #0 $w data
# I've seen this error - mike
if {![info exists data(hf:x1)]} {return}
set x1 $data(hf:x1)
if {![info exists data(hf:y1)]} {return}
set y1 $data(hf:y1)
if {![info exists data(hf:x2)]} {return}
set x2 $data(hf:x2)
if {![info exists data(hf:y2)]} {return}
set y2 $data(hf:y2)
tixTmpLine $x1 $y1 $x2 $y1 $w
tixTmpLine $x1 $y2 $x2 $y2 $w
tixTmpLine $x1 $y1 $x1 $y2 $w
tixTmpLine $x2 $y1 $x2 $y2 $w
}
# Place the hint frame to indicate the changes
#
proc tixResizeHandle:SetHintFrame {w x1 y1 width height} {
upvar #0 $w data
# The four sides of the window
#
set x2 [expr "$x1+$width"]
set y2 [expr "$y1+$height"]
set rx [winfo rootx [winfo parent $w]]
set ry [winfo rooty [winfo parent $w]]
incr x1 $rx
incr y1 $ry
incr x2 $rx
incr y2 $ry
if {[info exists data(hf:x1)]} {
tixResizeHandle:DrawTmpLines $w
}
set data(hf:x1) $x1
set data(hf:y1) $y1
set data(hf:x2) $x2
set data(hf:y2) $y2
tixResizeHandle:DrawTmpLines $w
}
proc tixResizeHandle:ShowHintFrame {w} {
upvar #0 $w data
place forget $data(w_ht)
place forget $data(w_hb)
place forget $data(w_hl)
place forget $data(w_hr)
update
}
proc tixResizeHandle:HideHintFrame {w} {
upvar #0 $w data
tixResizeHandle:DrawTmpLines $w
unset data(hf:x1)
unset data(hf:y1)
unset data(hf:x2)
unset data(hf:y2)
}
proc tixResizeHandle:UpdateSize {w x y width height} {
upvar #0 $w data
set data(-x) $x
set data(-y) $y
set data(-width) $width
set data(-height) $height
tixResizeHandle:ComposeWindow $w
if {$data(widget) != ""} {
place $data(widget) -x $x -y $y -width $width -height $height
}
if {$data(-command) != ""} {
eval $data(-command) $x $y $width $height
}
}
proc tixResizeHandle:ComposeWindow {w} {
upvar #0 $w data
set px $data(-x)
set py $data(-y)
set pw $data(-width)
set ph $data(-height)
# Show the hint frames
#
set x1 $px
set y1 $py
set x2 [expr "$px+$pw"]
set y2 [expr "$py+$ph"]
place $data(w_ht) -x $x1 -y $y1 -width $pw -bordermode outside
place $data(w_hb) -x $x1 -y $y2 -width $pw -bordermode outside
place $data(w_hl) -x $x1 -y $y1 -height $ph -bordermode outside
place $data(w_hr) -x $x2 -y $y1 -height $ph -bordermode outside
# Set the four corner resize handles
#
set sz_2 [expr $data(-handlesize)/2]
set x1 [expr "$px - $sz_2"]
set y1 [expr "$py - $sz_2"]
set x2 [expr "$px - $sz_2" + $pw]
set y2 [expr "$py - $sz_2" + $ph]
place $data(w_r00) -x $x1 -y $y1 \
-width $data(-handlesize) -height $data(-handlesize)
place $data(w_r01) -x $x1 -y $y2\
-width $data(-handlesize) -height $data(-handlesize)
place $data(w_r10) -x $x2 -y $y1\
-width $data(-handlesize) -height $data(-handlesize)
place $data(w_r11) -x $x2 -y $y2\
-width $data(-handlesize) -height $data(-handlesize)
# Set the four border resize handles
#
set mx [expr "$px + $pw/2 - $sz_2"]
set my [expr "$py + $ph/2 - $sz_2"]
place $data(w_bt) -x $mx -y $y1 \
-width $data(-handlesize) -height $data(-handlesize)
place $data(w_bb) -x $mx -y $y2 \
-width $data(-handlesize) -height $data(-handlesize)
place $data(w_bl) -x $x1 -y $my \
-width $data(-handlesize) -height $data(-handlesize)
place $data(w_br) -x $x2 -y $my \
-width $data(-handlesize) -height $data(-handlesize)
}
PK '�\�c�-/ / Tix8.4.3/SGrid.tclnu �[��� # -*- 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]
}
PK '�\/�{�� � Tix8.4.3/SHList.tclnu �[��� # -*- 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]
}
PK '�\ͼ�� � Tix8.4.3/SListBox.tclnu �[��� # -*- 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
}
}
PK '�\�C �| | Tix8.4.3/STList.tclnu �[��� # -*- 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]
}
PK '�\u �[ [ Tix8.4.3/SText.tclnu �[��� # -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: SText.tcl,v 1.4 2001/12/09 05:04:02 idiscovery Exp $
#
# SText.tcl --
#
# This file implements Scrolled Text 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 tixScrolledText {
-classname TixScrolledText
-superclass tixScrolledWidget
-method {
}
-flag {
}
-static {
}
-configspec {
}
-default {
{.scrollbar both}
{*Scrollbar.takeFocus 0}
}
-forcecall {
-scrollbar
}
}
proc tixScrolledText:ConstructWidget {w} {
upvar #0 $w data
global tcl_platform
tixChainMethod $w ConstructWidget
set data(w:text) \
[text $w.text]
set data(w:hsb) \
[scrollbar $w.hsb -orient horizontal]
set data(w:vsb) \
[scrollbar $w.vsb -orient vertical]
if {$data(-sizebox) && $tcl_platform(platform) == "windows"} {
# set data(w:sizebox) [ide_sizebox $w.sizebox]
}
set data(pw:client) $data(w:text)
}
proc tixScrolledText:SetBindings {w} {
upvar #0 $w data
tixChainMethod $w SetBindings
$data(w:text) config \
-xscrollcommand "tixScrolledText:XScroll $w"\
-yscrollcommand "tixScrolledText:YScroll $w"
$data(w:hsb) config -command "$data(w:text) xview"
$data(w:vsb) config -command "$data(w:text) yview"
}
#----------------------------------------------------------------------
#
# option configs
#----------------------------------------------------------------------
proc tixScrolledText:config-takefocus {w value} {
upvar #0 $w data
$data(w:text) config -takefocus $value
}
proc tixScrolledText:config-scrollbar {w value} {
upvar #0 $w data
if {[string match "auto*" $value]} {
set value "both"
}
set data(-scrollbar) $value
tixChainMethod $w config-scrollbar $value
return $value
}
#----------------------------------------------------------------------
#
# Widget commands
#----------------------------------------------------------------------
#----------------------------------------------------------------------
#
# Private Methods
#----------------------------------------------------------------------
#----------------------------------------------------------------------
# virtual functions to query the client window's scroll requirement
#----------------------------------------------------------------------
proc tixScrolledText:GeometryInfo {w mW mH} {
upvar #0 $w data
return [list "$data(x,first) $data(x,last)" "$data(y,first) $data(y,last)"]
}
proc tixScrolledText:XScroll {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 tixScrolledText:YScroll {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
}
PK '�\�
�&