

set rcsId {$Id: moodss.tcl,v 1.69 1998/04/21 13:39:29 jfontain Exp $}



set rcsId {$Id: getopt.tcl,v 1.2 1998/02/20 21:42:54 jfontain Exp $}


proc parseCommandLineArguments {switches arguments arrayName} {
    upvar $arrayName data

    if {[llength $switches]==0} {
        return $arguments
    }
    foreach {value flag} $switches {
        if {![string match {[-+]*} $value]||![string match {[01]} $flag]} {
            error "invalid switches: $switches"
        }
    }
    unset flag
    array set flag $switches

    set index 0
    foreach value $arguments {
        set argument($index) $value
        incr index
    }
    set maximum $index
    for {set index 0} {$index<$maximum} {incr index} {
        set switch $argument($index)
        if {![info exists flag($switch)]} break
        if {[string compare $switch --]==0} {
            incr index
            break
        }
        if {$flag($switch)} {
            if {[catch {set value $argument([incr index])}]||[string match {[-+]*} $value]} {
                error "no value for switch $switch"
            }
            set data($switch) $value
        } else {
            set data($switch) {}
        }
    }
    return [lrange $arguments $index end]
}

proc printUsage {exitCode} {
    puts stderr "usage: $::argv0 \[-update seconds\] module \[module\ ...]"
    exit $exitCode
}

set arguments(-update) {}
if {[catch {set argv [parseCommandLineArguments {-update 1} $argv arguments]} message]} {
    puts stderr $message
    printUsage 1
}

if {[llength $argv]<1} {
    printUsage 1
}


proc loadModules {modules} {
    foreach module $modules {
        if {[catch {package require $module}]} {
            puts stderr "$::argv0: could not load package \"$module\""
            exit 1
        }
        if {![info exists ${module}::data(indexColumns)]} {
            set ${module}::data(indexColumns) 0
        }
    }
}

proc setPollTimes {modules {commandLineTime {}}} {
    global pollTimes pollTime

    set default 0
    set minimum 0
    foreach module $modules {
        set times [set ${module}::data(pollTimes)]
        if {[llength $times]==0} {
            error "module $module poll times list is empty"
        }
        set time [lindex $times 0]
        if {$time>$default} {
            set default $time
        }
        set times [lsort -integer $times]
        set time [lindex $times 0]
        if {$time>$minimum} {
            set minimum $time
            set minimumModule $module
        }
        foreach time $times {
            set data($time) {}
        }
    }
    set pollTimes [lsort -integer [array names data]]
    set pollTimes [lrange $pollTimes [lsearch -exact $pollTimes $minimum] end]
    set pollTime $default
    if {[string length $commandLineTime]>0} {
        if {$commandLineTime<$minimum} {
            puts stderr "$::argv0: minimum poll time is $minimum seconds for module $minimumModule"
            exit 1
        }
        set pollTime $commandLineTime
    }
}

proc modulesString {} {
    global modules

    for {set index 0} {$index<([llength $modules]-1)} {incr index} {
        append string "[lindex $modules $index], "
    }
    append string [lindex $modules $index]
    return $string
}

lappend auto_path .
set modules $argv
loadModules $modules
setPollTimes $modules $arguments(-update)
set modulesString [modulesString]

if {[catch {package require stooop 3.5.1}]} {
set rcsId {$Id: stooop.tcl,v 3.60 1998/04/18 20:43:14 jfontain Exp $}

package provide stooop 3.5.1

catch {rename proc _proc}

namespace eval ::stooop {
    variable checkCode
    variable traceProcedureChannel
    variable traceProcedureFormat
    variable traceDataChannel
    variable traceDataFormat
    variable traceDataOperations

    set checkCode {}
    if {[info exists ::env(STOOOPCHECKALL)]} {
        array set ::env {STOOOPCHECKPROCEDURES {} STOOOPCHECKDATA {}}
    }
    if {[info exists ::env(STOOOPCHECKPROCEDURES)]} {
        append checkCode {::stooop::checkProcedure;}
    }
    if {[info exists ::env(STOOOPTRACEALL)]} {
        set ::env(STOOOPTRACEPROCEDURES) $::env(STOOOPTRACEALL)
        set ::env(STOOOPTRACEDATA) $::env(STOOOPTRACEALL)
    }
    if {[info exists ::env(STOOOPTRACEPROCEDURES)]} {
        set traceProcedureChannel $::env(STOOOPTRACEPROCEDURES)
        if {![regexp {^stdout|stderr$} $traceProcedureChannel]} {
            set traceProcedureChannel [open $::env(STOOOPTRACEPROCEDURES) w+]
        }
        set traceProcedureFormat {class: %C, procedure: %p, object: %O, arguments: %a}
        catch {set traceProcedureFormat $::env(STOOOPTRACEPROCEDURESFORMAT)}
        append checkCode {::stooop::traceProcedure;}
    }
    if {[info exists ::env(STOOOPTRACEDATA)]} {
        set traceDataChannel $::env(STOOOPTRACEDATA)
        if {![regexp {^stdout|stderr$} $traceDataChannel]} {
            set traceDataChannel [open $::env(STOOOPTRACEDATA) w+]
        }
        set traceDataFormat {class: %C, procedure: %p, array: %A, object: %O, member: %m, operation: %o, value: %v}
        catch {set traceDataFormat $::env(STOOOPTRACEDATAFORMAT)}
        set traceDataOperations rwu
        catch {set traceDataOperations $::env(STOOOPTRACEDATAOPERATIONS)}
    }

    namespace export class virtual new delete classof

    if {![info exists newId]} {
        variable newId 0
    }

    _proc new {classOrId args} {
        variable newId
        variable fullClass

        if {[scan $classOrId %u dummy]==0} {
            set constructor ${classOrId}::[namespace tail $classOrId]
            uplevel $constructor [set id [incr newId]] $args
            set fullClass($id) [namespace qualifiers [uplevel namespace which -command $constructor]]
        } else {
            if {[catch {set fullClass([set id [incr newId]]) $fullClass($classOrId)}]} {
                error "invalid object identifier $classOrId"
            }
            uplevel $fullClass($classOrId)::_copy $id $classOrId
        }
        return $id
    }

    _proc delete {args} {
        variable fullClass

        foreach id $args {
            uplevel ::stooop::deleteObject $fullClass($id) $id
            unset fullClass($id)
        }
    }

    _proc deleteObject {fullClass id} {
        uplevel ${fullClass}::~[namespace tail $fullClass] $id
        foreach name [array names ${fullClass}:: $id,*] {
            unset ${fullClass}::($name)
        }
    }

    _proc classof {id} {
        variable fullClass

        return $fullClass($id)
    }

    _proc copy {fullClass from to} {
        set index [string length $from]
        foreach name [array names ${fullClass}:: $from,*] {
            set ${fullClass}::($to[string range $name $index end]) [set ${fullClass}::($name)]
        }
    }
}

_proc ::stooop::class {args} {
    variable declared

    set class [lindex $args 0]
    set declared([uplevel namespace eval $class {namespace current}]) {}
    uplevel namespace eval $class [list "::variable {}\n[lindex $args end]"]
}

_proc ::stooop::parseProcedureName {namespace name fullClassVariable procedureVariable messageVariable} {
    variable declared
    upvar $fullClassVariable fullClass $procedureVariable procedure $messageVariable message

    if {[info exists declared($namespace)]&&([string length [namespace qualifiers $name]]==0)} {
        set fullClass $namespace
        set procedure $name
        return 1
    } else {
        if {![string match ::* $name]} {
            if {[string compare $namespace ::]==0} {
                set name ::$name
            } else {
                set name ${namespace}::$name
            }
        }
        set fullClass [namespace qualifiers $name]
        if {[info exists declared($fullClass)]} {
            set procedure [namespace tail $name]
            return 1
        } else {
            if {[string length $fullClass]==0} {
                set message "procedure $name class name is empty"
            } else {
                set message "procedure $name class $fullClass is unknown"
            }
            return 0
        }
    }
}

_proc ::stooop::virtual {keyword name arguments args} {
    variable pureVirtual

    if {[string compare [uplevel namespace which -command $keyword] ::proc]!=0} {
        error "virtual operator works only on proc, not $keyword"
    }
    if {![parseProcedureName [uplevel namespace current] $name fullClass procedure message]} {
        error $message
    }
    set class [namespace tail $fullClass]
    if {[string compare $class $procedure]==0} {
        error "cannot make class $fullClass constructor virtual"
    }
    if {[string compare ~$class $procedure]==0} {
        error "cannot make class $fullClass destructor virtual"
    }
    if {[string compare [lindex $arguments 0] this]!=0} {
        error "cannot make static procedure $procedure of class $fullClass virtual"
    }
    set pureVirtual [expr {[llength $args]==0}]
    uplevel ::proc [list $name $arguments [lindex $args 0]]
    unset pureVirtual
}

_proc proc {name arguments args} {
    if {![::stooop::parseProcedureName [uplevel namespace current] $name fullClass procedure message]} {
        uplevel _proc [list $name $arguments] $args
        return
    }
    if {[llength $args]==0} {
        error "missing body for ${fullClass}::$procedure"
    }
    set class [namespace tail $fullClass]
    if {[string compare $class $procedure]==0} {
        if {[string compare [lindex $arguments 0] this]!=0} {
            error "class $fullClass constructor first argument must be this"
        }
        if {[string compare [lindex $arguments 1] copy]==0} {
            if {[llength $arguments]!=2} {
                error "class $fullClass copy constructor must have 2 arguments exactly"
            }
            if {[catch {info body ::${fullClass}::$class}]} {
                error "class $fullClass copy constructor defined before constructor"
            }
            eval ::stooop::constructorDeclaration $fullClass $class 1 \{$arguments\} $args
        } else {
            eval ::stooop::constructorDeclaration $fullClass $class 0 \{$arguments\} $args
            ::stooop::generateDefaultCopyConstructor $fullClass
        }
    } elseif {[string compare ~$class $procedure]==0} {
        if {[llength $arguments]!=1} {
            error "class $fullClass destructor must have 1 argument exactly"
        }
        if {[string compare [lindex $arguments 0] this]!=0} {
            error "class $fullClass destructor argument must be this"
        }
        if {[catch {info body ::${fullClass}::$class}]} {
            error "class $fullClass destructor defined before constructor"
        }
        ::stooop::destructorDeclaration $fullClass $class $arguments [lindex $args 0]
    } else {
        if {[catch {info body ::${fullClass}::$class}]} {
            error "class $fullClass member procedure $procedure defined before constructor"
        }
        ::stooop::memberProcedureDeclaration $fullClass $class $procedure $arguments [lindex $args 0]
    }
}

_proc ::stooop::constructorDeclaration {fullClass class copy arguments args} {
    variable checkCode
    variable fullBases
    variable variable

    set number [llength $args]
    if {($number%2)==0} {
        error "bad class $fullClass constructor declaration, a base class, contructor arguments or body may be missing"
    }
    if {[string compare [lindex $arguments end] args]==0} {
        set variable($fullClass) {}
    }
    if {!$copy} {
        set fullBases($fullClass) {}
    }
    foreach {base baseArguments} [lrange $args 0 [expr {$number-2}]] {
        set constructor ${base}::[namespace tail $base]
        catch {$constructor}
        set fullBase [namespace qualifiers [uplevel 2 namespace which -command $constructor]]
        if {[string length $fullBase]==0} {
            if {[string match *$base $fullClass]} {
                error "class $fullClass cannot be derived from itself"
            } else {
                error "class $fullClass constructor defined before base class $base constructor"
            }
        }
        if {!$copy} {
            if {[lsearch -exact $fullBases($fullClass) $fullBase]>=0} {
                error "class $fullClass directly inherits from class $fullBase more than once"
            }
            lappend fullBases($fullClass) $fullBase
        }
        regsub -all \n $baseArguments {} constructorArguments($fullBase)
    }
    set constructorBody \
"::variable {}
$checkCode
"
    if {[llength $fullBases($fullClass)]>0} {
        if {[info exists variable($fullClass)]} {
            foreach fullBase $fullBases($fullClass) {
                if {![info exists constructorArguments($fullBase)]} {
                    error "missing base class $fullBase constructor arguments from class $fullClass constructor"
                }
                set baseConstructor ${fullBase}::[namespace tail $fullBase]
                if {[info exists variable($fullBase)]&&([string first {$args} $constructorArguments($fullBase)]>=0)} {
                    append constructorBody \
"::set _list \[::list $constructorArguments($fullBase)\]
::eval $baseConstructor \$this \[::lrange \$_list 0 \[::expr {\[::llength \$_list\]-2}\]\] \[::lindex \$_list end\]
::unset _list
::set ${fullBase}::(\$this,_derived) $fullClass
"
                } else {
                    append constructorBody \
"$baseConstructor \$this $constructorArguments($fullBase)
::set ${fullBase}::(\$this,_derived) $fullClass
"
                }
            }
        } else {
            foreach fullBase $fullBases($fullClass) {
                if {![info exists constructorArguments($fullBase)]} {
                    error "missing base class $fullBase constructor arguments from class $fullClass constructor"
                }
                set baseConstructor ${fullBase}::[namespace tail $fullBase]
                append constructorBody \
"$baseConstructor \$this $constructorArguments($fullBase)
::set ${fullBase}::(\$this,_derived) $fullClass
"
            }
        }
    }
    if {$copy} {
        append constructorBody \
"::catch {::set ${fullClass}::(\$this,_derived) \[::set ${fullClass}::(\$[::lindex $arguments 1],_derived)\]}
"
    }
    append constructorBody [lindex $args end]
    if {$copy} {
        _proc ${fullClass}::_copy $arguments $constructorBody
    } else {
        _proc ${fullClass}::$class $arguments $constructorBody
    }
}

_proc ::stooop::destructorDeclaration {fullClass class arguments body} {
    variable checkCode
    variable fullBases

    set body \
"::variable {}
$checkCode
$body
"
    for {set index [expr {[llength $fullBases($fullClass)]-1}]} {$index>=0} {incr index -1} {
        set fullBase [lindex $fullBases($fullClass) $index]
        append body \
"::stooop::deleteObject $fullBase \$this
"
    }
    _proc ${fullClass}::~$class $arguments $body
}

_proc ::stooop::memberProcedureDeclaration {fullClass class procedure arguments body} {
    variable checkCode
    variable pureVirtual

    if {[info exists pureVirtual]} {
        if {$pureVirtual} {
            _proc ${fullClass}::$procedure $arguments \
"::variable {}
$checkCode
::eval \$${fullClass}::(\$this,_derived)::$procedure \[::lrange \[::info level 0\] 1 end\]
"
        } else {
            _proc ${fullClass}::_$procedure $arguments \
"::variable {}
$checkCode
$body
"
            _proc ${fullClass}::$procedure $arguments \
"::variable {}
$checkCode
if {!\[::catch {::info body \$${fullClass}::(\$this,_derived)::$procedure}\]} {
::return \[::eval \$${fullClass}::(\$this,_derived)::$procedure \[::lrange \[::info level 0\] 1 end\]\]
}
::eval ${fullClass}::_$procedure \[::lrange \[::info level 0\] 1 end\]
"
        }
    } else {
        _proc ${fullClass}::$procedure $arguments \
"::variable {}
$checkCode
$body
"
    }
}

_proc ::stooop::generateDefaultCopyConstructor {fullClass} {
    variable fullBases

    foreach fullBase $fullBases($fullClass) {
        append body \
"${fullBase}::_copy \$this \$sibling
"
    }
    append body \
"::stooop::copy $fullClass \$sibling \$this
"
    _proc ${fullClass}::_copy {this sibling} $body
}


if {[llength [array names ::env STOOOP*]]>0} {

    catch {rename ::stooop::class ::stooop::_class}
    _proc ::stooop::class {args} {
        variable traceDataOperations

        set class [lindex $args 0]
        if {[info exists ::env(STOOOPCHECKDATA)]} {
            uplevel namespace eval $class [list {::trace variable {} wu ::stooop::checkData}]
        }
        if {[info exists ::env(STOOOPTRACEDATA)]} {
            uplevel namespace eval $class [list "::trace variable {} $traceDataOperations ::stooop::traceData"]
        }
        uplevel ::stooop::_class $args
    }

    if {[info exists ::env(STOOOPCHECKPROCEDURES)]} {
        catch {rename ::stooop::virtual ::stooop::_virtual}
        _proc ::stooop::virtual {keyword name arguments args} {
            variable interface

            uplevel ::stooop::_virtual [list $keyword $name $arguments] $args
            parseProcedureName [uplevel namespace current] $name fullClass procedure message
            if {[llength $args]==0} {
                set interface($fullClass) {}
            }
        }

        catch {rename ::stooop::new ::stooop::_new}
        _proc ::stooop::new {classOrId args} {
            variable fullClass
            variable interface

            if {[scan $classOrId %u dummy]==0} {
                set constructor ${classOrId}::[namespace tail $classOrId]
                catch {$constructor}
                set fullName [namespace qualifiers [uplevel namespace which -command $constructor]]
            } else {
                set fullName $fullClass($classOrId)
            }
            if {[info exists interface($fullName)]} {
                error "class $fullName with pure virtual procedures should not be instanciated"
            }
            return [uplevel ::stooop::_new $classOrId $args]
        }
    }

    _proc ::stooop::ancestors {fullClass} {
        variable ancestors
        variable fullBases

        if {[info exists ancestors($fullClass)]} {
            return $ancestors($fullClass)
        }
        set list {}
        foreach class $fullBases($fullClass) {
            set list [concat $list [list $class] [ancestors $class]]
        }
        set ancestors($fullClass) $list
        return $list
    }

    _proc ::stooop::debugInformation {className fullClassName procedureName fullProcedureName thisParameterName} {
        upvar $className class $fullClassName fullClass $procedureName procedure $fullProcedureName fullProcedure\
            $thisParameterName thisParameter
        variable declared

        set namespace [uplevel 2 namespace current]
        if {[lsearch -exact [array names declared] $namespace]<0} return
        set fullClass [string trimleft $namespace :]
        set class [namespace tail $fullClass]
        set list [info level -2]
        if {[llength $list]==0} return
        set procedure [lindex $list 0]
        set fullProcedure [uplevel 3 namespace which -command $procedure]
        set procedure [namespace tail $procedure]
        if {[string compare $class $procedure]==0} {
            set procedure constructor
        } elseif {[string compare ~$class $procedure]==0} {
            set procedure destructor
        }
        if {[string compare [lindex [info args $fullProcedure] 0] this]==0} {
            set thisParameter [lindex $list 1]
        }
    }

    _proc ::stooop::checkProcedure {} {
        variable fullClass

        debugInformation class qualifiedClass procedure qualifiedProcedure this
        if {![info exists this]} return
        if {[string compare $procedure constructor]==0} return
        if {![info exists fullClass($this)]} {
            error "$this is not a valid object identifier"
        }
        set fullName [string trimleft $fullClass($this) :]
        if {[string compare $fullName $qualifiedClass]==0} return
        if {[lsearch -exact [ancestors ::$fullName] ::$qualifiedClass]<0} {
            error "class $qualifiedClass of $qualifiedProcedure procedure not an ancestor of object $this class $fullName"
        }
    }

    _proc ::stooop::traceProcedure {} {
        variable traceProcedureChannel
        variable traceProcedureFormat

        debugInformation class qualifiedClass procedure qualifiedProcedure this
        set text $traceProcedureFormat
        regsub -all %C $text $qualifiedClass text
        regsub -all %c $text $class text
        regsub -all %P $text $qualifiedProcedure text
        regsub -all %p $text $procedure text
        if {[info exists this]} {
            regsub -all %O $text $this text
            regsub -all %a $text [lrange [info level -1] 2 end] text
        } else {
            regsub -all %O $text {} text
            regsub -all %a $text [lrange [info level -1] 1 end] text
        }
        puts $traceProcedureChannel $text
    }

    _proc ::stooop::checkData {array name operation} {
        scan $name %u,%s identifier member
        if {[info exists member]&&([string compare $member _derived]==0)} return

        debugInformation class qualifiedClass procedure qualifiedProcedure this
        if {![info exists class]} return
        set array [uplevel [list namespace which -variable $array]]
        if {![info exists procedure]} {
            if {[string compare $array ::${qualifiedClass}::]!=0} {
                error "class access violation in class $qualifiedClass namespace"
            }
            return
        }
        if {[string compare $qualifiedProcedure ::stooop::copy]==0} return
        if {[string compare $array ::${qualifiedClass}::]!=0} {
            error "class access violation in procedure $qualifiedProcedure"
        }
        if {![info exists this]} return
        if {![info exists identifier]} return
        if {$this!=$identifier} {
            error "object $identifier access violation in procedure $qualifiedProcedure acting on object $this"
        }
    }

    _proc ::stooop::traceData {array name operation} {
        variable traceDataChannel
        variable traceDataFormat

        scan $name %u,%s identifier member
        if {[info exists member]&&([string compare $member _derived]==0)} return

        if {![catch {lindex [info level -1] 0} procedure]&&([string compare ::stooop::deleteObject $procedure]==0)} return
        set class {}
        set qualifiedClass {}
        set procedure {}
        set qualifiedProcedure {}

        debugInformation class qualifiedClass procedure qualifiedProcedure this
        set text $traceDataFormat
        regsub -all %C $text $qualifiedClass text
        regsub -all %c $text $class text
        if {[info exists member]} {
            regsub -all %m $text $member text
        } else {
            regsub -all %m $text $name text
        }
        regsub -all %P $text $qualifiedProcedure text
        regsub -all %p $text $procedure text
        regsub -all %A $text [string trimleft [uplevel [list namespace which -variable $array]] :] text
        if {[info exists this]} {
            regsub -all %O $text $this text
        } else {
            regsub -all %O $text {} text
        }
        array set string {r read w write u unset}
        regsub -all %o $text $string($operation) text
        if {[string compare $operation u]==0} {
            regsub -all %v $text {} text
        } else {
            regsub -all %v $text [uplevel set ${array}($name)] text
        }
        puts $traceDataChannel $text
    }
}
}
namespace import stooop::*
if {[catch {package require switched 1.4}]} {
set rcsId {$Id: switched.tcl,v 1.4 1998/03/30 08:26:05 jfontain Exp $}

package provide switched [lindex {$Revision: 1.4 $} 1]

class switched {

    proc switched {this args} {
        if {([llength $args]%2)!=0} {
            error "value for \"[lindex $args end]\" missing"
        }
        set switched::($this,complete) 0
        set switched::($this,arguments) $args
    }

    proc ~switched {this} {}

    virtual proc options {this}

    proc complete {this} {
        foreach description [options $this] {
            set option [lindex $description 0]
            set switched::($this,$option) [set default [lindex $description 1]]
            if {[llength $description]<3} {
                set initialize($option) {}
            } elseif {[string compare $default [lindex $description 2]]!=0} {
                set switched::($this,$option) [lindex $description 2]
                set initialize($option) {}
            }
        }
        foreach {option value} $switched::($this,arguments) {
            if {[catch {string compare $switched::($this,$option) $value} different]} {
                error "$switched::($this,_derived): unknown option \"$option\""
            }
            if {$different} {
                set switched::($this,$option) $value
                set initialize($option) {}
            }
        }
        unset switched::($this,arguments)
        foreach option [array names initialize] {
            $switched::($this,_derived)::set$option $this $switched::($this,$option)
        }
        set switched::($this,complete) 1
    }

    proc configure {this args} {
        if {[llength $args]==0} {
            return [descriptions $this]
        }
        foreach {option value} $args {
            if {![info exists switched::($this,$option)]} {
                error "$switched::($this,_derived): unknown option \"$option\""
            }
        }
        if {[llength $args]==1} {
            return [description $this [lindex $args 0]]
        }
        if {([llength $args]%2)!=0} {
            error "value for \"[lindex $args end]\" missing"
        }
        foreach {option value} $args {
            if {[string compare $switched::($this,$option) $value]!=0} {
                $switched::($this,_derived)::set$option $this [set switched::($this,$option) $value]
            }
        }
    }

    proc cget {this option} {
        if {[catch {set value $switched::($this,$option)}]} {
            error "$switched::($this,_derived): unknown option \"$option\""
        }
        return $value
    }

    proc description {this option} {
        foreach description [options $this] {
            if {[string compare [lindex $description 0] $option]==0} {
                if {[llength $description]<3} {
                    lappend description $switched::($this,$option)
                    return $description
                } else {
                    return [lreplace $description 2 2 $switched::($this,$option)]
                }
            }
        }
    }

    proc descriptions {this} {
        set descriptions {}
        foreach description [options $this] {
            if {[llength $description]<3} {
                lappend description $switched::($this,[lindex $description 0])
                lappend descriptions $description
            } else {
                lappend descriptions [lreplace $description 2 2 $switched::($this,[lindex $description 0])]
            }
        }
        return $descriptions
    }

}
}

if {[catch {package require scwoop 2.2}]} {
set rcsId {$Id: scwoop.tcl,v 2.14 1998/04/13 19:37:02 jfontain Exp jfontain $}

package provide scwoop 2.2

class widget {}

switch $tcl_platform(platform) {
    macintosh {
        array set widget:: {default,ButtonAnchor center default,ButtonActiveBackgroundColor systemButtonText default,ButtonActiveBackgroundMono Black default,ButtonActiveForegroundColor systemButtonFace default,ChkradActiveForegroundColor DEF_BUTTON_ACTIVE_FG_COLOR default,ButtonActiveForegroundMono White default,ButtonBackgroundColor systemButtonFace default,ButtonBackgroundMono White default,ButtonBitmap {} default,ButtonBorderWidth 2 default,ButtonCursor {} default,ButtonCommand {} default,ButtonDefault disabled default,ButtonDisabledForegroundColor #a3a3a3 default,ButtonDisabledForegroundMono {} default,ButtonForeground systemButtonText default,ChkradForeground DEF_BUTTON_FG default,ButtonFont system default,ButtonHeight 0 default,ButtonHighlightBackground systemWindowBody default,ButtonHighlight systemButtonFrame default,LabelHighlightWidth 0 default,ButtonHighlightWidth 4 default,ButtonImage {} default,ButtonIndicator 1 default,ButtonJustify center default,ButtonOffValue 0 default,ButtonOnValue 1 default,ButtonPadX 7 default,LabelCheckRadiusPadX 1 default,ButtonPadY 3 default,LabelCheckRadiusPadY 1 default,ButtonRelief flat default,LabelCheckRadiusRelief flat default,ButtonSelectColor #b03060 default,ButtonSelectMono Black default,ButtonSelectImage {} default,ButtonState normal default,LabelTakeFocus 0 default,ButtonTakeFocus {} default,ButtonText {} default,ButtonTextVariable {} default,ButtonUnderline -1 default,ButtonValue {} default,ButtonWidth 0 default,ButtonWrapLength 0 default,RadiobuttonVariable selectedButton default,CheckbuttonVariable {} default,CanvasBackgroundColor systemWindowBody default,CanvasBackgroundMono White default,CanvasBorderWidth 0 default,CanvasCloseEnough 1 default,CanvasConfine 1 default,CanvasCursor {} default,CanvasHeight 7c default,CanvasHighlightBackground systemWindowBody default,CanvasHighlight Black default,CanvasHighlightWidth 3 default,CanvasInsertBackground Black default,CanvasInsertBorderColor 0 default,CanvasInsertBorderMono 0 default,CanvasInsertOffTime 300 default,CanvasInsertOnTime 600 default,CanvasInsertWidth 2 default,CanvasRelief flat default,CanvasScrollRegion {} default,CanvasSelectColor systemHighlight default,CanvasSelectMono Black default,CanvasSelectBorderColor 1 default,CanvasSelectBorderMono 0 default,CanvasSelectForegroundColor Black default,CanvasSelectForegroundMono White default,CanvasTakeFocus {} default,CanvasWidth 10c default,CanvasXScrollCommand {} default,CanvasXScrollIncrement 0 default,CanvasYScrollCommand {} default,CanvasYScrollIncrement 0 default,EntryBackgroundColor systemWindowBody default,EntryBackgroundMono White default,EntryBorderWidth 1 default,EntryCursor xterm default,EntryExportSelection 1 default,EntryFont "Helvetica 12" default,EntryForeground Black default,EntryHighlightBackground systemWindowBody default,EntryHighlight Black default,EntryHighlightWidth 0 default,EntryInsertBackground Black default,EntryInsertBorderColor 0 default,EntryInsertBorderMono 0 default,EntryInsertOffTime 300 default,EntryInsertOnTime 600 default,EntryInsertWidth 1 default,EntryJustify left default,EntryRelief solid default,EntryScrollCommand {} default,EntrySelectColor systemHighlight default,EntrySelectMono Black default,EntrySelectBorderColor 1 default,EntrySelectBorderMono 0 default,EntrySelectForegroundColor systemHighlightText default,EntrySelectForegroundMono White default,EntryShow {} default,EntryState normal default,EntryTakeFocus {} default,EntryTextVariable {} default,EntryWidth 20 default,FrameBackgroundColor systemWindowBody default,FrameBackgroundMono White default,FrameBorderWidth 0 default,FrameClass Frame default,FrameColormap {} default,FrameContainer 0 default,FrameCursor {} default,FrameHeight 0 default,FrameHighlightBackground systemWindowBody default,FrameHighlight Black default,FrameHighlightWidth 0 default,FrameRelief flat default,FrameTakeFocus 0 default,FrameUse {} default,FrameVisual {} default,FrameWidth 0 default,ListboxBackgroundColor systemWindowBody default,ListboxBackgroundMono White default,ListboxBorderWidth 1 default,ListboxCursor {} default,ListboxExportSelection 1 default,ListboxFont application default,ListboxForeground Black default,ListboxHeight 10 default,ListboxHighlightBackground systemWindowBody default,ListboxHighlight Black default,ListboxHighlightWidth 0 default,ListboxRelief solid default,ListboxScrollCommand {} default,ListboxSelectColor systemHighlight default,ListboxSelectMono Black default,ListboxSelectBorder 0 default,ListboxSelectForegroundColor systemHighlightText default,ListboxSelectForegroundMono White default,ListboxSelectMode browse default,ListboxSetGrid 0 default,ListboxTakeFocus {} default,ListboxWidth 20 default,MenuEntryActiveBackground {} default,MenuEntryActiveForeground {} default,MenuEntryAccelerator {} default,MenuEntryBackground {} default,MenuEntryBitmap None default,MenuEntryColumnBreak 0 default,MenuEntryCommand {} default,MenuEntryForeground {} default,MenuEntryFont {} default,MenuEntryHideMargin 0 default,MenuEntryImage {} default,MenuEntryIndicator 1 default,MenuEntryLabel {} default,MenuEntryMenu {} default,MenuEntryOffValue 0 default,MenuEntryOnValue 1 default,MenuEntrySelectImage {} default,MenuEntryState normal default,MenuEntryValue {} default,MenuEntryCheckVariable {} default,MenuEntryRadioVariable selectedButton default,MenuEntrySelect {} default,MenuEntryUnderline -1 default,MenuActiveBackgroundColor SystemMenuActive default,MenuActiveBackgroundMono Black default,MenuActiveBorderWidth 0 default,MenuActiveForegroundColor SystemMenuActiveText default,MenuActiveForegroundMono White default,MenuBackgroundColor SystemMenu default,MenuBackgroundMono White default,MenuBorderWidth 0 default,MenuCursor arrow default,MenuDisabledForegroundColor SystemMenuDisabled default,MenuDisabledForegroundMono {} default,MenuFont system default,MenuForeground SystemMenuText default,MenuPostCommand {} default,MenuRelief flat default,MenuSelectColor SystemMenuActive default,MenuSelectMono Black default,MenuTakeFocus 0 default,MenuTearoff 1 default,MenuTearoffCommand {} default,MenuTitle {} default,MenuType normal default,MenubuttonAnchor center default,MenubuttonActiveBackgroundColor #ececec default,MenubuttonActiveBackgroundMono Black default,MenubuttonActiveForegroundColor Black default,MenubuttonActiveForegroundMono White default,MenubuttonBackgroundColor systemWindowBody default,MenubuttonBackgroundMono White default,MenubuttonBitmap {} default,MenubuttonBorderWidth 2 default,MenubuttonCursor {} default,MenubuttonDirection below default,MenubuttonDisabledForegroundColor #a3a3a3 default,MenubuttonDisabledForegroundMono {} default,MenubuttonFont system default,MenubuttonForeground Black default,MenubuttonHeight 0 default,MenubuttonHighlightBackground systemWindowBody default,MenubuttonHighlight Black default,MenubuttonHighlightWidth 0 default,MenubuttonImage {} default,MenubuttonIndicator 0 default,MenubuttonJustify left default,MenubuttonMenu {} default,MenubuttonPadX 4p default,MenubuttonPadY 3p default,MenubuttonRelief flat default,MenubuttonState normal default,MenubuttonTakeFocus 0 default,MenubuttonText {} default,MenubuttonTextVariable {} default,MenubuttonUnderline -1 default,MenubuttonWidth 0 default,MenubuttonWrapLength 0 default,MessageAnchor center default,MessageAspect 150 default,MessageBackgroundColor systemWindowBody default,MessageBackgroundMono White default,MessageBorderWidth 2 default,MessageCursor {} default,MessageForeground Black default,MessageFont system default,MessageHighlightBackground systemWindowBody default,MessageHighlight Black default,MessageHighlightWidth 0 default,MessageJustify left default,MessagePadX -1 default,MessagePadY -1 default,MessageRelief flat default,MessageTakeFocus 0 default,MessageText {} default,MessageTextVariable {} default,MessageWidth 0 default,ScaleActiveBackgroundColor #ececec default,ScaleActiveBackgroundMono Black default,ScaleBackgroundColor systemWindowBody default,ScaleBackgroundMono White default,ScaleBigIncrement 0 default,ScaleBorderWidth 2 default,ScaleCommand {} default,ScaleCursor {} default,ScaleDigits 0 default,ScaleFont system default,ScaleForegroundColor Black default,ScaleForegroundMono Black default,ScaleFrom 0 default,ScaleHighlightBackground systemWindowBody default,ScaleHighlight Black default,ScaleHighlightWidth 0 default,ScaleLabel {} default,ScaleLength 100 default,ScaleOrient vertical default,ScaleRelief flat default,ScaleRepeatDelay 300 default,ScaleRepeatInterval 100 default,ScaleResolution 1 default,ScaleTroughColor #c3c3c3 default,ScaleTroughMono White default,ScaleShowValue 1 default,ScaleSliderLength 30 default,ScaleSliderRelief raised default,ScaleState normal default,ScaleTakeFocus {} default,ScaleTickInterval 0 default,ScaleTo 100 default,ScaleVariable {} default,ScaleWidth 15 default,ScrollbarActiveBackgroundColor #ececec default,ScrollbarActiveBackgroundMono Black default,ScrollbarActiveRelief raised default,ScrollbarBackgroundColor systemWindowBody default,ScrollbarBackgroundMono White default,ScrollbarBorderWidth 0 default,ScrollbarCommand {} default,ScrollbarCursor {} default,ScrollbarElementBorderWidth -1 default,ScrollbarHighlightBackground systemWindowBody default,ScrollbarHighlight Black default,ScrollbarHighlightWidth 0 default,ScrollbarJump 0 default,ScrollbarOrient vertical default,ScrollbarRelief flat default,ScrollbarRepeatDelay 300 default,ScrollbarRepeatInterval 100 default,ScrollbarTakeFocus {} default,ScrollbarTroughColor #c3c3c3 default,ScrollbarTroughMono White default,ScrollbarWidth 16 default,TextBackgroundColor systemWindowBody default,TextBackgroundMono White default,TextBorderWidth 0 default,TextCursor xterm default,TextForeground Black default,TextExportSelection 1 default,TextFont "Courier 12" default,TextHeight 24 default,TextHighlightBackground systemWindowBody default,TextHighlight Black default,TextHighlightWidth 3 default,TextInsertBackground Black default,TextInsertBorderColor 0 default,TextInsertBorderMono 0 default,TextInsertOffTime 300 default,TextInsertOnTime 600 default,TextInsertWidth 1 default,TextPadX 1 default,TextPadY 1 default,TextRelief flat default,TextSelectColor systemHighlight default,TextSelectMono Black default,TextSelectBorderColor 1 default,TextSelectBorderMono 0 default,TextSelectForegroundColor systemHighlightText default,TextSelectForegroundMono White default,TextSelectRelief solid default,TextSetGrid 0 default,TextSpacing1 0 default,TextSpacing2 0 default,TextSpacing3 0 default,TextState normal default,TextTabs {} default,TextTakeFocus {} default,TextWidth 80 default,TextWrap char default,TextXScrollCommand {} default,TextYScrollCommand {} default,ToplevelClass Toplevel default,ToplevelMenu {} default,ToplevelScreen {}}
    }
    unix {
        array set widget:: {default,ButtonAnchor center default,ButtonActiveBackgroundColor #ececec default,ButtonActiveBackgroundMono Black default,ButtonActiveForegroundColor Black default,ChkradActiveForegroundColor DEF_BUTTON_ACTIVE_FG_COLOR default,ButtonActiveForegroundMono White default,ButtonBackgroundColor #d9d9d9 default,ButtonBackgroundMono White default,ButtonBitmap {} default,ButtonBorderWidth 2 default,ButtonCursor {} default,ButtonCommand {} default,ButtonDefault disabled default,ButtonDisabledForegroundColor #a3a3a3 default,ButtonDisabledForegroundMono {} default,ButtonForeground Black default,ChkradForeground DEF_BUTTON_FG default,ButtonFont "Helvetica -12 bold" default,ButtonHeight 0 default,ButtonHighlightBackground #d9d9d9 default,ButtonHighlight Black default,LabelHighlightWidth 0 default,ButtonHighlightWidth 1 default,ButtonImage {} default,ButtonIndicator 1 default,ButtonJustify center default,ButtonOffValue 0 default,ButtonOnValue 1 default,ButtonPadX 3m default,LabelCheckRadiusPadX 1 default,ButtonPadY 1m default,LabelCheckRadiusPadY 1 default,ButtonRelief raised default,LabelCheckRadiusRelief flat default,ButtonSelectColor #b03060 default,ButtonSelectMono Black default,ButtonSelectImage {} default,ButtonState normal default,LabelTakeFocus 0 default,ButtonTakeFocus {} default,ButtonText {} default,ButtonTextVariable {} default,ButtonUnderline -1 default,ButtonValue {} default,ButtonWidth 0 default,ButtonWrapLength 0 default,RadiobuttonVariable selectedButton default,CheckbuttonVariable {} default,CanvasBackgroundColor #d9d9d9 default,CanvasBackgroundMono White default,CanvasBorderWidth 0 default,CanvasCloseEnough 1 default,CanvasConfine 1 default,CanvasCursor {} default,CanvasHeight 7c default,CanvasHighlightBackground #d9d9d9 default,CanvasHighlight Black default,CanvasHighlightWidth 1 default,CanvasInsertBackground Black default,CanvasInsertBorderColor 0 default,CanvasInsertBorderMono 0 default,CanvasInsertOffTime 300 default,CanvasInsertOnTime 600 default,CanvasInsertWidth 2 default,CanvasRelief flat default,CanvasScrollRegion {} default,CanvasSelectColor #c3c3c3 default,CanvasSelectMono Black default,CanvasSelectBorderColor 1 default,CanvasSelectBorderMono 0 default,CanvasSelectForegroundColor Black default,CanvasSelectForegroundMono White default,CanvasTakeFocus {} default,CanvasWidth 10c default,CanvasXScrollCommand {} default,CanvasXScrollIncrement 0 default,CanvasYScrollCommand {} default,CanvasYScrollIncrement 0 default,EntryBackgroundColor #d9d9d9 default,EntryBackgroundMono White default,EntryBorderWidth 2 default,EntryCursor xterm default,EntryExportSelection 1 default,EntryFont "Helvetica -12" default,EntryForeground Black default,EntryHighlightBackground #d9d9d9 default,EntryHighlight Black default,EntryHighlightWidth 1 default,EntryInsertBackground Black default,EntryInsertBorderColor 0 default,EntryInsertBorderMono 0 default,EntryInsertOffTime 300 default,EntryInsertOnTime 600 default,EntryInsertWidth 2 default,EntryJustify left default,EntryRelief sunken default,EntryScrollCommand {} default,EntrySelectColor #c3c3c3 default,EntrySelectMono Black default,EntrySelectBorderColor 1 default,EntrySelectBorderMono 0 default,EntrySelectForegroundColor Black default,EntrySelectForegroundMono White default,EntryShow {} default,EntryState normal default,EntryTakeFocus {} default,EntryTextVariable {} default,EntryWidth 20 default,FrameBackgroundColor #d9d9d9 default,FrameBackgroundMono White default,FrameBorderWidth 0 default,FrameClass Frame default,FrameColormap {} default,FrameContainer 0 default,FrameCursor {} default,FrameHeight 0 default,FrameHighlightBackground #d9d9d9 default,FrameHighlight Black default,FrameHighlightWidth 0 default,FrameRelief flat default,FrameTakeFocus 0 default,FrameUse {} default,FrameVisual {} default,FrameWidth 0 default,ListboxBackgroundColor #d9d9d9 default,ListboxBackgroundMono White default,ListboxBorderWidth 2 default,ListboxCursor {} default,ListboxExportSelection 1 default,ListboxFont "Helvetica -12 bold" default,ListboxForeground Black default,ListboxHeight 10 default,ListboxHighlightBackground #d9d9d9 default,ListboxHighlight Black default,ListboxHighlightWidth 1 default,ListboxRelief sunken default,ListboxScrollCommand {} default,ListboxSelectColor #c3c3c3 default,ListboxSelectMono Black default,ListboxSelectBorder 1 default,ListboxSelectForegroundColor Black default,ListboxSelectForegroundMono White default,ListboxSelectMode browse default,ListboxSetGrid 0 default,ListboxTakeFocus {} default,ListboxWidth 20 default,MenuEntryActiveBackground {} default,MenuEntryActiveForeground {} default,MenuEntryAccelerator {} default,MenuEntryBackground {} default,MenuEntryBitmap None default,MenuEntryColumnBreak 0 default,MenuEntryCommand {} default,MenuEntryForeground {} default,MenuEntryFont {} default,MenuEntryHideMargin 0 default,MenuEntryImage {} default,MenuEntryIndicator 1 default,MenuEntryLabel {} default,MenuEntryMenu {} default,MenuEntryOffValue 0 default,MenuEntryOnValue 1 default,MenuEntrySelectImage {} default,MenuEntryState normal default,MenuEntryValue {} default,MenuEntryCheckVariable {} default,MenuEntryRadioVariable selectedButton default,MenuEntrySelect {} default,MenuEntryUnderline -1 default,MenuActiveBackgroundColor #ececec default,MenuActiveBackgroundMono Black default,MenuActiveBorderWidth 2 default,MenuActiveForegroundColor Black default,MenuActiveForegroundMono White default,MenuBackgroundColor #d9d9d9 default,MenuBackgroundMono White default,MenuBorderWidth 2 default,MenuCursor arrow default,MenuDisabledForegroundColor #a3a3a3 default,MenuDisabledForegroundMono {} default,MenuFont "Helvetica -12 bold" default,MenuForeground Black default,MenuPostCommand {} default,MenuRelief raised default,MenuSelectColor #b03060 default,MenuSelectMono Black default,MenuTakeFocus 0 default,MenuTearoff 1 default,MenuTearoffCommand {} default,MenuTitle {} default,MenuType normal default,MenubuttonAnchor center default,MenubuttonActiveBackgroundColor #ececec default,MenubuttonActiveBackgroundMono Black default,MenubuttonActiveForegroundColor Black default,MenubuttonActiveForegroundMono White default,MenubuttonBackgroundColor #d9d9d9 default,MenubuttonBackgroundMono White default,MenubuttonBitmap {} default,MenubuttonBorderWidth 2 default,MenubuttonCursor {} default,MenubuttonDirection below default,MenubuttonDisabledForegroundColor #a3a3a3 default,MenubuttonDisabledForegroundMono {} default,MenubuttonFont "Helvetica -12 bold" default,MenubuttonForeground Black default,MenubuttonHeight 0 default,MenubuttonHighlightBackground #d9d9d9 default,MenubuttonHighlight Black default,MenubuttonHighlightWidth 0 default,MenubuttonImage {} default,MenubuttonIndicator 0 default,MenubuttonJustify center default,MenubuttonMenu {} default,MenubuttonPadX 4p default,MenubuttonPadY 3p default,MenubuttonRelief flat default,MenubuttonState normal default,MenubuttonTakeFocus 0 default,MenubuttonText {} default,MenubuttonTextVariable {} default,MenubuttonUnderline -1 default,MenubuttonWidth 0 default,MenubuttonWrapLength 0 default,MessageAnchor center default,MessageAspect 150 default,MessageBackgroundColor #d9d9d9 default,MessageBackgroundMono White default,MessageBorderWidth 2 default,MessageCursor {} default,MessageForeground Black default,MessageFont "Helvetica -12 bold" default,MessageHighlightBackground #d9d9d9 default,MessageHighlight Black default,MessageHighlightWidth 0 default,MessageJustify left default,MessagePadX -1 default,MessagePadY -1 default,MessageRelief flat default,MessageTakeFocus 0 default,MessageText {} default,MessageTextVariable {} default,MessageWidth 0 default,ScaleActiveBackgroundColor #ececec default,ScaleActiveBackgroundMono Black default,ScaleBackgroundColor #d9d9d9 default,ScaleBackgroundMono White default,ScaleBigIncrement 0 default,ScaleBorderWidth 2 default,ScaleCommand {} default,ScaleCursor {} default,ScaleDigits 0 default,ScaleFont "Helvetica -12 bold" default,ScaleForegroundColor Black default,ScaleForegroundMono Black default,ScaleFrom 0 default,ScaleHighlightBackground #d9d9d9 default,ScaleHighlight Black default,ScaleHighlightWidth 1 default,ScaleLabel {} default,ScaleLength 100 default,ScaleOrient vertical default,ScaleRelief flat default,ScaleRepeatDelay 300 default,ScaleRepeatInterval 100 default,ScaleResolution 1 default,ScaleTroughColor #c3c3c3 default,ScaleTroughMono White default,ScaleShowValue 1 default,ScaleSliderLength 30 default,ScaleSliderRelief raised default,ScaleState normal default,ScaleTakeFocus {} default,ScaleTickInterval 0 default,ScaleTo 100 default,ScaleVariable {} default,ScaleWidth 15 default,ScrollbarActiveBackgroundColor #ececec default,ScrollbarActiveBackgroundMono Black default,ScrollbarActiveRelief raised default,ScrollbarBackgroundColor #d9d9d9 default,ScrollbarBackgroundMono White default,ScrollbarBorderWidth 2 default,ScrollbarCommand {} default,ScrollbarCursor {} default,ScrollbarElementBorderWidth -1 default,ScrollbarHighlightBackground #d9d9d9 default,ScrollbarHighlight Black default,ScrollbarHighlightWidth 1 default,ScrollbarJump 0 default,ScrollbarOrient vertical default,ScrollbarRelief sunken default,ScrollbarRepeatDelay 300 default,ScrollbarRepeatInterval 100 default,ScrollbarTakeFocus {} default,ScrollbarTroughColor #c3c3c3 default,ScrollbarTroughMono White default,ScrollbarWidth 15 default,TextBackgroundColor #d9d9d9 default,TextBackgroundMono White default,TextBorderWidth 2 default,TextCursor xterm default,TextForeground Black default,TextExportSelection 1 default,TextFont "Courier -12" default,TextHeight 24 default,TextHighlightBackground #d9d9d9 default,TextHighlight Black default,TextHighlightWidth 1 default,TextInsertBackground Black default,TextInsertBorderColor 0 default,TextInsertBorderMono 0 default,TextInsertOffTime 300 default,TextInsertOnTime 600 default,TextInsertWidth 2 default,TextPadX 1 default,TextPadY 1 default,TextRelief sunken default,TextSelectColor #c3c3c3 default,TextSelectMono Black default,TextSelectBorderColor 1 default,TextSelectBorderMono 0 default,TextSelectForegroundColor Black default,TextSelectForegroundMono White default,TextSelectRelief raised default,TextSetGrid 0 default,TextSpacing1 0 default,TextSpacing2 0 default,TextSpacing3 0 default,TextState normal default,TextTabs {} default,TextTakeFocus {} default,TextWidth 80 default,TextWrap char default,TextXScrollCommand {} default,TextYScrollCommand {} default,ToplevelClass Toplevel default,ToplevelMenu {} default,ToplevelScreen {}}
    }
    windows {
        array set widget:: {default,ButtonAnchor center default,ButtonActiveBackgroundColor SystemButtonFace default,ButtonActiveBackgroundMono Black default,ButtonActiveForegroundColor SystemButtonText default,ChkradActiveForegroundColor SystemWindowText default,ButtonActiveForegroundMono White default,ButtonBackgroundColor SystemButtonFace default,ButtonBackgroundMono White default,ButtonBitmap {} default,ButtonBorderWidth 2 default,ButtonCursor {} default,ButtonCommand {} default,ButtonDefault disabled default,ButtonDisabledForegroundColor SystemDisabledText default,ButtonDisabledForegroundMono {} default,ButtonForeground SystemButtonText default,ChkradForeground SystemWindowText default,ButtonFont "{MS Sans Serif} 8" default,ButtonHeight 0 default,ButtonHighlightBackground SystemButtonFace default,ButtonHighlight SystemWindowFrame default,LabelHighlightWidth 0 default,ButtonHighlightWidth 1 default,ButtonImage {} default,ButtonIndicator 1 default,ButtonJustify center default,ButtonOffValue 0 default,ButtonOnValue 1 default,ButtonPadX 1 default,LabelCheckRadiusPadX 1 default,ButtonPadY 1 default,LabelCheckRadiusPadY 1 default,ButtonRelief raised default,LabelCheckRadiusRelief flat default,ButtonSelectColor SystemWindow default,ButtonSelectMono Black default,ButtonSelectImage {} default,ButtonState normal default,LabelTakeFocus 0 default,ButtonTakeFocus {} default,ButtonText {} default,ButtonTextVariable {} default,ButtonUnderline -1 default,ButtonValue {} default,ButtonWidth 0 default,ButtonWrapLength 0 default,RadiobuttonVariable selectedButton default,CheckbuttonVariable {} default,CanvasBackgroundColor SystemButtonFace default,CanvasBackgroundMono White default,CanvasBorderWidth 0 default,CanvasCloseEnough 1 default,CanvasConfine 1 default,CanvasCursor {} default,CanvasHeight 7c default,CanvasHighlightBackground SystemButtonFace default,CanvasHighlight SystemWindowFrame default,CanvasHighlightWidth 2 default,CanvasInsertBackground SystemButtonText default,CanvasInsertBorderColor 0 default,CanvasInsertBorderMono 0 default,CanvasInsertOffTime 300 default,CanvasInsertOnTime 600 default,CanvasInsertWidth 2 default,CanvasRelief flat default,CanvasScrollRegion {} default,CanvasSelectColor SystemHighlight default,CanvasSelectMono Black default,CanvasSelectBorderColor 1 default,CanvasSelectBorderMono 0 default,CanvasSelectForegroundColor SystemHighlightText default,CanvasSelectForegroundMono White default,CanvasTakeFocus {} default,CanvasWidth 10c default,CanvasXScrollCommand {} default,CanvasXScrollIncrement 0 default,CanvasYScrollCommand {} default,CanvasYScrollIncrement 0 default,EntryBackgroundColor SystemWindow default,EntryBackgroundMono White default,EntryBorderWidth 2 default,EntryCursor xterm default,EntryExportSelection 1 default,EntryFont "{MS Sans Serif} 8" default,EntryForeground SystemWindowText default,EntryHighlightBackground SystemButtonFace default,EntryHighlight SystemWindowFrame default,EntryHighlightWidth 0 default,EntryInsertBackground SystemWindowText default,EntryInsertBorderColor 0 default,EntryInsertBorderMono 0 default,EntryInsertOffTime 300 default,EntryInsertOnTime 600 default,EntryInsertWidth 2 default,EntryJustify left default,EntryRelief sunken default,EntryScrollCommand {} default,EntrySelectColor SystemHighlight default,EntrySelectMono Black default,EntrySelectBorderColor 0 default,EntrySelectBorderMono 0 default,EntrySelectForegroundColor SystemHighlightText default,EntrySelectForegroundMono White default,EntryShow {} default,EntryState normal default,EntryTakeFocus {} default,EntryTextVariable {} default,EntryWidth 20 default,FrameBackgroundColor SystemButtonFace default,FrameBackgroundMono White default,FrameBorderWidth 0 default,FrameClass Frame default,FrameColormap {} default,FrameContainer 0 default,FrameCursor {} default,FrameHeight 0 default,FrameHighlightBackground SystemButtonFace default,FrameHighlight SystemWindowFrame default,FrameHighlightWidth 0 default,FrameRelief flat default,FrameTakeFocus 0 default,FrameUse {} default,FrameVisual {} default,FrameWidth 0 default,ListboxBackgroundColor SystemButtonFace default,ListboxBackgroundMono White default,ListboxBorderWidth 2 default,ListboxCursor {} default,ListboxExportSelection 1 default,ListboxFont "{MS Sans Serif} 8" default,ListboxForeground SystemButtonText default,ListboxHeight 10 default,ListboxHighlightBackground SystemButtonFace default,ListboxHighlight SystemWindowFrame default,ListboxHighlightWidth 1 default,ListboxRelief sunken default,ListboxScrollCommand {} default,ListboxSelectColor SystemHighlight default,ListboxSelectMono Black default,ListboxSelectBorder 1 default,ListboxSelectForegroundColor SystemHighlightText default,ListboxSelectForegroundMono White default,ListboxSelectMode browse default,ListboxSetGrid 0 default,ListboxTakeFocus {} default,ListboxWidth 20 default,MenuEntryActiveBackground {} default,MenuEntryActiveForeground {} default,MenuEntryAccelerator {} default,MenuEntryBackground {} default,MenuEntryBitmap None default,MenuEntryColumnBreak 0 default,MenuEntryCommand {} default,MenuEntryForeground {} default,MenuEntryFont {} default,MenuEntryHideMargin 0 default,MenuEntryImage {} default,MenuEntryIndicator 1 default,MenuEntryLabel {} default,MenuEntryMenu {} default,MenuEntryOffValue 0 default,MenuEntryOnValue 1 default,MenuEntrySelectImage {} default,MenuEntryState normal default,MenuEntryValue {} default,MenuEntryCheckVariable {} default,MenuEntryRadioVariable selectedButton default,MenuEntrySelect {} default,MenuEntryUnderline -1 default,MenuActiveBackgroundColor SystemHighlight default,MenuActiveBackgroundMono Black default,MenuActiveBorderWidth 0 default,MenuActiveForegroundColor SystemHighlightText default,MenuActiveForegroundMono White default,MenuBackgroundColor SystemMenu default,MenuBackgroundMono White default,MenuBorderWidth 0 default,MenuCursor arrow default,MenuDisabledForegroundColor SystemDisabledText default,MenuDisabledForegroundMono {} default,MenuFont "{MS Sans Serif} 8" default,MenuForeground SystemMenuText default,MenuPostCommand {} default,MenuRelief flat default,MenuSelectColor SystemMenuText default,MenuSelectMono Black default,MenuTakeFocus 0 default,MenuTearoff 1 default,MenuTearoffCommand {} default,MenuTitle {} default,MenuType normal default,MenubuttonAnchor center default,MenubuttonActiveBackgroundColor SystemButtonFace default,MenubuttonActiveBackgroundMono Black default,MenubuttonActiveForegroundColor SystemButtonText default,MenubuttonActiveForegroundMono White default,MenubuttonBackgroundColor SystemButtonFace default,MenubuttonBackgroundMono White default,MenubuttonBitmap {} default,MenubuttonBorderWidth 2 default,MenubuttonCursor {} default,MenubuttonDirection below default,MenubuttonDisabledForegroundColor SystemDisabledText default,MenubuttonDisabledForegroundMono {} default,MenubuttonFont "{MS Sans Serif} 8" default,MenubuttonForeground SystemButtonText default,MenubuttonHeight 0 default,MenubuttonHighlightBackground SystemButtonFace default,MenubuttonHighlight SystemWindowFrame default,MenubuttonHighlightWidth 0 default,MenubuttonImage {} default,MenubuttonIndicator 0 default,MenubuttonJustify center default,MenubuttonMenu {} default,MenubuttonPadX 4p default,MenubuttonPadY 3p default,MenubuttonRelief flat default,MenubuttonState normal default,MenubuttonTakeFocus 0 default,MenubuttonText {} default,MenubuttonTextVariable {} default,MenubuttonUnderline -1 default,MenubuttonWidth 0 default,MenubuttonWrapLength 0 default,MessageAnchor center default,MessageAspect 150 default,MessageBackgroundColor SystemButtonFace default,MessageBackgroundMono White default,MessageBorderWidth 2 default,MessageCursor {} default,MessageForeground SystemButtonText default,MessageFont "{MS Sans Serif} 8" default,MessageHighlightBackground SystemButtonFace default,MessageHighlight SystemWindowFrame default,MessageHighlightWidth 0 default,MessageJustify left default,MessagePadX -1 default,MessagePadY -1 default,MessageRelief flat default,MessageTakeFocus 0 default,MessageText {} default,MessageTextVariable {} default,MessageWidth 0 default,ScaleActiveBackgroundColor SystemButtonFace default,ScaleActiveBackgroundMono Black default,ScaleBackgroundColor SystemButtonFace default,ScaleBackgroundMono White default,ScaleBigIncrement 0 default,ScaleBorderWidth 2 default,ScaleCommand {} default,ScaleCursor {} default,ScaleDigits 0 default,ScaleFont "{MS Sans Serif} 8" default,ScaleForegroundColor SystemButtonText default,ScaleForegroundMono Black default,ScaleFrom 0 default,ScaleHighlightBackground SystemButtonFace default,ScaleHighlight SystemWindowFrame default,ScaleHighlightWidth 2 default,ScaleLabel {} default,ScaleLength 100 default,ScaleOrient vertical default,ScaleRelief flat default,ScaleRepeatDelay 300 default,ScaleRepeatInterval 100 default,ScaleResolution 1 default,ScaleTroughColor SystemScrollbar default,ScaleTroughMono White default,ScaleShowValue 1 default,ScaleSliderLength 30 default,ScaleSliderRelief raised default,ScaleState normal default,ScaleTakeFocus {} default,ScaleTickInterval 0 default,ScaleTo 100 default,ScaleVariable {} default,ScaleWidth 15 default,ScrollbarActiveBackgroundColor SystemButtonFace default,ScrollbarActiveBackgroundMono Black default,ScrollbarActiveRelief raised default,ScrollbarBackgroundColor SystemButtonFace default,ScrollbarBackgroundMono White default,ScrollbarBorderWidth 0 default,ScrollbarCommand {} default,ScrollbarCursor {} default,ScrollbarElementBorderWidth -1 default,ScrollbarHighlightBackground SystemButtonFace default,ScrollbarHighlight SystemWindowFrame default,ScrollbarHighlightWidth 0 default,ScrollbarJump 0 default,ScrollbarOrient vertical default,ScrollbarRelief sunken default,ScrollbarRepeatDelay 300 default,ScrollbarRepeatInterval 100 default,ScrollbarTakeFocus {} default,ScrollbarTroughColor SystemScrollbar default,ScrollbarTroughMono White default,ScrollbarWidth 10 default,TextBackgroundColor SystemWindow default,TextBackgroundMono White default,TextBorderWidth 2 default,TextCursor xterm default,TextForeground SystemWindowText default,TextExportSelection 1 default,TextFont "{MS Sans Serif} 8" default,TextHeight 24 default,TextHighlightBackground SystemButtonFace default,TextHighlight SystemWindowFrame default,TextHighlightWidth 0 default,TextInsertBackground SystemWindowText default,TextInsertBorderColor 0 default,TextInsertBorderMono 0 default,TextInsertOffTime 300 default,TextInsertOnTime 600 default,TextInsertWidth 2 default,TextPadX 1 default,TextPadY 1 default,TextRelief sunken default,TextSelectColor SystemHighlight default,TextSelectMono Black default,TextSelectBorderColor 0 default,TextSelectBorderMono 0 default,TextSelectForegroundColor SystemHighlightText default,TextSelectForegroundMono White default,TextSelectRelief flat default,TextSetGrid 0 default,TextSpacing1 0 default,TextSpacing2 0 default,TextSpacing3 0 default,TextState normal default,TextTabs {} default,TextTakeFocus {} default,TextWidth 80 default,TextWrap char default,TextXScrollCommand {} default,TextYScrollCommand {} default,ToplevelClass Toplevel default,ToplevelMenu {} default,ToplevelScreen {}}
    }
}

class widget {
    proc widget {this path args} {
        set widget::($this,path) $path
    }

    proc ~widget {this} {}

    virtual proc configure {this args} {
        return [eval $widget::($this,path) configure $args]
    }

    virtual proc cget {this args} {
        return [$widget::($this,path) cget $args]
    }
}


foreach class {button canvas entry frame label listbox menu menubutton message radiobutton scale scrollbar text toplevel} {
    class $class {
        proc $class {this parentPath args} widget "\[::$class \$parentPath.\$this\] \$args" {
            eval $widget::($this,path) configure $args
        }
        proc ~$class {this} {
            destroy $widget::($this,path)
        }
    }
}

class table {
    proc table {this parentPath args} widget {[::table $parentPath.$this] $args} {
        eval $widget::($this,path) configure $args
    }
    proc ~table {this} {
        destroy $widget::($this,path)
    }
}

foreach class {barchart graph htext piechart} {
    class $class {
        proc $class {this parentPath args} widget "\[::blt::$class .\[string trimleft \$parentPath.\$this .\]\] \$args" {
            eval $widget::($this,path) configure $args
        }
        proc ~$class {this} {
            destroy $widget::($this,path)
        }
    }
}

class composite {}

proc composite::composite {this base args} widget {$widget::($base,path) $args} {
    if {([llength $args]%2)!=0} {
        error "value for \"[lindex $args end]\" missing"
    }
    set composite::($this,base) $base
    set composite::($this,base,path) $widget::($base,path)
    set composite::($this,_children) {}
    set composite::($this,complete) 0
    set composite::($this,initialArguments) $args
}

proc composite::~composite {this} {
    eval delete [lsort -integer -decreasing $composite::($this,_children)] $composite::($this,base)
}

virtual proc composite::options {this}

proc composite::configure {this args} {
    if {[llength $args]==0} {
        return [descriptions $this]
    }
    if {![string match -* $args]} {
        return [eval widget::configure $composite::($this,[lindex $args 0]) [lrange $args 1 end]]
    }
    foreach {option value} $args {
        if {![info exists composite::($this,$option)]} {
            error "$composite::($this,_derived): unknown option \"$option\""
        }
    }
    if {[llength $args]==1} {
        return [description $this [lindex $args 0]]
    }
    if {([llength $args]%2)!=0} {
        error "value for \"[lindex $args end]\" missing"
    }
    foreach {option value} $args {
        if {[string compare $composite::($this,$option) $value]!=0} {
            $composite::($this,_derived)::set$option $this [set composite::($this,$option) $value]
        }
    }
}

proc composite::manage {this args} {
    foreach {child name} $args {
        if {[string length $name]==0} {
            error "widget $child has no name"
        }
        if {[string match -* $name]} {
            error "widget $child name \"$name\" must not start with a dash character"
        }
        if {[info exists composite::($this,$name)]} {
            error "\"$name\" member name already exists in composite layer"
        }
        set composite::($this,$name) $child
        set composite::($this,$name,path) $widget::($child,path)
        lappend composite::($this,_children) $child
    }
}

proc composite::complete {this} {
    set path $widget::($this,path)
    foreach description [options $this] {
        set option [lindex $description 0]
        set composite::($this,$option) [set default [lindex $description 3]]
        if {[llength $description]<5} {
            set initialize($option) {}
        } elseif {[string compare $default [lindex $description 4]]!=0} {
            set composite::($this,$option) [lindex $description 4]
            set initialize($option) {}
        }
        set value [option get $path [lindex $description 1] [lindex $description 2]]
        if {([string length $value]>0)&&([string compare $value $default]!=0)} {
            set composite::($this,$option) $value
            set initialize($option) {}
        }
    }
    foreach {option value} $composite::($this,initialArguments) {
        if {[catch {string compare $composite::($this,$option) $value} different]} {
            error "$composite::($this,_derived): unknown option \"$option\""
        }
        if {$different} {
            set composite::($this,$option) $value
            set initialize($option) {}
        }
    }
    unset composite::($this,initialArguments)
    foreach option [array names initialize] {
        $composite::($this,_derived)::set$option $this $composite::($this,$option)
    }
    set composite::($this,complete) 1
}

proc composite::cget {this args} {
    switch [llength $args] {
        0 {
            error "wrong # args: should be \"cget $this ?child? ?child? ... option\""
        }
        1 {
            if {![string match -* $args]||![info exists composite::($this,$args)]} {
                error "$composite::($this,_derived): unknown option \"$args\""
            }
            return $composite::($this,$args)
        }
        default {
            return [eval widget::cget $composite::($this,[lindex $args 0]) [lrange $args 1 end]]
        }
    }
}

proc composite::try {this args} {
    if {([llength $args]%2)!=0} {
        error "value for \"[lindex $args end]\" missing"
    }
    foreach {option value} $args {
        catch {widget::configure $composite::($this,base) $option $value}
        foreach child $composite::($this,_children) {
            catch {widget::configure $child $option $value}
        }
    }
}

proc composite::description {this option} {
    foreach description [options $this] {
        if {[string compare [lindex $description 0] $option]==0} {
            if {[llength $description]<5} {
                lappend description $composite::($this,$option)
                return $description
            } else {
                return [lreplace $description 4 4 $composite::($this,$option)]
            }
        }
    }
}

proc composite::descriptions {this} {
    set descriptions {}
    foreach description [options $this] {
        if {[llength $description]<5} {
            lappend description $composite::($this,[lindex $description 0])
            lappend descriptions $description
        } else {
            lappend descriptions [lreplace $description 4 4 $composite::($this,[lindex $description 0])]
        }
    }
    return $descriptions
}

proc composite::managingOrder {this name1 name2} {
    return [expr {$composite::($this,$name1)-$composite::($this,$name2)}]
}

proc composite::componentNames {this} {
    set names {}
    foreach index [array names composite:: $this,*,path] {
        if {[regexp {,(.+),path} $index dummy name]} {
            lappend names $name
        }
    }
    return [lsort -command "managingOrder $this" $names]
}
set rcsId {$Id: bindings.tcl,v 1.4 1997/12/30 15:02:13 jfontain Exp $}


class bindings {
    proc bindings {this widget index} {
        ::set bindings::($this,widget) $widget
        bindtags $widget [linsert [bindtags $widget] $index bindings($this)]
    }
    proc ~bindings {this} {
        ::set tags [bindtags $bindings::($this,widget)]
        ::set index [lsearch -exact $tags bindings($this)]
        bindtags $bindings::($this,widget) [lreplace $tags $index $index]
        foreach tag [bind bindings($this)] {
            bind bindings($this) $tag {}
        }
    }
    proc set {this tag sequence} {
        bind bindings($this) $tag $sequence
    }
}
set rcsId {$Id: widgetip.tcl,v 1.31 1998/04/13 19:34:25 jfontain Exp $}

class widgetTip {

    class topLabel {

        proc topLabel {this parentPath args} composite {
            [new toplevel $parentPath -highlightbackground black -highlightthickness 1] $args
        } {
            composite::manage $this [new label $widget::($this,path)] label
            composite::complete $this
            pack $composite::($this,label,path)
            wm overrideredirect $widget::($this,path) 1
        }

        proc ~topLabel {this} {}

        proc options {this} {
            return [list\
                [list -bordercolor borderColor BorderColor Black Black]\
                [list -borderwidth borderWidth BorderWidth 1 1]\
                [list\
                    -background background Background\
                    $widget::(default,ButtonBackgroundColor) $widget::(default,ButtonBackgroundColor)\
                ]\
                [list -font font Font $widget::(default,ButtonFont) $widget::(default,ButtonFont)]\
                [list -foreground foreground Foreground $widget::(default,ButtonForeground) $widget::(default,ButtonForeground)]\
                [list -text text Text {} {}]\
            ]
        }

        foreach option {-background -font -foreground -text} {
            proc set$option {this value} "\$composite::(\$this,label,path) configure $option \$value"
        }

        proc set-bordercolor {this value} {
            $widget::($this,path) configure -highlightbackground $value
        }

        proc set-borderwidth {this value} {
            $widget::($this,path) configure -highlightthickness $value
        }
    }

    if {![info exists widgetTip::(label)]} {
        set widgetTip::(label) [new topLabel . -font $widget::(default,EntryFont) -background #FFFFBF]
        set widgetTip::(path) $widget::($widgetTip::(label),path)
        wm withdraw $widgetTip::(path)
        bind all <ButtonPress> {widgetTip::globalEvent %W}
        bind all <KeyPress> {widgetTip::globalEvent %W}
        set widgetTip::(xLast) -1
        set widgetTip::(yLast) -1
    }

    proc widgetTip {this args} switched {$args} {
        switched::complete $this
    }

    proc ~widgetTip {this} {
        disable $this
        catch {delete $widgetTip::($this,bindings)}
    }

    proc options {this} {
        return [list\
            [list -font $widget::(default,EntryFont) $widget::(default,EntryFont)]\
            [list -path {} {}]\
            [list -text {} {}]\
        ]
    }

    proc set-path {this value} {
        if {$switched::($this,complete)} {
            error {option -path cannot be set dynamically}
        }
        if {![winfo exists $value]} {
            error "invalid widget: \"$value\""
        }
        set bindings [new bindings $value 0]
        bindings::set $bindings <Enter> "widgetTip::enable $this"
        bindings::set $bindings <Leave> "widgetTip::disable $this"
        bindings::set $bindings <Destroy> "delete $this"
        set widgetTip::($this,bindings) $bindings
    }

    proc set-font {this value} {}
    proc set-text {this value} {}

    proc globalEvent {widget} {
        if {![catch {string first $switched::($widgetTip::(active),-path) $widget} value]&&($value==0)} {
            disable $widgetTip::(active)
        }
    }

    proc show {this x y} {
        set path $widgetTip::(path)
        widget::configure $widgetTip::(label) -font $switched::($this,-font) -text $switched::($this,-text)
        wm deiconify $path
        wm geometry $path +$x+$y
        update idletasks
        raise $path
    }

    proc enable {this} {
        set x [winfo pointerx $widgetTip::(path)]
        set y [winfo pointery $widgetTip::(path)]
        if {($x==$widgetTip::(xLast))&&($y==$widgetTip::(yLast))} {
            widgetTip::show $this [expr {$x+7}] [expr {$y+10}]
        } else {
            set widgetTip::(xLast) $x
            set widgetTip::(yLast) $y
            set widgetTip::(event) [after 300 "widgetTip::enable $this"]
        }
        set widgetTip::(active) $this
    }

    proc disable {this} {
        catch {after cancel $widgetTip::(event)}
        catch {unset widgetTip::(active)}
        wm withdraw $widgetTip::(path)
    }

}
set rcsId {$Id: arrowbut.tcl,v 1.31 1997/09/19 09:50:23 jfontain Exp $}

proc maximum {a b} {return [expr {$a>$b?$a:$b}]}

class arrowButton {}

proc arrowButton::arrowButton {this parentPath args} composite {
    [new canvas $parentPath\
        -relief raised -background $widget::(default,ButtonBackgroundColor)\
        -borderwidth $widget::(default,ButtonBorderWidth) -height $widget::(default,ScrollbarWidth)\
        -highlightbackground $widget::(default,ButtonHighlightBackground) -highlightcolor $widget::(default,ButtonHighlight)\
        -highlightthickness $widget::(default,ButtonHighlightWidth) -width $widget::(default,ScrollbarWidth)\
    ] $args
} {
    set path $widget::($this,path)
    set arrowButton::($this,triangle) [$path create polygon 0 0 0 0 0 0]
    bind $path <Configure> "arrowButton::redraw $this %w %h"
    set arrowButton::($this,active) 0
    composite::complete $this
}

proc arrowButton::~arrowButton {this} {}

proc arrowButton::options {this} {
    return [list\
        [list\
            -activebackground activeBackground Foreground\
            $widget::(default,ButtonActiveBackgroundColor) $widget::(default,ButtonActiveBackgroundColor)\
        ]\
        [list -background background Background $widget::(default,ButtonBackgroundColor) $widget::(default,ButtonBackgroundColor)]\
        [list -borderwidth borderWidth BorderWidth $widget::(default,ButtonBorderWidth) $widget::(default,ButtonBorderWidth)]\
        [list -command command Command {} {}]\
        [list -direction direction Direction down]\
        [list\
            -disabledforeground disabledForeground DisabledForeground\
            $widget::(default,ButtonDisabledForegroundColor) $widget::(default,ButtonDisabledForegroundColor)\
        ]\
        [list -foreground foreground Foreground $widget::(default,ButtonForeground) $widget::(default,ButtonForeground)]\
        [list -height height Height $widget::(default,ScrollbarWidth) $widget::(default,ScrollbarWidth)]\
        [list\
            -highlightbackground highlightBackground HighlightBackground\
            $widget::(default,ButtonHighlightBackground) $widget::(default,ButtonHighlightBackground)\
        ]\
        [list -highlightcolor highlightColor HighlightColor $widget::(default,ButtonHighlight) $widget::(default,ButtonHighlight)]\
        [list\
            -highlightthickness highlightThickness HighlightThickness\
            $widget::(default,ButtonHighlightWidth) $widget::(default,ButtonHighlightWidth)\
        ]\
        [list -repeatdelay repeatDelay RepeatDelay 0 0]\
        [list -state state State normal]\
        [list -takefocus takeFocus TakeFocus 1]\
        [list -width width Width $widget::(default,ScrollbarWidth) $widget::(default,ScrollbarWidth)]\
    ]
}

proc arrowButton::set-activebackground {this value} {}

proc arrowButton::set-state {this value} {
    set path $widget::($this,path)
    switch $value {
        normal {
            $path itemconfigure $arrowButton::($this,triangle)\
                -fill $composite::($this,-foreground) -outline $composite::($this,-foreground)
            bind $path <Enter> "arrowButton::activate $this"
            bind $path <Leave> "arrowButton::deactivate $this; arrowButton::raise $this"
            bind $path <ButtonPress-1>\
                "set arrowButton::($this,buttonPressed) 1; arrowButton::sink $this; arrowButton::startTimer $this"
            bind $path <ButtonRelease-1>\
                "arrowButton::raise $this; arrowButton::invoke $this 0; set arrowButton::($this,buttonPressed) 0"
            if {$composite::($this,-takefocus)} {
                bind $path <KeyPress-space> "arrowButton::sink $this"
                bind $path <KeyRelease-space> "arrowButton::raise $this; arrowButton::invoke $this 1"
            } else {
                bind $path <KeyPress-space> {}
                bind $path <KeyRelease-space> {}
            }
        }
        disabled {
            $widget::($this,path) itemconfigure $arrowButton::($this,triangle)\
                -fill $composite::($this,-disabledforeground) -outline $composite::($this,-disabledforeground)
            bind $path <Enter> {}
            bind $path <Leave> {}
            bind $path <ButtonPress-1> {}
            bind $path <ButtonRelease-1> {}
            bind $path <KeyPress-space> {}
            bind $path <KeyRelease-space> {}
        }
        default {
            error "bad state value \"$value\": must be normal or disabled"
        }
    }
}

foreach option {-background -borderwidth -height -highlightbackground -highlightcolor -highlightthickness -width} {
    proc arrowButton::set$option {this value} "\$widget::(\$this,path) configure $option \$value"
}

foreach option {-disabledforeground -foreground} {
    proc arrowButton::set$option {this value} {set-state $this $composite::($this,-state)}
}

proc arrowButton::set-command {this value} {}

proc arrowButton::set-direction {this value} {
    if {\
        ([string first $value down]!=0)&&([string first $value up]!=0)&&\
        ([string first $value left]!=0)&&([string first $value right]!=0)\
    } {
        error "bad direction value \"$value\": must be down, up, left or right (or any abbreviation)"
    }
    redraw $this [winfo width $widget::($this,path)] [winfo height $widget::($this,path)]
}

proc arrowButton::set-takefocus {this value} {
    if {![regexp {^0|1$} $value]} {
        error "bad takefocus value \"$value\": must be 0 or 1"
    }
    $widget::($this,path) configure -takefocus $value
    set-state $this $composite::($this,-state)
}

proc arrowButton::set-repeatdelay {this value} {}

proc arrowButton::redraw {this width height} {
    set insideWidth [expr {$width-2*($composite::($this,-borderwidth)+$composite::($this,-highlightthickness))}]
    set insideHeight [expr {$height-2*($composite::($this,-borderwidth)+$composite::($this,-highlightthickness))}]
    switch -glob $composite::($this,-direction) {
        d* {
            set insideWidth [maximum [expr {$insideWidth/4}] 1]
            $widget::($this,path) coords $arrowButton::($this,triangle) 0 0 [expr {2*$insideWidth}] 0 $insideWidth $insideWidth
        }
        u* {
            set insideWidth [maximum [expr {$insideWidth/4}] 1]
            $widget::($this,path) coords $arrowButton::($this,triangle) 0 0 [expr {2*$insideWidth}] 0 $insideWidth -$insideWidth
        }
        l* {
            set insideHeight [maximum [expr {$insideHeight/4}] 1]
            $widget::($this,path) coords $arrowButton::($this,triangle) 0 0 0 [expr {2*$insideHeight}] -$insideHeight $insideHeight
        }
        r* {
            set insideHeight [maximum [expr {$insideHeight/4}] 1]
            $widget::($this,path) coords $arrowButton::($this,triangle) 0 0 0 [expr {2*$insideHeight}] $insideHeight $insideHeight
        }
    }
    centerTriangle $this $width $height
}

proc arrowButton::centerTriangle {this width height} {
    set box [$widget::($this,path) bbox $arrowButton::($this,triangle)]
    $widget::($this,path) move $arrowButton::($this,triangle)\
        [expr {($width-[lindex $box 2]-[lindex $box 0])/2}] [expr {($height-[lindex $box 3]-[lindex $box 1])/2}]
}

proc arrowButton::activate {this} {
    $widget::($this,path) configure -background $composite::($this,-activebackground)
    set arrowButton::($this,active) 1
}

proc arrowButton::deactivate {this} {
    $widget::($this,path) configure -background $composite::($this,-background)
    set arrowButton::($this,active) 0
}

proc arrowButton::sink {this} {
    set path $widget::($this,path)
    $path configure -relief sunken
    centerTriangle $this [winfo width $path] [winfo height $path]
    $path move $arrowButton::($this,triangle) 1 1
}

proc arrowButton::raise {this} {
    set path $widget::($this,path)
    $path configure -relief raised
    centerTriangle $this [winfo width $path] [winfo height $path]
    if {[info exists arrowButton::($this,event)]} {
        after cancel $arrowButton::($this,event)
        unset arrowButton::($this,event)
    }
}

proc arrowButton::invoke {this fromKey} {
    if {([string length $composite::($this,-command)]>0)&&($arrowButton::($this,active)||$fromKey)} {
        uplevel #0 $composite::($this,-command)
    }
}

proc arrowButton::startTimer {this} {
    if {$composite::($this,-repeatdelay)>0} {
        set arrowButton::($this,event) [after $composite::($this,-repeatdelay) "arrowButton::processTimer $this"]
    }
}

proc arrowButton::processTimer {this} {
    if {$arrowButton::($this,buttonPressed)} {
        startTimer $this
        invoke $this 0
    } else {
        unset arrowButton::($this,event)
    }
}
set rcsId {$Id: spinent.tcl,v 1.37 1997/11/02 14:08:30 jfontain Exp $}

class spinEntry {}

proc spinEntry::spinEntry {this parentPath args} composite {
    [new frame $parentPath -highlightthickness $widget::(default,ButtonHighlightWidth)] $args
} {
    ::set path $widget::($this,path)
    composite::manage $this [new entry $path -highlightthickness 0] entry\
        [new arrowButton $path\
            -takefocus 0 -command "spinEntry::decrease $this" -height 4 -highlightthickness 0\
            -repeatdelay $widget::(default,ScrollbarRepeatDelay)\
        ] decrease\
        [new arrowButton $path\
            -direction up -takefocus 0 -command "spinEntry::increase $this" -height 4 -highlightthickness 0\
            -repeatdelay $widget::(default,ScrollbarRepeatDelay)\
        ] increase

    bind $path <Return> "spinEntry::invoke $this"
    bind $path <KP_Enter> "spinEntry::invoke $this"
    bind $composite::($this,entry,path) <Return> "spinEntry::invoke $this"
    bind $composite::($this,entry,path) <KP_Enter> "spinEntry::invoke $this"

    spinEntry::setupUpAndDownKeysBindings $this $path
    spinEntry::setupUpAndDownKeysBindings $this $composite::($this,entry,path)

    composite::complete $this
}

proc spinEntry::~spinEntry {this} {}

proc spinEntry::options {this} {
    return [list\
        [list -command command Command {} {}]\
        [list -editable editable editable 1 1]\
        [list -font font Font $widget::(default,ButtonFont)]\
        [list -justify justify Justify $widget::(default,EntryJustify) $widget::(default,EntryJustify)]\
        [list -list list List {} {}]\
        [list -range range Range {} {}]\
        [list -repeatdelay repeatDelay RepeatDelay $widget::(default,ScrollbarRepeatDelay) $widget::(default,ScrollbarRepeatDelay)]\
        [list -side side Side left]\
        [list -state state State normal]\
        [list -width width Width $widget::(default,EntryWidth) $widget::(default,EntryWidth)]\
    ]
}

proc spinEntry::set-command {this value} {}

proc spinEntry::set-editable {this value} {
    setStatesAndBindings $this
}

proc spinEntry::set-list {this value} {
    if {$composite::($this,complete)} {
        error {option -orient cannot be set dynamically}
    }
    if {[string length [$composite::($this,entry,path) get]]==0} {
        set $this [lindex $value 0]
    }
}

proc spinEntry::set-range {this value} {
    if {$composite::($this,complete)} {
        error {option -range cannot be set dynamically}
    }
    if {[llength $value]!=3} {
        error {option -range argument format must be {minimum maximum increment}}
    }
    ::set spinEntry::($this,minimum) [lindex $composite::($this,-range) 0]
    ::set spinEntry::($this,maximum) [lindex $composite::($this,-range) 1]
    ::set spinEntry::($this,increment) [lindex $composite::($this,-range) 2]
    if {[catch {expr {$spinEntry::($this,maximum)-$spinEntry::($this,minimum)+$spinEntry::($this,increment)}}]} {
        error {option -range arguments must be numeric values}
    }
    if {[string length [$composite::($this,entry,path) get]]==0} {
        set $this $spinEntry::($this,minimum)
    }
}

proc spinEntry::set-repeatdelay {this value} {
    widget::configure $composite::($this,decrease) -repeatdelay $value
    widget::configure $composite::($this,increase) -repeatdelay $value
}

proc spinEntry::set-state {this value} {
    if {![regexp {^disabled|normal$} $value]} {
        error "bad state value \"$value\": must be normal or disabled"
    }
    setStatesAndBindings $this
}

foreach option {-font -justify -width} {
    proc spinEntry::set$option {this value} "\$composite::(\$this,entry,path) configure $option \$value"
}

proc spinEntry::set-side {this value} {
    if {![regexp {^left|right$} $value]} {
        error "bad side value \"$value\": must be left or right"
    }
    pack forget $composite::($this,entry,path) $composite::($this,increase,path) $composite::($this,decrease,path)
    pack $composite::($this,entry,path) -side $value -fill both -expand 1
    pack $composite::($this,increase,path) $composite::($this,decrease,path) -fill y -expand 1
}

proc spinEntry::decrease {this} {
    set $this [spinEntry::next $this -1]
    invoke $this
}
proc spinEntry::increase {this} {
    set $this [spinEntry::next $this 1]
    invoke $this
}

proc spinEntry::next {this direction} {
    ::set value [$composite::($this,entry,path) get]
    if {[catch {::set spinEntry::($this,increment)} increment]} {
        ::set index [lsearch -exact $composite::($this,-list) $value]
        incr index $direction
        if {$index<0} {
            return [lindex $composite::($this,-list) 0]
        } elseif {$index>=[llength $composite::($this,-list)]} {
            return [lindex $composite::($this,-list) end]
        } else {
            return [lindex $composite::($this,-list) $index]
        }
    } else {
        ::set minimum $spinEntry::($this,minimum)
        ::set maximum $spinEntry::($this,maximum)
        if {[catch {expr {$value+0}}]} {
            return [expr {$direction<0?$minimum:$maximum}]
        } else {
            ::set value [string range [expr {double($value-$minimum)/$increment}] 0 end]
            ::set value [expr {(int($value)+$direction)*$increment}]
            if {$value<=$minimum} {
                return $minimum
            } elseif {$value>=$maximum} {
                return $maximum
            } else {
                return $value
            }
        }
    }
}

proc spinEntry::setStatesAndBindings {this} {
    if {[string compare $composite::($this,-state) normal]==0} {
        widget::configure $composite::($this,decrease) -state normal
        widget::configure $composite::($this,increase) -state normal
        if {$composite::($this,-editable)} {
            $widget::($this,path) configure -takefocus 0
            $composite::($this,entry,path) configure -state normal
        } else {
            $widget::($this,path) configure -takefocus 1
            $composite::($this,entry,path) configure -state disabled
        }
    } else {
        $widget::($this,path) configure -takefocus 0
        widget::configure $composite::($this,decrease) -state disabled
        widget::configure $composite::($this,increase) -state disabled
        widget::configure $composite::($this,entry) -state disabled
    }
}

proc spinEntry::setupUpAndDownKeysBindings {this path} {
    bind $path <KeyPress-Down> "arrowButton::sink $composite::($this,decrease); spinEntry::decrease $this"
    bind $path <KeyRelease-Down> "arrowButton::raise $composite::($this,decrease)"
    bind $path <KeyPress-Up> "arrowButton::sink $composite::($this,increase); spinEntry::increase $this"
    bind $path <KeyRelease-Up> "arrowButton::raise $composite::($this,increase)"
}

proc spinEntry::invoke {this} {
    if {[string length $composite::($this,-command)]>0} {
        uplevel #0 $composite::($this,-command) [list [$composite::($this,entry,path) get]]
    }
}

proc spinEntry::set {this text} {
    ::set path $composite::($this,entry,path)
    $path configure -state normal
    $path delete 0 end
    $path insert 0 $text
    if {!$composite::($this,-editable)} {
        $path configure -state disabled
    }
}

proc spinEntry::get {this} {
    return [$composite::($this,entry,path) get]
}
set rcsId {$Id: panner.tcl,v 1.18 1997/07/13 12:32:30 jfontain Exp $}

class panner {}

proc panner::panner {this parentPath args} composite {[new frame $parentPath] $args} {
    set panner::($this,handles) {}
    set panner::($this,lastManagerSize) 0
    composite::complete $this
}

proc panner::~panner {this} {}

proc panner::options {this} {
    return [list\
        [list -handlesize handleSize HandleSize 8]\
        [list -handleplacement handlePlacement HandlePlacement 0.9 0.9]\
        [list -orient orient Orient vertical]\
        [list -panes panes Panes 2 3]\
    ]
}

proc panner::try {this option value} {
    set path $widget::($this,path)
    catch {$path configure $option $value}
    set lastIndex [expr {(2*$composite::($this,-panes))-2}]
    for {set itemIndex 0} {$itemIndex<=$lastIndex} {incr itemIndex} {
        set frame $path.$itemIndex
        catch {$frame configure $option $value}
        if {($itemIndex%2)!=0} {
            catch {$frame.separator configure $option $value}
            catch {$frame.handle configure $option $value}
        }
    }
}
proc panner::set-handlesize {this value} {
    set $composite::($this,-handlesize) [expr {(([winfo pixels $widget::($this,path) $value]+1)/2)*2}]
    if {$composite::($this,complete)} {
        updateHandleSize $this
    }
}

proc panner::set-orient {this value} {
    if {$composite::($this,complete)} {
        error {option -orient cannot be set dynamically}
    }
    if {([string first $value vertical]!=0)&&([string first $value horizontal]!=0)} {
        error "bad orientation value \"$value\": must be horizontal or vertical (or any abbreviation)"
    }
    if {[string match v* $composite::($this,-orient)]} {
        bind $widget::($this,path) <Configure> "panner::resize $this %h"
    } else {
        bind $widget::($this,path) <Configure> "panner::resize $this %w"
    }
}

proc panner::set-panes {this value} {
    if {$composite::($this,complete)} {
        error {option -panes cannot be set dynamically}
    }
    set path $widget::($this,path)
    if {[string match v* $composite::($this,-orient)]} {
        set vertical 1
        grid columnconfigure $path 0 -weight 1
        set sticky ew
        set cursor sb_v_double_arrow
    } else {
        set vertical 0
        grid rowconfigure $path 0 -weight 1
        set sticky ns
        set cursor sb_h_double_arrow
    }
    set paneIndex 0
    set itemIndex 0
    while 1 {
        set frame [frame $path.$itemIndex]
        if {$vertical} {
            grid $frame -sticky nsew -row $itemIndex -column 0
            grid rowconfigure $path $itemIndex -weight 1000000
        } else {
            grid $frame -sticky nsew -column $itemIndex -row 0
            grid columnconfigure $path $itemIndex -weight 1000000
        }
        incr paneIndex
        set panner::($this,frame$paneIndex) $frame
        if {$paneIndex==$value} {
            break
        }
        incr itemIndex
        set frame [frame $path.$itemIndex]
        if {$vertical} {
            grid $frame -sticky $sticky -row $itemIndex -column 0
            grid rowconfigure $path $itemIndex -weight 1
        } else {
            grid $frame -sticky $sticky -column $itemIndex -row 0
            grid columnconfigure $path $itemIndex -weight 1
        }
        frame $frame.separator -borderwidth 1 -relief ridge
        if {$vertical} {
            $frame.separator configure -height 2
        } else {
            $frame.separator configure -width 2
        }
        place $frame.separator -anchor center -relx 0.5 -rely 0.5
        if {$vertical} {
            place $frame.separator -relwidth 1
        } else {
            place $frame.separator -relheight 1
        }
        button $frame.handle -borderwidth 1 -highlightthickness 0 -cursor $cursor -takefocus 0
        bind $frame.handle <ButtonPress-1> "panner::startMotion $this %W"
        if {$vertical} {
            bind $frame.handle <ButtonRelease-1> "panner::endMotion $this %W $itemIndex %Y"
            place $frame.handle -rely 0.5 -anchor center
        } else {
            bind $frame.handle <ButtonRelease-1> "panner::endMotion $this %W $itemIndex %X"
            place $frame.handle -relx 0.5 -anchor center
        }
        incr itemIndex
    }
    updateHandleSize $this
    set-handleplacement $this $composite::($this,-handleplacement)
}

proc panner::set-handleplacement {this value} {
    set path $widget::($this,path)
    set lastIndex [expr {(2*$composite::($this,-panes))-2}]
    if {[string first $composite::($this,-orient) vertical]==0} {
        for {set itemIndex 1} {$itemIndex<=$lastIndex} {incr itemIndex 2} {
            place $path.$itemIndex.handle -relx $value
        }
    } else {
        for {set itemIndex 1} {$itemIndex<=$lastIndex} {incr itemIndex 2} {
            place $path.$itemIndex.handle -rely $value
        }
    }
}

proc panner::startMotion {this handle} {
    set path $widget::($this,path)
    if {[string first $composite::($this,-orient) vertical]==0} {
        bind $handle <Motion> "panner::verticalMotion $this %Y"
        set panner::(line) [frame $path.line -background black -height 1 -width [winfo width $path]]
        set panner::(minimum) [winfo rooty $path]
        set panner::(maximum) [expr {$panner::(minimum)+[winfo height $path]-1}]
    } else {
        bind $handle <Motion> "panner::horizontalMotion $this %X"
        set panner::(line) [frame $path.line -background black -width 1 -height [winfo height $path]]
        set panner::(minimum) [winfo rootx $path]
        set panner::(maximum) [expr {$panner::(minimum)+[winfo width $path]-1}]
    }
}

proc panner::clip {coordinate} {
    if {$coordinate<$panner::(minimum)} {
        return $panner::(minimum)
    } elseif {$coordinate>$panner::(maximum)} {
        return $panner::(maximum)
    } else {
        return $coordinate
    }
}

proc panner::endMotion {this handle row rootCoordinate} {
    set visible [expr {[llength [place info $panner::(line)]]>0}]
    destroy $panner::(line)
    bind $handle <Motion> {}
    if {$visible} {
        split $this $row [expr {[clip $rootCoordinate]-$panner::(minimum)}]
    }
    unset panner::(line) panner::(minimum) panner::(maximum)
}

proc panner::verticalMotion {this yRoot} {
    place $panner::(line) -y [expr {[clip $yRoot]-$panner::(minimum)}]
}

proc panner::horizontalMotion {this xRoot} {
    place $panner::(line) -x [expr {[clip $xRoot]-$panner::(minimum)}]
}

proc panner::split {this handleIndex coordinate} {
    if {[string match v* $composite::($this,-orient)]} {
        set vertical 1
        set itemName row
        set sizeName height
    } else {
        set vertical 0
        set itemName column
        set sizeName width
    }
    set path $widget::($this,path)
    set lastIndex [expr {(2*$composite::($this,-panes))-2}]
    if {[grid propagate $path]} {
        grid propagate $path 0
        for {set itemIndex 0} {$itemIndex<=$lastIndex} {incr itemIndex} {
            grid ${itemName}configure $path $itemIndex -minsize [winfo $sizeName $path.$itemIndex]
        }
    }
    set separatorsSize 0
    set framesSize 0
    set beforeIndex [expr {$handleIndex-1}]
    set afterIndex [expr {$handleIndex+1}]
    if {$vertical} {
        set lastCoordinate [lindex [grid bbox $path 0 $handleIndex] 1]
        set masterSize [lindex [grid bbox $path] 3]
        set frameStart [lindex [grid bbox $path 0 $beforeIndex] 1]
        set box [grid bbox $path 0 $afterIndex]
        set frameEnd [expr {[lindex $box 1]+[lindex $box 3]}]
    } else {
        set lastCoordinate [lindex [grid bbox $path $handleIndex 0] 0]
        set masterSize [lindex [grid bbox $path] 2]
        set frameStart [lindex [grid bbox $path $beforeIndex 0] 0]
        set box [grid bbox $path $afterIndex 0]
        set frameEnd [expr {[lindex $box 0]+[lindex $box 2]}]
    }
    if {$coordinate>$lastCoordinate} {
        incr coordinate -[expr {$composite::($this,-handlesize)/2}]
        for {set itemIndex $handleIndex} {$itemIndex<=$lastIndex} {incr itemIndex} {
            if {($itemIndex%2)==0} {
                incr framesSize [grid ${itemName}configure $path $itemIndex -minsize]
            } else {
                incr separatorsSize $composite::($this,-handlesize)
            }
        }
        set remaining [expr {$masterSize-$coordinate-$separatorsSize}]
        if {$remaining<0} {
            set size [expr {$masterSize-$frameStart-$separatorsSize}]
            set remaining 0
        } else {
            set size [expr {$coordinate-$frameStart}]
        }
        grid ${itemName}configure $path $beforeIndex -minsize $size
        for {set itemIndex $lastIndex} {$itemIndex>=$afterIndex} {incr itemIndex -2} {
            if {$remaining>[grid ${itemName}configure $path $itemIndex -minsize]} {
                incr remaining -[grid ${itemName}configure $path $itemIndex -minsize]
            } elseif {$remaining>0} {
                grid ${itemName}configure $path $itemIndex -minsize $remaining
                set remaining 0
            } else {
                grid ${itemName}configure $path $itemIndex -minsize 0
            }
        }
    } elseif {$coordinate<$lastCoordinate} {
        incr coordinate [expr {$composite::($this,-handlesize)/2}]
        for {set itemIndex $handleIndex} {$itemIndex>=0} {incr itemIndex -1} {
            if {($itemIndex%2)==0} {
                incr framesSize [grid ${itemName}configure $path $itemIndex -minsize]
            } else {
                incr separatorsSize $composite::($this,-handlesize)
            }
        }
        set remaining [expr {$coordinate-$separatorsSize}]
        if {$remaining<0} {
            set size [expr {$frameEnd-$separatorsSize}]
            set remaining 0
        } else {
            set size [expr {$frameEnd-$coordinate}]
        }
        grid ${itemName}configure $path $afterIndex -minsize $size
        for {set itemIndex 0} {$itemIndex<=$beforeIndex} {incr itemIndex 2} {
            if {$remaining>[grid ${itemName}configure $path $itemIndex -minsize]} {
                incr remaining -[grid ${itemName}configure $path $itemIndex -minsize]
            } elseif {$remaining>0} {
                grid ${itemName}configure $path $itemIndex -minsize $remaining
                set remaining 0
            } else {
                grid ${itemName}configure $path $itemIndex -minsize 0
            }
        }
    }
}

proc panner::updateHandleSize {this} {
    set size $composite::($this,-handlesize)
    set path $widget::($this,path)
    set lastIndex [expr {(2*$composite::($this,-panes))-2}]
    if {[string match v* $composite::($this,-orient)]} {
        for {set row 1} {$row<$lastIndex} {incr row 2} {
            set frame $path.$row
            place $frame.handle -width $size -height $size
            $frame configure -height $size
            grid rowconfigure $path $row -minsize $size
        }
    } else {
        for {set column 1} {$column<$lastIndex} {incr column 2} {
            set frame $path.$column
            place $frame.handle -width $size -height $size
            $frame configure -width $size
            grid columnconfigure $path $column -minsize $size
        }
    }
}

proc panner::resize {this size} {
    if {$size==$panner::($this,lastManagerSize)} {
        return
    }
    set panner::($this,lastManagerSize) $size
    set path $widget::($this,path)
    if {[grid propagate $path]} {
        return
    }
    set lastIndex [expr {(2*$composite::($this,-panes))-2}]
    set lastSize 0
    set newSize $size
    if {[string match v* $composite::($this,-orient)]} {
        set itemName row
    } else {
        set itemName column
    }
    for {set itemIndex 0} {$itemIndex<=$lastIndex} {incr itemIndex} {
        if {($itemIndex%2)==0} {
            incr lastSize [grid ${itemName}configure $path $itemIndex -minsize]
        } else {
            incr newSize -$composite::($this,-handlesize)
        }
    }
    set ratio [expr {double($newSize)/$lastSize}]
    for {set itemIndex 0} {$itemIndex<$lastIndex} {incr itemIndex 2} {
        set size [expr {round($ratio*[grid ${itemName}configure $path $itemIndex -minsize])}]
        grid ${itemName}configure $path $itemIndex -minsize $size
        incr newSize -$size
    }
    grid ${itemName}configure $path $itemIndex -minsize $newSize
}
}

if {[catch {package require Tktable 1.8}]} {
    switch $tcl_platform(platform) {
        unix {
            load ./Tktable.so.1.82
        }
        windows {
            load ./tktable.dll
        }
    }
}

if {[catch {package require BLT 8.0}]} {
    switch $tcl_platform(platform) {
        unix {
            load ./libBLT8.0.so
        }
        windows {
            load ./blt80.dll
        }
    }
}

if {[catch {package require tkpiechart 4.2}]} {
set rcsId {$Id: pielabel.tcl,v 1.37 1998/03/28 20:42:15 jfontain Exp $}

class pieLabeler {

    set pieLabeler::(default,font) {Helvetica -12}

    proc pieLabeler {this canvas args} {
        set pieLabeler::($this,canvas) $canvas
    }

    proc ~pieLabeler {this} {}

    proc link {this pie} {
        set pieLabeler::($this,pie) $pie
    }

    virtual proc new {this slice args}

    virtual proc delete {this label}

    virtual proc update {this label value}

    virtual proc selectState {this label {state {}}}

}
set rcsId {$Id: boxlabel.tcl,v 1.34 1998/03/28 20:42:15 jfontain Exp $}

class pieBoxLabeler {

    proc pieBoxLabeler {this canvas args} pieLabeler {$canvas $args} switched {$args} {
        switched::complete $this
    }

    proc ~pieBoxLabeler {this} {
        catch {::delete $pieBoxLabeler::($this,array)}
    }

    proc options {this} {
        return [list\
            [list -font $pieLabeler::(default,font) $pieLabeler::(default,font)]\
            [list -justify left left]\
            [list -offset 5 5]\
            [list -xoffset 0 0]\
        ]
    }

    foreach option {-font -justify -offset -xoffset} {
        proc set$option {this value} "
            if {\$switched::(\$this,complete)} {
                error {option $option cannot be set dynamically}
            }
        "
    }

    proc new {this slice args} {
        if {![info exists pieBoxLabeler::($this,array)]} {
            set box [$pieLabeler::($this,canvas) bbox pie($pieLabeler::($this,pie))]
            set pieBoxLabeler::($this,array) [::new canvasLabelsArray\
                $pieLabeler::($this,canvas) [lindex $box 0] [expr {[lindex $box 3]+$switched::($this,-offset)}]\
                [expr {[lindex $box 2]-[lindex $box 0]}] -xoffset $switched::($this,-xoffset)\
            ]
        }
        set label [eval ::new canvasLabel $pieLabeler::($this,canvas) 0 0\
            $args [list -justify $switched::($this,-justify) -font $switched::($this,-font)]\
        ]
        canvasLabelsArray::manage $pieBoxLabeler::($this,array) $label
        $pieLabeler::($this,canvas) addtag pieLabeler($this) withtag canvasLabelsArray($pieBoxLabeler::($this,array))
        switched::configure $label -text [switched::cget $label -text]:
        set pieBoxLabeler::($this,selected,$label) 0
        return $label
    }

    proc delete {this label} {
        canvasLabelsArray::delete $pieBoxLabeler::($this,array) $label
        unset pieBoxLabeler::($this,selected,$label)
    }

    proc update {this label value} {
        regsub {:.*$} [switched::cget $label -text] ": $value" text
        switched::configure $label -text $text
    }

    proc selectState {this label {selected {}}} {
        if {[string length $selected]==0} {
            return $pieBoxLabeler::($this,selected,$label)
        }
        if {$selected} {
            switched::configure $label -borderwidth 2
        } else {
            switched::configure $label -borderwidth 1
        }
        set pieBoxLabeler::($this,selected,$label) $selected
    }

}
set rcsId {$Id: canlabel.tcl,v 1.20 1998/03/28 08:38:12 jfontain Exp $}

class canvasLabel {

    proc canvasLabel {this canvas x y args} switched {$args} {
        set canvasLabel::($this,canvas) $canvas
        set canvasLabel::($this,origin) [$canvas create line $x $y $x $y -fill {} -tags canvasLabel($this)]
        set canvasLabel::($this,rectangle) [$canvas create rectangle 0 0 0 0 -tags canvasLabel($this)]
        set canvasLabel::($this,text) [$canvas create text 0 0 -tags canvasLabel($this)]

        switched::complete $this
    }

    proc ~canvasLabel {this} {
        $canvasLabel::($this,canvas) delete canvasLabel($this)
    }

    proc options {this} {
        return [list\
            [list -anchor center center]\
            [list -background {} {}]\
            [list -bordercolor black black]\
            [list -borderwidth 1 1]\
            [list -bulletwidth 20 20]\
            [list -font {Helvetica -12}]\
            [list -foreground black black]\
            [list -justify left left]\
            [list -padding 2 2]\
            [list -stipple {} {}]\
            [list -style box box]\
            [list -text {} {}]\
            [list -width 0 0]\
        ]
    }

    proc set-background {this value} {
        $canvasLabel::($this,canvas) itemconfigure $canvasLabel::($this,rectangle) -fill $value
    }
    proc set-bordercolor {this value} {
        $canvasLabel::($this,canvas) itemconfigure $canvasLabel::($this,rectangle) -outline $value
    }
    proc set-borderwidth {this value} {
        $canvasLabel::($this,canvas) itemconfigure $canvasLabel::($this,rectangle) -width $value
        update $this
    }
    proc set-foreground {this value} {
        $canvasLabel::($this,canvas) itemconfigure $canvasLabel::($this,text) -fill $value
    }
    proc set-stipple {this value} {
        $canvasLabel::($this,canvas) itemconfigure $canvasLabel::($this,rectangle) -stipple $value
    }
    proc set-style {this value} {
        if {![regexp {^box|split$} $value]} {
            error "bad style value \"$value\": must be box or split"
        }
        update $this
    }
    foreach option {-anchor -bulletwidth -padding} {
        proc set$option {this value} {update $this}
    }
    foreach option {-font -justify -text -width} {
        proc set$option {this value} "
            \$canvasLabel::(\$this,canvas) itemconfigure \$canvasLabel::(\$this,text) $option \$value
            update \$this
        "
    }

    proc update {this} {
        set canvas $canvasLabel::($this,canvas)
        set rectangle $canvasLabel::($this,rectangle)
        set text $canvasLabel::($this,text)

        set coordinates [$canvas coords $canvasLabel::($this,origin)]
        set x [lindex $coordinates 0]
        set y [lindex $coordinates 1]

        set border [$canvas itemcget $rectangle -width]
        set textBox [$canvas bbox $text]
        set padding [winfo fpixels $canvas $switched::($this,-padding)]

        if {[string compare $switched::($this,-style) split]==0} {
            set textHeight [expr {[lindex $textBox 3]-[lindex $textBox 1]}]
            set rectangleWidth [winfo fpixels $canvas $switched::($this,-bulletwidth)]
            set halfWidth [expr {($rectangleWidth+$padding+([lindex $textBox 2]-[lindex $textBox 0]))/2.0}]
            set halfHeight [expr {($textHeight/2.0)+$border}]
            $canvas coords $rectangle\
                [expr {$x-$halfWidth}] [expr {$y-$halfHeight}] [expr {$x-$halfWidth+$rectangleWidth}] [expr {$y+$halfHeight}]
            $canvas coords $text [expr {$x+(($rectangleWidth+$padding)/2.0)}] $y
        } else {
            set width [expr {$switched::($this,-width)==0?[lindex $textBox 2]-[lindex $textBox 0]:$switched::($this,-width)}]
            set halfWidth [expr {$border+$padding+($width/2.0)}]
            set halfHeight [expr {$border+$padding+(([lindex $textBox 3]-[lindex $textBox 1])/2.0)}]
            $canvas coords $rectangle [expr {$x-$halfWidth}] [expr {$y-$halfHeight}] [expr {$x+$halfWidth}] [expr {$y+$halfHeight}]
            $canvas coords $text $x $y
        }
        set anchor $switched::($this,-anchor)
        set xDelta [expr {([string match *w $anchor]-[string match *e $anchor])*$halfWidth}]
        set yDelta [expr {([string match n* $anchor]-[string match s* $anchor])*$halfHeight}]
        $canvas move $rectangle $xDelta $yDelta
        $canvas move $text $xDelta $yDelta
    }

}
set rcsId {$Id: labarray.tcl,v 1.16 1998/03/28 20:37:16 jfontain Exp $}

class canvasLabelsArray {

    proc canvasLabelsArray {this canvas x y width args} switched {$args} {
        set canvasLabelsArray::($this,canvas) $canvas
        set canvasLabelsArray::($this,width) [winfo fpixels $canvas $width]
        set canvasLabelsArray::($this,origin) [$canvas create line $x $y $x $y -fill {} -tags canvasLabelsArray($this)]
        set canvasLabelsArray::($this,labels) {}
        switched::complete $this
    }

    proc ~canvasLabelsArray {this} {
        eval ::delete $canvasLabelsArray::($this,labels)
        $canvasLabelsArray::($this,canvas) delete canvasLabelsArray($this)
    }

    proc options {this} {
        return [list\
            [list -justify left left]\
            [list -xoffset 0 0]\
        ]
    }

    foreach option {-justify -xoffset} {
        proc set$option {this value} "
            if {\$switched::(\$this,complete)} {
                error {option $option cannot be set dynamically}
            }
        "
    }

    proc manage {this label} {
        $canvasLabelsArray::($this,canvas) addtag canvasLabelsArray($this) withtag canvasLabel($label)
        set index [llength $canvasLabelsArray::($this,labels)]
        lappend canvasLabelsArray::($this,labels) $label
        position $this $label $index
    }

    proc delete {this label} {
        set index [lsearch -exact $canvasLabelsArray::($this,labels) $label]
        if {$index<0} {
            error "invalid label $label for canvas labels array $this"
        }
        set canvasLabelsArray::($this,labels) [lreplace $canvasLabelsArray::($this,labels) $index $index]
        ::delete $label
        foreach label [lrange $canvasLabelsArray::($this,labels) $index end] {
            position $this $label $index
            incr index
        }
    }

    proc position {this label index} {
        set canvas $canvasLabelsArray::($this,canvas)

        set coordinates [$canvas coords $canvasLabelsArray::($this,origin)]
        set x [expr {[lindex $coordinates 0]+(($index%2?1:-1)*$switched::($this,-xoffset))}]
        set y [lindex $coordinates 1]
        set coordinates [$canvas bbox canvasLabel($label)]
        set y [expr {$y+(($index/2)*([lindex $coordinates 3]-[lindex $coordinates 1]))}]

        switch $switched::($this,-justify) {
            left {
                set x [expr {$x+(($index%2)*($canvasLabelsArray::($this,width)/2.0))}]
                set anchor nw
            }
            right {
                set x [expr {$x+((($index%2)+1)*($canvasLabelsArray::($this,width)/2.0))}]
                set anchor ne
            }
            default {
                set x [expr {$x+((1.0+(2*($index%2)))*$canvasLabelsArray::($this,width)/4)}]
                set anchor n
            }
        }
        switched::configure $label -anchor $anchor
        set coordinates [$canvas coords canvasLabel($label)]
        $canvas move canvasLabel($label) [expr {$x-[lindex $coordinates 0]}] [expr {$y-[lindex $coordinates 1]}]
    }

    proc labels {this} {
        return $canvasLabelsArray::($this,labels)
    }

}
set rcsId {$Id: perilabel.tcl,v 1.36 1998/04/09 21:55:19 jfontain Exp $}

class piePeripheralLabeler {

    variable PI 3.14159265358979323846

    proc piePeripheralLabeler {this canvas args} pieLabeler {$canvas $args} switched {$args} {
        switched::complete $this
    }

    proc ~piePeripheralLabeler {this} {
        catch {delete $piePeripheralLabeler::($this,array)}
        $pieLabeler::($this,canvas) delete pieLabeler($this)
    }

    proc options {this} {
        return [list\
            [list -bulletwidth 20 20]\
            [list -font $pieLabeler::(default,font) $pieLabeler::(default,font)]\
            [list -justify left left]\
            [list -offset 5 5]\
            [list -smallfont {Helvetica -10} {Helvetica -10}]\
            [list -xoffset 0 0]\
        ]
    }

    foreach option {-bulletwidth -font -justify -offset -smallfont -xoffset} {
        proc set$option {this value} "
            if {\$switched::(\$this,complete)} {
                error {option $option cannot be set dynamically}
            }
        "
    }

    proc new {this slice args} {
        set canvas $pieLabeler::($this,canvas)

        set text [$canvas create text 0 0 -font $switched::($this,-smallfont) -tags pieLabeler($this)]
        set box [$canvas bbox $text]
        set smallTextHeight [expr {[lindex $box 3]-[lindex $box 1]}]

        if {![info exists piePeripheralLabeler::($this,array)]} {
            set box [$canvas bbox pie($pieLabeler::($this,pie))]
            set piePeripheralLabeler::($this,array) [eval ::new canvasLabelsArray\
                $canvas [lindex $box 0] [expr {[lindex $box 3]+(2*$switched::($this,-offset))+$smallTextHeight}]\
                [expr {[lindex $box 2]-[lindex $box 0]}] -justify $switched::($this,-justify) -xoffset $switched::($this,-xoffset)\
            ]
        }

        set label [eval ::new canvasLabel $pieLabeler::($this,canvas) 0 0 $args\
            [list\
                -style split -justify $switched::($this,-justify) -bulletwidth $switched::($this,-bulletwidth)\
                -font $switched::($this,-font)\
            ]\
        ]
        canvasLabelsArray::manage $piePeripheralLabeler::($this,array) $label

        $canvas addtag pieLabeler($this) withtag canvasLabelsArray($piePeripheralLabeler::($this,array))

        set piePeripheralLabeler::($this,textItem,$label) $text
        set piePeripheralLabeler::($this,slice,$label) $slice
        set piePeripheralLabeler::($this,selected,$label) 0

        return $label
    }

    proc anglePosition {degrees} {
        return [expr {(2*($degrees/90))+(($degrees%90)!=0)}]
    }

    set index 0
    foreach anchor {w sw s se e ne n nw} {
        set piePeripheralLabeler::(anchor,[anglePosition [expr {$index*45}]]) $anchor
        incr index
    }
    unset index anchor

    proc update {this label value} {
        set text $piePeripheralLabeler::($this,textItem,$label)
        position $this $text $piePeripheralLabeler::($this,slice,$label)
        $pieLabeler::($this,canvas) itemconfigure $text -text $value
    }

    proc position {this text slice} {
        variable PI

        slice::data $slice data
        set midAngle [expr {$data(start)+($data(extent)/2.0)}]
        set radians [expr {$midAngle*$PI/180}]
        set x [expr {($data(xRadius)+$switched::($this,-offset))*cos($radians)}]
        set y [expr {($data(yRadius)+$switched::($this,-offset))*sin($radians)}]
        set angle [expr {round($midAngle)%360}]
        if {$angle>180} {
            set y [expr {$y-$data(height)}]
        }

        set canvas $pieLabeler::($this,canvas)
        set coordinates [$canvas coords $text]
        $canvas move $text [expr {$data(xCenter)+$x-[lindex $coordinates 0]}] [expr {$data(yCenter)-$y-[lindex $coordinates 1]}]
        $canvas itemconfigure $text -anchor $piePeripheralLabeler::(anchor,[anglePosition $angle])
    }

    proc delete {this label} {
        canvasLabelsArray::delete $piePeripheralLabeler::($this,array) $label
        $pieLabeler::($this,canvas) delete $piePeripheralLabeler::($this,textItem,$label)
        unset piePeripheralLabeler::($this,textItem,$label) piePeripheralLabeler::($this,slice,$label)\
            piePeripheralLabeler::($this,selected,$label)
        foreach label [canvasLabelsArray::labels $piePeripheralLabeler::($this,array)] {
            position $this $piePeripheralLabeler::($this,textItem,$label) $piePeripheralLabeler::($this,slice,$label)
        }
    }

    proc selectState {this label {selected {}}} {
        if {[string length $selected]==0} {
            return $piePeripheralLabeler::($this,selected,$label)
        }
        if {$selected} {
            switched::configure $label -borderwidth 2
        } else {
            switched::configure $label -borderwidth 1
        }
        set piePeripheralLabeler::($this,selected,$label) $selected
    }

}
set rcsId {$Id: slice.tcl,v 1.32 1998/04/09 21:56:03 jfontain Exp $}


class slice {
    variable PI 3.14159265358979323846
}

proc slice::slice {this canvas x y radiusX radiusY start extent args} switched {$args} {

    set slice::($this,canvas) $canvas
    set slice::($this,start) 0
    set slice::($this,radiusX) $radiusX
    set slice::($this,radiusY) $radiusY

    switched::complete $this
    complete $this $x $y
    update $this $start $extent
}

proc slice::~slice {this} {
    if {[string length $switched::($this,-deletecommand)]>0} {
        uplevel $switched::($this,-deletecommand)
    }
    $slice::($this,canvas) delete slice($this)
}

proc slice::options {this} {
    return [list\
        [list -bottomcolor {} {}]\
        [list -deletecommand {} {}]\
        [list -height 0 0]\
        [list -topcolor {} {}]\
    ]
}

foreach option {-bottomcolor -height -topcolor} {
    proc slice::set$option {this value} "
        if {\$switched::(\$this,complete)} {
            error {option $option cannot be set dynamically}
        }
    "
}

proc slice::set-deletecommand {this value} {}

proc slice::normalizedAngle {value} {
    while {$value>=180} {
        set value [expr {$value-360}]
    }
    while {$value<-180} {
        set value [expr {$value+360}]
    }
    return $value
}

proc slice::complete {this x y} {
    set canvas $slice::($this,canvas)
    set radiusX $slice::($this,radiusX)
    set radiusY $slice::($this,radiusY)
    set bottomColor $switched::($this,-bottomcolor)

    set slice::($this,origin) [$canvas create line -$radiusX -$radiusY -$radiusX -$radiusY -fill {} -tags slice($this)]

    if {$switched::($this,-height)>0} {
        set slice::($this,startBottomArcFill) [$canvas create arc\
            0 0 0 0 -style chord -extent 0 -fill $bottomColor -outline $bottomColor -tags slice($this)\
        ]
        set slice::($this,startPolygon) [$canvas create polygon 0 0 0 0 0 0 -fill $bottomColor -tags slice($this)]
        set slice::($this,startBottomArc) [$canvas create arc 0 0 0 0 -style arc -extent 0 -fill black -tags slice($this)]

        set slice::($this,endBottomArcFill) [$canvas create arc\
            0 0 0 0 -style chord -extent 0 -fill $bottomColor -outline $bottomColor -tags slice($this)\
        ]
        set slice::($this,endPolygon) [$canvas create polygon 0 0 0 0 0 0 -fill $bottomColor -tags slice($this)]
        set slice::($this,endBottomArc) [$canvas create arc 0 0 0 0 -style arc -extent 0 -fill black -tags slice($this)]

        set slice::($this,startLeftLine) [$canvas create line 0 0 0 0 -tags slice($this)]
        set slice::($this,startRightLine) [$canvas create line 0 0 0 0 -tags slice($this)]
        set slice::($this,endLeftLine) [$canvas create line 0 0 0 0 -tags slice($this)]
        set slice::($this,endRightLine) [$canvas create line 0 0 0 0 -tags slice($this)]
    }

    set slice::($this,topArc) [$canvas create arc\
        -$radiusX -$radiusY $radiusX $radiusY -fill $switched::($this,-topcolor) -tags slice($this)\
    ]

    $canvas move slice($this) [expr {$x+$radiusX}] [expr {$y+$radiusY}]
}

proc slice::update {this start extent} {
    set canvas $slice::($this,canvas)

    set coordinates [$canvas coords slice($this)]

    set radiusX $slice::($this,radiusX)
    set radiusY $slice::($this,radiusY)
    $canvas coords $slice::($this,origin) -$radiusX -$radiusY $radiusX $radiusY
    $canvas coords $slice::($this,topArc) -$radiusX -$radiusY $radiusX $radiusY

    set extent [maximum 0 $extent]
    if {$extent>=360} {
        set extent 359.9999999999999
    }
    $canvas itemconfigure $slice::($this,topArc)\
        -start [set slice::($this,start) [normalizedAngle $start]] -extent [set slice::($this,extent) $extent]

    if {$switched::($this,-height)>0} {
        updateBottom $this
    }

    $canvas move slice($this) [expr {[lindex $coordinates 0]+$radiusX}] [expr {[lindex $coordinates 1]+$radiusY}]
}

proc slice::updateBottom {this} {
    variable PI

    set start $slice::($this,start)
    set extent $slice::($this,extent)

    set canvas $slice::($this,canvas)
    set radiusX $slice::($this,radiusX)
    set radiusY $slice::($this,radiusY)
    set height $switched::($this,-height)

    $canvas itemconfigure $slice::($this,startBottomArcFill) -extent 0
    $canvas coords $slice::($this,startBottomArcFill) -$radiusX -$radiusY $radiusX $radiusY
    $canvas move $slice::($this,startBottomArcFill) 0 $height
    $canvas itemconfigure $slice::($this,startBottomArc) -extent 0
    $canvas coords $slice::($this,startBottomArc) -$radiusX -$radiusY $radiusX $radiusY
    $canvas move $slice::($this,startBottomArc) 0 $height
    $canvas coords $slice::($this,startLeftLine) 0 0 0 0
    $canvas coords $slice::($this,startRightLine) 0 0 0 0
    $canvas itemconfigure $slice::($this,endBottomArcFill) -extent 0
    $canvas coords $slice::($this,endBottomArcFill) -$radiusX -$radiusY $radiusX $radiusY
    $canvas move $slice::($this,endBottomArcFill) 0 $height
    $canvas itemconfigure $slice::($this,endBottomArc) -extent 0
    $canvas coords $slice::($this,endBottomArc) -$radiusX -$radiusY $radiusX $radiusY
    $canvas move $slice::($this,endBottomArc) 0 $height
    $canvas coords $slice::($this,endLeftLine) 0 0 0 0
    $canvas coords $slice::($this,endRightLine) 0 0 0 0
    $canvas coords $slice::($this,startPolygon) 0 0 0 0 0 0 0 0
    $canvas coords $slice::($this,endPolygon) 0 0 0 0 0 0 0 0

    set startX [expr {$radiusX*cos($start*$PI/180)}]
    set startY [expr {-$radiusY*sin($start*$PI/180)}]
    set end [normalizedAngle [expr {$start+$extent}]]
    set endX [expr {$radiusX*cos($end*$PI/180)}]
    set endY [expr {-$radiusY*sin($end*$PI/180)}]

    set startBottom [expr {$startY+$height}]
    set endBottom [expr {$endY+$height}]

    if {(($start>=0)&&($end>=0))||(($start<0)&&($end<0))} {
        if {$extent<=180} {
            if {$start<0} {
                $canvas itemconfigure $slice::($this,startBottomArcFill) -start $start -extent $extent
                $canvas itemconfigure $slice::($this,startBottomArc) -start $start -extent $extent
                $canvas coords $slice::($this,startPolygon) $startX $startY $endX $endY $endX $endBottom $startX $startBottom
                $canvas coords $slice::($this,startLeftLine) $startX $startY $startX $startBottom
                $canvas coords $slice::($this,startRightLine) $endX $endY $endX $endBottom
            }
        } else {
            if {$start<0} {
                $canvas itemconfigure $slice::($this,startBottomArcFill) -start 0 -extent $start
                $canvas itemconfigure $slice::($this,startBottomArc) -start 0 -extent $start
                $canvas coords $slice::($this,startPolygon) $startX $startY $radiusX 0 $radiusX $height $startX $startBottom
                $canvas coords $slice::($this,startLeftLine) $startX $startY $startX $startBottom
                $canvas coords $slice::($this,startRightLine) $radiusX 0 $radiusX $height

                set bottomArcExtent [expr {$end+180}]
                $canvas itemconfigure $slice::($this,endBottomArcFill) -start -180 -extent $bottomArcExtent
                $canvas itemconfigure $slice::($this,endBottomArc) -start -180 -extent $bottomArcExtent
                $canvas coords $slice::($this,endPolygon) -$radiusX 0 $endX $endY $endX $endBottom -$radiusX $height
                $canvas coords $slice::($this,endLeftLine) -$radiusX 0 -$radiusX $height
                $canvas coords $slice::($this,endRightLine) $endX $endY $endX $endBottom
            } else {
                $canvas itemconfigure $slice::($this,startBottomArcFill) -start 0 -extent -180
                $canvas itemconfigure $slice::($this,startBottomArc) -start 0 -extent -180
                $canvas coords $slice::($this,startPolygon) -$radiusX 0 $radiusX 0 $radiusX $height -$radiusX $height
                $canvas coords $slice::($this,startLeftLine) -$radiusX 0 -$radiusX $height
                $canvas coords $slice::($this,startRightLine) $radiusX 0 $radiusX $height
            }
        }
    } else {
        if {$start<0} {
            $canvas itemconfigure $slice::($this,startBottomArcFill) -start 0 -extent $start
            $canvas itemconfigure $slice::($this,startBottomArc) -start 0 -extent $start
            $canvas coords $slice::($this,startPolygon) $startX $startY $radiusX 0 $radiusX $height $startX $startBottom
            $canvas coords $slice::($this,startLeftLine) $startX $startY $startX $startBottom
            $canvas coords $slice::($this,startRightLine) $radiusX 0 $radiusX $height
        } else {
            set bottomArcExtent [expr {$end+180}]
            $canvas itemconfigure $slice::($this,endBottomArcFill) -start -180 -extent $bottomArcExtent
            $canvas itemconfigure $slice::($this,endBottomArc) -start -180 -extent $bottomArcExtent
            $canvas coords $slice::($this,endPolygon) -$radiusX 0 $endX $endY $endX $endBottom -$radiusX $height
            $canvas coords $slice::($this,startLeftLine) -$radiusX 0 -$radiusX $height
            $canvas coords $slice::($this,startRightLine) $endX $endY $endX $endBottom
        }
    }
}

proc slice::position {this start} {
    update $this $start $slice::($this,extent)
}

proc slice::rotate {this angle} {
    if {$angle!=0} {
        update $this [expr {$slice::($this,start)+$angle}] $slice::($this,extent)
    }
}

proc slice::size {this extent} {
    update $this $slice::($this,start) $extent
}

proc slice::data {this arrayName} {
    upvar $arrayName data

    set data(start) $slice::($this,start)
    set data(extent) $slice::($this,extent)
    set data(xRadius) $slice::($this,radiusX)
    set data(yRadius) $slice::($this,radiusY)
    set coordinates [$slice::($this,canvas) coords $slice::($this,origin)]
    set data(xCenter) [expr {[lindex $coordinates 0]+$data(xRadius)}]
    set data(yCenter) [expr {[lindex $coordinates 1]+$data(yRadius)}]
    set data(height) $switched::($this,-height)
}

class slice {
    proc maximum {a b} {return [expr {$a>$b?$a:$b}]}
}

set rcsId {$Id: objselec.tcl,v 1.3 1998/04/20 14:51:14 jfontain Exp $}


class objectSelection {

    proc objectSelection {this args} switched {$args} {
        switched::complete $this
    }

    proc ~objectSelection {this} {
        variable ${this}selected

        catch {::unset ${this}selected}
    }

    proc options {this} {
        return [::list\
            [::list -selectcommand {} {}]\
        ]
    }

    proc set-selectcommand {this value} {}

    proc set {this ids selected} {
        variable ${this}selected

        ::set select {}
        ::set deselect {}
        foreach id $ids {
            if {[info exists ${this}selected($id)]&&($selected==[::set ${this}selected($id)])} continue
            if {$selected} {
                lappend select $id
                ::set ${this}selected($id) 1
            } else {
                lappend deselect $id
                ::set ${this}selected($id) 0
            }
        }
        update $this $select $deselect
    }

    proc update {this selected deselected} {
        if {[string length $switched::($this,-selectcommand)]==0} return
        if {[llength $selected]>0} {
            uplevel #0 $switched::($this,-selectcommand) [::list $selected] 1
        }
        if {[llength $deselected]>0} {
            uplevel #0 $switched::($this,-selectcommand) [::list $deselected] 0
        }
    }

    proc unset {this ids} {
        variable ${this}selected

        foreach id $ids {
            ::unset ${this}selected($id)
        }
    }


    proc add {this ids} {
        set $this $ids 0
    }

    proc remove {this ids} {
        unset $this $ids
    }

    proc select {this ids} {
        clear $this
        set $this $ids 1
        ::set objectSelection::($this,lastSelected) [lindex $ids end]
    }

    proc deselect {this ids} {
        set $this $ids 0
    }

    proc toggle {this ids} {
        variable ${this}selected

        ::set select {}
        ::set deselect {}
        foreach id $ids {
            if {[::set ${this}selected($id)]} {
                lappend deselect $id
                ::set ${this}selected($id) 0
            } else {
                lappend select $id
                ::set ${this}selected($id) 1
                ::set objectSelection::($this,lastSelected) $id
            }
        }
        update $this $select $deselect
    }

    proc extend {this id} {
        variable ${this}selected

        if {[info exists objectSelection::($this,lastSelected)]} {
            ::set list [lsort -integer [array names ${this}selected]]
            ::set last [lsearch -exact $list $objectSelection::($this,lastSelected)]
            ::set index [lsearch -exact $list $id]
            clear $this
            if {$index>$last} {
                set $this [lrange $list $last $index] 1
            } else {
                set $this [lrange $list $index $last] 1
            }
        } else {
            select $this $id
        }
    }

    proc clear {this} {
        variable ${this}selected

        set $this [array names ${this}selected] 0
    }

    proc selected {this} {
        variable ${this}selected

        ::set list {}
        foreach id [array names ${this}selected] {
            if {[::set ${this}selected($id)]} {
                lappend list $id
            }
        }
        return [lsort -integer $list]
    }

    proc list {this} {
        variable ${this}selected

        return [lsort -integer [array names ${this}selected]]
    }
}
set rcsId {$Id: pie.tcl,v 1.64 1998/04/20 20:17:25 jfontain Exp $}

package provide tkpiechart 4.2

class pie {
    set pie::(colors) {#7FFFFF #7FFF7F #FF7F7F #FFFF7F #7F7FFF #FFBF00 #BFBFBF #FF7FFF #FFFFFF}
}

proc pie::pie {this canvas x y width height args} switched {$args} {
    set pie::($this,canvas) $canvas

    set pie::($this,x) [winfo fpixels $canvas $x]
    set pie::($this,y) [winfo fpixels $canvas $y]
    set pie::($this,radiusX) [expr {[winfo fpixels $canvas $width]/2.0}]
    set pie::($this,radiusY) [expr {[winfo fpixels $canvas $height]/2.0}]

    set pie::($this,colorIndex) 0
    set pie::($this,slices) {}

    switched::complete $this
    complete $this
}

proc pie::~pie {this} {
    catch {$pie::($this,canvas) delete $pie::($this,title)}
    delete $pie::($this,labeler)
    eval delete $pie::($this,slices) $pie::($this,backgroundSlice)
    catch {delete $pie::($this,selector)}
}

proc pie::options {this} {
    return [list\
        [list -background {} {}]\
        [list -colors $pie::(colors) $pie::(colors)]\
        [list -labeler 0 0]\
        [list -selectable 0 0]\
        [list -thickness 0]\
        [list -title {} {}]\
        [list -titlefont {} {}]\
        [list -titleoffset 2 2]\
    ]
}

foreach option {-background -colors -labeler -selectable -title -titlefont -titleoffset} {
    proc pie::set$option {this value} "
        if {\$switched::(\$this,complete)} {
            error {option $option cannot be set dynamically}
        }
    "
}

proc pie::set-thickness {this value} {
    if {$switched::($this,complete)} {
        error {option -thickness cannot be set dynamically}
    }
    set pie::($this,thickness) [winfo fpixels $pie::($this,canvas) $value]
}

proc pie::complete {this} {
    set canvas $pie::($this,canvas)

    if {$switched::($this,-labeler)==0} {
        set pie::($this,labeler) [new pieBoxLabeler $canvas]
    } else {
        set pie::($this,labeler) $switched::($this,-labeler)
    }
    $canvas addtag pie($this) withtag pieLabeler($pie::($this,labeler))
    pieLabeler::link $pie::($this,labeler) $this

    if {[string length $switched::($this,-background)]==0} {
        set bottomColor {}
    } else {
        set bottomColor [tkDarken $switched::($this,-background) 60]
    }
    set slice [new slice\
        $canvas $pie::($this,x) $pie::($this,y) $pie::($this,radiusX) $pie::($this,radiusY) 90 360\
        -height $pie::($this,thickness) -topcolor $switched::($this,-background) -bottomcolor $bottomColor\
    ]
    $canvas addtag pie($this) withtag slice($slice)
    $canvas addtag pieGraphics($this) withtag slice($slice)
    set pie::($this,backgroundSlice) $slice
}

proc pie::newSlice {this {text {}}} {
    set canvas $pie::($this,canvas)

    set start 90
    foreach slice $pie::($this,slices) {
        set start [expr {$start-$slice::($slice,extent)}]
    }
    set color [lindex $switched::($this,-colors) $pie::($this,colorIndex)]
    set pie::($this,colorIndex) [expr {($pie::($this,colorIndex)+1)%[llength $switched::($this,-colors)]}]

    set coordinates [$canvas coords slice($pie::($this,backgroundSlice))]

    set slice [new slice\
        $canvas [lindex $coordinates 0] [lindex $coordinates 1] $pie::($this,radiusX) $pie::($this,radiusY) $start 0\
        -height $pie::($this,thickness) -topcolor $color -bottomcolor [tkDarken $color 60]\
    ]
    $canvas addtag pie($this) withtag slice($slice)
    $canvas addtag pieGraphics($this) withtag slice($slice)
    lappend pie::($this,slices) $slice

    if {[string length $text]==0} {
        set text "slice [llength $pie::($this,slices)]"
    }
    set labeler $pie::($this,labeler)
    set label [pieLabeler::new $labeler $slice -text $text -background $color]
    set pie::($this,sliceLabel,$slice) $label
    $canvas addtag pie($this) withtag pieLabeler($labeler)

    if {$switched::($this,-selectable)} {
        if {![info exists pie::($this,selector)]} {
            set pie::($this,selector) [new objectSelection -selectcommand "pie::setLabelsState $this"]
        }
        set selector $pie::($this,selector)
        objectSelection::add $selector $label
        $canvas bind canvasLabel($label) <ButtonRelease-1> "objectSelection::select $selector $label"
        $canvas bind slice($slice) <ButtonRelease-1> "objectSelection::select $selector $label"
        $canvas bind canvasLabel($label) <Control-ButtonRelease-1> "objectSelection::toggle $selector $label"
        $canvas bind slice($slice) <Control-ButtonRelease-1> "objectSelection::toggle $selector $label"
        $canvas bind canvasLabel($label) <Shift-ButtonRelease-1> "objectSelection::extend $selector $label"
        $canvas bind slice($slice) <Shift-ButtonRelease-1> "objectSelection::extend $selector $label"
    }

    return $slice
}

proc pie::deleteSlice {this slice} {
    set index [lsearch -exact $pie::($this,slices) $slice]
    if {$index<0} {
        error "invalid slice $slice for pie $this"
    }
    set pie::($this,slices) [lreplace $pie::($this,slices) $index $index]
    set extent $slice::($slice,extent)
    delete $slice
    foreach following [lrange $pie::($this,slices) $index end] {
        slice::rotate $following $extent
    }
    pieLabeler::delete $pie::($this,labeler) $pie::($this,sliceLabel,$slice)
    if {$switched::($this,-selectable)} {
        objectSelection::remove $pie::($this,selector) $pie::($this,sliceLabel,$slice)
    }
    unset pie::($this,sliceLabel,$slice)
}

proc pie::sizeSlice {this slice unitShare {valueToDisplay {}}} {
    set index [lsearch -exact $pie::($this,slices) $slice]
    if {$index<0} {
        error "invalid slice $slice for pie $this"
    }
    set newExtent [expr {[maximum [minimum $unitShare 1] 0]*360}]
    set growth [expr {$newExtent-$slice::($slice,extent)}]
    slice::update $slice [expr {$slice::($slice,start)-$growth}] $newExtent

    if {[string length $valueToDisplay]>0} {
        pieLabeler::update $pie::($this,labeler) $pie::($this,sliceLabel,$slice) $valueToDisplay
    } else {
        pieLabeler::update $pie::($this,labeler) $pie::($this,sliceLabel,$slice) $unitShare
    }

    set value [expr {-1*$growth}]
    foreach slice [lrange $pie::($this,slices) [incr index] end] {
        slice::rotate $slice $value
    }
}

proc pie::createTitle {this string font offset} {
    if {[string length $string]==0} {
        return
    }
    set canvas $pie::($this,canvas)
    set box [$canvas bbox pie($this)]
    set pie::($this,title) [\
        $canvas create text [expr {[lindex $box 0]+([lindex $box 2]-[lindex $box 0])/2}] [expr {[lindex $box 1]-$offset}]\
            -anchor s -tags pie($this) -text $string\
    ]
    if {[string length $font]>0} {
        $canvas itemconfigure $pie::($this,title) -font $font
    }
}

proc pie::selectedSlices {this} {
    set list {}
    foreach slice $pie::($this,slices) {
        if {[pieLabeler::selectState $pie::($this,labeler) $pie::($this,sliceLabel,$slice)]} {
            lappend list $slice
        }
    }
    return $list
}

proc pie::setLabelsState {this labels selected} {
    set labeler $pie::($this,labeler)
    foreach label $labels {
        pieLabeler::selectState $labeler $label $selected
    }
}

class pie {
    proc maximum {a b} {return [expr {$a>$b?$a:$b}]}
    proc minimum {a b} {return [expr {$a<$b?$a:$b}]}
}
}

set rcsId {$Id: utility.tcl,v 1.2 1998/02/15 20:43:44 jfontain Exp $}

proc minimum {a b} {return [expr {$a<$b?$a:$b}]}
proc maximum {a b} {return [expr {$a>$b?$a:$b}]}

proc ldelete {listName value} {
    upvar $listName list

    set index [lsearch -exact $list $value]
    if {$index<0} {
        error "\"$value\" is not in list"
    }
    set list [lreplace $list $index $index]

}

set rcsId {$Id: font.tcl,v 1.2 1998/04/19 18:29:55 jfontain Exp $}

class font {
    catch {widget::widget}
    set font::(mediumBold) [eval font create [font actual $widget::(default,ButtonFont)]]
    set font::(mediumNormal) [eval font create [font actual $font::(mediumBold)]]
    font configure $font::(mediumNormal) -weight normal
    set font::(smallNormal) [eval font create [font actual $font::(mediumNormal)]]
    font configure $font::(smallNormal) -size [expr {round(0.8*[font actual $font::(mediumNormal) -size])}]
}

set rcsId {$Id: scroll.tcl,v 1.2 1997/07/13 12:44:15 jfontain Exp $}


class scroll {}

proc scroll::scroll {this scrollableClass parentPath args} composite {[new frame $parentPath] $args} {
    set path $widget::($this,path)
    composite::manage $this [new $scrollableClass $path] scrolled\
        [new scrollbar $path -orient horizontal] horizontal [new scrollbar $path] vertical

    widget::configure $composite::($this,scrolled)\
        -xscrollcommand "scroll::horizontalScroll $this" -yscrollcommand "scroll::verticalScroll $this"
    widget::configure $composite::($this,horizontal) -command "$composite::($this,scrolled,path) xview"
    widget::configure $composite::($this,vertical) -command "$composite::($this,scrolled,path) yview"

    grid $composite::($this,scrolled,path) -sticky nsew
    grid rowconfigure $path 0 -weight 1
    grid columnconfigure $path 0 -weight 1

    composite::complete $this
}

proc scroll::~scroll {this} {}

proc scroll::options {this} {
    return [list\
        [list -automatic automatic Automatic 1 1]\
    ]
}

proc scroll::set-automatic {this value} {
    eval horizontalScroll $this [$composite::($this,scrolled,path) xview]
    eval verticalScroll $this [$composite::($this,scrolled,path) yview]
}

proc scroll::update {path column row first last} {
    if {[llength [grid info $path]]==0} {
        grid $path -column $column -row $row -sticky nsew
    }
    $path set $first $last
}

proc scroll::horizontalScroll {this first last} {
    if {!$composite::($this,-automatic)||(($last-$first)<1)} {
        update $composite::($this,horizontal,path) 0 1 $first $last
    } else {
        grid forget $composite::($this,horizontal,path)
    }
}

proc scroll::verticalScroll {this first last} {
    if {!$composite::($this,-automatic)||(($last-$first)<1)} {
        update $composite::($this,vertical,path) 1 0 $first $last
    } elseif {$composite::($this,-automatic)} {
        grid forget $composite::($this,vertical,path)
    }
}

set rcsId {$Id: lifolbl.tcl,v 1.9 1998/03/28 08:39:53 jfontain Exp $}


set rcsId {$Id: xifo.tcl,v 1.15 1998/04/08 21:24:07 jfontain Exp $}


class xifo {
    proc xifo {this size} {
        set xifo::($this,size) $size
        empty $this
    }

    proc ~xifo {this} {
        variable ${this}data
        catch {unset ${this}data}
    }

    proc in {this data} {
        variable ${this}data
        tidyUp $this
        if {[array size ${this}data]>=$xifo::($this,size)} {
            unset ${this}data($xifo::($this,first))
            incr xifo::($this,first)
        }
        set ${this}data([incr xifo::($this,last)]) $data
    }

    proc tidyUp {this} {
        variable ${this}data
        catch {
            unset ${this}data($xifo::($this,unset))
            unset xifo::($this,unset)
        }
    }

    proc empty {this} {
        variable ${this}data
        catch {unset ${this}data}
        catch {unset xifo::($this,unset)}
        set xifo::($this,first) 0
        set xifo::($this,last) -1
    }

    proc isEmpty {this} {
        variable ${this}data
        return [expr {[array size ${this}data]==0}]
    }

    virtual proc out {this}

    virtual proc data {this}
}

class lifo {
    proc lifo {this {size 2147483647}} xifo {$size} {}

    proc ~lifo {this} {}

    proc out {this} {
        xifo::tidyUp $this
        if {[array size xifo::${this}data]==0} {
            error "lifo $this out error, empty"
        }
        set xifo::($this,unset) $xifo::($this,last)
        incr xifo::($this,last) -1
        return [set xifo::${this}data($xifo::($this,unset))]
    }

    proc data {this} {
        set list {}
        set first $xifo::($this,first)
        for {set index $xifo::($this,last)} {$index>=$first} {incr index -1} {
            lappend list [set xifo::${this}data($index)]
        }
        return $list
    }
}

class fifo {
    proc fifo {this {size 2147483647}} xifo {$size} {}

    proc ~fifo {this} {}

    proc out {this} {
        xifo::tidyUp $this
        if {[array size xifo::${this}data]==0} {
            error "fifo $this out error, empty"
        }
        set xifo::($this,unset) $xifo::($this,first)
        incr xifo::($this,first)
        return [set xifo::${this}data($xifo::($this,unset))]
    }

    proc data {this} {
        set list {}
        set last $xifo::($this,last)
        for {set index $xifo::($this,first)} {$index<=$last} {incr index} {
            lappend list [set xifo::${this}data($index)]
        }
        return $list
    }
}


class lifoLabel {}

proc lifoLabel::lifoLabel {this parentPath args} composite {
    [new frame $parentPath -relief sunken -borderwidth $widget::(default,ButtonBorderWidth)] $args
} {
    set path $widget::($this,path)
    composite::manage $this [new label $path -font {helvetica -12 bold} -text Message:] header [new frame $path] separator\
        [new label $path -font {helvetica -12} -anchor w] body
    pack $composite::($this,header,path) $composite::($this,separator,path) -side left
    pack $composite::($this,body,path) -fill x -expand 1
    set lifoLabel::($this,lifo) [new lifo]
    composite::complete $this
}

proc lifoLabel::~lifoLabel {this} {
    delete $lifoLabel::($this,lifo)
}

proc lifoLabel::options {this} {
    return [list\
        [list -borderwidth borderWidth BorderWidth $widget::(default,ButtonBorderWidth) $widget::(default,ButtonBorderWidth)]\
        [list -font font Font {helvetica -12} {helvetica -12}]\
        [list -header header Text Message: Message:]\
        [list -headerfont headerFont Font {helvetica -12 bold} {helvetica -12 bold}]\
        [list -relief relief Relief sunken sunken]\
        [list -spacing spacing Spacing 0 0]\
    ]
}

foreach option {-borderwidth -relief} {
    proc lifoLabel::set$option {this value} "\$widget::(\$this,path) configure $option \$value"
}

proc lifoLabel::set-font {this value} {
    $composite::($this,body,path) configure -font $value
}

proc lifoLabel::set-headerfont {this value} {
    $composite::($this,header,path) configure -font $value
}

proc lifoLabel::set-header {this value} {
    $composite::($this,header,path) configure -text $value
}

proc lifoLabel::set-spacing {this value} {
    $composite::($this,separator,path) configure -width $value
}

proc lifoLabel::push {this string} {
    if {[string length [set current [$composite::($this,body,path) cget -text]]]>0} {
        xifo::in $lifoLabel::($this,lifo) $current
    }
    $composite::($this,body,path) configure -text $string
}

proc lifoLabel::pop {this} {
    set string {}
    catch {set string [lifo::out $lifoLabel::($this,lifo)]}
    $composite::($this,body,path) configure -text $string
    return $string
}

proc lifoLabel::flash {this string {seconds 1}} {
    after [expr 1000*$seconds] lifoLabel::pop $this
    push $this $string
}

set rcsId {$Id: keyslink.tcl,v 1.4 1998/02/20 22:01:33 jfontain Exp $}


class buttonKeysLink {
    proc buttonKeysLink {this buttonPath keySymbols {bindPath {}}} {
        if {[string length $bindPath]==0} {
            set bindings [new bindings $buttonPath 0]
        } else {
            set bindings [new bindings $bindPath 0]
        }
        foreach key $keySymbols {
            bindings::set $bindings <KeyPress-$key> "$buttonPath configure -relief sunken"
            bindings::set $bindings <KeyRelease-$key> "$buttonPath configure -relief raised"
        }
        bindings::set $bindings <Destroy> "delete $this"
        set buttonKeysLink::($this,bindings) $bindings
    }
    proc ~buttonKeysLink {this} {
        delete $buttonKeysLink::($this,bindings)
    }
}

set rcsId {$Id: dialog.tcl,v 1.11 1998/02/20 21:41:41 jfontain Exp $}

class dialogBox {}

proc dialogBox::dialogBox {this parentPath args} composite {[new toplevel $parentPath] $args} {
    set path $widget::($this,path)
    wm withdraw $path
    composite::manage $this [new frame $path -relief sunken -borderwidth 1 -height 2] separator [new frame $path] buttons
    set buttons $composite::($this,buttons,path)
    composite::manage $this [new button $buttons -text OK -command "dialogBox::done $this"] ok\
        [new button $buttons -text Cancel -command "catch {delete $this}"] cancel

    grid $composite::($this,separator,path) -column 0 -row 1 -sticky ew
    grid $buttons -column 0 -row 2 -sticky nsew
    grid rowconfigure $path 0 -weight 1
    grid columnconfigure $path 0 -weight 1

    wm protocol $path WM_DELETE_WINDOW "delete $this"
    bind $path <KeyRelease-Escape> "catch {delete $this}"
    bind $path <KeyRelease-Return> "dialogBox::done $this"
    bind $path <KeyRelease-KP_Enter> "dialogBox::done $this"
    composite::complete $this
}

proc dialogBox::~dialogBox {this} {}

proc dialogBox::options {this} {
    return [list\
        [list -buttons buttons Buttons o]\
        [list -command command Command {} {}]\
        [list -default default Default {} {}]\
        [list -die die Die 1 1]\
        [list -grab grab Grab local]\
        [list -title title Title {Dialog box}]\
        [list -transient transient Transient 1]\
        [list -x x Coordinate 0]\
        [list -y y Coordinate 0]
    ]
}

proc dialogBox::set-buttons {this value} {
    if {$composite::($this,complete)} {
        error {option -buttons cannot be set dynamically}
    }
    if {![regexp {^(o|c|oc)$} $value]} {
        error "bad buttons value \"$value\": must be o, c or oc"
    }
    pack forget $composite::($this,ok,path) $composite::($this,cancel,path)
    set ok [expr {[string first o $value]>=0}]
    set cancel [expr {[string first c $value]>=0}]
    if {$ok} {
        pack $composite::($this,ok,path) -side left -expand 1 -pady 3
        new buttonKeysLink $composite::($this,ok,path) {Return KP_Enter} $widget::($this,path)
    }
    if {$cancel} {
        pack $composite::($this,cancel,path) -side left -expand 1 -pady 3
        new buttonKeysLink $composite::($this,cancel,path) Escape $widget::($this,path)
    }
}

proc dialogBox::set-default {this value} {
    if {$composite::($this,complete)} {
        error {option -default cannot be set dynamically}
    }
    switch $composite::($this,-default) {
        o {
            $composite::($this,ok,path) configure -default active
        }
        c {
            $composite::($this,cancel,path) configure -default active
        }
        default {
            error "bad default value \"$value\": must be o or c"
        }
    }
}

proc dialogBox::set-command {this value} {}
proc dialogBox::set-die {this value} {}

proc dialogBox::set-grab {this value} {
    switch $value {
        global {
            grab -global $widget::($this,path)
        }
        local {
            grab $widget::($this,path)
        }
        release {
            grab release $widget::($this,path)
        }
        default {
            error "bad grab value \"$value\": must be global, local or release"
        }
    }
}

proc dialogBox::set-title {this value} {
    wm title $widget::($this,path) $value
}

foreach option {-x -y} {
    proc dialogBox::set$option {this value} {
        if {[winfo ismapped $widget::($this,path)]} {
            place $this
        }
    }
}

proc dialogBox::set-transient {this value} {
    if {$value} {
        wm transient $widget::($this,path) [winfo toplevel $widget::($this,path)]
    } else {
        wm transient $widget::($this,path) {}
    }
}

proc dialogBox::display {this path} {
    if {[string length $path]==0} {
        if {[info exists dialogBox::($this,displayed)]} {
            grid forget $dialogBox::($this,displayed)
            unset dialogBox::($this,displayed)
        }
        return
    }
    if {[info exists dialogBox::($this,displayed)]} {
        error "a widget ($dialogBox::($this,displayed)) is already displayed"
    }
    set dialogBox::($this,displayed) $path
    grid $path -in $widget::($this,path) -column 0 -row 0 -sticky nsew -pady 3
    place $this
}

proc dialogBox::done {this} {
    if {[string length $composite::($this,-command)]>0} {
        uplevel #0 $composite::($this,-command)
    }
    if {[info exists composite::($this,-die)]&&$composite::($this,-die)} {
        delete $this
    }
}

proc dialogBox::place {this} {
    update idletasks
    set path $widget::($this,path)
    set x [minimum $composite::($this,-x) [expr {[winfo screenwidth $path]-[winfo reqwidth $path]}]]
    set y [minimum $composite::($this,-y) [expr {[winfo screenheight $path]-[winfo reqheight $path]}]]
    wm geometry $path +$x+$y
    wm deiconify $path
}

set rcsId {$Id: viewer.tcl,v 1.5 1998/04/21 16:17:33 jfontain Exp $}

class viewer {

    set viewer::(list) {}

    proc viewer {this} {
        global canvas

        new canvasHandles $canvas -path $widget::($this,path)
        lappend viewer::(list) $this
    }

    proc ~viewer {this} {
        variable ${this}traces

        foreach array [array names ${this}traces] {
            trace vdelete ${array}(updates) w "viewer::update $this $array"
        }
        catch {unset ${this}traces}
        ldelete viewer::(list) $this
    }

    virtual proc supportedTypes {this}

    proc view {this cells} {
        foreach cell [parseCells $this $cells] {
            eval monitorCell $this $cell
        }
    }

    virtual proc monitorCell {this array row column}

    proc parseCells {this cells} {
        global messenger

        if {[llength $cells]==0} return
        set parsed {}
        foreach cell $cells {
            if {![info exists $cell]} {
                error "\"$cell\" cell does not exist"
            }
            parse $cell array row column type
            if {[lsearch -exact [supportedTypes $this] $type]<0} {
                lifoLabel::flash $messenger "cannot display data of type $type"
                bell
                return
            }
            lappend parsed [list $array $row $column]
        }
        return $parsed
    }

    proc parse {dataCell arrayName rowName columnName typeName} {
        upvar $arrayName array $rowName row $columnName column $typeName type

        if {![regexp {^(.*)\(([0-9]+),([0-9]+)\)$} $dataCell dummy array row column]||($row<0)||($column<0)} {
            error "\"$dataCell\" is not a valid array cell"
        }
        set type [set ${array}($column,type)]
    }

    proc updateInterval {value} {
        foreach viewer $viewer::(list) {
            catch {composite::configure $viewer -interval $value}
        }
    }

    proc label {array row column} {
        set label {}
        foreach index [set ${array}(indexColumns)] {
            append label "[set ${array}($row,$index)] "
        }
        append label [set ${array}($column,label)]
        return $label
    }

    virtual proc update {this array args}

    proc registerTrace {this array} {
        variable ${this}traces

        if {![info exists ${this}traces($array)]} {
            trace variable ${array}(updates) w "viewer::update $this $array"
            set ${this}traces($array) 0
        }
        incr ${this}traces($array)
    }

    proc unregisterTrace {this array} {
        variable ${this}traces

        if {[incr ${this}traces($array) -1]<=0} {
            trace vdelete ${array}(updates) w "viewer::update $this $array"
            unset ${this}traces($array)
        }
    }
}

set rcsId {$Id: blt2d.tcl,v 1.13 1998/04/21 16:36:43 jfontain Exp $}

class blt2DViewer {

    set blt2DViewer::(colors) {#7FFFFF #7FFF7F #FF7F7F #FFFF7F #7F7FFF #FFBF00 #BFBFBF #FF7FFF #FFFFFF}

    proc blt2DViewer {this path} viewer {} {
        $path configure -plotbackground $widget::(default,ButtonBackgroundColor)
        $path yaxis configure -title {} -min 0 -tickfont $font::(smallNormal)
        $path legend configure -borderwidth 1 -font $font::(mediumNormal)

        set blt2DViewer::($this,drop) [new dropSite\
            -path $path -formats DATACELLS -command "viewer::view $this \$dragSite::data(DATACELLS)"\
        ]

        set blt2DViewer::($this,drag) [new dragSite -path $path -validcommand "blt2DViewer::validateDrag $this"]
        dragSite::provide $blt2DViewer::($this,drag) OBJECTS "blt2DViewer::dragData $this"
        dragSite::provide $blt2DViewer::($this,drag) DATACELLS "blt2DViewer::dragData $this"

        set blt2DViewer::($this,elements) {}
        set blt2DViewer::($this,selector) [new objectSelection -selectcommand "blt2DViewer::setElementsState $this"]
        bind $path <ButtonRelease-1> "blt2DViewer::setSelection $this %x %y"
        bind $path <Control-ButtonRelease-1> "blt2DViewer::toggleSelection $this %x %y"
        bind $path <Shift-ButtonRelease-1> "blt2DViewer::extendSelection $this %x %y"

        set blt2DViewer::($this,colorIndex) 0
        set blt2DViewer::($this,path) $path
    }

    proc ~blt2DViewer {this} {
        delete $blt2DViewer::($this,drag) $blt2DViewer::($this,drop) $blt2DViewer::($this,selector)
        eval delete $blt2DViewer::($this,elements)
    }

    proc supportedTypes {this} {
        return {integer real}
    }

    proc dragData {this format} {
        set selectedElements [objectSelection::selected $blt2DViewer::($this,selector)]
        switch $format {
            OBJECTS {
                if {[llength $selectedElements]>0} {
                    return $selectedElements
                } elseif {[llength $blt2DViewer::($this,elements)]==0} {
                    return $this
                } else {
                    return {}
                }
            }
            DATACELLS {
                return [cellsFromElements $this $selectedElements]
            }
        }
    }

    proc validateDrag {this x y} {
        if {\
            ([llength [objectSelection::selected $blt2DViewer::($this,selector)]]>0)||\
            ([llength $blt2DViewer::($this,elements)]==0)\
        } {
            return 1
        } else {
            return 0
        }
    }

    proc monitorCell {this array row column} {
        viewer::registerTrace $this $array
        set cell ${array}($row,$column)
        if {[lsearch -exact [cellsFromElements $this $blt2DViewer::($this,elements)] $cell]>=0} return
        set element [newElement $this $blt2DViewer::($this,path) -label [viewer::label $array $row $column]]
        switched::configure $element -color [lindex $blt2DViewer::(colors) $blt2DViewer::($this,colorIndex)]
        switched::configure $element -deletecommand "blt2DViewer::deletedElement $this $array $element"
        set blt2DViewer::($this,colorIndex) [expr {($blt2DViewer::($this,colorIndex)+1)%[llength $blt2DViewer::(colors)]}]
        lappend blt2DViewer::($this,elements) $element
        set blt2DViewer::($this,cell,$element) $cell
        objectSelection::add $blt2DViewer::($this,selector) $element
    }

    proc deletedElement {this array element} {
        viewer::unregisterTrace $this $array
        ldelete blt2DViewer::($this,elements) $element
        objectSelection::remove $blt2DViewer::($this,selector) $element
        unset blt2DViewer::($this,cell,$element)
        if {[llength $blt2DViewer::($this,elements)]==0} {
            delete $this
        }
    }

    proc update {this array args} {
        updateTimeDisplay $this [set seconds [clock seconds]]
        foreach element $blt2DViewer::($this,elements) {
            set cell $blt2DViewer::($this,cell,$element)
            if {[string first $array $cell]<0} continue
            set value {}
            catch {set value [set $cell]}
            updateElement $this $element $seconds $value
        }
    }

    virtual proc newElement {this path args}

    virtual proc updateElement {this element seconds value}

    virtual proc updateTimeDisplay {this seconds} {}

    proc cellsFromElements {this elements} {
        set cells {}
        foreach element $elements {
            lappend cells $blt2DViewer::($this,cell,$element)
        }
        return $cells
    }

    proc setElementsState {this elements select} {
        if {$select} {
            set action activate
        } else {
            set action deactivate
        }
        set path $blt2DViewer::($this,path)
        foreach element $elements {
            $path legend $action $element
        }
    }

    proc setSelection {this x y} {
        if {[string length [set element [$blt2DViewer::($this,path) legend get @$x,$y]]]>0} {
            objectSelection::select $blt2DViewer::($this,selector) $element
        }
    }

    proc toggleSelection {this x y} {
        if {[string length [set element [$blt2DViewer::($this,path) legend get @$x,$y]]]>0} {
            objectSelection::toggle $blt2DViewer::($this,selector) $element
        }
    }

    proc extendSelection {this x y} {
        if {[string length [set element [$blt2DViewer::($this,path) legend get @$x,$y]]]>0} {
            objectSelection::extend $blt2DViewer::($this,selector) $element
        }
    }

}

set rcsId {$Id: datatab.tcl,v 1.15 1998/04/08 21:58:59 jfontain Exp $}

class dataTable {
    proc dataTable {this parentPath args} composite {[new scroll table $parentPath] $args} {
        set path $composite::($composite::($this,base),scrolled,path)
        $path tag configure title -font $font::(mediumBold) -anchor c
        $path configure -font $font::(mediumNormal) -rows 2 -state disabled -titlerows 1 -roworigin -1 -colstretchmode unset\
            -variable dataTable::${this}data
        $path tag configure title -font $font::(mediumBold) -anchor c
        $path tag configure highlight -font $font::(mediumNormal) -background [$path tag cget sel -background]

        bindtags $path "$path . all"

        set dataTable::($this,drag) [new dragSite -path $path -validcommand "dataTable::validateDrag $this"]
        dragSite::provide $dataTable::($this,drag) DATACELLS "dataTable::selectedDataCells $this"

        bind $path <ButtonRelease-1> "dataTable::columnSort $this %x %y %X %Y"

        set dataTable::($this,sortOrder) increasing
        set dataTable::($this,tablePath) $path
        composite::complete $this
    }

    proc ~dataTable {this} {
        variable ${this}data

        catch {unset ${this}data}
        delete $dataTable::($this,drag)
    }

    proc options {this} {
        return [list\
            [list -columns columns Columns 0 0]\
            [list -titlefont titleFont TitleFont $font::(mediumBold) $font::(mediumBold)]\
            [list -data data Data {} {}]\
        ]
    }

    proc set-columns {this value} {
        $dataTable::($this,tablePath) configure -cols $value
    }

    proc set-titlefont {this value} {
        $dataTable::($this,tablePath) tag configure title -font $value
    }

    proc set-data {this value} {
        variable ${this}data
        upvar $value data

        if {![array exists $value]} {
            error "\"$value\" argument is not an existing array"
        }
        set list {}
        for {set column 0} {$column<$data(columns)} {incr column} {
            lappend list -1,$column $data($column,label)
        }
        array set ${this}data $list
        $dataTable::($this,tablePath) configure -cols $column
        highlightColumn $this [lindex $data(sort) 0]
        set dataTable::($this,sortOrder) [lindex $data(sort) 1]
        trace variable ${value}(updates) w "dataTable::update $this"
    }

    proc highlightColumn {this {column {}}} {
        set path $dataTable::($this,tablePath)
        set highlighted [lindex [$path tag col highlight] 0]
        if {[string length $column]==0} {
            return $highlighted
        } else {
            if {[string length $highlighted]>0} {
                $path tag col {} $highlighted
            }
            $path tag col highlight $column
        }
    }

    proc columnSort {this x y xRoot yRoot} {
        set path $dataTable::($this,tablePath)
        if {[string compare [winfo containing $xRoot $yRoot] $path]!=0} return

        set number [expr {[$path cget -rows]-1}]
        if {$number==0} return
        scan [$path index @$x,$y] %d,%d row column
        if {$row>=0} return

        if {[string compare $column [highlightColumn $this]]==0} {
            if {[string compare $dataTable::($this,sortOrder) increasing]==0} {
                set dataTable::($this,sortOrder) decreasing
            } else {
                set dataTable::($this,sortOrder) increasing
            }
        } else {
            set dataTable::($this,sortOrder) increasing
        }
        highlightColumn $this $column
        update $this
    }

    proc update {this args} {
        if {[string length $composite::($this,-data)]==0} return

        variable ${this}data
        upvar $composite::($this,-data) data

        set path $dataTable::($this,tablePath)

        set cursor [$path cget -cursor]
        $path configure -cursor watch
        ::update idletasks

        set sortColumn [highlightColumn $this]
        set lists {}
        foreach name [array names data *,0] {
            scan $name %u dataRow
            lappend lists [list $dataRow $data($dataRow,$sortColumn)]
        }
        set lists [lsort -$dataTable::($this,sortOrder) -$data($sortColumn,type) -index 1 $lists]

        set row 0
        foreach pair $lists {
            set dataRow [lindex $pair 0]
            set ${this}data($row,-1) $dataRow
            for {set column 0} {$column<$data(columns)} {incr column} {
                set ${this}data($row,$column) $data($dataRow,$column)
            }
            incr row
        }
        $path configure -rows [incr row]
        highlightColumn $this $sortColumn

        $path configure -cursor $cursor
        ::update idletasks
    }

    proc selectedDataCells {this format} {
        variable ${this}data

        foreach {row column} [split [$dataTable::($this,tablePath) index @$dragSite::(x),$dragSite::(y)] ,] {}
        return $composite::($this,-data)([set ${this}data($row,-1)],$column)
    }

    proc validateDrag {this x y} {
        scan [$dataTable::($this,tablePath) index @$x,$y] %d,%d row column
        if {($row<0)||($column<0)} {
            return 0
        }
        return 1
    }
}

set rcsId {$Id: datagraf.tcl,v 1.26 1998/04/21 16:21:59 jfontain Exp $}

class dataGraph {

    proc dataGraph {this parentPath args} composite {
        [new graph $parentPath -title {} -topmargin 3 -bufferelements 0 -plotborderwidth 1] $args
    } blt2DViewer {$widget::($this,path)} {
        $widget::($this,path) xaxis configure -tickfont $font::(smallNormal) -title {} -rotate 90 -command dataGraph::axisTime
        composite::complete $this
    }

    proc ~dataGraph {this} {}

    proc iconData {} {
        return {
            R0lGODdhKAAoAKUAAHt5e87PzgAAANbX1v///zFhITFhGJTXa633e6X3e5znc6Xvc3u+Wpznazk4
            OZTfa4zPY3NJAPffSufHOda2Mc6mKVIIY2sYexBhe4wQpa3X54S+zr0o1qUYvbUYzrUg1lKWrb0Y
            3t44/60Yzt5B/+dJ/+dR/9YY984Y7+dZ/+dh/94o/+9x/wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
            AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACwAAAAAKAAoAAAG/kCAcEgsGo/IYQAg
            aDqf0Kh02lwKAthsYIDlbrVer3Y8ZgYI6DQaoG6z2+n3Gm09wwlyeN6tflsHd3iBgoF5fmZDBYpJ
            AIoGBUaPj0Z1aAUHmAWEapeYB5ppBQgICQqghwKABJ2ZeYoLCwoLpYqKpbAMkISVqwyeC6CrsAoK
            DAzDCg3FC8aQbKhLQgW+BwsNtdUNzdMMxb7bDuFEf5zGyp4H2osOisbbAA5y0G3cD98QuUPxjbX6
            fXRMVHHi5s7ZHCNz4gC8gqTWIkYQAfCCs2/Iv0IXyd2JwJEjH4wKCUxMw1GCSZMRLt4xtDDakAgm
            J8iUKSGCkY42GY2EKZNC/oWfFCbUTAmg5EmPLEUGJCmhZ4WOFYKihNl05tSMZtDwnOAzZ9GfNJv6
            /BlVaM2Qf4REoMD2abi3HKOy7Qo1aNeKErMSiEDWpgM3fPsSCfzT5i69ezkK+Qu4oyGcQg5f6ROZ
            sZ54K/cltEKls2cpViyIvoCh9IXTqFOXNp2a9OrWF6xkmI1Bg20Ms3Pnrm1bA+7dvTdguMChOAcr
            HTx8wLChue8P0KGX1tDc+era1UEMDxFChAgrIzyMwACi+nPptpuDKL+hN/UN64dfCEGiPvgR0tm3
            X/0+Pnn98GknH3clFAgeByEg+J9z6cHHWmnr+Ycad/XZxwR3GIawYHUOXsJ23YQYmiCiCVZwhyCC
            Gv4X4YAYwjbiiyOWeAIKM6KAQgiuvXZBCjz26OOPQFpRo41E4phaBiGooOSSTDbppJAoOCnllFQ2
            acUKK7Cg5ZZcdunll18uQcaYZJZZZhAAOw==
        }
    }

    proc options {this} {
        return [list\
            [list -height height Height 200]\
            [list -interval interval Interval 5]\
            [list -samples samples Samples 101 101]\
            [list -width width Width 300]\
        ]
    }

    foreach option {-height -width} {
        proc set$option {this value} "\$widget::(\$this,path) configure $option \$value"
    }

    proc set-interval {this value} {
        xAxisUpdate $this [clock seconds]
    }

    proc set-samples {this value} {
        if {$composite::($this,complete)} {
            error {option -samples cannot be set dynamically}
        }
    }

    proc xAxisUpdate {this currentTime} {
        $widget::($this,path) xaxis configure\
            -min [expr {$currentTime-($composite::($this,-samples)*$composite::($this,-interval))}] -max $currentTime\
            -stepsize 60 -subdivisions 6
    }

    proc axisTime {path value} {
        return [clock format $value -format %T]
    }

    proc newElement {this path args} {
        return [eval new element $path $args]
    }

    proc updateTimeDisplay {this seconds} {
        xAxisUpdate $this $seconds
    }

    proc updateElement {this element seconds value} {
        element::update $element $seconds $value
    }
}

class dataGraph {
    class element {

        set (intervals) 100

        proc element {this path args} switched {$args} {
            $path element line $this -label {}

            global [set xVector ${this}xData] [set yVector ${this}yData]
            global $xVector
            set dots [expr {[set (intervals)]+1}]
            blt::vector ${xVector}($dots)
            $path element configure $this -xdata $xVector

            set yVector ${this}yData
            global $yVector
            blt::vector ${yVector}($dots)
            $path element configure $this -ydata $yVector

            set ($this,path) $path
            switched::complete $this
        }

        proc ~element {this} {
            global [set xVector ${this}xData] [set yVector ${this}yData]
            unset $xVector $yVector
            [set ($this,path)] element delete $this
            if {[string length $switched::($this,-deletecommand)]>0} {
                uplevel #0 $switched::($this,-deletecommand)
            }
        }

        proc options {this} {
            return [list\
                [list -color black black]\
                [list -deletecommand {} {}]\
                [list -label {} {}]\
            ]
        }

        foreach option {-color -label} {
            proc set$option {this value} "\[set (\$this,path)\] element configure \$this $option \$value"
        }

        proc set-deletecommand {this value} {}

        proc update {this x y} {
            global [set xVector ${this}xData] [set yVector ${this}yData]

            if {[string length $y]==0} {
                set y 0
            }
            $xVector delete 0
            $xVector append $x
            $yVector delete 0
            $yVector append $y
        }
    }
}

set rcsId {$Id: databar.tcl,v 1.6 1998/04/21 16:37:09 jfontain Exp $}

class dataBarChart {

    proc dataBarChart {this parentPath args} composite {
        [new graph $parentPath -title {} -bottommargin 6 -topmargin 3 -bufferelements 0 -plotborderwidth 1] $args
    } blt2DViewer {$widget::($this,path)} {
        $widget::($this,path) xaxis configure -mapped 0
        composite::complete $this
    }

    proc ~dataBarChart {this} {}

    proc options {this} {
        return [list\
            [list -height height Height 200]\
            [list -mode mode Mode normal normal]\
            [list -width width Width 300]\
        ]
    }

    foreach option {-height -width} {
        proc set$option {this value} "\$widget::(\$this,path) configure $option \$value"
    }

    proc set-mode {this value} {
        $widget::($this,path) configure -barmode $value
    }

    proc newElement {this path args} {
        set element [eval new element $path $args]
        element::update $element {}
        return $element
    }

    proc updateElement {this element seconds value} {
        element::update $element $value
    }

}

class dataBarChart {
    class element {

        proc element {this path args} switched {$args} {
            $path element bar $this -label {} -borderwidth 1 -xdata 0
            set ($this,path) $path
            switched::complete $this
        }

        proc ~element {this} {
            [set ($this,path)] element delete $this
            if {[string length $switched::($this,-deletecommand)]>0} {
                uplevel #0 $switched::($this,-deletecommand)
            }
        }

        proc options {this} {
            return [list\
                [list -color black black]\
                [list -deletecommand {} {}]\
                [list -label {} {}]\
            ]
        }

        proc set-label {this value} {
            [set ($this,path)] element configure $this -label $value
        }

        proc set-color {this value} {
            [set ($this,path)] element configure $this -foreground $value
        }

        proc set-deletecommand {this value} {}

        proc update {this y} {
            if {[string length $y]==0} {
                [set ($this,path)] element configure $this -ydata 0 -label "$switched::($this,-label): ?"
            } else {
                [set ($this,path)] element configure $this -ydata $y -label "$switched::($this,-label): $y"
            }
        }
    }
}

class dataSideBarChart {
    proc dataSideBarChart {this parentPath args} dataBarChart {$parentPath $args} {
        composite::configure $this -mode aligned
    }
    proc ~dataSideBarChart {this} {}
    proc iconData {} {
        return {
            R0lGODdhKAAoAMYAAHt5e87PzgAAANbX1v///xAoCAAIADFhITFhGAAQAK33e6X3e5znc6Xvc5zn
            a5TXa5Tfazk4OUJJQozPY4THWnvHWoTPY3u+Wnu+UqWupQAYAHO2UlI4ABAIABgQADEgAHNJAGuu
            SikgAPffSu/XQiEYAGOmSu/PQufHOWOeQue+OVqWOda2MQAgACEQAN6+MVKOOd62MUqGMc6mKVII
            YzEIOXMQhGsQe2sYe4wQpUJ5KTkoAK0YzrUg1r0o1qUYvbUYzgAoADlxKUIoAM6eIQAYIQAQEBBp
            hBBhe944/8aWIa3X57Xf76XP594w/95B/zlpIb2OGMaeIedJ/70Y3kowAAAQGJTH3oy+1oS+znMo
            e+dR/ylZGLWGEGumvXOuxudZ/9YY984Y7yFRELV5EAAgKWsge+dh/61xCAAoOVKWrXMwe2NBAAAw
            QkKOpd4o/wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACwA
            AAAAKAAoAAAH/oAAgoOEhYaHiIMBAAKNjo+QkZKTjYsCAZiZAQOYnJuanp6ao6OMAQSoqagAqq2s
            ramvq6iWp7AEsrC5rqqvlgOoBQIGxAcIxsi9t7OxtKaCw8QJCtQLDA0IidqKpqjE39YNDdcHysu5
            vozABN8GCeIMDA4MCOa36M6X3u0N8/MPBwbhWjawGYFagtol+AcBAsAIEiJsQ/TLW4KLBh44fPBg
            QkBBBe+Zq4UqgbuLDieo9Chwl72CFdldNLlyAoUKH1m5NMgMIYCZFy1UoCCUwgGIEiYeIkkAqIGb
            FC5IzRlS10h1FmdWkCoVA9UMBPEd7EZAQwINZjGo3cChQwcP/h9AyJ0LgpdBn2jNJtiwIcQGD247
            iBhBeAQJEiCUMj2L1kDfvoFLfDB8+HDdl+kErGNs1m8IEyVCwz18gsSJE5d5wiSbV4MBE7BBh5Z8
            +gQK24lBVs08QFDrBCmCp5gt+TYKFCpQgIAoMdHivMBXpFhB/ANyFCxUqMj9SixTDS3AJ1hBfoWL
            D+g/qGDx4gV77sx6kk3Qor6B6TBgpEfPPkYMFizAt1s+jqAVXgL5wSCDCPv9ByALM4BAySOW0GAh
            ePUlIMOGMqTH4AwAzgAiCDWUaMMNJ6J4Aw4sWpLDixiaJYMONKa3gwgi5hihhTTwwEMPQAbpgw+W
            /ABEDxgG/mEAjULo8MEOQ+zwQY5EFDGMEQYcgcSWXCbhZRKW8AAED+AF0UICOgih5gdRDjHlDEoo
            QYwRdC7BxBJ4NoGEE0k88USYP2pgZhAJqAkFFGwOMYQIcUYhxZx13pknEn0+MUWYPlAhaAtKHgrF
            AYlW8UGcSkRBpxFWWLFEE1e0egUSfk7xJyNU1CqomQkcoCuoVVTBwQdRBBtFqkUUYUWrWGCRRRZI
            aOHsFpbU6sOthOqKABcf+CpqFF10W+y3ymbhhRdfNOssGNGGIcatZ17LxRgfcCDvB12QUW8Z+JZh
            xRfkjusFEmY4e4Yl6q4bxMEGjKEwvNqKUC8aZOCbhr7+OXqhhhrNrrHGwIwUTG0CC8PLxsgfQAxx
            GW2kbMXFF7vhRsYbW/LGzDTXbPPNOOf8xiKk9Ozzzz8HAgA7
        }
    }
}

class dataStackedBarChart {
    proc dataStackedBarChart {this parentPath args} dataBarChart {$parentPath $args} {
        composite::configure $this -mode stacked
    }
    proc ~dataStackedBarChart {this} {}
    proc iconData {} {
        return {
            R0lGODdhKAAoAMYAAHt5e87PzgAAANbX1v///xAoCAAIADFhITFhGAAQAK33e6X3e5znc6Xvc5zn
            a5TXa5Tfazk4OUJJQozPY4THWnvHWoTPY3u+Wnu+UlI4ABAIABgQADEgAHNJACkgAO/XQvffSiEY
            AO/PQufHOee+Oda2MSEQAN6+Md62MVIIY86mKWsQe2sYe4wQpTkoAHMoe70o1qUYvbUYzrUg1gAY
            IQAQEBBphBBhe2sge944/60Yzq3X57Xf76XP53Mwe95B/+dJ/70Y3gAQGJTH3oy+1oS+zudR/2um
            vXOuxudZ/9YY984Y7wAgKedh/wAoOVKWrQAwQkKOpd4o/wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
            AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
            AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACwA
            AAAAKAAoAAAH/oAAgoOEhYaHiIMBAAKNjo+QkZKTjYsCAZiZAQOYnJuanp6ao6OMAQSoqagAqq2s
            ramvq6iWp7AEsrC5rqqvlgOoBQIGxAcIxsjHysnMy7i0poLDxAkK1gsMDdYK2NrX2dvdCIS1qMTn
            3Q3Z6evZ6g3sDQfPBL/m5wkN6gwO7gz8/gDq+9cPAb1yBM4Ra9Cv3wOGAB82ZCAx4oFB9aIBUJjA
            IQQIDzyCFBmS4scHByJIiADAXsIEMA08APngwYSZNW3irHmTps2LgjJeQpXAAMwEICconZB0aVOl
            TycAZeXSaMylEyhUwKqV69alWqcKXQTgKEwLFSigVZt2rdu2/nAppJQgoaUpokcNaKVwoe/evhf+
            +k0LWGxVsxUAX8CQGDBjxY8dG75LIIMGDRs4dNjMubPnz50x1hK04bIGDx9AqAaRWnVr1q0/vJbd
            IYJtu0MJmA7BQbbv38CD/+4gmhEwAiGSZxbxgXnz58yji5AOXQTxoAiTJ+cwYvqI7967i+hOfrz3
            8depGheknTf57+/fk4A/f/yI+bVX4rbVngOJ+SWU8N8IAgI4YIEGkpDeWKiYwMGDHJxQwgkUSljh
            hBZSOCGGEy6IEIQPTojCiCKiUGKAJJ5YgoeMOOIBiCYGWEKMM8ooI400dvCIJSn0COGLKgSowpBC
            BlkCkUQe/mmkCh2swMKTlrQgJYQueDDklVhmqSWWHbzgJQyWxCDDDDQMU4MBNtygpppprnlDm2vC
            uSYOXuZgiQ4y6EBMDXzuwMMOgPbgJ6A7CPpnoIMGesMLPvjww506zLBnn4cWmqillRpKaA+LNgrE
            nTAEwWcNQghR6BCoDnFqqqui2uoQN9D5wqOMBGFrqTTQIASqRBBRRBG8+grsEL3+GuyvnfpghCW2
            wpDrs8IecQQS0U5bLbW/SotEskkwq8QSTITLhBBITCutueVqa6666R4Rq5dNWPItuEw4Me65Rzzx
            BL768rvvufomGy8j8zIBxcFC6KtvFFEo/ATDDkOsMMMCFlsixcUYZ6zxxhx3LMUipIQs8sgjBwIA
            Ow==
        }
    }
}

set rcsId {$Id: datapie.tcl,v 1.14 1998/04/21 16:20:36 jfontain Exp $}

class dataPieChart {

    proc dataPieChart {this parentPath width height thickness args} composite {[new canvas $parentPath] $args} viewer {} {
        set path $widget::($this,path)

        set dataPieChart::($this,pie) [new pie $path 0 0 $width $height\
            -title {} -thickness $thickness -selectable 1\
            -labeler [new piePeripheralLabeler $path -font $font::(mediumNormal) -smallfont $font::(smallNormal)]\
        ]
        set dataPieChart::($this,slices) {}

        set dataPieChart::($this,drop) [new dropSite\
            -path $path -formats DATACELLS -command "viewer::view $this \$dragSite::data(DATACELLS)"\
        ]
        set dataPieChart::($this,drag) [new dragSite -path $path -validcommand "dataPieChart::validateDrag $this"]
        dragSite::provide $dataPieChart::($this,drag) OBJECTS "dataPieChart::dragData $this"
        dragSite::provide $dataPieChart::($this,drag) DATACELLS "dataPieChart::dragData $this"

        bind $path <Configure> "dataPieChart::resize $this"

        composite::complete $this
    }

    proc ~dataPieChart {this} {
        delete $dataPieChart::($this,pie) $dataPieChart::($this,drag) $dataPieChart::($this,drop)
    }

    proc options {this} {
        return [list\
            [list -height height Height 200]\
            [list -width width Width 300]\
        ]
    }

    foreach option {-height -width} {
        proc set$option {this value} "\$widget::(\$this,path) configure $option \$value"
    }

    proc dragData {this format} {
        switch $format {
            OBJECTS {
                if {[llength $dataPieChart::($this,selectedSlices)]>0} {
                    return $dataPieChart::($this,selectedSlices)
                } elseif {[llength $dataPieChart::($this,slices)]==0} {
                    return $this
                } else {
                    return {}
                }
            }
            DATACELLS {
                return [cellsFromSlices $this $dataPieChart::($this,selectedSlices)]
            }
        }
    }

    proc validateDrag {this x y} {
        set dataPieChart::($this,selectedSlices) [slice::selected $dataPieChart::($this,pie)]
        if {([llength $dataPieChart::($this,selectedSlices)]>0)||([llength $dataPieChart::($this,slices)]==0)} {
            return 1
        } else {
            return 0
        }
    }

    proc supportedTypes {this} {
        return {integer real}
    }

    proc monitorCell {this array row column} {
        viewer::registerTrace $this $array
        set cell ${array}($row,$column)
        if {[lsearch -exact [cellsFromSlices $this $dataPieChart::($this,slices)] $cell]>=0} return
        set slice [new slice $dataPieChart::($this,pie) [viewer::label $array $row $column]]
        lappend dataPieChart::($this,slices) $slice
        switched::configure $slice -deletecommand "dataPieChart::deletedSlice $this $array $slice"
        set dataPieChart::($this,cell,$slice) $cell
    }

    proc update {this array args} {
        set cells [cellsFromSlices $this $dataPieChart::($this,slices)]
        set sum 0.0
        foreach cell $cells {
            catch {set sum [expr {$sum+[set $cell]}]}
        }
        foreach slice $dataPieChart::($this,slices) cell $cells {
            if {[catch {set $cell} value]||($sum==0)} {
                slice::update $slice 0 ?
            } else {
                set value [expr {[set $cell]/$sum}]
                slice::update $slice $value "[format %.1f [expr {$value*100}]] %"
            }
        }
        resize $this
    }

    proc resize {this} {
        $widget::($this,path) configure -scrollregion [$widget::($this,path) bbox all]
    }

    proc deletedSlice {this array slice} {
        viewer::unregisterTrace $this $array
        ldelete dataPieChart::($this,slices) $slice
        unset dataPieChart::($this,cell,$slice)
        if {[llength $dataPieChart::($this,slices)]==0} {
            delete $this
        }
    }

    proc cellsFromSlices {this slices} {
        set cells {}
        foreach slice $slices {
            lappend cells $dataPieChart::($this,cell,$slice)
        }
        return $cells
    }
}

class dataPieChart {

    class slice {

        proc slice {this pie label args} switched {$args} {
            set ($this,pie) $pie
            set slice [pie::newSlice $pie $label]
            set ($this,slice) $slice
            set (this,$slice) $this
            switched::complete $this
        }

        proc ~slice {this} {
            pie::deleteSlice [set ($this,pie)] [set ($this,slice)]
            unset (this,[set ($this,slice)])
            if {[string length $switched::($this,-deletecommand)]>0} {
                uplevel #0 $switched::($this,-deletecommand)
            }
        }

        proc options {this} {
            return [list\
                [list -deletecommand {} {}]\
            ]
        }

        proc set-deletecommand {this value} {}

        proc update {this value string} {
            pie::sizeSlice [set ($this,pie)] [set ($this,slice)] $value $string
        }

        proc selected {pie} {
            set list {}
            foreach slice [pie::selectedSlices $pie] {
                lappend list [set (this,$slice)]
            }
            return $list
        }

    }

}

class data2DPieChart {

    proc data2DPieChart {this parentPath args} dataPieChart {$parentPath 160 160 0 -width 200 -height 220 $args} {}

    proc ~data2DPieChart {this} {}

    proc iconData {} {
        return {
            R0lGODdhKAAoAKUAAHt5e87PzgAAANbX1v///zFhIXNJAKX3e/ffSpznc+/XQozPY+fHOXvHWta2
            Mc6mKUJJQhBhe63X54y+1pTH3lKWrWumvVIIY2sYe4wQpb0o1qUYvbUYzq0Yzr0Y3t44/95B/+dJ
            /+dR/+dZ/9YY9+dh/94o/+9x/wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
            AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACwAAAAAKAAoAAAG/kCAcEgsGo/IYQAg
            aDqf0Kh02lwKAthsYIDlbrVer3Y8ZgYI6DQaoG6z2+n3Gm09wwlyeN6tflsHd3iBgoF5fmZJRAWL
            BQaOiUZ1hWiLB5YFCJkIjnxxdEyAdwCVlpeampxzngSSdwWlBwkJB5inCrcGqqp1R6+wsgu1t8MM
            DAZJf3C+lsALwcO3xdLHfZ9XbcuxCc4JDQXR0g7i4rmryWq+stsL698K0uHk1ayIQ8vq3c7e8PEO
            Dw/l8AhpRSmWtgYN9O0rNq7hv4CHBIQikK7ZOoQFGDb09+/hLjNpXqljl3ABQm8OO6oE+PGKvVj6
            TCpEubImQAhECL7iNvNk/iNHQIMGZRNxYgGeJk+ejCChadMJEqBSmDChQgSi1uxQPJBQqVKmTqE2
            nUrVglWs9CTaQ9jNK0KwTqNGpTrBbAScSkCGbOsWrty5dO0KIUSQotulT5/SLSsYbWHDff8uDty4
            ZZQCh+FOZlzBqhQrFy5gGD0as1emmzlbJc0ag5UMsGPDNv12AtnFFnJ3jsBag2/fVjZwEE6cQwfa
            ESbnXr6bdAcPHz5A/2Clg/Hr1jscLxBhuXfdVnmP7gCivHkQ1bWrX689QoTO8OG7Z00eRIj7+Ktr
            6LC/P4jnHniAgXsEEkhffeeZZ0WAIHjQoAggiCDhhB205px2E2aY4YIiQHgA4YcaasheiCSKsOAI
            KKao4oostuiiFSSUIOOMNNZo4404wojjjjzuaIUJJpwg5JBEFmnkkUcuQcaSTDbZZBAAOw==
        }
    }

}

class data3DPieChart {

    proc data3DPieChart {this parentPath args} dataPieChart {$parentPath 200 100 20 -width 250 -height 180 $args} {}

    proc ~data3DPieChart {this} {}

    proc iconData {} {
        return {
            R0lGODdhKAAoAKUAAHt5e87PzgAAANbX1v///zFhIXNJAKX3e/ffSu/XQufHOZznc9a2MY7PYc6m
            KRBhe63X55TH3oy+1lKWrUJJQk2SMDF5lFIIY2sYe4wQpb0o1qUYvbUYzr0Y3t44/60Yzt5B/+dJ
            /+dR/+dZ/9YY9+dh/94o/+9x/wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
            AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACwAAAAAKAAoAAAG/kCAcEgsGo/IYQAg
            aDqf0Kh02lwKAthsYIDlbrVer3Y8ZgYI6DQaoG6z2+n3Gm09wwlyeN6tflsHd3iBgoF5fmZJRAWL
            BQaOBolFdYMEjAeXBQiaCI99ngR/gYuXpAeZmwgJCo5zcXRmdwWlpAunmqoKCgwGhK11RrKzCwsN
            trm6DMmQR6FqwbTDDbWpx8jJu5+Tac8H0sQN4Jm51+QMDry+TIDb0N/fBdblDvPohL9Cz9HE+8Xy
            8//0JMFCEwwcP34FzAFcSC+dgHWVLumTBi7co4sYWdkbWCkaRXfgHkAYSXJkhAgQJEx44HAJvo8w
            Q5YkeTKChJsrKRDR1tFb/sWfImfWvKlSwgM2hx5uK/DzW8WgKYcSnaDy6MYrSyn+lGny5E2bRVda
            TTpgSIEKTLfKlOo17AMLD3Qq4XgWrdoGIonqpUr1LVykr7ASrEA4LVC9YYv6/XvVzuDChh8k5qvY
            guWjgEExgVIX8qIHlPk+GL0YbhQrFy5gWI2hM2HCpGOXtgyXtW0rGXLrzuAaNu3fwGuv1kCcuJUN
            HJAr57DodYXZwYVj6ODBA3UPVj5w0M6dA/PO0H+PZt0BhPnz2T+oX7++A6PwpG2fD0GffnYNH/Dr
            78CfPwbZ8dlW3nkEgmAFfyCU14EIIIjg4IO2sfYBeQ9WWOGBIizYYIMWPlYIAnsfcNihhQeOYOKJ
            KKao4oosWkFCCTDGKOOMNNZoo4s25qhjjlaYYMIJQAYp5JBEFlnkEmQkqeSSSwYBADs=
        }
    }

}


array set HMtag_map {
	b      {weight bold}
	blockquote	{style i indent 1 Trindent rindent}
	bq		{style i indent 1 Trindent rindent}
	cite   {style i}
	code   {family courier}
	dfn    {style i}	
	dir    {indent 1}
	dl     {indent 1}
	em     {style i}
	h1     {size 24 weight bold}
	h2     {size 22}		
	h3     {size 20}	
	h4     {size 18}
	h5     {size 16}
	h6     {style i}
	i      {style i}
	kbd    {family courier weight bold}
	menu     {indent 1}
	ol     {indent 1}
	pre    {fill 0 family courier Tnowrap nowrap}
	samp   {family courier}		
	strong {weight bold}		
	tt     {family courier}
	u	 {Tunderline underline}
	ul     {indent 1}
	var    {style i}	
}


array set HMtag_map {
	center {Tcenter center}
	strike {Tstrike strike}
	u	   {Tunderline underline}
}


set HMtag_map(hmstart) {
	family times   weight medium   style r   size 14
	Tcenter ""   Tlink ""   Tnowrap ""   Tunderline ""   list list
	fill 1   indent "" counter 0 adjust 0
}


array set HMinsert_map {
	blockquote "\n\n" /blockquote "\n"
	br	"\n"
	dd	"\n" /dd	"\n"
	dl	"\n" /dl	"\n"
	dt	"\n"
	form "\n"	/form "\n"
	h1	"\n\n"	/h1	"\n"
	h2	"\n\n"	/h2	"\n"
	h3	"\n\n"	/h3	"\n"
	h4	"\n"	/h4	"\n"
	h5	"\n"	/h5	"\n"
	h6	"\n"	/h6	"\n"
	li   "\n"
	/dir "\n"
	/ul "\n"
	/ol "\n"
	/menu "\n"
	p	"\n\n"
	pre "\n"	/pre "\n"
}


array set HMlist_elements {
	ol 1   ul 1   menu 1   dl 1   dir 1
}

proc HMinit_win {win} {
	upvar #0 HM$win var
	
	HMinit_state $win
	$win tag configure underline -underline 1
	$win tag configure center -justify center
	$win tag configure nowrap -wrap none
	$win tag configure rindent -rmargin $var(S_tab)c
	$win tag configure strike -overstrike 1
	$win tag configure mark -foreground red
	$win tag configure list -spacing1 3p -spacing3 3p
	$win tag configure compact -spacing1 0p
	$win tag configure link -borderwidth 2 -foreground blue
	HMset_indent $win $var(S_tab)
	$win configure -wrap word

	$win mark set $var(S_insert) 1.0

	$win tag configure thin -font [HMx_font times 2 medium r]
	$win tag configure hr -relief sunken -borderwidth 2 -wrap none \
		-tabs [winfo width $win]
	bind $win <Configure> {
		%W tag configure hr -tabs %w
		%W tag configure last -spacing3 %h
	}


	$win tag bind link <1> "HMlink_hit $win %x %y"
}


proc HMset_indent {win cm} {
	set tabs [expr $cm / 2.0]
	$win configure -tabs ${tabs}c
	foreach i {1 2 3 4 5 6 7 8 9} {
		set tab [expr $i * $cm]
		$win tag configure indent$i -lmargin1 ${tab}c -lmargin2 ${tab}c \
			-tabs "[expr $tab + $tabs]c [expr $tab + 2*$tabs]c"
	}
}


proc HMreset_win {win} {
	upvar #0 HM$win var
	regsub -all { +[^L ][^ ]*} " [$win tag names] " {} tags
	catch "$win tag delete $tags"
	eval $win mark unset [$win mark names]
	$win delete 0.0 end
	$win tag configure hr -tabs [winfo width $win]

	$win mark set $var(S_insert) 1.0

	catch unset [info globals HM$win.form*]

	HMinit_state $win
	return HM$win
}


proc HMinit_state {win} {
	upvar #0 HM$win var
	array set tmp [array get var S_*]
	catch {unset var}
	array set var {
		stop 0
		tags 0
		fill 0
		list list
		S_adjust_size 0
		S_tab 1.0
		S_unknown \xb7
		S_update 10
		S_symbols O*=+-o\xd7\xb0>:\xb7
		S_insert Insert
	}
	array set var [array get tmp]
}


array set HMparam_map {
	-update S_update
	-tab S_tab
	-unknown S_unknown
	-stop S_stop
	-size S_adjust_size
	-symbols S_symbols
    -insert S_insert
}

proc HMset_state {win args} {
	upvar #0 HM$win var
	global HMparam_map
	set bad 0
	if {[catch {array set params $args}]} {return 0}
	foreach i [array names params] {
		incr bad [catch {set var($HMparam_map($i)) $params($i)}]
	}
	return [expr $bad == 0]
}



proc HMrender {win tag not param text} {
	upvar #0 HM$win var
	if {$var(stop)} return
	global HMtag_map HMinsert_map HMlist_elements
	set tag [string tolower $tag]
	set text [HMmap_esc $text]

	if {[info exists HMlist_elements($tag)]} {
		set list "list [expr {[HMextract_param $param compact] ? "compact" : "list"}]"
	} else {
		set list ""
	}

	if {[info exists var(divert)]} {
		set win $var(divert)
		upvar #0 HM$win var
	}

	catch {HMstack $win $not "$HMtag_map($tag) $list"}

	set bad [catch {$win insert $var(S_insert) $HMinsert_map($not$tag) "space $var(font)"}]
	if {!$bad && [lindex $var(fill) end]} {
		set text [string trimleft $text]
	}

	if {[lindex $var(fill) end]} {
		set text [HMzap_white $text]
	}

	catch {HMmark $not$tag $win $param text} err

	catch {HMtag_$not$tag $win $param text} msg



	set tags [HMcurrent_tags $win]
	$win insert $var(S_insert) $text $tags

	if {!([incr var(tags)] % $var(S_update))} {
		update
	}
}



proc HMtag_hmstart {win param text} {
	upvar #0 HM$win var
	$win mark gravity $var(S_insert) left
	$win insert end "\n " last
	$win mark gravity $var(S_insert) right
}

proc HMtag_/hmstart {win param text} {
	$win delete last.first end
}


proc HMtag_title {win param text} {
	upvar $text data
	wm title [winfo toplevel $win] $data
	set data ""
}

proc HMtag_hr {win param text} {
	upvar #0 HM$win var
	$win insert $var(S_insert) "\n" space "\n" thin "\t" "thin hr" "\n" thin
}


proc HMtag_ol {win param text} {
	upvar #0 HM$win var
	set var(count$var(level)) 0
}

proc HMtag_ul {win param text} {
	upvar #0 HM$win var
	catch {unset var(count$var(level))}
}

proc HMtag_menu {win param text} {
	upvar #0 HM$win var
	set var(menu) ->
	set var(compact) 1
}

proc HMtag_/menu {win param text} {
	upvar #0 HM$win var
	catch {unset var(menu)}
	catch {unset var(compact)}
}
	
proc HMtag_dt {win param text} {
	upvar #0 HM$win var
	upvar $text data
	set level $var(level)
	incr level -1
	$win insert $var(S_insert) "$data" \
		"hi [lindex $var(list) end] indent$level $var(font)"
	set data {}
}

proc HMtag_li {win param text} {
	upvar #0 HM$win var
	set level $var(level)
	incr level -1
	set x [string index $var(S_symbols)+-+-+-+-" $level]
	catch {set x [incr var(count$level)]}
	catch {set x $var(menu)}
	$win insert $var(S_insert) \t$x\t "mark [lindex $var(list) end] indent$level $var(font)"
}


proc HMtag_a {win param text} {
	upvar #0 HM$win var


	if {[HMextract_param $param href]} {
		set var(Tref) [list L:$href]
		HMstack $win "" "Tlink link"
		HMlink_setup $win $href
	}


	if {[HMextract_param $param name]} {
		set var(Tname) [list N:$name]
		HMstack $win "" "Tanchor anchor"
		$win mark set N:$name "$var(S_insert) - 1 chars"
		$win mark gravity N:$name left
		if {[info exists var(goto)] && $var(goto) == $name} {
			unset var(goto)
			set var(going) $name
		}
	}
}


proc HMgoto {win where {callback HMwent_to}} {
	upvar #0 HM$win var
	if {[regexp N:$where [$win mark names]]} {
		$win see N:$where
		update
		eval $callback $win [list $where]
		return 1
	} else {
		set var(goto) $where
		return 0
	}
}


proc HMwent_to {win where {count 0} {color orange}} {
	upvar #0 HM$win var
	if {$count > 5} return
	catch {$win tag configure N:$where -foreground $color}
	update
	after 200 [list HMwent_to $win $where [incr count] \
				[expr {$color=="orange" ? "" : "orange"}]]
}

proc HMtag_/a {win param text} {
	upvar #0 HM$win var
	if {[info exists var(Tref)]} {
		unset var(Tref)
		HMstack $win / "Tlink link"
	}


	if {[info exists var(going)]} {
		$win yview N:$var(going)
		update
		HMwent_to $win $var(going)
		unset var(going)
	}

	if {[info exists var(Tname)]} {
		unset var(Tname)
		HMstack $win / "Tanchor anchor"
	}
}


proc HMtag_img {win param text} {
	upvar #0 HM$win var

	array set align_map {top top    middle center    bottom bottom}
	set align bottom
	HMextract_param $param align
	catch {set align $align_map([string tolower $align])}

	set alt "<image>"
	HMextract_param $param alt
	set alt [HMmap_esc $alt]

	set border 1
	HMextract_param $param border

	set item $win.$var(tags)
	if {[HMextract_param $param width] && [HMextract_param $param height]} {
		frame $item -width $width -height $height
		pack propagate $item 0
		set label $item.label
		label $label
		pack $label -expand 1 -fill both
	} else {
		set label $item
		label $label 
	}

	$label configure -relief ridge -fg orange -text $alt
	catch {$label configure -bd $border}
	$win window create $var(S_insert) -align $align -window $item -pady 2 -padx 2

	set tags [HMcurrent_tags $win]
	foreach tag $tags {
		$win tag add $tag $item
	}

	if {[HMextract_param $param ismap]} {
		set link [lindex $tags [lsearch -glob $tags L:*]]
		regsub L: $link {} link
		global HMevents
		regsub -all {%} $link {%%} link2
		foreach i [array names HMevents] {
			bind $label <$i> "catch \{%W configure $HMevents($i)\}"
		}
		bind $label <1> "+HMlink_callback $win $link2?%x,%y"
	} 

	set src ""
	HMextract_param $param src
	HMset_image $win $label $src
	return $label
}

proc HMset_image {win handle src} {
	HMgot_image $handle "can't get\n$src"
}


proc HMgot_image {win image_error} {
	if {[winfo name $win] == "label"} {
		pack propagate [winfo parent $win] 1
	}
	if {[catch {$win configure -image $image_error}]} {
		$win configure -image {}
		$win configure -text $image_error
	}
}


array set HMevents {
	Enter	{-borderwidth 2 -relief raised }
	Leave	{-borderwidth 2 -relief flat }
	1		{-borderwidth 2 -relief sunken}
	ButtonRelease-1	{-borderwidth 2 -relief raised}
}


proc HMlink_setup {win href} {
	global HMevents
	regsub -all {%} $href {%%} href2
	foreach i [array names HMevents] {
		eval {$win tag bind  L:$href <$i>} \
			\{$win tag configure \{L:$href2\} $HMevents($i)\}
	}
}


proc HMlink_hit {win x y} {
	set tags [$win tag names @$x,$y]
	set link [lindex $tags [lsearch -glob $tags L:*]]
	regsub L: $link {} link
	HMlink_callback $win $link
}


proc HMlink_callback {win href} {
	puts "Got hit on $win, link $href"
}


proc HMextract_param {param key {val ""}} {

	if {$val == ""} {
		upvar $key result
	} else {
		upvar $val result
	}
    set ws "    \n\r"
 
    if {
      [regsub -nocase [format {.*%s[%s]*=[%s]*"([^"]*).*} $key $ws $ws] $param {\1} value] ||
      [regsub -nocase [format {.*%s[%s]*=[%s]*'([^']*).*} $key $ws $ws] $param {\1} value] ||
      [regsub -nocase [format {.*%s[%s]*=[%s]*([^%s]+).*} $key $ws $ws $ws] $param {\1} value] } {
        set result $value
        return 1
    }

	
	set bad \[^a-zA-Z\]+
	if {[regexp -nocase  "$bad$key$bad" -$param-]} {
		return 1
	} else {
		return 0
	}
}



proc HMstack {win push list} {
	upvar #0 HM$win var
	array set tags $list
	if {$push == ""} {
		foreach tag [array names tags] {
			lappend var($tag) $tags($tag)
		}
	} else {
		foreach tag [array names tags] {
			set var($tag) [lreplace $var($tag) end end]
		}
	}
}


proc HMcurrent_tags {win} {
	upvar #0 HM$win var
	set font font
	foreach i {family size weight style} {
		set $i [lindex $var($i) end]
		append font :[set $i]
	}
	set xfont [HMx_font $family $size $weight $style $var(S_adjust_size)]
	HMset_font $win $font $xfont
	set indent [llength $var(indent)]
	incr indent -1
	lappend tags $font indent$indent
	foreach tag [array names var T*] {
		lappend tags [lindex $var($tag) end]
	}
	set var(font) $font
	set var(xfont) [$win tag cget $font -font]
	set var(level) $indent
	return $tags
}


proc HMset_font {win tag font} {
	catch {$win tag configure $tag -font $font} msg
}

proc HMx_font {family size weight style {adjust_size 0}} {
	catch {incr size $adjust_size}
	return "-*-$family-$weight-$style-normal-*-*-${size}0-*-*-*-*-*-*"
}


proc HMoptimize {} {
	regsub -all "\n\[ 	\]*#\[^\n\]*" [info body HMrender] {} body
	regsub -all ";\[ 	\]*#\[^\n]*" $body {} body
	regsub -all "\n\n+" $body \n body
	proc HMrender {win tag not param text} $body
}

proc HMparse_html {html {cmd HMtest_parse} {start hmstart}} {
	regsub -all \{ $html {\&ob;} html
	regsub -all \} $html {\&cb;} html
	set w " \t\r\n"
	proc HMcl x {return "\[$x\]"}
	set exp <(/?)([HMcl ^$w>]+)[HMcl $w]*([HMcl ^>]*)>
	set sub "\}\n$cmd {\\2} {\\1} {\\3} \{"
	regsub -all $exp $html $sub html
	eval "$cmd {$start} {} {} \{ $html \}"
	eval "$cmd {$start} / {} {}"
}

proc HMtest_parse {command tag slash text_after_tag} {
	puts "==> $command $tag $slash $text_after_tag"
}


proc HMzap_white {data} {
	regsub -all "\[ \t\r\n\]+" $data " " data
	return $data
}


proc HMmap_esc {text} {
	if {![regexp & $text]} {return $text}
	regsub -all {([][$\\])} $text {\\\1} new
	regsub -all {&#([0-9][0-9]?[0-9]?);?} \
		$new {[format %c [scan \1 %d tmp;set tmp]]} new
	regsub -all {&([a-zA-Z]+);?} $new {[HMdo_map \1]} new
	return [subst $new]
}


proc HMdo_map {text {unknown ?}} {
	global HMesc_map
	set result $unknown
	catch {set result $HMesc_map($text)}
	return $result
}


array set HMesc_map {
   lt <   gt >   amp &   quot \"   copy \xa9
   reg \xae   ob \x7b   cb \x7d   nbsp \xa0
}

array set HMesc_map {
	nbsp \xa0 iexcl \xa1 cent \xa2 pound \xa3 curren \xa4
	yen \xa5 brvbar \xa6 sect \xa7 uml \xa8 copy \xa9
	ordf \xaa laquo \xab not \xac shy \xad reg \xae
	hibar \xaf deg \xb0 plusmn \xb1 sup2 \xb2 sup3 \xb3
	acute \xb4 micro \xb5 para \xb6 middot \xb7 cedil \xb8
	sup1 \xb9 ordm \xba raquo \xbb frac14 \xbc frac12 \xbd
	frac34 \xbe iquest \xbf Agrave \xc0 Aacute \xc1 Acirc \xc2
	Atilde \xc3 Auml \xc4 Aring \xc5 AElig \xc6 Ccedil \xc7
	Egrave \xc8 Eacute \xc9 Ecirc \xca Euml \xcb Igrave \xcc
	Iacute \xcd Icirc \xce Iuml \xcf ETH \xd0 Ntilde \xd1
	Ograve \xd2 Oacute \xd3 Ocirc \xd4 Otilde \xd5 Ouml \xd6
	times \xd7 Oslash \xd8 Ugrave \xd9 Uacute \xda Ucirc \xdb
	Uuml \xdc Yacute \xdd THORN \xde szlig \xdf agrave \xe0
	aacute \xe1 acirc \xe2 atilde \xe3 auml \xe4 aring \xe5
	aelig \xe6 ccedil \xe7 egrave \xe8 eacute \xe9 ecirc \xea
	euml \xeb igrave \xec iacute \xed icirc \xee iuml \xef
	eth \xf0 ntilde \xf1 ograve \xf2 oacute \xf3 ocirc \xf4
	otilde \xf5 ouml \xf6 divide \xf7 oslash \xf8 ugrave \xf9
	uacute \xfa ucirc \xfb uuml \xfc yacute \xfd thorn \xfe
	yuml \xff
}



array set HMtag_map {
	textarea    {fill 0}
}



proc HMtag_isindex {win param text} {
	upvar #0 HM$win var

	set item $win.$var(tags)
	if {[winfo exists $item]} {
		destroy $item
	}
	frame $item -relief ridge -bd 3
	set prompt "Enter search keywords here"
	HMextract_param $param prompt
	label $item.label -text [HMmap_esc $prompt] -font $var(xfont)
	entry $item.entry
	bind $item.entry <Return> "$item.submit invoke"
	button $item.submit -text search -font $var(xfont) -command \
		[format {HMsubmit_index %s {%s} [HMmap_reply [%s get]]} \
		$win $param $item.entry]
	pack $item.label -side top
	pack $item.entry $item.submit -side left


	$win insert $var(S_insert) \n isindex
	HMwin_install $win $item
	$win insert $var(S_insert) \n isindex
	bind $item <Visibility> {focus %W.entry}
}


proc HMsubmit_index {win param text} {
	HMlink_callback $win ?$text
}


proc HMtag_form {win param text} {
	upvar #0 HM$win var

	set id HM$win.form$var(tags)
	upvar #0 $id form

	if {[info exists var(form_id)]} {
		puts "Missing end-form tag !!!! $var(form_id)"
		HMtag_/form $win {} {}
	}
	catch {unset form}
	set var(form_id) $id

	set form(param) $param
	set form(reset) ""
	set form(reset_button) ""
	set form(submit) ""
	set form(submit_button) ""
}


proc HMtag_/form {win param text} {
	upvar #0 HM$win var
	upvar #0 $var(form_id) form

	foreach name [array names form radio_*] {
		regsub radio_ $name {} name
		lappend form(submit) [list $name \$form(radio_$name)]
	}


	foreach item $form(reset_button) {
		$item configure -command $form(reset)
	}

	if {$form(submit_button) == ""} {
		HMinput_submit $win {}
	}


	foreach item $form(submit_button) {
		set submit $form(submit)
		catch {lappend submit $form(submit_$item)}
		$item configure -command  \
				[list HMsubmit_button $win $var(form_id) $form(param) \
				$submit]
	}

	unset form(reset) form(submit) form(reset_button) form(submit_button)
	unset var(form_id)
}


proc HMtag_input {win param text} {
	upvar #0 HM$win var

	set type text
	HMextract_param $param type
	set type [string tolower $type]
	if {[catch {HMinput_$type $win $param} err]} {
		puts stderr $err
	}
}


proc HMinput_text {win param {show {}}} {
	upvar #0 HM$win var
	upvar #0 $var(form_id) form

	HMextract_param $param name
	set item $win.input_text,$var(tags)
	set size 20; HMextract_param $param size
	set maxlength 0; HMextract_param $param maxlength
	entry $item -width $size -show $show

	set value ""; HMextract_param $param value
	$item insert 0 $value
		
	HMwin_install $win $item

	append form(reset) ";$item delete 0 end;$item insert 0 [list $value]"
	lappend form(submit) [list $name "\[$item get]"]

	if {$maxlength} {
		bindtags $item "[bindtags $item] max$maxlength"
		bind max$maxlength <KeyPress> "%W delete $maxlength end"
	}
}


proc HMinput_password {win param} {
	HMinput_text $win $param *
}


proc HMinput_checkbox {win param} {
	upvar #0 HM$win var
	upvar #0 $var(form_id) form

	HMextract_param $param name
	HMextract_param $param value

	set variable $var(form_id)(check_$var(tags))	
	set item $win.input_checkbutton,$var(tags)
	checkbutton $item -variable $variable -off {} -on $value -text "  "
	if {[HMextract_param $param checked]} {
		$item select
		append form(reset) ";$item select"
	} else {
		append form(reset) ";$item deselect"
	}

	HMwin_install $win $item
	lappend form(submit) [list $name \$form(check_$var(tags))]
}


proc HMinput_radio {win param} {
	upvar #0 HM$win var
	upvar #0 $var(form_id) form

	HMextract_param $param name
	HMextract_param $param value

	set first [expr ![info exists form(radio_$name)]]
	set variable $var(form_id)(radio_$name)
	set variable $var(form_id)(radio_$name)
	set item $win.input_radiobutton,$var(tags)
	radiobutton $item -variable $variable -value $value -text " "

	HMwin_install $win $item

	if {$first || [HMextract_param $param checked]} {
		$item select
		append form(reset) ";$item select"
	} else {
		append form(reset) ";$item deselect"
	}

}


proc HMinput_hidden {win param} {
	upvar #0 HM$win var
	upvar #0 $var(form_id) form
	HMextract_param $param name
	HMextract_param $param value
	lappend form(submit) [list $name $value]
}


proc HMinput_image {win param} {
	upvar #0 HM$win var
	upvar #0 $var(form_id) form
	HMextract_param $param name
	set name
	set item [HMtag_img $win $param {}]
	$item configure -relief raised -bd 2 -bg blue


	set submit $win.dummy_submit,$var(tags)
	if {[winfo exists $submit]} {
		destroy $submit
	}
	button $submit	-takefocus 0
	lappend form(submit_button) $submit
	set form(submit_$submit) [list $name $name.\$form(X).\$form(Y)]
	
	$item configure -takefocus 1
	bind $item <FocusIn> "catch \{$win see $item\}"
	bind $item <1> "$item configure -relief sunken"
	bind $item <Return> "
		set $var(form_id)(X) 0
		set $var(form_id)(Y) 0
		$submit invoke	
	"
	bind $item <ButtonRelease-1> "
		set $var(form_id)(X) %x
		set $var(form_id)(Y) %y
		$item configure -relief raised
		$submit invoke	
	"
}


proc HMinput_reset {win param} {
	upvar #0 HM$win var
	upvar #0 $var(form_id) form

	set value reset
	HMextract_param $param value

	set item $win.input_reset,$var(tags)
	button $item -text [HMmap_esc $value]
	HMwin_install $win $item
	lappend form(reset_button) $item
}


proc HMinput_submit {win param} {
	upvar #0 HM$win var
	upvar #0 $var(form_id) form

	HMextract_param $param name
	set value submit
	HMextract_param $param value
	set item $win.input_submit,$var(tags)
	button $item -text [HMmap_esc $value] -fg blue
	HMwin_install $win $item
	lappend form(submit_button) $item
	catch {set form(submit_$item) [list $name $value]}
}


proc HMtag_select {win param text} {
	upvar #0 HM$win var
	upvar #0 $var(form_id) form

	HMextract_param $param name
	set size 5;  HMextract_param $param size
	set form(select_size) $size
	set form(select_name) $name
	set form(select_values) ""
	if {[HMextract_param $param multiple]} {
		set mode multiple
	} else {
		set mode single
	}
	set item $win.select,$var(tags)
    frame $item
    set form(select_frame) $item
	listbox $item.list -selectmode $mode -width 0 -exportselection 0
	HMwin_install $win $item
}


proc HMtag_option {win param text} {
	upvar #0 HM$win var
	upvar #0 $var(form_id) form
	upvar $text data
	set frame $form(select_frame)

	if {[HMextract_param $param selected]} {
        lappend form(select_default) [$form(select_frame).list size]
    }
    set value [string trimright $data " \n"]
    $frame.list insert end $value
	HMextract_param $param value
	lappend form(select_values) $value
	set data ""
}
 

proc HMtag_/select {win param text} {
	upvar #0 HM$win var
	upvar #0 $var(form_id) form
	set frame $form(select_frame)
	set size $form(select_size)
	set items [$frame.list size]

	append form(reset) ";$frame.list selection clear 0  $items"
	if {[info exists form(select_default)]} {
		foreach i $form(select_default) {
			$frame.list selection set $i
			append form(reset) ";$frame.list selection set $i"
		}
	} else {
		$frame.list selection set 0
		append form(reset) ";$frame.list selection set 0"
	}


	for {set i 0} {$i < $size} {incr i} {
		set value [format {[expr {[%s selection includes %s] ? {%s} : {}}]} \
				$frame.list $i [lindex $form(select_values) $i]]
		lappend form(submit) [list $form(select_name) $value]
	}
	

	if {$size > 1 && $items <= $size} {
		$frame.list configure -height $items
		pack $frame.list


	} elseif {$size > 1} {
		scrollbar $frame.scroll -command "$frame.list yview"  \
				-orient v -takefocus 0
		$frame.list configure -height $size \
			-yscrollcommand "$frame.scroll set"
		pack $frame.list $frame.scroll -side right -fill y


	} else {
		scrollbar $frame.scroll -command "$frame.list yview"  \
			-orient h -takefocus 0
		$frame.list configure -height 1 \
			-yscrollcommand "$frame.scroll set"
		pack $frame.list $frame.scroll -side top -fill x
	}


	foreach i [array names form select_*] {
		unset form($i)
	}
}


proc HMtag_textarea {win param text} {
	upvar #0 HM$win var
	upvar #0 $var(form_id) form
	upvar $text data

	set rows 5; HMextract_param $param rows
	set cols 30; HMextract_param $param cols
	HMextract_param $param name
	set item $win.textarea,$var(tags)
	frame $item
	text $item.text -width $cols -height $rows -wrap none \
			-yscrollcommand "$item.scroll set" -padx 3 -pady 3
	scrollbar $item.scroll -command "$item.text yview"  -orient v
	$item.text insert 1.0 $data
	HMwin_install $win $item
	pack $item.text $item.scroll -side right -fill y
	lappend form(submit) [list $name "\[$item.text get 0.0 end]"]
	append form(reset) ";$item.text delete 1.0 end; \
			$item.text insert 1.0 [list $data]"
	set data ""
}


proc HMwin_install {win item} {
	upvar #0 HM$win var
	$win window create $var(S_insert) -window $item -align bottom
	$win tag add indent$var(level) $item
	set focus [expr {[winfo class $item] != "Frame"}]
	$item configure -takefocus $focus
	bind $item <FocusIn> "$win see $item"
}


proc HMsubmit_button {win form_id param stuff} {
	upvar #0 HM$win var
	upvar #0 $form_id form
	set query ""
	foreach pair $stuff {
		set value [subst [lindex $pair 1]]
		if {$value != ""} {
			set item [lindex $pair 0]
			lappend query $item $value
		}
	}
	HMsubmit_form $win $param $query
}


proc HMsubmit_form {win param query} {
	set result ""
	set sep ""
	foreach i $query {
		append result  $sep [HMmap_reply $i]
		if {$sep != "="} {set sep =} {set sep &}
	}
	puts $result
}

 
set HMalphanumeric	a-zA-Z0-9
for {set i 1} {$i <= 256} {incr i} {
    set c [format %c $i]
    if {![string match \[$HMalphanumeric\] $c]} {
        set HMform_map($c) %[format %.2x $i]
    }
}

array set HMform_map {
    " " +   \n %0d%0a
}

 
proc HMmap_reply {string} {
    global HMform_map HMalphanumeric
    regsub -all \[^$HMalphanumeric\] $string {$HMform_map(&)} string
    regsub -all \n $string {\\n} string
    regsub -all \t $string {\\t} string
    regsub -all {[][{})\\]\)} $string {\\&} string
    return [subst $string]
}



proc HMcgiDecode {data} {
	set data [split $data "&="]
	foreach i $data {
		lappend result [cgiMap $i]
	}
	return $result
}

proc HMcgiMap {data} {
	regsub -all {\+} $data " " data
	
	if {[regexp % $data]} {
		regsub -all {([][$\\])} $data {\\\1} data
		regsub -all {%([0-9a-fA-F][0-9a-fA-F])} $data  {[format %c 0x\1]} data
		return [subst $data]
	} else {
		return $data
	}
}


auto_load tkFocusOK
proc tkFocusOK w {
    set code [catch {$w cget -takefocus} value]
    if {($code == 0) && ($value != "")} {
    if {$value == 0} {
        return 0
    } elseif {$value == 1} {
        return 1
    } else {
        set value [uplevel #0 $value $w]
        if {$value != ""} {
        return $value
        }
    }
    }
    set code [catch {$w cget -state} value]
    if {($code == 0) && ($value == "disabled")} {
    return 0
    }
    regexp Key|Focus "[bind $w] [bind [winfo class $w]]"
}
set htmlHelpContents {
<UL>
<LI>
<A HREF="#about">About this document</A></LI>

<LI>
<A HREF="#introduction">Introduction</A></LI>

<LI>
<A HREF="#required">Required software</A></LI>

<LI>
<A HREF="#architecture">Architecture</A></LI>

<LI>
<A HREF="#core">Core</A></LI>

<UL>
<LI>
<A HREF="#userinterface">User interface</A></LI>

<UL>
<LI>
<A HREF="#draganddrop">drag and drop</A></LI>

<UL>
<LI>
<A HREF="#dropsites">drop sites</A></LI>

<LI>
<A HREF="#dragsites">drag sites</A></LI>
</UL>
</UL>

<LI>
<A HREF="#commandline">Command line</A></LI>
</UL>

<LI>
<A HREF="#modules">Modules</A></LI>

<UL>
<LI>
<A HREF="#source">source</A></LI>

<UL>
<LI>
<A HREF="#namespace">namespace</A></LI>

<LI>
<A HREF="#configuration">configuration</A></LI>

<LI>
<A HREF="#variabledata">variable data</A></LI>
</UL>

<LI>
<A HREF="#installation">installation</A></LI>
</UL>

<LI>
<A HREF="#future">Future developments</A></LI>

<LI>
<A HREF="#misc">Miscellaneous information</A></LI>
</UL>
</BODY>
</HTML>
}
set htmlHelpData {
<BODY>
<HTML>
<H3>
<A NAME="about"></A>About this document</H3>
This document contains general information, reference information and examples
designed to help the user understand the moodss application and the programmer
write modules for it.
<H3>
<A NAME="introduction"></A>Introduction</H3>
Quite often, one needs to monitor changing data, whether it might come
from a system, such as the different processes running on a Unix server,
or from a network, such as the kind and volume of traffic that runs through
it.

<P>Most often, such data can be organized in a table with rows of information,
each column representing a different type of data. For example, in the
case of processes running on a system, rows might be sorted according to
their unique process identifier, and columns might represent such values
as CPU usage, memory usage, owner's name, time of creation, ...

<P>The software used to view this type of information comes in different
forms and shapes. Unix users might be familiar with the "top" application
which presents rows of process data as lines of text, whereas RMON (Remote
MONitoring) SNMP software usually uses multiple windows with graphical
displays, curves, pie charts, multiple configuration dialog boxes, even
3D visualization modules to present network traffic, connection matrices,
...

<P>In most cases, data comes from one or several tables. A common interface,
graphical with menus, drag'n'drop capability, table widgets and graphical
data viewers such as multiple line graphs, bar and pie charts, could be
used. The user could then sort table rows, select one or more cells, rows,
columns, to launch viewers such as other tables, charts, ... best suited
to the way data should be presented. In effect, what is needed is a spreadsheet
that is capable of dealing with dynamically changing data.

<P>Moodss (Modular Object Oriented Dynamic SpreadSheet) is an attempt at
answering these needs. It is composed of a main part (the core) and an
unlimited number of modules, each module interfacing to a specific type
of data. The core is written in the great Tcl language (<A HREF="http://sunscript.sun.com/">http://sunscript.sun.com/</A>
or <A HREF="http://www.scriptics.com/">http://www.scriptics.com/</A> )
using object oriented techniques thanks to the stooop and scwoop packages
(<A HREF="http://www.mygale.org/~jfontain/">http://www.mygale.org/~jfontain/</A>).
The module function is to describe the type of data that it is also in
charge of retrieving and formatting when asked by the core. Modules can
be written in plain Tcl and optionally use dynamically linked libraries
written in the C language (modules are packages in the Tcl sense).

<P>Modules are loaded when moodss is started. One or more modules can be
handled concurrently (new feature of version 3.0). Module names are specified
in the command line and cannot be unloaded.

<P>As features are added to moodss, different ways of viewing data will
be made available while the modules will stay the same. The goal of moodss
is to become a nice feature packed generic way of viewing data. Moodss
can be used to monitor any type of data, since the simplest cases can fit
in a table with a single row.

<P>As moodss is written in Tcl and uses well supported extensions (Tktable
and BLT), it will run on most Tcl/Tk supported platforms: UNIX and Windows
(I do not know if Tktable and BLT are available for the MacIntosh). Some
modules may be specific to a platform, but the core is guaranteed to run
on them all.

<P>After reading and understanding this document, you should be able to
write your own modules in order to monitor the data that you are interested
in.

<P>Moodss is free software. You can redistribute it and/or modify it under
the terms of a BSD type license: please see the COPYRIGHT file or use the
main window About help menu for more information.
<H3>
<A NAME="required"></A>Required software</H3>
For the current version (3.0), the following packages must be installed
before attempting to install moodss (make sure to check the INSTALL file
for the latest information):
<UL>
<LI>
Tcl/Tk version 8.0 or above (at <A HREF="http://sunscript.sun.com/">http://sunscript.sun.com/</A>)</LI>

<LI>
tkTable version 1.8 or above (at <A HREF="http://www.cs.uoregon.edu/research/tcl/">http://www.cs.uoregon.edu/research/tcl/</A>)<B>*</B></LI>

<LI>
the BLT library for Tcl/Tk 8.0 (<A HREF="ftp://ftp.neosoft.com/pub/tcl/sorted/devel/blt8.0p2-unoff">ftp://ftp.neosoft.com/pub/tcl/sorted/devel/blt8.0p2-unoff.tgz</A>)<B>*</B></LI>
</UL>

<DIV ALIGN=right><B>*</B><I> many thanks to the authors for these great
packages</I></DIV>
&nbsp
<BR>The stooop library and required scwoop and pie widgets are included
in the self-contained <I>moodss</I> file. Therefore, it is not required
to install the stooop, scwoop and tkpiechart packages, unless you want
to work on the moodss source code itself. However, should you want to get
more information on those extensions, you could find the latest versions
at:
<UL>
<LI>
stooop version 3.5.1 or above (at <A HREF="http://www.mygale.org/~jfontain/">http://www.mygale.org/~jfontain/</A>)</LI>

<LI>
scwoop version 2.2 or above (at <A HREF="http://www.mygale.org/~jfontain/">http://www.mygale.org/~jfontain/</A>)</LI>

<LI>
tkpiechart version 4.2 or above (at <A HREF="http://www.mygale.org/~jfontain/">http://www.mygale.org/~jfontain/</A>)</LI>
</UL>

<H3>
<A NAME="architecture"></A>Architecture</H3>
The moodss application is composed of the core software and one or several
modules. Modules are implemented as Tcl packages and thus usually comprise
a Tcl source file and a pkgIndex.tcl file required by the Tcl package implementation.

<P>The core will load one or more modules, whose names were passed as command
line parameters and will start displaying module data in one or more tables.
The tables are then updated at the frequency defined by the poll time,
which the user may change. For example, to launch moodss with the random
module, just type:
<PRE>$ wish moodss random</PRE>
All the module code and data are kept in a separate namespace. The module
data is stored is a single array including some configuration data used
when the module is loaded by the core, and variable data (displayed in
the application table and eventual graphical viewers) which the module
must update when requested by the core.

<P>The initial data tables represent the first data views, from which cells
can be selected and when dropped through a drag'n'drop operation into a
graph, bar chart or pie chart iconic site, result in the creation of graphical
data viewers. In turn, these viewers can display more table cells, which
when dropped into the graphical viewer, result in the creation of corresponding
data graph lines, bars, or slices.

<P>Any draggable data can be dropped in valid drop sites at any time. It
is thus possible to drag several data cells from any viewer into other
ones, the trash, ... even if the data comes from different modules.

<P>All data viewers can be moved and resized at will through a simple internal
window manager.
<H3>
<A NAME="core"></A>Core</H3>

<H4>
<A NAME="userinterface"></A>User interface</H4>
Soon after the application launch, tabular data is displayed in one or
more tkTable widgets with automatic scroll bars, between the menu bar,
the drop sites with graphical viewers and trash icons and a message area,
as one can see below:
<BR>&nbsp
<CENTER><IMG SRC="moodss1.jpg" ALT="moodss initial main window view" HEIGHT=506 WIDTH=620></CENTER>


<P>The message area is used to display status information, such as when
the data is being updated, and help information, as the user moves the
mouse pointer over sensitive areas, such as table column headers. Further
help is provided through widget tips (also known as balloons) when appropriate,
and of course the Help menu.

<P>The window title shows the name of the current module along with the
poll time.

<P>The <I>File</I> menu only contains the <I>Exit</I> menu entry, used
to gracefully quit the moodss application.

<P>The <I>Options</I> menu contains the <I>Poll time</I> entry which when
selected launches the corresponding dialog box, as shown below:
<BR>&nbsp
<CENTER><IMG SRC="moodss2.jpg" ALT="poll time dialog box" HEIGHT=225 WIDTH=228></CENTER>


<P>The user can select a new poll time among the module choices from a
spin entry widget, or directly type in a new value, as long as it is not
smaller than the module minimum poll time, in which case a message dialog
box warns the user.

<P>Table data can be sorted at any time by simply clicking on a column
title. Clicking on the same column title again sorts the data in opposite
order, thus toggling between increasing and decreasing orders.
<BR>When sorting, the selected column is used as a reference, meaning that
all rows will be rearranged so that the selected column appears sorted,
with values either increasing or decreasing.
<BR>The reference column for sorting always appear in a darker shade of
gray.

<P>Aside from the main tables, graphical viewers can be created for viewing
table cell data behavior over time. Viewers can also be deleted, data views
(such as pie slices, curves, ...) can be added or removed from existing
viewers, ... These functions are all implemented using the drag and drop
functionality described below.

<P>Graphical viewers available at this time are BLT graph viewers (such
as can be seen below), side-by-side bars charts, stacked bars charts, 2D
pie charts and 3D pie charts*.

<P>*<I>note: if you know of any other nice viewers (like 3D graphs) that
work with Tcl, please let me know so I can integrate them. Many thanks
in advance...</I>
<CENTER>
<H5>
<IMG SRC="moodss3.jpg" ALT="moodss window with graph data viewers" HEIGHT=656 WIDTH=682></H5></CENTER>
All data viewers can be moved and resized thanks to handling areas in the
data viewer borders. When moving the mouse pointer over these areas, the
mouse cursor changes to indicate the available action. Corner handles allow
resizing in both x and y axis. Handles in the middle of the sides allow
resizing in either the x or y axis direction. All other areas can be used
for moving the data viewer. Clicking on any part of the border changes
the stacking order: the viewer being clicked on either goes below (eventually
becomes hidden) the other viewers, or becomes fully visible (on top, eventually
hiding other viewers). Further description of this small window manager
functionality is useless, as it behaves like a standard window manager
(let me know if it does not).

<P>The <I>Help</I> menu contains <I>Global</I> help (actually launches
an embedded HTML viewer with this very document), <I>Modules</I> help,
and <I>About</I> general information entries.
<H5>
<A NAME="draganddrop"></A>Drag and drop</H5>
Drag and drop in moodss tries to behave as the familiar Windows functionality
(no, it doesn't mean I am a Bill Gates fan :). For example, to create a
cell graphical plot, one must place the mouse pointer over a data cell
in the main table, hold down the first mouse button (the left one for a
right handed user) while dragging over to the left-most icon below the
menu bar (when dragging an object, as the mouse pointer passes over possible
drop sites, they are highlighted with a thin black surrounding border for
user feedback). Releasing the mouse button at this time results in the
creation of a BLT graph viewer.

<P>Only valid drop sites for the data being dragged are highlighted when
the mouse cursor passes over them, thus guaranteeing error free operations.

<P>In summary, data cells can be dragged from any data table or any viewer
into any viewer icon, any viewer or the trash can.
<H6>
<A NAME="dropsites"></A>Drop sites</H6>
All icons right below the menu bar are valid drop sites for data cells
(several may be dropped at the same time). From left to right:
<UL>
<LI>
graph viewer with one or more data curves created at once</LI>

<LI>
side by side bar chart with one or more data bars created at once</LI>

<LI>
stacked bar chart with one or more data bars created at once</LI>

<LI>
2D pie chart with one or more data slices created at once</LI>

<LI>
3D pie chart with one or more data slices created at once</LI>

<LI>
object trash with one or more data viewers deleted at once</LI>
</UL>
For example, a graph viewer with 1 curve is created by dropping a data
cell into the graph viewer icon.

<P>Once a viewer exists, it also acts as a drop site for data cells, which
may be dragged from any data table or other viewers. Dropping one or more
cells directly in the viewer results in corresponding lines, bars or slices
being created and automatically updated. Each new graphical element is
assigned a new and different color.

<P>You may delete one or more graphical viewer elements (graph lines, bar
chart bars or pie charts slices) from a graphical viewer by selecting them
(using the first mouse button) through their labels. Several elements can
be selected by depressing the control key as the first mouse button is
pressed. The selection can also be extended by depressing the shift key
along with the first mouse button. The pie slices can also be directly
selected by clicking on the slices themselves.
<BR>Then dragging from the viewer to the trash drop site (the bullet hole)
on the upper right side of the main window and releasing the first mouse
button result in the corresponding viewer elements to be destroyed. If
there are no remaining lines, the graphical viewer itself (graph, bar chart
or pie) is destroyed.
<H6>
<A NAME="dragsites"></A>Drag sites</H6>
A data table is obviously a drag site. At the moment, only one cell can
be dragged at once.

<P>Any graphical viewer is also a drag site. It requires selecting one
or more graphical viewer elements before initiating the drag operation
from any point in the viewer. If there are no selected elements, dragging
is impossible: the mouse cursor is not changed into the drag circular cursor.
<H4>
<A NAME="commandline"></A>Command line</H4>
Launching moodss is very simple: just pass one or more data module names
as parameters, as in:
<PRE>$ wish moodss random</PRE>
or, for 2 modules at once:
<PRE>$ wish moodss ps cpustats</PRE>
You may eventually specify a poll time in seconds using:
<PRE>$ wish moodss -update 25 random</PRE>

<H3>
<A NAME="modules"></A>Modules</H3>
All examples are drawn from the <I>random</I> sample module.
<H4>
<A NAME="source"></A>source</H4>
Since a module is a package, it must have a name in the Tcl sense. For
example, at the beginning of the <I>random.tcl</I> file, one can find the
following statement:
<PRE>package provide random 1.1</PRE>
This line simply states that this is the <I>1.1</I> version of the <I>random</I>
package. Please note that the package name must also be used as the module
namespace name (see below).
<H5>
<A NAME="namespace"></A>namespace</H5>
All module procedures and data are kept in a specific namespace bearing
the module name. For example (from the <I>random.tcl</I> source file):
<PRE>namespace eval random {
&nbsp;&nbsp;&nbsp; array set data {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ...
&nbsp;&nbsp;&nbsp; }
&nbsp;&nbsp;&nbsp; proc update {} {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ...
&nbsp;&nbsp;&nbsp; }
}</PRE>

<H5>
<A NAME="configuration"></A>configuration</H5>
The module configuration defines the data table column headers, help information,
... This data never changes during the lifetime of the application.

<P>All the module configuration data is stored as array members of the
array named <I>data</I> within the module namespace. For example:
<PRE>namespace eval random {
&nbsp;&nbsp;&nbsp; array set data {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; updates 0
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; 0,label name 0,type ascii 0,message {user name}
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; 1,label cpu 1,type real 1,message {cpu usage in percent}
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; 2,label disk 2,type integer 2,message {disk usage in megabytes}
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; 3,label command 3,type dictionary 3,message {most time consuming command}
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; pollTimes {10 5 20 30 60 120 300}
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; columns 4
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; sort {1 decreasing}
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; indexColumns {0 3}
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; helpText {
This is a simple demonstration module ...
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; }
&nbsp;&nbsp;&nbsp; }
&nbsp;&nbsp;&nbsp; ...
}</PRE>
The <I>updates</I> member is a counter used to keep track of the number
of times that the module data was updated, and is also used by the core
to detect when module data display should be updated (see <A HREF="#variabledata">variable
data</A> for more information).

<P>The <I>columns</I> member defines the number of columns in the table
to be displayed by the core.

<P>The <I>n,label</I> members define the text to be displayed as column
titles. There must be as many <I>n,label</I> members as they are columns.
<BR>The <I>n,type</I> members define the type of the corresponding column
data. Valid types are simply those that the Tcl <I>lsort</I> command can
handle: <I>ascii</I>, <I>dictionary</I>, <I>integer</I> and <I>real</I>.
There must be as many <I>n,type</I> members as they are columns.
<BR>The <I>n,message</I> members define the text of the help message to
be displayed in the message area (see <A HREF="#architecture">User Interface</A>)
as the user moves the mouse pointer over column titles. It should be composed
of only a few words, just enough to actually help the user understand what
the column data means. There must be as many <I>n,message</I> members as
they are columns.
<BR>Note that column numbers start at 0.

<P>The <I>pollTimes</I> member is a list of valid poll times (in seconds)
for the module. The list need not be ordered, as its first element represents
the default poll time value to be used when the moodss application starts.
This value may be overridden by a command line argument. The smallest value
in the list is used by the core as the lowest possible poll time and checked
against when the user enters a new value through the poll time dialog box.
The list must not be empty.
<BR>Note that the list is also used by moodss as a set of possible choices
in the dialog box used to set the new poll time. The user may still directly
input any value as long as it is greater than or equal to the minimum value.

<P>The <I>sort</I> list defines the index of the column which should be
initially used as a reference for sorting the data table rows, and in which
order (<I>increasing</I> or <I>decreasing</I>) the rows should be sorted.
The column index for sorting works like the <I>-index</I> Tcl <I>lsort</I>
command option, that is rows are sorted so that that specific column appears
sorted in the specified order.

<P>The <I>indexColumns</I> list specifies the columns required to uniquely
identify a row in the table. In database talk, it represents the table
key. To maintain backward compatibility, it is optional and defaults to
0, the leftmost column. The index columns are used when creating data viewer
elements: their label is built by concatenating the key value for the cell
row with the cell column title. The key value is the concatenation of the
index column values for the cell.

<P>The <I>helpText</I> member specifies a text of any length, to be displayed
when the user requests help information on the current module from within
the help menu.
<H5>
<A NAME="variabledata"></A>variable data</H5>
The tabular data (variable data) that the module code must update is stored
in the same <I>data</I> array as the module configuration data.

<P>The core invokes the module <I>update</I> procedure (which obviously
must exist) when it is time to refresh the data display (tables and eventually
graphical viewers). At this time, the update procedure may update the tabular
data straight away (synchronous operation) or launch a request for later
data update (asynchronous operation).

<P>It actually does not matter when the data is updated. The core will
know that fresh data is available when the <I>updates</I> array member
is set (actually incremented as it also serves as a counter for the number
of updates so far).
<BR>It is the module programmer's responsibility to increment this counter
right after all tabular data has been updated.

<P>For example, retrieving information for the processes running on a machine
is a local operation that can be achieved in a reasonably small amount
of time. In such a case, data would be updated immediately and the <I>updates</I>
variable incremented at the same time.
<BR>But if the data has to be retrieved from across a network, waiting
for it to come back would cause a delay that the user would certainly notice,
as the application would not respond to mouse or keyboard input during
the whole time that it would take to fetch the whole data. In such cases,
it is easier to let the update procedure return immediately without setting
the <I>updates</I> variable, which would be incremented at a later time,
only when the data would become available. For example, when waiting for
data to come across a network connection, the Tcl <I>fileevent</I> command
could be used on a non blocking channel, where the script to be evaluated
when the channel becomes readable would increment the <I>updates</I> array
member.
<BR>Thus, data update can occur synchronously or asynchronously.

<P>For example:
<PRE>namespace eval random {
&nbsp;&nbsp;&nbsp; ...
&nbsp;&nbsp;&nbsp; proc update {} {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; variable data
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; array set data "
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; 0,0 john&nbsp;&nbsp;&nbsp; 0,1 1234 0,2 4567 0,3 cc
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; 1,0 william 1,1 8901 1,2 2345 1,3 xedit
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; 2,0 anny&nbsp;&nbsp;&nbsp; 2,1 6789 2,2 0123 2,3 ps
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; 4,0 peter&nbsp;&nbsp; 4,1 4567 4,2 8901 4,3 ls
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; 6,0 laura&nbsp;&nbsp; 6,1 2345 6,2 6789 6,3 emacs
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; 3,0 robert&nbsp; 3,1 1234 3,2 5678 3,3 top
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; "
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; incr data(updates)
&nbsp;&nbsp;&nbsp; }
}</PRE>
The tabular data array index is the <I>row</I> number followed by the <I>column</I>
number separated by a <I>comma</I>. The column number must start from 0
up to the total number of columns minus 1 (no holes are allowed in the
column sequence).
<BR>The row number can take any integer value and be defined in any order,
as long as it is unique during the lifetime of the module data. If a new
row is created, it must take a value that was never used: the index of
a row that has disappeared cannot be reused. Row numbers need not be consecutive.

<P>When all rows (or only those table cells that have changed) have been
updated, the <I>updates</I> member array must be incremented so that the
core knows that it can update the table data display.
<H4>
<A NAME="installation"></A>installation</H4>
A module is a package in the Tcl sense. When writing a module, you must
then provide a <I>pkgIndex.tcl</I> file along with the module code file.
The <I>pkgIndex.tcl</I> file is very simple, as the following example shows:
<PRE>package ifneeded random 1.0 "source [file join $dir random.tcl]"</PRE>
The line above says that if the <I>random</I> package is needed, the Tcl
core should source the <I>random.tcl</I> module source code from the directory
where it was installed. <I>1.0</I> is the version number for the package.

<P>Modules can be installed at any valid place that the Tcl core allows
(look at the <I>pkg_mkIndex</I> manual page for more information).

<P>When you unpack moodss, you will find the sample modules in sub-directories.
The current directory (.) is appended to the <I>auto_load</I> global list
variable so that sample modules can be found when moodss is run from the
unpacking directory.

<P>For example, if you unpacked moodss in <I>/home/joe/moodss-3.0/</I>,
you will find the random module package in <I>/home/joe/moodss-3.0/random/</I>
so that the following will work:
<PRE>$ cd /home/joe/moodss-3.0/
$ wish moodss random</PRE>
You can install your new modules in the default location: <I>/usr/local/lib/</I>
on Unix. For example, if you move the files in <I>/home/joe/moodss-3.0/random/</I>
to <I>/usr/local/lib/random/</I>, moodss (actually Tcl :) will still be
able to find the <I>random</I> module (again, look at the <I>pkg_mkIndex</I>
manual page for more information).

<P>Please take a look at the INSTALL file for the latest information on
how to install the moodss application itself.
<H3>
<A NAME="future"></A>Future developments</H3>
The following features will eventually be added to the core:
<UL>
<LI>
resizable pies</LI>

<LI>
more Linux modules</LI>

<LI>
more data viewers: summary tables, ...</LI>

<LI>
table multiple cell selection (as well as rows, columns)</LI>

<LI>
writable table cells?</LI>
</UL>
I welcome any suggestion for new features that you may need in your specific
use of moodss.
<H3>
<A NAME="misc"></A>Miscellaneous information</H3>
For downloading Tcl software (such as stooop, scwoop, ...), visit my <A HREF="http://www.mygale.org/~jfontain/">web
page</A>.

<P>Send your comments, complaints, ... to <A HREF="mailto:jfontain@mygale.org">Jean-Luc
Fontaine</A>.
</BODY>
</HTML>
}

set rcsId {$Id: html.tcl,v 1.5 1998/04/21 16:33:50 jfontain Exp $}

array set HMtag_map {
    code {family Helvetica}
    kbd {family Helvetica weight bold}
    pre {fill 0 family Helvetica Tnowrap nowrap}
    samp {family Helvetica}
    tt {family Helvetica}
}

proc helpWindow {} {
    global htmlHelpDataText

    if {[winfo exists .topHelp]} {
        wm deiconify .topHelp
        raise .topHelp
        return
    }
    toplevel .topHelp
    wm title .topHelp {moodss: global help}
    frame .topHelp.bound

    set panes [new panner .topHelp -panes 2]
    pack $widget::($panes,path) -fill both -expand 1

    set contents [new scroll text $panner::($panes,frame1)]
    pack $widget::($contents,path) -fill both -expand 1

    set widget [new scroll text $panner::($panes,frame2)]
    pack $widget::($widget,path) -fill both -expand 1

    bind .topHelp.bound <Destroy> "delete $widget $contents $panes"

    set contentsText $composite::($contents,scrolled,path)
    $contentsText configure -cursor watch
    update idletasks
    HMinit_win $contentsText
    $contentsText configure -state normal
    HMparse_html $::htmlHelpContents "HMrender $contentsText"
    $contentsText configure -state disabled
    HMset_state $contentsText -stop 1

    set htmlHelpDataText $composite::($widget,scrolled,path)
    $htmlHelpDataText configure -cursor watch
    update idletasks
    HMinit_win $htmlHelpDataText
    $htmlHelpDataText configure -state normal
    HMparse_html $::htmlHelpData "HMrender $htmlHelpDataText"
    $htmlHelpDataText configure -state disabled
    HMset_state $htmlHelpDataText -stop 1
    focus $htmlHelpDataText

    $htmlHelpDataText configure -cursor {}
    $contentsText configure -cursor {}
    update idletasks
}

proc HMlink_callback {widget reference} {
    global htmlHelpDataText

    if {![string match #* $reference]} return
    HMgoto $htmlHelpDataText [string trimleft $reference #]
}

proc HMset_image {widget label source} {
    pack propagate [winfo parent $label] 1
}

set rcsId {$Id: help.tcl,v 1.13 1998/04/21 16:35:22 jfontain Exp $}

namespace eval help {

    variable nameAndVersion {
moodss: a Modular Object Oriented Dynamic SpreadSheet
version 2.2
    }

    variable description {
Copyright (C) 1997-98 Jean-Luc Fontaine. All rights reserved.

Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.
2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.
3. All advertising materials mentioning features or use of this software must display the following acknowledgement:
        This product includes software developed by Jean-Luc Fontaine.
4. The name of the author may not be used to endorse or promote products derived from this software without specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

        jfontain@mygale.org


This software includes the Tcl HTML library developped by Sun Microsystems and made available under the following license terms:

Sun Microsystems, Inc.  The following terms apply to all files associated with the software unless explicitly disclaimed in individual files.

The authors hereby grant permission to use, copy, modify, distribute, and license this software and its documentation for any purpose, provided that existing copyright notices are retained in all copies and that this notice is included verbatim in any distributions. No written agreement, license, or royalty fee is required for any of the authorized uses. Modifications to this software may be copyrighted by their authors and need not follow the licensing terms described here, provided that the new terms are clearly indicated on the first page of each file where they apply.

IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.

RESTRICTED RIGHTS: Use, duplication or disclosure by the government is subject to the restrictions as set forth in subparagraph (c) (1) (ii) of the Rights in Technical Data and Computer Software Clause as DFARS 252.227-7013 and FAR 52.227-19.
    }
}

proc simpleTextDialogBox {title text} {
    set dialog [new dialogBox . -buttons o -default o -title $title -x [winfo pointerx .] -y [winfo pointery .]]
    set widget [new scroll text $widget::($dialog,path)]
    $composite::($widget,scrolled,path) insert end $text
    $composite::($widget,scrolled,path) configure\
        -state disabled -borderwidth 0 -font $font::(mediumNormal) -wrap word -height 20 -padx 10
    bind $widget::($dialog,path) <Destroy> "catch {delete $widget}"
    dialogBox::display $dialog $widget::($widget,path)
}

proc aboutDialogBox {} {
    set dialog [new dialogBox . -buttons o -default o -title {moodss: about} -x [winfo pointerx .] -y [winfo pointery .]]
    set frame [frame $widget::($dialog,path).frame]
    set text [new scroll text $frame]
    $composite::($text,scrolled,path) insert end $help::description
    $composite::($text,scrolled,path) configure\
        -state disabled -borderwidth 0 -font $font::(mediumNormal) -wrap word -height 20 -padx 10

    grid rowconfigure $frame 1 -weight 1
    grid columnconfigure $frame 0 -weight 1
    grid columnconfigure $frame 1 -weight 1
    grid $widget::($text,path) -row 1 -column 0 -columnspan 2 -sticky nsew

    set TRANSPARENT_GIF_COLOR [$frame cget -background]
    grid [label $frame.icon -image [image create photo -data [dataGraph::iconData]]] -row 0 -column 0
    grid [label $frame.name -text $help::nameAndVersion] -row 0 -column 1

    bind $widget::($dialog,path) <Destroy> "catch {delete $text}"
    dialogBox::display $dialog $frame
}

proc modulesHelpDialogBox {args} {
    foreach module $args {
        append text "$module module:\n"
        if {[catch {append text [set ${module}::data(helpText)]}]} {
             append text "\nno help available\n"
        }
        append text \n
    }
    simpleTextDialogBox {moodss: modules help} $text
}

set rcsId {$Id: drag.tcl,v 1.17 1998/04/20 14:37:43 jfontain Exp $}

class dragSite {
    proc dragSite {this args} switched {$args} {
        switched::complete $this
    }

    proc ~dragSite {this} {
        variable ${this}provider
        variable draggable

        unset ${this}provider
        catch {delete $dragSite::($this,bindings)}
        catch {unset draggable($switched::($this,-path))}
    }

    proc options {this} {
        return [list\
            [list -data {} {}]\
            [list -path {} {}]\
            [list -validcommand {} {}]\
        ]
    }

    proc set-data {this value} {
        proc unformatted {this format} {return $switched::($this,-data)}
        provide $this {} "dragSite::unformatted $this"
    }

    proc set-path {this value} {
        variable draggable

        if {$switched::($this,complete)} {
            error {option -path cannot be set dynamically}
        }
        if {![winfo exists $value]} {
            error "invalid path: \"$value\""
        }
        if {[info exists draggable($value)]} {
            error "path \"$value\" is already a drag site"
        }
        set draggable($value) {}
        set dragSite::($this,bindings) [new bindings $value end]
        bindings::set $dragSite::($this,bindings) <ButtonPress-1> "dragSite::hit $this %x %y %X %Y"
        bindings::set $dragSite::($this,bindings) <Destroy> "delete $this"
    }

    proc set-validcommand {this value} {}

    proc provide {this format {command 0}} {
        variable ${this}provider

        switch $command {
            0 {
                return [set ${this}provider($format)]
            }
            {} {
                unset ${this}provider($format)
            }
            default {
                set ${this}provider($format) $command
            }
        }
    }

    proc hit {this xWidget yWidget xRoot yRoot} {
        bindings::set $dragSite::($this,bindings) <ButtonRelease-1> {}
        bindings::set $dragSite::($this,bindings) <Button1-Motion> {}
        set command $switched::($this,-validcommand)
        if {([string length $command]>0)&&![uplevel #0 $command $xWidget $yWidget]} return
        set dragSite::(x) $xWidget
        set dragSite::(y) $yWidget
        set dragSite::(X) $xRoot
        set dragSite::(Y) $yRoot
        bindings::set $dragSite::($this,bindings) <Button1-Motion> "dragSite::start $this %X %Y"
    }

    proc start {this xRoot yRoot} {
        variable ${this}provider

        if {(abs($xRoot-$dragSite::(X))+abs($yRoot-$dragSite::(Y)))<5} return

        set path $switched::($this,-path)
        set bindings $dragSite::($this,bindings)

        set dragSite::(bindtags) [bindtags $path]
        bindtags $path bindings($bindings)

        $path configure -cursor circle
        update idletasks

        set dragSite::(highlightFrame) [new toplevel . -background {} -highlightthickness 1 -highlightbackground black]
        wm withdraw $widget::($dragSite::(highlightFrame),path)
        wm overrideredirect $widget::($dragSite::(highlightFrame),path) 1
        set dragSite::(dropRegions) [dropSite::regions [array names ${this}provider]]
        set dragSite::(lastSite) 0
        bindings::set $bindings <ButtonRelease-1> "dragSite::drop $this %X %Y"
        bindings::set $bindings <Button1-Motion> "dragSite::track $this %X %Y"
    }

    proc framed {x y left top right bottom} {
        return [expr {($x>=$left)&&($x<=$right)&&($y>=$top)&&($y<=$bottom)}]
    }

    proc dropSite {xRoot yRoot} {
        foreach region $dragSite::(dropRegions) {
            if {[framed $xRoot $yRoot [lindex $region 1] [lindex $region 2] [lindex $region 3] [lindex $region 4]]} {
                return [lindex $region 0]
            }
        }
        return 0
    }

    proc track {this xRoot yRoot} {
        set site [dropSite $xRoot $yRoot]
        if {$site==$dragSite::(lastSite)} {
            return
        } elseif {($site==0)||([string compare $switched::($site,-path) $switched::($this,-path)]==0)} {
            wm withdraw $widget::($dragSite::(highlightFrame),path)
        } else {
            set frame $widget::($dragSite::(highlightFrame),path)
            wm withdraw $frame
            set path $switched::($site,-path)
            $frame configure -width [expr {[winfo width $path]+2}] -height [expr {[winfo height $path]+2}]
            wm geometry $frame +[expr {[winfo rootx $path]-1}]+[expr {[winfo rooty $path]-1}]
            wm deiconify $frame
        }
        set dragSite::(lastSite) $site
    }

    proc drop {this xRoot yRoot} {
        variable ${this}provider
        variable data

        bindtags $switched::($this,-path) $dragSite::(bindtags)
        unset dragSite::(bindtags)

        $switched::($this,-path) configure -cursor {}
        update idletasks

        delete $dragSite::(highlightFrame)
        unset dragSite::(lastSite)

        set site [dropSite $xRoot $yRoot]
        unset dragSite::(dropRegions)
        if {($site==0)||($site==$this)} return

        foreach format [switched::cget $site -formats] {
            if {[catch {set command [set ${this}provider($format)]}]} continue
            set data($format) [uplevel #0 $command [list $format]]
        }
        unset dragSite::(x) dragSite::(y) dragSite::(X) dragSite::(Y)
        dropSite::dropped $site
        unset data
    }
}

set rcsId {$Id: drop.tcl,v 1.9 1998/02/20 21:42:28 jfontain Exp $}

class dropSite {
    set dropSite::(list) {}

    proc dropSite {this args} switched {$args} {
        lappend dropSite::(list) $this
        switched::complete $this
    }

    proc ~dropSite {this} {
        set index [lsearch -exact $dropSite::(list) $this]
        set dropSite::(list) [lreplace $dropSite::(list) $index $index]
        catch {delete $dropSite::($this,bindings)}
    }

    proc options {this} {
        return [list\
            [list -command {} {}]\
            [list -formats {{}} {{}}]\
            [list -path {} {}]\
        ]
    }

    proc set-command {this value} {}
    proc set-formats {this value} {}

    proc set-path {this value} {
        if {$switched::($this,complete)} {
            error {option -path cannot be set dynamically}
        }
        if {![winfo exists $value]} {
            error "invalid widget: \"$value\""
        }
        set dropSite::($this,bindings) [new bindings $value end]
        set dropSite::($this,visible) 1
        bindings::set $dropSite::($this,bindings) <Visibility>\
            "set dropSite::($this,visible) \[string compare %s VisibilityFullyObscured\]"
    }

    proc dropped {this} {
        if {[string length $switched::($this,-command)]>0} {
            uplevel #0 $switched::($this,-command)
        }
    }

    proc regions {formats} {
        set regions {}
        foreach site $dropSite::(list) {
            if {[catch {winfo viewable $switched::($site,-path)} viewable]} continue
            if {!$viewable||!$dropSite::($site,visible)} continue
            foreach format $switched::($site,-formats) {
                if {[lsearch -exact $formats $format]>=0} {
                    set path $switched::($site,-path)
                    set x [winfo rootx $path]; set y [winfo rooty $path]
                    lappend regions [list $site $x $y [expr {$x+[winfo width $path]}] [expr $y+{[winfo height $path]}]]
                    break
                }
            }
        }
        return $regions
    }
}

set rcsId {$Id: canvhand.tcl,v 1.9 1998/02/20 21:39:32 jfontain Exp $}

class canvasHandles {
    proc canvasHandles {this parentPath args} composite {[new frame $parentPath] $args} {
        if {[string compare [winfo class $parentPath] Canvas]!=0} {
            error "parent must be the manager canvas"
        }
        set path $widget::($this,path)
        bind $path <Configure> "canvasHandles::resize $this %w %h"
        bind $path <Motion> "canvasHandles::setCursor $this %x %y"
        bind $path <Enter> "canvasHandles::setCursor $this %x %y"
        bind $path <Button1-Motion> "canvasHandles::buttonMotion $this %x %y"
        bind $path <ButtonPress-1> "canvasHandles::buttonPress $this %x %y"
        bind $path <ButtonRelease-1> "canvasHandles::buttonRelease $this"
        set canvasHandles::($this,item) [$parentPath create window 0 0 -window $path -anchor nw]
        set canvasHandles::($this,canvas) $parentPath
        set canvasHandles::($this,raised) 1
        composite::complete $this
    }

    proc ~canvasHandles {this} {
        $canvasHandles::($this,canvas) delete $canvasHandles::($this,item) outline
        catch {delete $canvasHandles::($this,bindings)}
    }

    proc options {this} {
        return [list\
            [list\
                -background background Background $widget::(default,ButtonBackgroundColor) $widget::(default,ButtonBackgroundColor)\
            ]\
            [list -borderwidth borderWidth BorderWidth 3]\
            [list -handlesize handleSize HandleSize 7 7]\
            [list -path path Path {} {}]\
            [list -relief relief Relief ridge]\
        ]
    }

    proc set-handlesize {this value} {
        resize $this [winfo width $widget::($this,path)] [winfo height $widget::($this,path)]
    }

    proc set-path {this value} {
        if {![winfo exists $value]} {
            error "invalid widget: \"$value\""
        }
        set path $widget::($this,path)
        catch {eval pack forget [pack slaves $path]}
        catch {delete $canvasHandles::($this,bindings)}
        set canvasHandles::($this,bindings) [new bindings $value end]
        bindings::set $canvasHandles::($this,bindings) <Destroy> "delete $this"
        raise $value $path
        pack $value -in $path -fill both -expand 1
    }

    foreach option {-background -relief -borderwidth} {
        proc set$option {this value} "\$widget::(\$this,path) configure $option \$value"
    }

    proc buttonMotion {this x y} {
        set canvasHandles::(motion) {}
        canvasHandles::updateOutline $this $x $y
    }

    proc buttonPress {this x y} {
        set canvasHandles::(xLast) $x; set canvasHandles::(yLast) $y
        canvasHandles::createOutline $this
    }

    proc buttonRelease {this} {
        if {[info exists canvasHandles::(motion)]} {
            canvasHandles::updateGeometry $this
            raise $widget::($this,path)
            set canvasHandles::($this,raised) 1
            unset canvasHandles::(motion)
        } else {
            if {$canvasHandles::($this,raised)} {
                lower $widget::($this,path)
                set canvasHandles::($this,raised) 0
            } else {
                raise $widget::($this,path)
                set canvasHandles::($this,raised) 1
            }
        }
        catch {raise $composite::($this,-path) $widget::($this,path)}
        canvasHandles::destroyOutline $this
        unset canvasHandles::(xLast) canvasHandles::(yLast) canvasHandles::(hidden)
    }

    proc resize {this width height} {
        set size [maximum $composite::($this,-handlesize) $composite::($this,-borderwidth)]

        set halfHeight [expr {($height/2)}]
        set canvasHandles::($this,topHandleBottom) [minimum $size $halfHeight]
        set canvasHandles::($this,bottomHandleTop) [expr {$height-$canvasHandles::($this,topHandleBottom)}]
        set canvasHandles::($this,midHandleTop)\
            [maximum [expr {$halfHeight-$size}] [expr {$canvasHandles::($this,topHandleBottom)+$size}]]
        set canvasHandles::($this,midHandleBottom)\
            [minimum [expr {$halfHeight+$size}] [expr {$canvasHandles::($this,bottomHandleTop)-$size}]]

        set halfWidth [expr {($width/2)}]
        set canvasHandles::($this,leftHandleRight) [minimum $size $halfWidth]
        set canvasHandles::($this,rightHandleLeft) [expr {$width-$canvasHandles::($this,leftHandleRight)}]
        set canvasHandles::($this,midHandleLeft)\
            [maximum [expr {$halfWidth-$size}] [expr {$canvasHandles::($this,leftHandleRight)+$size}]]
        set canvasHandles::($this,midHandleRight)\
            [minimum [expr {$halfWidth+$size}] [expr {$canvasHandles::($this,rightHandleLeft)-$size}]]
    }

    proc setCursor {this x y} {
        if {[info exists canvasHandles::(motion)]} {
            return
        }
        set border $composite::($this,-borderwidth)
        set path $widget::($this,path)
        set cursor fleur
        set direction {}
        if {$x<$border} {
            set side left
            set direction w
        } elseif {$x>=([winfo width $path]-$border)} {
            set side right
            set direction e
        }
        if {[info exists side]} {
            if {$y<$canvasHandles::($this,topHandleBottom)} {
                set cursor top_${side}_corner
                append direction n
            } elseif {$y>$canvasHandles::($this,bottomHandleTop)} {
                set cursor bottom_${side}_corner
                append direction s
            } elseif {($y>$canvasHandles::($this,midHandleTop))&&($y<$canvasHandles::($this,midHandleBottom))} {
                set cursor ${side}_side
            } else {
                set cursor fleur
                set direction {}
            }
        } else {
            if {$y<$border} {
                set side top
                set direction n
            } elseif {$y>=([winfo height $path]-$border)} {
                set side bottom
                set direction s
            }
            if {[info exists side]} {
                if {$x<$canvasHandles::($this,leftHandleRight)} {
                    set cursor ${side}_left_corner
                    append direction w
                } elseif {$x>$canvasHandles::($this,rightHandleLeft)} {
                    set cursor ${side}_right_corner
                    append direction e
                } elseif {($x>$canvasHandles::($this,midHandleLeft))&&($x<$canvasHandles::($this,midHandleRight))} {
                    set cursor ${side}_side
                } else {
                    set cursor fleur
                    set direction {}
                }
            }
        }
        if {[string compare $cursor [$widget::($this,path) cget -cursor]]!=0} {
            $widget::($this,path) configure -cursor $cursor
            update idletasks
        }
        set canvasHandles::($this,direction) $direction
    }

    proc updateOutline {this x y} {
        if {$canvasHandles::(hidden)} {
            positionOutlineInStackingOrder $this raise
        }
        set canvas $canvasHandles::($this,canvas)
        set coordinates [$canvas coords $canvasHandles::($this,item)]
        set xFrame [lindex $coordinates 0]
        set yFrame [lindex $coordinates 1]
        if {($xFrame+$x)<0} {
            set x [expr {-$xFrame}]
        }
        if {($yFrame+$y)<0} {
            set y [expr {-$yFrame}]
        }
        set width [winfo width $canvas]
        if {($xFrame+$x)>=$width} {
            set x [expr {$width-$xFrame-1}]
        }
        set height [winfo height $canvas]
        if {($yFrame+$y)>=$height} {
            set y [expr {$height-$yFrame-1}]
        }

        if {[string length $canvasHandles::($this,direction)]==0} {
            $canvas move outline [expr {$x-$canvasHandles::(xLast)}] [expr {$y-$canvasHandles::(yLast)}]
            set canvasHandles::(xLast) $x
            set canvasHandles::(yLast) $y
            return
        }

        set width [winfo width $widget::($this,path)]
        set height [winfo height $widget::($this,path)]

        switch $canvasHandles::($this,direction) {
            nw - wn {
                displayOutline $this [expr {$xFrame+$x}] [expr {$yFrame+$y}] [expr {$width-$x}] [expr {$height-$y}]
            }
            n {
                displayOutline $this $xFrame [expr {$yFrame+$y}] $width [expr {$height-$y}]
            }
            ne - en {
                displayOutline $this $xFrame [expr {$yFrame+$y}] $x [expr {$height-$y}]
            }
            e {
                displayOutline $this $xFrame $yFrame $x $height
            }
            se - es {
                displayOutline $this $xFrame $yFrame $x $y
            }
            s {
                displayOutline $this $xFrame $yFrame $width $y
            }
            sw - ws {
                displayOutline $this [expr {$xFrame+$x}] $yFrame [expr {$width-$x}] $y
            }
            w {
                displayOutline $this [expr {$xFrame+$x}] $yFrame [expr {$width-$x}] $height
            }
        }
    }

    proc createOutline {this} {
        set canvas $canvasHandles::($this,canvas)
        foreach side {top bottom left right} {
            set frame $widget::([new frame $canvas -background black],path)
            set canvasHandles::($side,item) [$canvas create window 0 0 -window $frame -width 0 -height 0 -anchor nw -tags outline]
        }
        positionOutlineInStackingOrder $this lower
        eval displayOutline $this [$canvas coords $canvasHandles::($this,item)]\
            [winfo width $widget::($this,path)] [winfo height $widget::($this,path)]
    }

    proc positionOutlineInStackingOrder {this order} {
        set canvas $canvasHandles::($this,canvas)
        foreach side {top bottom left right} {
            $order [$canvas itemcget $canvasHandles::($side,item) -window]
        }
        set canvasHandles::(hidden) [string compare $order raise]
    }

    proc displayOutline {this x y width height} {
        set minimum [expr {(2*$composite::($this,-borderwidth))+1}]
        set width [maximum $minimum $width]
        set height [maximum $minimum $height]
        set canvas $canvasHandles::($this,canvas)
        $canvas coords $canvasHandles::(top,item) $x $y
        $canvas coords $canvasHandles::(bottom,item) $x [expr {$y+$height-1}]
        $canvas coords $canvasHandles::(left,item) $x $y
        $canvas coords $canvasHandles::(right,item) [expr {$x+$width-1}] $y
        $canvas itemconfigure $canvasHandles::(top,item) -width $width
        $canvas itemconfigure $canvasHandles::(bottom,item) -width $width
        $canvas itemconfigure $canvasHandles::(left,item) -height $height
        $canvas itemconfigure $canvasHandles::(right,item) -height $height
    }

    proc destroyOutline {this} {
        set canvas $canvasHandles::($this,canvas)
        foreach side {top bottom left right} {
            destroy [$canvas itemcget $canvasHandles::($side,item) -window]
            unset canvasHandles::($side,item)
        }
        $canvas delete outline
    }

    proc updateGeometry {this} {
        set canvas $canvasHandles::($this,canvas)
        eval $canvas coords $canvasHandles::($this,item) [$canvas coords outline]
        $canvas itemconfigure $canvasHandles::($this,item) -width [$canvas itemcget $canvasHandles::(top,item) -width]\
            -height [$canvas itemcget $canvasHandles::(left,item) -height]
    }
}


proc updateTitle {} {
    global modulesString pollTime

    wm title . "moodss: $modulesString data (every $pollTime seconds)"
}

proc createMenuWidget {parentPath} {
    global modules

    set menu [menu $parentPath.menu -tearoff 0]

    $menu add cascade -label File -menu [menu $menu.file -tearoff 0] -underline 0
    $menu.file add command -label Exit -command exit -underline 1 -accelerator Alt+X
    bind $parentPath <Alt-x> exit

    $menu add cascade -label Options -menu [menu $menu.options -tearoff 0] -underline 0
    $menu.options add command -label {Poll time...} -command inquirePollTime -underline 0

    $menu add cascade -label Help -menu [menu $menu.help -tearoff 0] -underline 0
    $menu.help add command -label Global... -underline 0 -accelerator F1 -command helpWindow
    bind $parentPath <F1> helpWindow
    $menu.help add command -label Modules... -underline 0 -command "modulesHelpDialogBox $modules"
    $menu.help add command -label About... -underline 0 -command aboutDialogBox

    $parentPath configure -menu $menu
}

proc createMessageWidget {parentPath} {
    global messenger

    set messenger [new lifoLabel $parentPath -headerfont $font::(mediumBold) -font $font::(mediumNormal)]
    return $widget::($messenger,path)
}

proc createDragAndDropZone {parentPath} {
    global canvas

    set frame [frame $parentPath.drops]

    set label [label $frame.graph -image [image create photo -data [dataGraph::iconData]]]
    pack $label -pady 1 -side left
    new dropSite -path $label -formats DATACELLS -command "viewer::view \[new dataGraph $canvas\] \$dragSite::data(DATACELLS)"
    new widgetTip -path $label -text {graph drop site}

    set label [label $frame.sideBarChart -image [image create photo -data [dataSideBarChart::iconData]]]
    pack $label -pady 1 -side left
    new dropSite\
        -path $label -formats DATACELLS -command "viewer::view \[new dataSideBarChart $canvas\] \$dragSite::data(DATACELLS)"
    new widgetTip -path $label -text {side bar chart drop site}

    set label [label $frame.stackedBarChart -image [image create photo -data [dataStackedBarChart::iconData]]]
    pack $label -pady 1 -side left
    new dropSite -path $label -formats DATACELLS\
        -command "viewer::view \[new dataStackedBarChart $canvas\] \$dragSite::data(DATACELLS)"
    new widgetTip -path $label -text {stacked bar chart drop site}

    set label [label $frame.2DPieChart -image [image create photo -data [data2DPieChart::iconData]]]
    pack $label -pady 1 -side left
    new dropSite -path $label -formats DATACELLS\
        -command "viewer::view \[new data2DPieChart $canvas\] \$dragSite::data(DATACELLS)"
    new widgetTip -path $label -text {2D pie chart drop site}

    set label [label $frame.3DPieChart -image [image create photo -data [data3DPieChart::iconData]]]
    pack $label -pady 1 -side left
    new dropSite -path $label -formats DATACELLS\
        -command "viewer::view \[new data3DPieChart $canvas\] \$dragSite::data(DATACELLS)"
    new widgetTip -path $label -text {3D pie chart drop site}

    set trashData {
        R0lGODlhKAAoAKUAAP8A/8/Lz+/r71FRUZ6anpaSlv/7/wgICL66vkFBQYaChtfT17LA3LaytjAw
        MFlZWZaant/b3/fz96aipnFxcWlpaWFhYTAoKCAgICgoKOfj576yvklJSRAQEBAQCI6Slq6yrp6S
        nhgYGAAAAI6KjoaKhnl5ecfDx66ipiAoIOfr5ygwMJ6Slnlxce/j5zg4OL7Dx6aint/T38fLz4Z5
        hvf7/8/Tz66qtqairv/z939/f/fz79fLz0lRUXmChllRUSH5BAEAAAAALAAAAAAoACgAAAb+QIBw
        SBwGisikckkUDAhMYiEaNQwO06ggS00iDIXEQcFcLA5dpUDAaCgch8GDDIVEDJJJIp2URBQUFQoW
        CRcYGRkGihoBCnt8RQYbDxwZhx0eBwcYHyAMIRMDDpBEEwYPGBgiHSOtrh0PJCVhGaRDCw0JHq68
        vAkDJh0cfBIEHAoNGb3LvR0ODlBDJwsTSHcnBRaszNytAxMaa4oGJyRCAn4LBggMBAfd8BwQCxL1
        AiiPAOrjDRMU8PBSUDghIJyKFcOEBDAQIMKJCQqUAeQW54QEDREKjOACQIOGAhQ4iJgY0KIAFgco
        FFlIgoKDXSS7UZAggIKIJAJCtFjxLib+NwcuNLwYkARGDAovevpchkFGhBFLEJhIupTbDA2jlBho
        8K/qsg400CzJ80Cp11Ydhi6JEIBEgm1nW2HgkBDJFwQVHGCI6wqRWGs1ClRIMJLviAQmoCbBY4LD
        i1R8LUSwYSJJAAE3OhzogDBuBgISYNRCouFEhgHmAFCAWbUCugkvcKLCMYREA7MxNRjQMCFrkRMY
        og0xUCGFzwMcDORYMImYBhYJJHbTgUPGDow8eORKI2AHAkeqzB54QYG6ABkCFgSYESDACOFM0GGr
        8MCCBQo9FJgowAAHjjUCGODCAjxE0EAHFnSh2wkfkOADDSGwoIA/CTgwgH8MKKCAAC5S8MBAASLk
        w8QJBsgwAQEk0PBDYX4dgAMCrfg2AUqjUaGCAQsgQMIKRCHxT4K2EEEAOjZYIAJHRKQWJBEgCJCD
        kUtCgoJRHkQJCQkWbGTllrYEAQA7
    }
    set label [label $frame.trash -image [image create photo -data $trashData]]
    pack $label -pady 1 -side right
    new dropSite -path $label -formats OBJECTS -command "eval delete \$dragSite::data(OBJECTS)"
    new widgetTip -path $label -text {objects trash drop site}
    return $frame
}

proc inquirePollTime {} {
    global pollTimes pollTime

    set dialog\
        [new dialogBox . -buttons oc -default o -title {moodss: Poll time} -die 0 -x [winfo pointerx .] -y [winfo pointery .]]
    set frame [frame $widget::($dialog,path).frame]
    set minimum [lindex $pollTimes 0]
    set message [message $frame.message\
        -width [winfo screenwidth .] -font $font::(mediumNormal) -justify center\
        -text "Please enter new poll time\n(greater than $minimum):"\
    ]
    pack $message
    set entry [new spinEntry $frame -width 4 -list $pollTimes -side right]
    spinEntry::set $entry $pollTime
    pack $widget::($entry,path) -anchor e -side left -expand 1 -padx 2
    pack [label $frame.label -text seconds] -anchor w -side right -expand 1 -padx 2
    dialogBox::display $dialog $frame
    widget::configure $dialog -command "
        set time \[spinEntry::get $entry\]
        if {\$time<$minimum} {
            bell
            $message configure -text {Please enter new poll time\n(must be greater than $minimum):}
        } else {
            if {\$time!=\$pollTime} {
                set pollTime \$time
                viewer::updateInterval \$time
                updateTitle
                refresh
            }
            delete $dialog
        }
    "
    bind $frame <Destroy> "delete $entry"
}

proc refresh {} {
    global updateEvent modulesString modules messenger pollTime

    catch {after cancel $updateEvent}

    lifoLabel::push $messenger "launching $modulesString data update..."
    update idletasks
    foreach module $modules {
        ${module}::update
    }
    lifoLabel::pop $messenger
    update idletasks
    set updateEvent [after [expr {1000*$pollTime}] refresh]
}

proc dataTableTitleColumnMotion {path module x y} {
    global tableData messenger

    if {[catch {scan [$path index @$x,$y] %d,%d row column}]||($row>=0)} {
        if {[info exists tableData(lastColumn)]} {
            lifoLabel::pop $messenger
            widgetTip::disable $tableData(tip)
            unset tableData(lastColumn)
        }
    } elseif {![info exists tableData(lastColumn)]} {
        lifoLabel::push $messenger [set ${module}::data([set tableData(lastColumn) $column],message)]
        widgetTip::enable $tableData(tip)
        set tableData(lastColumn) $column
    } elseif {$column!=$tableData(lastColumn)} {
        lifoLabel::pop $messenger
        lifoLabel::push $messenger [set ${module}::data([set tableData(lastColumn) $column],message)]
    }
}

proc dataTableHelpSetup {path module} {
    global tableData

    bind $path <Motion> "dataTableTitleColumnMotion %W $module %x %y"
    bind $path <Leave> "dataTableTitleColumnMotion %W $module {} {}"
    set tableData(tip) [new widgetTip -text {click to toggle sort}]
    bind $path <ButtonPress> "widgetTip::disable $tableData(tip)"
}

createMenuWidget .
pack [createMessageWidget .] -side bottom -fill x
updateTitle

set view [new scroll canvas .]
set canvas $composite::($view,scrolled,path)
set width [winfo screenwidth .]
set height [winfo screenheight .]
$canvas configure -background white -width $width -height $height -scrollregion [list 0 0 $width $height]
wm geometry . 400x300

pack [createDragAndDropZone .] -fill x
pack $widget::($view,path) -fill both -expand 1

foreach module $modules {
    set table [new dataTable $canvas -data ${module}::data]
    new canvasHandles $canvas -path $widget::($table,path)
    dataTableHelpSetup $dataTable::($table,tablePath) $module
}

refresh

