File: moodss

package info (click to toggle)
moodss 5.0-2
links: PTS
area: main
in suites: slink
size: 1,104 kB
ctags: 430
sloc: tcl: 12,266; sh: 59; makefile: 43
file content (8448 lines) | stat: -rwxr-xr-x 348,064 bytes
#!/bin/sh
# the next line restarts using the interpreter \
exec wish "$0" "$@"



set rcsId {$Id: utility.tcl,v 1.4 1998/09/18 21:18:30 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]

}

proc startGatheringRCSIds {} {
    trace variable ::rcsId w recordRCSId
}

proc recordRCSId {variableName empty operation} {
    foreach {header file version} $::rcsId break
    regsub {,v$} $file {} file
    set ::sourceVersion($file) $version
}
startGatheringRCSIds

set rcsId {$Id: moodss.tcl,v 1.108 1998/10/17 20:39:24 jfontain Exp $}

set applicationVersion 5.0


set rcsId {$Id: getopt.tcl,v 1.3 1998/05/24 19:24:43 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 \[OPTION\]... \[MODULE\] \[MODULE\]..."
    puts stderr {  -f, --file       configuration file name (implies no modules)}
    puts stderr {  -h, --help       display this help and exit}
    puts stderr {  -p, --poll-time  poll time in seconds}
    puts stderr {  -r, --read-only  disable viewer creation, editing, ...}
    puts stderr {  -S, --static     disable internal window manager sizing and moving}
    puts stderr {  --version        output version information and exit}
    exit $exitCode
}

if {[catch\
    {\
        set argv [parseCommandLineArguments\
            {-f 1 --file 1 -h 0 --help 0 -p 1 --poll-time 1 -r 0 --read-only 0 -S 0 --static 0 --version 0} $argv arguments\
        ]\
    }\
    message\
]} {
    puts stderr $message
    printUsage 1
}
foreach {short long} {-f --file -h --help -p --poll-time -r --read-only -S --static} {
    catch {set arguments($short) $arguments($long)}
}

if {[info exists arguments(--version)]} {
    puts "moodss (a Modular Object Oriented Dynamic SpreadSheet) version $applicationVersion"
    exit
}
if {\
    ([info exists arguments(-f)]&&([llength $argv]>0))||(![info exists arguments(-f)]&&([llength $argv]==0))||\
    [info exists arguments(-h)]\
} {
    printUsage 1
}

proc loadModules {modules} {
    foreach module $modules {
        if {[info exists loaded($module)]} {
            puts stderr "$::argv0: module \"$module\" was specified more than once"
            exit 1
        }
        if {[catch {package require $module}]} {
            puts stderr "$::argv0: could not load package \"$module\""
            exit 1
        }
        set loaded($module) {}
        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<0} {
            set intervals($time) {}
            continue
        }
        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
    }
    if {$pollTime==0} { 
        set sum 0
        set number 0
        foreach interval [array names intervals] {
            incr sum $interval
            incr number
        }
        set pollTime [expr {round(double($sum)/-$number)}]
    }
}

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


if 1 {
set rcsId {$Id: stooop.tcl,v 3.63 1998/09/05 20:21:54 jfontain Exp $}

package provide stooop 3.6.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
::uplevel \$${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 \[::uplevel \$${fullClass}::(\$this,_derived)::$procedure \[::lrange \[::info level 0\] 1 end\]\]
}
::uplevel ${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 newId
            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]]
                set fullClass([expr {$newId+1}]) $fullName
            } 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 1 {
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 1 {
set rcsId {$Id: scwoutil.tcl,v 1.1 1998/09/15 21:17:14 jfontain Exp $}

if {[string compare $::tcl_platform(platform) windows]==0} {
    proc showTopLevel {path geometry} {
        wm deiconify $path
        wm geometry $path $geometry
    }
} else {
    proc showTopLevel {path geometry} {
        wm geometry $path $geometry
        wm deiconify $path
    }
}
set rcsId {$Id: scwoop.tcl,v 2.20 1998/10/09 21:02:15 jfontain Exp $}

package provide scwoop 2.5

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} {
        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 "\[eval ::$class \$parentPath.\$this \$args\]" {}
        proc ~$class {this} {
            destroy $widget::($this,path)
        }
    }
}

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

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

class composite {}

proc composite::composite {this base args} widget {$widget::($base,path)} {
    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.32 1998/09/19 19:38:46 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)
        showTopLevel $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.38 1998/10/01 20:07:02 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 [expr {$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.20 1998/10/04 14:43:02 jfontain Exp $}

class panner {
    set panner::(default,HandleSize) 8
}

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

proc panner::~panner {this} {}

proc panner::options {this} {
    return [list\
        [list -handlesize handleSize HandleSize $panner::(default,HandleSize)]\
        [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 panner::($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 {$panner::($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 $panner::($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 {$panner::($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 $panner::($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 $panner::($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 -$panner::($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
}
}


set rcsId {$Id: record.tcl,v 1.8 1998/10/17 20:40:52 jfontain Exp $}


class record {

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

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

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

    proc set-file {this value} {}

    proc write {this} {
        if {[string length $switched::($this,-file)]==0} {
            error {-file option undefined}
        }
        set file [open $switched::($this,-file) w+]

        puts $file "version $::applicationVersion"
        set seconds [clock seconds]
        puts $file "date [clock format $seconds -format %D] time [clock format $seconds -format %T]"
        puts $file "configuration {}"
        puts $file "width [winfo width .] height [winfo height .]"
        puts $file "pollTime $::pollTime"
        puts $file "modules \{"
        foreach module $::modules(all) {
            puts $file "    $module \{"
            puts $file "        arguments {}"
            puts $file "        tables \{"
            set index 0
            foreach table $dataTable::(list) {
                if {[string compare $module [namespace qualifiers [composite::cget $table -data]]]!=0} continue
                foreach {x y width height} [canvasWindowManager::getGeometry $::windowManager $widget::($table,path)] {}
                puts $file "            $index \{"
                puts $file "                x $x y $y width $width height $height"
                puts $file "            \}"
                incr index
            }
            puts $file "        \}"
            puts $file "    \}"
        }
        puts $file \}
        puts $file "viewers \{"
        set index 0
        foreach viewer $viewer::(list) {
            puts $file "    $index \{"
            puts $file "        class [classof $viewer]"
            foreach {x y width height} [canvasWindowManager::getGeometry $::windowManager $widget::($viewer,path)] {}
            puts $file "        x $x y $y width $width height $height"
            puts $file "        cells {[viewer::cells $viewer]}"
            set options [viewer::initializationConfiguration $viewer]
            if {[llength $options]>0} {
                puts $file "        $options"
            }
            puts $file "    \}"
            incr index
        }
        puts $file \}

        close $file
    }

    proc read {this} {
        variable ${this}data

        if {[string length $switched::($this,-file)]==0} {
            error {-file option undefined}
        }
        set file [open $switched::($this,-file)]
        array set ${this}data [::read $file]
        close $file
    }

    proc modules {this} {
        variable ${this}data

        array set data [set ${this}data(modules)]
        return [array names data]
    }

    proc pollTime {this} {
        variable ${this}data

        return [set ${this}data(pollTime)]
    }

    proc sizes {this} {
        variable ${this}data

        return "[set ${this}data(width)] [set ${this}data(height)]"
    }

    proc viewersData {this} {
        variable ${this}data

        array set data [set ${this}data(viewers)]
        set list {}
        foreach index [lsort -integer [array names data]] {
            array set viewer $data($index)
            set options {}
            foreach name [array names viewer -*] {
                lappend options $name $viewer($name)
            }
            lappend list $viewer(class) $viewer(cells) $viewer(x) $viewer(y) $viewer(width) $viewer(height) $options
        }
        return $list
    }

    proc tableGeometry {this module {index 0}} {
        variable ${this}data

        array set data [set ${this}data(modules)]
        array set moduleData $data($module)
        unset data
        array set tablesData $moduleData(tables)
        unset moduleData
        array set data $tablesData($index)
        unset tablesData
        return "$data(x) $data(y) $data(width) $data(height)"
    }

}

if {[info exists arguments(-f)]} {
    set saveFile $arguments(-f)
    set initializer [new record -file $saveFile]
    record::read $initializer
    set modules(all) [record::modules $initializer]
} else {
    set saveFile {}
    set modules(all) $argv
}
set modules(all,string) [commaSeparatedString $modules(all)]
set readOnly [info exists arguments(-r)]
set static [info exists arguments(-S)]

lappend auto_path /usr/lib/moodss .
loadModules $modules(all)

set modules(synchronous) {}
foreach module $modules(all) {
    if {[lindex [set ${module}::data(pollTimes)] 0]>0} {
        lappend modules(synchronous) $module
    }
}
set modules(synchronous,string) [commaSeparatedString $modules(synchronous)]

if {[info exists arguments(-p)]} {
    setPollTimes $modules(all) $arguments(-p)
} elseif {[info exists initializer]} {
    setPollTimes $modules(all) [record::pollTime $initializer]
} else {
    setPollTimes $modules(all)
}

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

if {[catch {package require BLT}]} {
    switch $tcl_platform(platform) {
        unix {
            load ./libBLT.so.2.4f
        }
        windows {
            load ./blt80.dll
        }
    }
}
set officialBLT [expr {$blt_version!=8.0}]

if 1 {
set rcsId {$Id: pielabel.tcl,v 1.40 1998/06/07 10:07:30 jfontain Exp $}

class pieLabeler {

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

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

    proc ~pieLabeler {this} {}

    virtual proc new {this slice args}

    virtual proc delete {this label}

    virtual proc set {this label value}

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

    virtual proc update {this left top right bottom}

    virtual proc room {this arrayName}

}
set rcsId {$Id: boxlabel.tcl,v 1.39 1998/06/07 10:20:43 jfontain Exp $}

class pieBoxLabeler {

    proc pieBoxLabeler {this canvas args} pieLabeler {$canvas $args} switched {$args} {
        ::set pieBoxLabeler::($this,array) [::new canvasLabelsArray $canvas]
        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} {
        ::set label [eval ::new canvasLabel $pieLabeler::($this,canvas)\
            $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 set {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
    }

    proc update {this left top right bottom} {
        ::set canvas $pieLabeler::($this,canvas)
        ::set array $pieBoxLabeler::($this,array)
        foreach {x y} [$canvas coords canvasLabelsArray($array)] {}
        $canvas move canvasLabelsArray($array) [expr {$left-$x}] [expr {$bottom-[canvasLabelsArray::height $array]-$y}]
        switched::configure $array -width [expr {$right-$left}]
    }

    proc room {this arrayName} {
        upvar $arrayName data

        ::set data(left) 0
        ::set data(right) 0
        ::set data(top) 0
        ::set box [$pieLabeler::($this,canvas) bbox canvasLabelsArray($pieBoxLabeler::($this,array))]
        if {[llength $box]==0} {
            ::set data(bottom) 0
        } else {
            ::set data(bottom) [expr {[lindex $box 3]-[lindex $box 1]+$switched::($this,-offset)}]
        }
    }
}
set rcsId {$Id: canlabel.tcl,v 1.22 1998/06/07 10:08:13 jfontain Exp $}

class canvasLabel {

    proc canvasLabel {this canvas args} switched {$args} {
        set canvasLabel::($this,canvas) $canvas
        set canvasLabel::($this,origin) [$canvas create image 0 0 -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 -scale {1 1} {1 1}]\
            [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-scale {this value} {
        update $this
    }
    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)

        foreach {x y} [$canvas coords $canvasLabel::($this,origin)] {}

        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
        eval $canvas scale canvasLabel($this) $x $y $switched::($this,-scale)
    }

}
set rcsId {$Id: labarray.tcl,v 1.20 1998/06/07 13:47:02 jfontain Exp $}

class canvasLabelsArray {

    proc canvasLabelsArray {this canvas args} switched {$args} {
        set canvasLabelsArray::($this,canvas) $canvas
        set canvasLabelsArray::($this,origin) [$canvas create image 0 0 -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 -width 100]\
        ]
    }

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

    proc set-width {this value} {
        set canvasLabelsArray::($this,width) [winfo fpixels $canvasLabelsArray::($this,canvas) $value]
        update $this
    }

    proc update {this} {
        set index 0
        foreach label $canvasLabelsArray::($this,labels) {
            position $this $label $index
            incr index
        }
    }

    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)

        foreach {x y} [$canvas coords $canvasLabelsArray::($this,origin)] {}
        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
        foreach {xDelta yDelta} [$canvas coords canvasLabel($label)] {}
        $canvas move canvasLabel($label) [expr {$x-$xDelta}] [expr {$y-$yDelta}]
    }

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

    proc height {this} {
        set number [llength $canvasLabelsArray::($this,labels)]
        if {$number==0} {
            return 0
        }
        set coordinates [$canvasLabelsArray::($this,canvas) bbox canvasLabel([lindex $canvasLabelsArray::($this,labels) 0])]
        return [expr {(($number+1)/2)*([lindex $coordinates 3]-[lindex $coordinates 1])}]
    }

}
set rcsId {$Id: perilabel.tcl,v 1.45 1998/06/09 21:17:52 jfontain Exp $}

class piePeripheralLabeler {

    variable PI 3.14159265358979323846

    proc piePeripheralLabeler {this canvas args} pieLabeler {$canvas $args} switched {$args} {
        switched::complete $this
        ::set piePeripheralLabeler::($this,array) [::new canvasLabelsArray $canvas -justify $switched::($this,-justify)]
        ::set piePeripheralLabeler::($this,valueWidth)\
            [font measure $switched::($this,-smallfont) $switched::($this,-widestvaluetext)]
        ::set piePeripheralLabeler::($this,valueHeight) [font metrics $switched::($this,-smallfont) -ascent]
    }

    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 -widestvaluetext 0.00 0.00]\
        ]
    }

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

    proc set-smallfont {this value} {
        if {$switched::($this,complete)} {
            error {option -smallfont 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 label [eval ::new canvasLabel $pieLabeler::($this,canvas) $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 set {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
    }

    proc update {this left top right bottom} {
        ::set canvas $pieLabeler::($this,canvas)
        ::set array $piePeripheralLabeler::($this,array)
        foreach {x y} [$canvas coords canvasLabelsArray($array)] {}
        $canvas move canvasLabelsArray($array) [expr {$left-$x}] [expr {$bottom-[canvasLabelsArray::height $array]-$y}]
        switched::configure $array -width [expr {$right-$left}]
        foreach label [canvasLabelsArray::labels $array] {
            position $this $piePeripheralLabeler::($this,textItem,$label) $piePeripheralLabeler::($this,slice,$label)
        }
    }

    proc room {this arrayName} {
        upvar $arrayName data

        ::set data(left) [expr {$piePeripheralLabeler::($this,valueWidth)+$switched::($this,-offset)}]
        ::set data(right) $data(left)
        ::set data(top) [expr {$switched::($this,-offset)+$piePeripheralLabeler::($this,valueHeight)}]
        ::set box [$pieLabeler::($this,canvas) bbox canvasLabelsArray($piePeripheralLabeler::($this,array))]
        if {[llength $box]==0} {
            ::set data(bottom) $data(top)
        } else {
            ::set data(bottom) [expr {$data(top)+[lindex $box 3]-[lindex $box 1]}]
        }
    }

}
set rcsId {$Id: slice.tcl,v 1.39 1998/06/07 10:19:25 jfontain Exp $}


class slice {
    variable PI 3.14159265358979323846
}

proc slice::slice {this canvas xRadius yRadius args} switched {$args} {
    set slice::($this,canvas) $canvas
    set slice::($this,xRadius) $xRadius
    set slice::($this,yRadius) $yRadius
    switched::complete $this
    complete $this
    update $this
}

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 -scale {1 1} {1 1}]\
        [list -startandextent {0 0} {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::set-scale {this value} {
    if {$switched::($this,complete)} {
        update $this
    }
}

proc slice::set-startandextent {this value} {
    foreach {start extent} $value {}
    set slice::($this,start) [normalizedAngle $start]
    if {$extent<0} {
        set slice::($this,extent) 0
    } elseif {$extent>=360} {
        set slice::($this,extent) [expr {360-pow(10,-$::tcl_precision+3)}]
    } else {
        set slice::($this,extent) $extent
    }
    if {$switched::($this,complete)} {
        update $this
    }
}

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} {
    set canvas $slice::($this,canvas)
    set xRadius $slice::($this,xRadius)
    set yRadius $slice::($this,yRadius)
    set bottomColor $switched::($this,-bottomcolor)
    set slice::($this,origin) [$canvas create image -$xRadius -$yRadius -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\
        -$xRadius -$yRadius $xRadius $yRadius -fill $switched::($this,-topcolor) -tags slice($this)\
    ]
    $canvas move slice($this) $xRadius $yRadius
}

proc slice::update {this} {
    set canvas $slice::($this,canvas)
    set coordinates [$canvas coords $slice::($this,origin)]
    set xRadius $slice::($this,xRadius)
    set yRadius $slice::($this,yRadius)
    $canvas coords $slice::($this,origin) -$xRadius -$yRadius
    $canvas coords $slice::($this,topArc) -$xRadius -$yRadius $xRadius $yRadius
    $canvas itemconfigure $slice::($this,topArc) -start $slice::($this,start) -extent $slice::($this,extent)
    if {$switched::($this,-height)>0} {
        updateBottom $this
    }
    $canvas move slice($this) [expr {[lindex $coordinates 0]+$xRadius}] [expr {[lindex $coordinates 1]+$yRadius}]
    eval $canvas scale slice($this) $coordinates $switched::($this,-scale)
}

proc slice::updateBottom {this} {
    variable PI

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

    set canvas $slice::($this,canvas)
    set xRadius $slice::($this,xRadius)
    set yRadius $slice::($this,yRadius)
    set height $switched::($this,-height)

    $canvas itemconfigure $slice::($this,startBottomArcFill) -extent 0
    $canvas coords $slice::($this,startBottomArcFill) -$xRadius -$yRadius $xRadius $yRadius
    $canvas move $slice::($this,startBottomArcFill) 0 $height
    $canvas itemconfigure $slice::($this,startBottomArc) -extent 0
    $canvas coords $slice::($this,startBottomArc) -$xRadius -$yRadius $xRadius $yRadius
    $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) -$xRadius -$yRadius $xRadius $yRadius
    $canvas move $slice::($this,endBottomArcFill) 0 $height
    $canvas itemconfigure $slice::($this,endBottomArc) -extent 0
    $canvas coords $slice::($this,endBottomArc) -$xRadius -$yRadius $xRadius $yRadius
    $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 {$xRadius*cos($start*$PI/180)}]
    set startY [expr {-$yRadius*sin($start*$PI/180)}]
    set end [normalizedAngle [expr {$start+$extent}]]
    set endX [expr {$xRadius*cos($end*$PI/180)}]
    set endY [expr {-$yRadius*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 $xRadius 0 $xRadius $height $startX $startBottom
                $canvas coords $slice::($this,startLeftLine) $startX $startY $startX $startBottom
                $canvas coords $slice::($this,startRightLine) $xRadius 0 $xRadius $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) -$xRadius 0 $endX $endY $endX $endBottom -$xRadius $height
                $canvas coords $slice::($this,endLeftLine) -$xRadius 0 -$xRadius $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) -$xRadius 0 $xRadius 0 $xRadius $height -$xRadius $height
                $canvas coords $slice::($this,startLeftLine) -$xRadius 0 -$xRadius $height
                $canvas coords $slice::($this,startRightLine) $xRadius 0 $xRadius $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 $xRadius 0 $xRadius $height $startX $startBottom
            $canvas coords $slice::($this,startLeftLine) $startX $startY $startX $startBottom
            $canvas coords $slice::($this,startRightLine) $xRadius 0 $xRadius $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) -$xRadius 0 $endX $endY $endX $endBottom -$xRadius $height
            $canvas coords $slice::($this,startLeftLine) -$xRadius 0 -$xRadius $height
            $canvas coords $slice::($this,startRightLine) $endX $endY $endX $endBottom
        }
    }
}

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

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

    set data(start) $slice::($this,start)
    set data(extent) $slice::($this,extent)
    foreach {x y} $switched::($this,-scale) {}
    set data(xRadius) [expr {$x*$slice::($this,xRadius)}]
    set data(yRadius) [expr {$y*$slice::($this,yRadius)}]
    set data(height) [expr {$y*$switched::($this,-height)}]
    foreach {x y} [$slice::($this,canvas) coords $slice::($this,origin)] {}
    set data(xCenter) [expr {$x+$data(xRadius)}]
    set data(yCenter) [expr {$y+$data(yRadius)}]
}
set rcsId {$Id: selector.tcl,v 1.2 1998/05/24 19:18:21 jfontain Exp $}


class selector {

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

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

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

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

    proc set-selectcommand {this value} {}

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

        ::set select {}
        ::set deselect {}
        foreach index $indices {
            if {[info exists ${this}selected($index)]&&($selected==[::set ${this}selected($index)])} continue
            if {$selected} {
                lappend select $index
                ::set ${this}selected($index) 1
            } else {
                lappend deselect $index
                ::set ${this}selected($index) 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 indices} {
        variable ${this}selected

        foreach index $indices {
            ::unset ${this}selected($index)
        }
    }


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

    proc remove {this indices} {
        unset $this $indices
    }

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

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

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

        ::set select {}
        ::set deselect {}
        foreach index $indices {
            if {[::set ${this}selected($index)]} {
                lappend deselect $index
                ::set ${this}selected($index) 0
            } else {
                lappend select $index
                ::set ${this}selected($index) 1
                ::set selector::($this,lastSelected) $index
            }
        }
        update $this $select $deselect
    }

    virtual proc extend {this index} {}

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

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

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

        ::set list {}
        foreach index [array names ${this}selected] {
            if {[::set ${this}selected($index)]} {
                lappend list $index
            }
        }
        return $list
    }

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

        return [array names ${this}selected]
    }
}

set rcsId {$Id: objselec.tcl,v 1.5 1998/05/24 19:24:43 jfontain Exp $}


class objectSelector {

    proc objectSelector {this args} selector {$args} {}

    proc ~objectSelector {this} {}


    proc extend {this id} {
        if {[info exists selector::($this,lastSelected)]} {
            set list [list $this]
            set last [lsearch -exact $list $selector::($this,lastSelected)]
            set index [lsearch -exact $list $id]
            selector::clear $this
            if {$index>$last} {
                selector::set $this [lrange $list $last $index] 1
            } else {
                selector::set $this [lrange $list $index $last] 1
            }
        } else {
            selector::select $this $id
        }
    }

    proc selected {this} {
        return [lsort -integer [selector::_selected $this]]
    }

    proc list {this} {
        return [lsort -integer [selector::_list $this]]
    }
}
set rcsId {$Id: pie.tcl,v 1.80 1998/06/09 21:20:45 jfontain Exp $}

package provide tkpiechart 5.2

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

proc pie::pie {this canvas x y args} switched {$args} {
    set pie::($this,canvas) $canvas
    set pie::($this,colorIndex) 0
    set pie::($this,slices) {}
    set pie::($this,origin) [$canvas create image $x $y -tags pie($this)]
    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)}
    $pie::($this,canvas) delete $pie::($this,origin)
}

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

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::set-height {this value} {
    set pie::($this,height) [expr {[winfo fpixels $pie::($this,canvas) $value]-1}]
    if {$switched::($this,complete)} {
        update $this
    } else {
        set pie::($this,initialHeight) $pie::($this,height)
    }
}
proc pie::set-width {this value} {
    set pie::($this,width) [expr {[winfo fpixels $pie::($this,canvas) $value]-1}]
    if {$switched::($this,complete)} {
        update $this
    } else {
        set pie::($this,initialWidth) $pie::($this,width)
    }
}

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))

    if {[string length $switched::($this,-background)]==0} {
        set bottomColor {}
    } else {
        set bottomColor [tkDarken $switched::($this,-background) 60]
    }
    set slice [new slice\
        $canvas [expr {$pie::($this,initialWidth)/2}] [expr {$pie::($this,initialHeight)/2}]\
        -startandextent {90 360} -height $pie::($this,thickness) -topcolor $switched::($this,-background) -bottomcolor $bottomColor\
    ]
    $canvas addtag pie($this) withtag slice($slice)
    $canvas addtag pieSlices($this) withtag slice($slice)
    set pie::($this,backgroundSlice) $slice
    if {[string length $switched::($this,-title)]==0} {
        set pie::($this,titleRoom) 0
    } else {
        set pie::($this,title) [$canvas create text 0 0\
            -anchor n -text $switched::($this,-title) -font $switched::($this,-titlefont) -tags pie($this)\
        ]
        set pie::($this,titleRoom) [expr {\
            [font metrics $switched::($this,-titlefont) -ascent]+[winfo fpixels $canvas $switched::($this,-titleoffset)]\
        }]
    }
    update $this
}

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 slice [new slice\
        $canvas [expr {$pie::($this,initialWidth)/2}] [expr {$pie::($this,initialHeight)/2}] -startandextent "$start 0"\
        -height $pie::($this,thickness) -topcolor $color -bottomcolor [tkDarken $color 60]\
    ]
    eval $canvas move slice($slice) [$canvas coords pieSlices($this)]
    $canvas addtag pie($this) withtag slice($slice)
    $canvas addtag pieSlices($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)

    update $this

    if {$switched::($this,-selectable)} {
        if {![info exists pie::($this,selector)]} {
            set pie::($this,selector) [new objectSelector -selectcommand "pie::setLabelsState $this"]
        }
        set selector $pie::($this,selector)
        selector::add $selector $label
        $canvas bind canvasLabel($label) <ButtonRelease-1> "selector::select $selector $label"
        $canvas bind slice($slice) <ButtonRelease-1> "selector::select $selector $label"
        $canvas bind canvasLabel($label) <Control-ButtonRelease-1> "selector::toggle $selector $label"
        $canvas bind slice($slice) <Control-ButtonRelease-1> "selector::toggle $selector $label"
        $canvas bind canvasLabel($label) <Shift-ButtonRelease-1> "selector::extend $selector $label"
        $canvas bind slice($slice) <Shift-ButtonRelease-1> "selector::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)} {
        selector::remove $pie::($this,selector) $pie::($this,sliceLabel,$slice)
    }
    unset pie::($this,sliceLabel,$slice)
    update $this
}

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)}]
    switched::configure $slice -startandextent "[expr {$slice::($slice,start)-$growth}] $newExtent"

    if {[string length $valueToDisplay]>0} {
        pieLabeler::set $pie::($this,labeler) $pie::($this,sliceLabel,$slice) $valueToDisplay
    } else {
        pieLabeler::set $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::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
    }
}

proc pie::currentSlice {this} {
    set tags [$pie::($this,canvas) gettags current]
    if {[scan $tags slice(%u) slice]>0} {
        return $slice
    }
    if {[scan $tags canvasLabel(%u) label]>0} {
        foreach slice $pie::($this,slices) {
            if {$pie::($this,sliceLabel,$slice)==$label} {
                return $slice
            }
        }
    }
    return 0
}

proc pie::update {this} {
    set canvas $pie::($this,canvas)
    pieLabeler::room $pie::($this,labeler) room
    foreach {x y} [$canvas coords $pie::($this,origin)] {}
    foreach {xSlices ySlices} [$canvas coords pieSlices($this)] {}
    $canvas move pieSlices($this) [expr {$x+$room(left)-$xSlices}] [expr {$y+$room(top)+$pie::($this,titleRoom)-$ySlices}]
    set scale [list\
        [expr {($pie::($this,width)-$room(left)-$room(right))/$pie::($this,initialWidth)}]\
        [expr {\
            ($pie::($this,height)-$room(top)-$room(bottom)-$pie::($this,titleRoom))/\
            ($pie::($this,initialHeight)+$pie::($this,thickness))\
        }]\
    ]
    switched::configure $pie::($this,backgroundSlice) -scale $scale
    foreach slice $pie::($this,slices) {
        switched::configure $slice -scale $scale
    }
    if {$pie::($this,titleRoom)>0} {
        $canvas coords $pie::($this,title) [expr {$x+($pie::($this,width)/2)}] $y
    }
    pieLabeler::update $pie::($this,labeler) $x $y [expr {$x+$pie::($this,width)}] [expr {$y+$pie::($this,height)}]
}

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: config.tcl,v 1.3 1998/05/24 19:24:43 jfontain Exp $}

class configuration {
    set (xWindowManagerInitialOffset) 30
    set (yWindowManagerInitialOffset) 20
    set (graphNumberOfIntervals) 100
}

set rcsId {$Id: font.tcl,v 1.4 1998/07/29 20:45:07 jfontain Exp $}


class font {
    catch {widget::widget}

    set font::(mediumBold) [eval font create [font actual $widget::(default,ButtonFont)]]
    font configure $font::(mediumBold) -weight bold
    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.9 1998/10/04 14:57:52 jfontain Exp $}


class scroll {

    proc 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 [new frame $path] filler

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

        grid propagate $widget::($this,path) 0

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

        set scroll::($this,0,1,path) $composite::($this,vertical,path)
        set scroll::($this,1,0,path) $composite::($this,horizontal,path)

        composite::complete $this
    }

    proc ~scroll {this} {}

    proc options {this} {
        return [list\
            [list -automatic automatic Automatic 1 1]\
            [list\
                -scrollbarborderwidth scrollbarBorderWidth ScrollbarBorderWidth\
                $widget::(default,ScrollbarBorderWidth) $widget::(default,ScrollbarBorderWidth)\
            ]\
            [list\
                -scrollbarelementborderwidth scrollbarElementBorderWidth ScrollbarElementBorderWidth\
                $widget::(default,ScrollbarElementBorderWidth) $widget::(default,ScrollbarElementBorderWidth)\
            ]\
            [list\
                -scrollbarwidth scrollbarWidth ScrollbarWidth $widget::(default,ScrollbarWidth) $widget::(default,ScrollbarWidth)\
            ]\
            [list -height height Height $widget::(default,CanvasHeight)]\
            [list -horizontal horizontal Horizontal 1 1]\
            [list -vertical vertical Vertical 1 1]\
            [list -width width Width $widget::(default,CanvasWidth)]\
        ]
    }

    foreach option {-automatic -horizontal -vertical} {
        proc set$option {this value} "
            if {\$composite::(\$this,complete)} {
                error {option $option cannot be set dynamically}
            }
        "
    }

   foreach option {borderwidth elementborderwidth width} {
        proc set-scrollbar$option {this value} "
            \$composite::(\$this,vertical,path) configure -$option \$value
            \$composite::(\$this,horizontal,path) configure -$option \$value
        "
    }

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

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

    proc update {this row column first last} {
        set path $scroll::($this,$row,$column,path)
        foreach {previousFirst previousLast} [$path get] {}
        if {($first!=$previousFirst)||($last!=$previousLast)} {
            $path set $first $last
        }
        set visible [llength [grid info $path]]
        if {!$composite::($this,-automatic)||(($last-$first)<1)} {
            if {!$visible} {
                if {$composite::($this,-vertical)} {
                    grid $composite::($this,vertical,path) -row 0 -column 1 -sticky nsew
                }
                if {$composite::($this,-horizontal)} {
                    grid $composite::($this,horizontal,path) -row 1 -column 0 -sticky nsew
                }
                grid $composite::($this,filler,path) -sticky nsew -column 1 -row 1
            }
        } else {
            foreach {first last} [$scroll::($this,$column,$row,path) get] {}
            if {$visible&&(($last-$first)>=1)} {
                grid remove $scroll::($this,0,1,path)
                grid remove $scroll::($this,1,0,path)
                grid remove $composite::($this,filler,path)
            }
        }
    }

}

set rcsId {$Id: lifolbl.tcl,v 1.11 1998/10/09 19:36:40 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.5 1998/05/24 19:24:43 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.12 1998/05/24 19:24:43 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.14 1998/10/17 20:40:31 jfontain Exp $}

class viewer {

    set viewer::(list) {}

    proc viewer {this} {
        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
            set arrays([lindex $cell 0]) {}
        }
        foreach array [array names arrays] {
            update $this $array
        }
    }

    virtual proc monitorCell {this array row column}

    proc parseCells {this cells} {
        if {[llength $cells]==0} return
        set parsed {}
        foreach cell $cells {
            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)] {
            if {[catch {set ${array}($row,$index)} value]} {
                append label {? }
            } else {
                append label "$value "
            }
        }
        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)
        }
    }

    virtual proc cells {this}

    virtual proc initializationConfiguration {this} {
        return {}
    }

}

set rcsId {$Id: blt2d.tcl,v 1.25 1998/10/10 20:58:19 jfontain Exp $}

class blt2DViewer {

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

    proc blt2DViewer {this path} viewer {} {
        $path configure -cursor {}
if {$::officialBLT} {
        $path configure -plotpadx 2 -plotpady 2
        $path yaxis configure -tickshadow {}
}
        $path yaxis configure -title {} -tickfont $font::(smallNormal)
        $path legend configure -borderwidth 1 -font $font::(mediumNormal) -activebackground white

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

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

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

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

    proc dragData {this format} {
        set selectedElements [selector::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 $blt2DViewer::($this,elements)]==0} {
            return 1
        }
        return [expr {\
            [lsearch -exact [selector::selected $blt2DViewer::($this,selector)] [$blt2DViewer::($this,path) legend get @$x,$y]]>=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
        catch {selector::add $blt2DViewer::($this,selector) $element}
    }

    proc cells {this} {
        return [cellsFromElements $this $blt2DViewer::($this,elements)]
    }

    proc deletedElement {this array element} {
        viewer::unregisterTrace $this $array
        ldelete blt2DViewer::($this,elements) $element
        catch {selector::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} {
            selector::select $blt2DViewer::($this,selector) $element
        }
    }

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

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

    proc allowDrag {this} {
        set path $blt2DViewer::($this,path)

        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,selector) [new objectSelector -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 rcsId {$Id: tablesel.tcl,v 1.2 1998/05/24 19:24:43 jfontain Exp $}


class tableSelector {

    proc tableSelector {this args} selector {$args} {}

    proc ~tableSelector {this} {}


    proc extend {this cell} {
        if {[info exists selector::($this,lastSelected)]} {
            scan $selector::($this,lastSelected) %d,%d startRow startColumn
            scan $cell %d,%d lastRow lastColumn
            if {$lastRow<$startRow} {
                set last $startRow
                set startRow $lastRow
                set lastRow $last
            }
            if {$lastColumn<$startColumn} {
                set last $startColumn
                set startColumn $lastColumn
                set lastColumn $last
            }
            set list {}
            for {set row $startRow} {$row<=$lastRow} {incr row} {
                for {set column $startColumn} {$column<=$lastColumn} {incr column} {
                    lappend list $row,$column
                }
            }
            selector::clear $this
            selector::set $this $list 1
        } else {
            selector::select $this $cell
        }
    }

    proc list {this} {
        return [lsort -integer [selector::_list $this]]
    }
}

set rcsId {$Id: datatab.tcl,v 1.45 1998/10/10 20:56:43 jfontain Exp $}

class dataTable {

    set dataTable::(list) {}

    set dataTable::(scrollbarBorderWidth) [expr {$widget::(default,ScrollbarBorderWidth)==0?0:1}]
    set dataTable::(scrollbarWidth) [expr {2*$widget::(default,ScrollbarWidth)/3}]

    proc dataTable {this parentPath args} composite {
        [new scroll table $parentPath\
            -scrollbarwidth $dataTable::(scrollbarWidth) -scrollbarelementborderwidth $dataTable::(scrollbarBorderWidth)\
        ]
        $args
    } {
        set path $composite::($composite::($this,base),scrolled,path)
        $path configure -font $font::(mediumNormal) -rows 2 -state disabled -titlerows 1 -roworigin -1 -colstretchmode unset\
            -variable dataTable::${this}data -resizeborders col -cursor {} -bordercursor sb_h_double_arrow -highlightthickness 0\
            -takefocus 0
        $path tag configure select -background white

        bindtags $path "$path . all"

        bind $path <ButtonPress-1> "dataTable::buttonPress $this %x %y"
        bind $path <Button1-Motion> {%W border dragto %x %y}

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

        lappend dataTable::(list) $this

        composite::complete $this
        setupDataView $this
    }

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

        catch {unset ${this}data}
        catch {eval delete $dataTable::($this,arrow) $dataTable::($this,tips)}
        catch {delete $dataTable::($this,drag)}
        catch {delete $dataTable::($this,selector)}
        ldelete dataTable::(list) $this
    }

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

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

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

        set path $dataTable::($this,tablePath)
        for {set column 0} {$column<[llength $dataTable::($this,dataColumns)]} {incr column} {
            $path.$column.label configure -font $value
        }
    }

    proc set-data {this value} {
        if {$composite::($this,complete)} {
            error {option -data cannot be set dynamically}
        }
        if {![array exists $value]} {
            error "\"$value\" argument is not an existing array"
        }
    }

    proc set-draggable {this value} {
        if {$composite::($this,complete)} {
            error {option -draggable cannot be set dynamically}
        }
        if {!$value} return
        set path $dataTable::($this,tablePath)
        set dataTable::($this,drag) [new dragSite -path $path -validcommand "dataTable::validateDrag $this"]
        dragSite::provide $dataTable::($this,drag) DATACELLS "dataTable::dragData $this"

        set dataTable::($this,selector) [new tableSelector -selectcommand "dataTable::setCellsState $this"]
        bind $path <ButtonRelease-1> "dataTable::buttonRelease $this %x %y"
        bind $path <Control-ButtonRelease-1> "dataTable::toggleSelection $this %x %y"
        bind $path <Shift-ButtonRelease-1> "dataTable::extendSelection $this %x %y"
    }

    proc set-view {this value} {
        if {$composite::($this,complete)} {
            error {option -view cannot be set dynamically}
        }
        if {![array exists $value]} {
            error "\"$value\" argument is not an existing array"
        }
    }

    proc buttonRelease {this x y} {
        if {!$dataTable::($this,columnBorderHit)} {
            set number [expr {[$dataTable::($this,tablePath) cget -rows]-1}]
            if {$number==0} return
            scan [$dataTable::($this,tablePath) index @$x,$y] %d,%d row column
            if {$row<0} return
            catch {selector::select $dataTable::($this,selector) $row,$column}
        }
        unset dataTable::($this,columnBorderHit)
    }

    proc columnSort {this column} {
        if {$column==$dataTable::($this,sortColumn)} {
            if {[string compare $dataTable::($this,sortOrder) increasing]==0} {
                set dataTable::($this,sortOrder) decreasing
            } else {
                set dataTable::($this,sortOrder) increasing
            }
        } else {
            set dataTable::($this,sortColumn) $column
            set dataTable::($this,sortOrder) increasing
        }
        catch {selector::clear $dataTable::($this,selector)}
        update $this
    }

    proc update {this args} {
        variable ${this}data
        upvar #0 $composite::($this,-data) data

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

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

        set sortColumn $dataTable::($this,sortColumn)
        set lists {}
        if {[regexp {^integer|real$} $data($sortColumn,type)]} {
            foreach name [array names data *,$sortColumn] {
                scan $name %u dataRow
                if {[catch {expr {double($data($dataRow,$sortColumn))}}]} {
                    lappend lists [list $dataRow 0]
                } else {
                    lappend lists [list $dataRow $data($dataRow,$sortColumn)]
                }
            }
        } else {
            foreach name [array names data *,$sortColumn] {
                scan $name %u dataRow
                lappend lists [list $dataRow $data($dataRow,$sortColumn)]
            }
        }
        set lists [lsort -$dataTable::($this,sortOrder) -$data($sortColumn,type) -index 1 $lists]

        catch {set selector $dataTable::($this,selector)}
        set changed 0
        set row 0
        set rows {}
        foreach pair $lists {
            set dataRow [lindex $pair 0]
            if {![info exists ${this}data($row,dataRow)]} {
                lappend rows $row
            }
            set ${this}data($row,dataRow) $dataRow
            set column 0
            foreach dataColumn $dataTable::($this,dataColumns) {
                set ${this}data($row,$column) $data($dataRow,$dataColumn)
                incr column
            }
            incr row
        }
        $path configure -rows [expr {$row+1}]

        set columns [llength $dataTable::($this,dataColumns)]

        if {[llength $rows]>0} {
            set changed 1
            set cells {}
            foreach new $rows {
                for {set column 0} {$column<$columns} {incr column} {
                    lappend cells $new,$column
                }
            }
            catch {selector::add $selector $cells}
        }

        set rows {}
        while {[info exists ${this}data($row,dataRow)]} {
            lappend rows $row
            incr row
        }
        if {[llength $rows]>0} {
            set changed 1
            set cells {}
            foreach old $rows {
                unset ${this}data($old,dataRow)
                for {set column 0} {$column<$columns} {incr column} {
                    lappend cells $old,$column
                    unset ${this}data($old,$column)
                }
            }
            catch {selector::remove $selector $cells}
        }

        if {$changed} {
           catch {selector::clear $selector}
        }

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

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

        set data $composite::($this,-data)
        set list {}
        foreach cell [selector::selected $dataTable::($this,selector)] {
            scan $cell %d,%d row column
            lappend list ${data}([set ${this}data($row,dataRow)],[set ${this}data($column,dataColumn)])
        }
        return $list
    }

    proc validateDrag {this x y} {
        if {$dataTable::($this,columnBorderHit)} {
            return 0
        }
        return [expr\
            {[lsearch -exact [selector::selected $dataTable::($this,selector)] [$dataTable::($this,tablePath) index @$x,$y]]>=0}\
        ]
    }

    proc setCellsState {this cells select} {
        if {$select} {
            eval $dataTable::($this,tablePath) tag cell select $cells
        } else {
            eval $dataTable::($this,tablePath) tag cell {{}} $cells
        }
    }

    proc toggleSelection {this x y} {
        set cell [$dataTable::($this,tablePath) index @$x,$y]
        scan $cell %d row
        if {$row<0} return
        selector::toggle $dataTable::($this,selector) $cell
    }

    proc extendSelection {this x y} {
        set cell [$dataTable::($this,tablePath) index @$x,$y]
        scan $cell %d row
        if {$row<0} return
        selector::extend $dataTable::($this,selector) $cell
    }

    proc updateSortingArrow {this column} {
        set path $widget::($dataTable::($this,arrow),path)

        set label $dataTable::($this,tablePath).$column.label
        foreach event {<Enter> <Leave> <ButtonRelease-1>} {
            bind $path $event [bind $label $event]
        }
        if {[string compare $dataTable::($this,sortOrder) increasing]==0} {
            widget::configure $dataTable::($this,arrow) -direction down
        } else {
            widget::configure $dataTable::($this,arrow) -direction up
        }
        place $path -in $dataTable::($this,tablePath).$column -anchor e -relx 1 -rely 0.5 -relheight 1
    }

    proc createTitles {this} {
        variable ${this}data
        upvar #0 $composite::($this,-data) data

        set path $dataTable::($this,tablePath)
        set font $composite::($this,-titlefont)
        set column 0
        foreach dataColumn $dataTable::($this,dataColumns) {
            set frame [frame $path.$column]
            set label [label $path.$column.label -font $font -text $data($dataColumn,label) -cursor top_left_arrow]
            place $label -relwidth 1 -relheight 1
            $path window configure -1,$column -window $frame -padx 2 -pady 2 -sticky nsew
            bind $label <ButtonRelease-1> "dataTable::columnSort $this $dataColumn; dataTable::updateSortingArrow $this $column"
            bind $label <Enter> "lifoLabel::push $::messenger [list $data($dataColumn,message)]"
            bind $label <Leave> "lifoLabel::pop $::messenger"
            lappend dataTable::($this,tips) [new widgetTip -path $label -text {click to toggle sort}]
            incr column
        }
        $path configure -cols $column
        if {![info exists dataTable::($this,arrow)]} {
            set arrow [new arrowButton $path -state disabled -borderwidth 0 -highlightthickness 0 -width 12]
            widget::configure $arrow -disabledforeground [widget::cget $arrow -foreground]
            $widget::($arrow,path) configure -cursor top_left_arrow
            lappend dataTable::($this,tips) [new widgetTip -path $widget::($arrow,path) -text {click to toggle sort}]
            set dataTable::($this,arrow) $arrow
        }
    }

    proc buttonPress {this x y} {
        foreach {row column} [$dataTable::($this,tablePath) border mark $x $y] {}
        set dataTable::($this,columnBorderHit) [expr {[info exists column]&&([string length $column]>0)}]
    }

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

        variable ${this}data
        if {[string length $composite::($this,-view)]>0} {
            upvar #0 $composite::($this,-view) data
        } else {
            upvar #0 $composite::($this,-data) data
        }
        if {[catch {set columns $data(visibleColumns)}]} {
            set columns {}
            foreach name [array names data *,label] {
                if {[scan $name %u column]>0} {
                    lappend columns $column
                }
            }
        }
        set dataTable::($this,dataColumns) [lsort -integer $columns]
        set dataTable::($this,sortColumn) [lindex $data(sort) 0]
        if {[lsearch -exact $columns $dataTable::($this,sortColumn)]<0} {
            error "sort column $dataTable::($this,sortColumn) is not visible"
        }
        set dataTable::($this,sortOrder) [lindex $data(sort) 1]
        set column 0
        foreach dataColumn $dataTable::($this,dataColumns) {
            set ${this}data($column,dataColumn) $dataColumn
            if {$dataColumn==$dataTable::($this,sortColumn)} {
                set sortColumnIndex $column
            }
            incr column
        }
        createTitles $this
        updateSortingArrow $this $sortColumnIndex
        trace variable $composite::($this,-data)(updates) w "dataTable::update $this"
    }
}

set rcsId {$Id: datagraf.tcl,v 1.44 1998/10/11 09:27:20 jfontain Exp $}


class dataGraph {

if {$::officialBLT} {
    set (widget) stripchart
} else {
    set (widget) graph
}

    proc dataGraph {this parentPath args} composite {
        [new $dataGraph::(widget) $parentPath -title {} -topmargin 3 -bufferelements 0 -plotborderwidth 1 -plotbackground black]
        $args
    } blt2DViewer {$widget::($this,path)} {
        set path $widget::($this,path)
        $path xaxis configure -tickfont $font::(smallNormal) -title {} -rotate 90 -command dataGraph::axisTime
if {$::officialBLT} {
        $path xaxis configure -tickshadow {}
        $path pen create void -linewidth 0 -symbol none
}
        bind $path <Visibility> "dataGraph::resized $this"
        set dataGraph::($this,plotWidth) 0
        composite::complete $this
    }

    proc ~dataGraph {this} {
        if {[string length $composite::($this,-deletecommand)]>0} {
            uplevel #0 $composite::($this,-deletecommand)
        }
    }

    proc iconData {} {
        return {
            R0lGODdhKAAoAKUAAHt5e87PzgAAANbX1v///zFhITFhGJTXa633e6X3e5znc6Xvc3u+Wpznazk4OZTfa4zPY3NJAPffSufHOda2Mc6mKVIIY2sYexBhe4wQ
            pa3X54S+zr0o1qUYvbUYzrUg1lKWrb0Y3t44/60Yzt5B/+dJ/+dR/9YY984Y7+dZ/+dh/94o/+9x/wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
            AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACwAAAAAKAAoAAAG/kCAcEgsGo/IYQAgaDqf0Kh02lwKAthsYIDlbrVer3Y8ZgYI6DQaoG6z2+n3Gm09wwlyeN6t
            flsHd3iBgoF5fmZDBYpJAIoGBUaPj0Z1aAUHmAWEapeYB5ppBQgICQqghwKABJ2ZeYoLCwoLpYqKpbAMkISVqwyeC6CrsAoKDAzDCg3FC8aQbKhLQgW+BwsN
            tdUNzdMMxb7bDuFEf5zGyp4H2osOisbbAA5y0G3cD98QuUPxjbX6fXRMVHHi5s7ZHCNz4gC8gqTWIkYQAfCCs2/Iv0IXyd2JwJEjH4wKCUxMw1GCSZMRLt4x
            tDDakAgmJ8iUKSGCkY42GY2EKZNC/oWfFCbUTAmg5EmPLEUGJCmhZ4WOFYKihNl05tSMZtDwnOAzZ9GfNJv6/BlVaM2Qf4REoMD2abi3HKOy7Qo1aNeKErMS
            iEDWpgM3fPsSCfzT5i69ezkK+Qu4oyGcQg5f6ROZsZ54K/cltEKls2cpViyIvoCh9IXTqFOXNp2a9OrWF6xkmI1Bg20Ms3Pnrm1bA+7dvTdguMChOAcrHTx8
            wLChue8P0KGX1tDc+era1UEMDxFChAgrIzyMwACi+nPptpuDKL+hN/UN64dfCEGiPvgR0tm3X/0+Pnn98GknH3clFAgeByEg+J9z6cHHWmnr+Ycad/XZxwR3
            GIawYHUOXsJ23YQYmiCiCVZwhyCCGv4X4YAYwjbiiyOWeAIKM6KAQgiuvXZBCjz26OOPQFpRo41E4phaBiGooOSSTDbppJAoOCnllFQ2acUKK7Cg5ZZcdunl
            l18uQcaYZJZZZhAAOw==
        }
    }

    proc options {this} {
        set samples [expr {$configuration::(graphNumberOfIntervals)+1}]
        return [list\
            [list -deletecommand {} {}]\
            [list -draggable draggable Draggable 0 0]\
            [list -height height Height 200]\
            [list -interval interval Interval 5]\
            [list -samples samples Samples $samples $samples]\
            [list -width width Width 300]\
        ]
    }

    proc set-deletecommand {this value} {}

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

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

    proc set-interval {this value} {
        set dataGraph::($this,range) [expr {($composite::($this,-samples)-1)*$value}]
        updateGraduations $this
    }

    proc set-samples {this value} {
        if {$composite::($this,complete)} {
            error {option -samples cannot be set dynamically}
        }
        set dataGraph::($this,range) [expr {($value-1)*$composite::($this,-interval)}]
    }

    proc xAxisUpdate {this currentTime} {
        $widget::($this,path) xaxis configure -min [expr {$currentTime-$dataGraph::($this,range)}] -max $currentTime
    }

    proc axisTime {path value} {
        set value [expr {int($value)}]
        if {($value%60)==0} {
            return [clock format $value -format %H:%M]
        } else {
            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
    }

    proc updateGraduations {this} {
        if {$dataGraph::($this,plotWidth)==0} return
        set minimum [expr {(2*6*$dataGraph::($this,range))/$dataGraph::($this,plotWidth)}]
        foreach step {10 60 300 600 1800 3600 18000 36000 86400} division {5 6 5 5 5 6 5 5 4} {
            if {$step>$minimum} break
        }
        $widget::($this,path) xaxis configure -stepsize $step -subdivisions $division
        xAxisUpdate $this [clock seconds]
    }

    proc resized {this} {
        set width [$widget::($this,path) extents plotwidth]
        if {$width!=$dataGraph::($this,plotWidth)} {
            set dataGraph::($this,plotWidth) $width
            updateGraduations $this
        }
    }

}

class dataGraph {

    class element {

        set (vectorIndex) 0

        proc element {this path args} switched {$args} {
            global [set ($this,xVector) vector[incr (vectorIndex)]] [set ($this,yVector) vector[incr (vectorIndex)]]

            $path element create $this -label {} -symbol none
            set dots [expr {$configuration::(graphNumberOfIntervals)+1}]
if {$::officialBLT} {
            global [set ($this,weights) vector[incr (vectorIndex)]]
            blt::vector create [set ($this,xVector)]($dots)
            blt::vector create [set ($this,yVector)]($dots)
            blt::vector create [set ($this,weights)]($dots)
            $path element configure $this -weight [set ($this,weights)] -styles {{void 0 0}}
} else {
            blt::vector [set ($this,xVector)]($dots)
            blt::vector [set ($this,yVector)]($dots)
}
            $path element configure $this -xdata [set ($this,xVector)] -ydata [set ($this,yVector)]
            set ($this,path) $path
            switched::complete $this
        }

        proc ~element {this} {
            global [set ($this,xVector)] [set ($this,yVector)]

if {$::officialBLT} {
            global [set ($this,weights)]
            blt::vector destroy [set ($this,xVector)] [set ($this,yVector)] [set ($this,weights)]
} else {
            unset [set ($this,xVector)] [set ($this,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} {}

if {$::officialBLT} {

        proc update {this x y} {
            global [set ($this,xVector)] [set ($this,yVector)] [set ($this,weights)]

            if {[set [set ($this,xVector)](end)]==0} {
                if {[string length $y]==0} return
                set [set ($this,xVector)](end) $x
                set [set ($this,yVector)](end) $y
            }
            [set ($this,xVector)] delete 0
            [set ($this,yVector)] delete 0
            [set ($this,weights)] delete 0
            [set ($this,xVector)] append $x
            if {[string length $y]==0} {
                [set ($this,yVector)] append [set [set ($this,yVector)](end)]
                [set ($this,weights)] append 0
                [set ($this,path)] element configure $this -label "$switched::($this,-label): ?"
            } else {
                [set ($this,yVector)] append $y
                [set ($this,weights)] append 1
                [set ($this,path)] element configure $this -label "$switched::($this,-label): $y"
            }
        }

} else {

        proc update {this x y} {
            global [set ($this,xVector)] [set ($this,yVector)]

            if {[string length $y]==0} {
                set y 0
                [set ($this,path)] element configure $this -label "$switched::($this,-label): ?"
            } else {
                [set ($this,path)] element configure $this -label "$switched::($this,-label): $y"
            }
            if {[set [set ($this,xVector)](end)]==0} {
                set [set ($this,xVector)](:) $x
                set [set ($this,yVector)](:) $y
            }
            [set ($this,xVector)] delete 0
            [set ($this,yVector)] delete 0
            [set ($this,xVector)] append $x
            [set ($this,yVector)] append $y
        }

}

    }

}

set rcsId {$Id: databar.tcl,v 1.15 1998/10/11 09:27:20 jfontain Exp $}

class dataBarChart {

    proc dataBarChart {this parentPath args} composite {
        [new barchart $parentPath\
            -title {} -bottommargin 6 -topmargin 3 -bufferelements 0 -plotborderwidth 1\
            -plotbackground $widget::(default,ButtonBackgroundColor)\
        ] $args
    } blt2DViewer {$widget::($this,path)} {
if {$::officialBLT} {
        $widget::($this,path) grid off
        $widget::($this,path) xaxis configure -hide 1
} else {
        $widget::($this,path) xaxis configure -mapped 0
}
        composite::complete $this
    }

    proc ~dataBarChart {this} {
        if {[string length $composite::($this,-deletecommand)]>0} {
            uplevel #0 $composite::($this,-deletecommand)
        }
    }

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

    proc set-deletecommand {this value} {}

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

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

    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 create $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///wAIADFhITFhGAAQAK33e6X3e5znc6Xvc5zna5TXa5Tfazk4OUJJQozPY4THWnvHWoTPY3u+Wnu+UqWupQAY
            AHO2UhgQADEgAHNJAGuuShAIACkgAPffSu/XQiEYAGOmSu/PQufHOWOeQue+OVqWOda2MQAgAN6+MVKOOd62MUqGMc6mKVIIYzEIOXMQhGsQe2sYe0J5KTko
            AK0YzrUg1r0o1owQpQAoADlxKc6eIQAQEBBphBBhe944/6UYvbUYzkIoAMaWIa3X57Xf76XP594w/95B/zlpIb2OGMaeIedJ/0owAAAQGJTH3r0Y3iFREFI4
            AAAYIYy+1oS+znMoe+dR/ylZGLWGEGumvXOuxudZ/7V5EAAgKWsge+dh/9YY984Y761xCFKWrXMwe2NBAAAwQkKOpd4o/wAAAAAAAAAAAAAAAAAAAAAAAAAA
            AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACwAAAAAKAAoAAAH/oAAgoOEhYaHiIMBAAKNjo+QkZKTjYsCAZiZAQOYnJuanp6ao6OMAQSo
            qagAqq2sramvq6iWp7AEsrC5rqqvlgOoBQUGB8TFxbq3s7G0poIFCAnSCgoLDAeJ2YW1wQXVDODWBsnKub6MwATQ4QsLDQsH5LfmzZfdDO8N7w4Ggr3KuP4R
            qPUMwb4HCPlBiKBN2y9UCAo4eOCgogMJ/eiVE8iNAAIEFCWIFJlR4DyO6CAWGClyAoWSzDbGJAjgYwUKEyrcnGBgYcNsHSO6nGChqAWYy07OTOkRAQWjRS8g
            JYABoMaOGRBc2MpVg4ENHDqIHStWXsCBzmoi0KDBA1u3/gY+gAhBl64IER1+AsBaoG1btx4MjOAQ4q5hvGbPCUiXFfBbEl853C0xuUSHxPVsZShAorNnyINL
            iDZhooSJvBqX/RKU9YTr1ycEcyhN2gSK0z4dmkLVOsWJFL5TyLZtQoUKFChQmzzbcQUC4NCBG+DAAYUKFtivK4+pejeBFQV+twDeosV0DtddqDe+PSlzRo6y
            lp/f4sV5F8bzw+hACZKlGAA698KABNoHAgcwGAfDgip0IIMMM0RIwww0TEhDDRj+B2BWL9jg4YcG3ADCgiQu2AGAOKSIQw4stqiDDpbsICMPBXjYg402hIjg
            gj74YOIPBQARxJBEBiHEkUJY/jIEETk4Z0MPUEZpQBE7GmElDEZ08MMPRyBxxJdHJBGEEkIssYQlOBCBAw8IQMmEm0xMCYKVTTjhhBFNaMmll2CKWeYST6C5
            Io1MFGqoAQZAwYGVeDZhZQdRRBGmFJRSGoSZT5zJCA46TOEcoqAiSkUVHDRh6ql5WhEFpVe0igUWQWSRhRZaWDLFrWwiWgwxW1ChaBNcBCtsB1ZYccWrXSTr
            RaxZfPGFrVPo4NwBW1RbLRWjcsAFGNuCwW0HYUThRRfjJttFEGJkMcYYtpJRBo3YxhsvFCBsa4a3YJgBbhTmJnvGGbGisa4l7r6LgLzypsHBvfd6q68aUfwr
            8RprGgQ8MCMFF8zGxhx37PHHIHO8CCkkl2yyyYEAADs=
        }
    }
}

class dataStackedBarChart {
    proc dataStackedBarChart {this parentPath args} dataBarChart {$parentPath $args} {
        composite::configure $this -mode stacked
    }
    proc ~dataStackedBarChart {this} {}
    proc iconData {} {
        return {
            R0lGODdhKAAoAMYAAHt5e87PzgAAANbX1v///xAoCAAIADFhITFhGAAQAK33e6X3e5znc6Xvc5zna5TXa5Tfazk4OUJJQozPY4THWnvHWoTPY3u+Wnu+UlI4
            ABAIABgQADEgAHNJACkgAO/XQvffSiEYAO/PQufHOee+Oda2MSEQAN6+Md62MVIIY86mKWsQe2sYe4wQpTkoAHMoe70o1qUYvbUYzrUg1gAYIQAQEBBphBBh
            e2sge944/60Yzq3X57Xf76XP53Mwe95B/+dJ/70Y3gAQGJTH3oy+1oS+zudR/2umvXOuxudZ/9YY984Y7wAgKedh/wAoOVKWrQAwQkKOpd4o/wAAAAAAAAAA
            AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
            AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACwAAAAAKAAoAAAH/oAAgoOEhYaHiIMBAAKNjo+QkZKTjYsCAZiZAQOYnJuanp6ao6OMAQSo
            qagAqq2sramvq6iWp7AEsrC5rqqvlgOoBQIGxAcIxsjHysnMy7i0poLDxAkK1gsMDdYK2NrX2dvdCIS1qMTn3Q3Z6evZ6g3sDQfPBL/m5wkN6gwO7gz8/gDq
            +9cPAb1yBM4Ra9Cv3wOGAB82ZCAx4oFB9aIBUJjAIQQIDzyCFBmS4scHByJIiADAXsIEMA08APngwYSZNW3irHmTps2LgjJeQpXAAMwEICconZB0aVOlTycA
            ZeXSaMylEyhUwKqV69alWqcKXQTgKEwLFSigVZt2rdu2/nAppJQgoaUpokcNaKVwoe/evhf++k0LWGxVsxUAX8CQGDBjxY8dG75LIIMGDRs4dNjMubPnz50x
            1hK04bIGDx9AqAaRWnVr1q0/vJbdIYJtu0MJmA7BQbbv38CD/+4gmhEwAiGSZxbxgXnz58yji5AOXQTxoAiTJ+cwYvqI7967i+hOfrz38depGheknTf57+/f
            k4A/f/yI+bVX4rbVngOJ+SWU8N8IAgI4YIEGkpDeWKiYwMGDHJxQwgkUSljhhBZSOCGGEy6IEIQPTojCiCKiUGKAJJ5YgoeMOOIBiCYGWEKMM8ooI400dvCI
            JSn0COGLKgSowpBCBlkCkUQe/mmkCh2swMKTlrQgJYQueDDklVhmqSWWHbzgJQyWxCDDDDQMU4MBNtygpppprnlDm2vCuSYOXuZgiQ4y6EBMDXzuwMMOgPbg
            J6A7CPpnoIMGesMLPvjww506zLBnn4cWmqillRpKaA+LNgrEnTAEwWcNQghR6BCoDnFqqqui2uoQN9D5wqOMBGFrqTTQIASqRBBRRBG8+grsEL3+Guyvnfpg
            hCW2wpDrs8IecQQS0U5bLbW/SotEskkwq8QSTITLhBBITCutueVqa6666R4Rq5dNWPItuEw4Me65RzzxBL768rvvufomGy8j8zIBxcFC6KtvFFEo/ATDDkOs
            MMMCFlsixcUYZ6zxxhx3LMUipIQs8sgjBwIAOw==
        }
    }
}

if {$officialBLT} {

class dataOverlapBarChart {
    proc dataOverlapBarChart {this parentPath args} dataBarChart {$parentPath $args} {
        composite::configure $this -mode overlap
    }
    proc ~dataOverlapBarChart {this} {}
    proc iconData {} {
        return {
            R0lGODdhKAAoAMYAAHt5e87PzgAAANbX1v///xAoCAAIADFhITFhGAAQAK33e6X3e5znc6Xvc5zna5TXa5Tfazk4OUJJQozPY4THWnvHWoTPY3u+Wnu+UqWu
            pQAYAHO2UlI4ABAIABgQADEgAHNJAGuuSikgAPffSu/XQiEYAGOmSu/PQufHOWOeQue+OVqWOda2MQAgACEQAN6+MVKOOd62MUqGMc6mKVIIYzEIOXMQhGsQ
            e2sYe4wQpUJ5KTkoAK0YzrUg1r0o1qUYvbUYzgAoADlxKUIoAM6eIQAYIQAQEBBphBBhe944/8aWIa3X57Xf76XP594w/95B/zlpIb2OGMaeIedJ/70Y3kow
            AAAQGJTH3oy+1oS+znMoe+dR/ylZGLWGEGumvXOuxudZ/9YY984Y7yFRELV5EAAgKWsge+dh/61xCAAoOVKWrXMwe2NBAAAwQkKOpd4o/wAAAAAAAAAAAAAA
            AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACwAAAAAKAAoAAAH/oAAgoOEhYaHiIMBAAKNjo+QkZKTjYsCAZiZAQOYnJuanp6ao6OMAQSo
            qagAqq2sramvq6iWp7AEsrC5rqqvlgOoBQIGxAcIxsi9t7OxtKaCw8QJCtQLDA0IidqKpqjE39YNDdcHysu5vozABN8GCeIMDA4MCOa36M6X3u0N8/MPBwbh
            WjawGYFagtol+AcBAsAIEiJsQ/TLW4KLBh44fPBgQkBBBe+Zq4UqgbuLDieo9Chwl72CFdldNLlyAoUKH1m5NMgMIYCZFy1UoCCUwgGIEiYeIkkAqIGbFC5I
            zRlS10h1FmdWkCoVA9UMBPEd7EZAQwINZjGo3cChQwcP/h9AyJ0LgpdBn2jNJtiwIcQGD247iBhBeAQJEiCUMj2L1kDfvoFLfDB8+HDdl+kErGNs1m8IEyVC
            wz18gsSJE5d5wiSbV4MBE7BBh5Z8+gQK24lBVs08QFDrBCmCp5gt+TYKFCpQgIAoMdHivMBXpFhB/ANyFCxUqMj9SixTDS3AJ1hBfoWLD+g/qGDx4gV77sx6
            kk3Qor6B6TBgpEfPPkYMFizAt1s+jqAVXgL5wSCDCPv9ByALM4BAySOW0GAhePUlIMOGMqTH4AwAzgAiCDWUaMMNJ6J4Aw4sWpLDixiaJYMONKa3gwgi5hih
            hTTwwEMPQAbpgw+W/ABEDxgG/mEAjULo8MEOQ+zwQY5EFDGMEQYcgcSWXCbhZRKW8AAED+AF0UICOgih5gdRDjHlDEooQYwRdC7BxBJ4NoGEE0k88USYP2pg
            ZhAJqAkFFGwOMYQIcUYhxZx13pknEn0+MUWYPlAhaAtKHgrFAYlW8UGcSkRBpxFWWLFEE1e0egUSfk7xJyNU1CqomQkcoCuoVVTBwQdRBBtFqkUUYUWrWGCR
            RRZIaOHsFpbU6sOthOqKABcf+CpqFF10W+y3ymbhhRdfNOssGNGGIcatZ17LxRgfcCDvB12QUW8Z+JZhxRfkjusFEmY4e4Yl6q4bxMEGjKEwvNqKUC8aZOCb
            hr7+OXqhhhrNrrHGwIwUTG0CC8PLxsgfQAxxGW2kbMXFF7vhRsYbW/LGzDTXbPPNOOf8xiKk9Ozzzz8HAgA7
        }
    }
}

}

set rcsId {$Id: datapie.tcl,v 1.26 1998/10/11 09:27:20 jfontain Exp $}

class dataPieChart {

    proc dataPieChart {this parentPath thickness args} composite {
        [new canvas $parentPath -highlightthickness 0 -borderwidth 2] $args
    } viewer {} {
        set path $widget::($this,path)
        set dataPieChart::($this,slices) {}
        set dataPieChart::($this,drop) [new dropSite\
            -path $path -formats DATACELLS -command "viewer::view $this \$dragSite::data(DATACELLS)"\
        ]

        composite::complete $this

        set padding [$path cget -borderwidth]
        set dataPieChart::($this,pie) [new pie $path $padding $padding\
            -title {} -thickness $thickness -selectable $composite::($this,-draggable)\
            -labeler [new piePeripheralLabeler $path\
                -font $font::(mediumNormal) -smallfont $font::(smallNormal) -widestvaluetext {00.0 %}\
            ]\
        ]
        set padding [expr {2*$padding}]
        bind $path <Configure>\
            "switched::configure $dataPieChart::($this,pie) -width \[expr {%w-$padding}\] -height \[expr {%h-$padding}\]"
    }

    proc ~dataPieChart {this} {
        delete $dataPieChart::($this,pie) $dataPieChart::($this,drop)
        catch {delete $dataPieChart::($this,drag)}
        if {[string length $composite::($this,-deletecommand)]>0} {
            uplevel #0 $composite::($this,-deletecommand)
        }
    }

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

    proc set-deletecommand {this value} {}

    proc set-draggable {this value} {
        if {$composite::($this,complete)} {
            error {option -draggable cannot be set dynamically}
        }
        if {!$value} return
        set dataPieChart::($this,drag) [new dragSite -path $widget::($this,path) -validcommand "dataPieChart::validateDrag $this"]
        dragSite::provide $dataPieChart::($this,drag) OBJECTS "dataPieChart::dragData $this"
        dragSite::provide $dataPieChart::($this,drag) DATACELLS "dataPieChart::dragData $this"
    }

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

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

    proc validateDrag {this x y} {
        if {[llength $dataPieChart::($this,slices)]==0} {
            return 1
        }
        return [expr {\
            [lsearch -exact [slice::selected $dataPieChart::($this,pie)] [slice::current $dataPieChart::($this,pie)]]>=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}]] %"
            }
        }
    }

    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
    }

    proc cells {this} {
        return [cellsFromSlices $this $dataPieChart::($this,slices)]
    }
}

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
        }

        proc current {pie} {
            set slice [pie::currentSlice $pie]
            if {$slice==0} {
                return 0
            } else {
                return [set (this,$slice)]
            }            
        }

    }

}

class data2DPieChart {

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

    proc ~data2DPieChart {this} {}

    proc iconData {} {
        return {
            R0lGODdhKAAoAKUAAHt5e87PzgAAANbX1v///zFhIXNJAKX3e/ffSpznc+/XQozPY+fHOXvHWta2Mc6mKUJJQhBhe63X54y+1pTH3lKWrWumvVIIY2sYe4wQ
            pb0o1qUYvbUYzq0Yzr0Y3t44/95B/+dJ/+dR/+dZ/9YY9+dh/94o/+9x/wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
            AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACwAAAAAKAAoAAAG/kCAcEgsGo/IYQAgaDqf0Kh02lwKAthsYIDlbrVer3Y8ZgYI6DQaoG6z2+n3Gm09wwlyeN6t
            flsHd3iBgoF5fmZJRAWLBQaOiUZ1hWiLB5YFCJkIjnxxdEyAdwCVlpeampxzngSSdwWlBwkJB5inCrcGqqp1R6+wsgu1t8MMDAZJf3C+lsALwcO3xdLHfZ9X
            bcuxCc4JDQXR0g7i4rmryWq+stsL698K0uHk1ayIQ8vq3c7e8PEODw/l8AhpRSmWtgYN9O0rNq7hv4CHBIQikK7ZOoQFGDb09+/hLjNpXqljl3ABQm8OO6oE
            +PGKvVj6TCpEubImQAhECL7iNvNk/iNHQIMGZRNxYgGeJk+ejCChadMJEqBSmDChQgSi1uxQPJBQqVKmTqE2nUrVglWs9CTaQ9jNK0KwTqNGpTrBbAScSkCG
            bOsWrty5dO0KIUSQotulT5/SLSsYbWHDff8uDty4ZZQCh+FOZlzBqhQrFy5gGD0as1emmzlbJc0ag5UMsGPDNv12AtnFFnJ3jsBag2/fVjZwEE6cQwfaESbn
            Xr6bdAcPHz5A/2Clg/Hr1jscLxBhuXfdVnmP7gCivHkQ1bWrX689QoTO8OG7Z00eRIj7+Ktr6LC/P4jnHniAgXsEEkhffeeZZ0WAIHjQoAggiCDhhB205px2
            E2aY4YIiQHgA4YcaasheiCSKsOAIKKao4oostuiiFSSUIOOMNNZo4404wojjjjzuaIUJJpwg5JBEFmnkkUcuQcaSTDbZZBAAOw==
        }
    }

}

class data3DPieChart {

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

    proc ~data3DPieChart {this} {}

    proc iconData {} {
        return {
            R0lGODdhKAAoAKUAAHt5e87PzgAAANbX1v///zFhIXNJAKX3e/ffSu/XQufHOZznc9a2MY7PYc6mKRBhe63X55TH3oy+1lKWrUJJQk2SMDF5lFIIY2sYe4wQ
            pb0o1qUYvbUYzr0Y3t44/60Yzt5B/+dJ/+dR/+dZ/9YY9+dh/94o/+9x/wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
            AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACwAAAAAKAAoAAAG/kCAcEgsGo/IYQAgaDqf0Kh02lwKAthsYIDlbrVer3Y8ZgYI6DQaoG6z2+n3Gm09wwlyeN6t
            flsHd3iBgoF5fmZJRAWLBQaOBolFdYMEjAeXBQiaCI99ngR/gYuXpAeZmwgJCo5zcXRmdwWlpAunmqoKCgwGhK11RrKzCwsNtrm6DMmQR6FqwbTDDbWpx8jJ
            u5+Tac8H0sQN4Jm51+QMDry+TIDb0N/fBdblDvPohL9Cz9HE+8Xy8//0JMFCEwwcP34FzAFcSC+dgHWVLumTBi7co4sYWdkbWCkaRXfgHkAYSXJkhAgQJEx4
            4HAJvo8wQ5YkeTKChJsrKRDR1tFb/sWfImfWvKlSwgM2hx5uK/DzW8WgKYcSnaDy6MYrSyn+lGny5E2bRVdaTTpgSIEKTLfKlOo17AMLD3Qq4XgWrdoGIonq
            pUr1LVykr7ASrEA4LVC9YYv6/XvVzuDChh8k5qvYguWjgEExgVIX8qIHlPk+GL0YbhQrFy5gWI2hM2HCpGOXtgyXtW0rGXLrzuAaNu3fwGuv1kCcuJUNHJAr
            57DodYXZwYVj6ODBA3UPVj5w0M6dA/PO0H+PZt0BhPnz2T+oX7++A6PwpG2fD0GffnYNH/Dr78CfPwbZ8dlW3nkEgmAFfyCU14EIIIjg4IO2sfYBeQ9WWOGB
            IizYYIMWPlYIAnsfcNihhQeOYOKJKKao4oosWkFCCTDGKOOMNNZoo4s25qhjjlaYYMIJQAYp5JBEFlnkEmQkqeSSSwYBADs=
        }
    }

}

set rcsId {$Id: lastwish.tcl,v 1.1 1998/07/16 20:21:57 jfontain Exp $}

class lastWish {

    proc lastWish {this command} {
        set lastWish::($this,command) $command
    }

    proc ~lastWish {this} {
        uplevel #0 $lastWish::($this,command)
    }

}

set rcsId {$Id: sumtable.tcl,v 1.9 1998/10/11 09:27:20 jfontain Exp $}

class summaryTable {

    proc summaryTable {this parentPath args} composite {[new frame $parentPath] $args} viewer {} {
        variable ${this}data

        array set ${this}data {
            updates 0
            0,label data 0,type ascii 0,message {data cell description}
            1,label current 1,type real 1,message {current value}
            2,label average 2,type real 2,message {average value since viewer creation}
            3,label minimum 3,type real 3,message {minimum value since viewer creation}
            4,label maximum 4,type real 4,message {maximum value since viewer creation}
            sort {0 increasing}
            indexColumns 0
        }
        set summaryTable::($this,nextRow) 0


        composite::complete $this

        set table [new dataTable $widget::($this,path)\
            -data summaryTable::${this}data -draggable $composite::($this,-draggable) -titlefont $composite::($this,-titlefont)\
        ]
        set summaryTable::($this,drop) [new dropSite\
            -path $dataTable::($table,tablePath) -formats DATACELLS -command "viewer::view $this \$dragSite::data(DATACELLS)"\
        ]
        if {$composite::($this,-draggable)} {
            dragSite::provide $dataTable::($table,drag) OBJECTS "summaryTable::dragData $this"
        }
        pack $widget::($table,path) -fill both -expand 1
        set summaryTable::($this,dataTable) $table
    }

    proc ~summaryTable {this} {
        variable ${this}data
        variable ${this}cellRow

        delete $summaryTable::($this,dataTable) $summaryTable::($this,drop)
        unset ${this}data
        catch {unset ${this}cellRow}
        if {[string length $composite::($this,-deletecommand)]>0} {
            uplevel #0 $composite::($this,-deletecommand)
        }
    }

    proc iconData {} {
        return {
            R0lGODdhKAAoAIQAAHt5e87PzgAAANbX1v///9/f339/fzk4OUJJQlIIY2sQe2sYe4wQpXMoe70o1qUYvbUYzrUg1msge944/60YznMwe95B/+dJ/70Y3udR
            /9YY984Y794o/wAAAAAAAAAAACwAAAAAKAAoAAAF/iAgjmRpnugYAELrvnAsz+0qBHgeDDi/6z6fbjhkBQjIJBKgbDKbyecSaTtCCVJo1ql82gZImniMpRpF
            sELBoG672e53QUCqhl9qeDy/b7MFZQRfdy58fWuHiIBeRoQtBpCRkpOUkXQigmcsLwSInZ8FnWygoH8HCAcAgwRpBAakoaGvsaSvl0x2rJyetLGjvaJzI5kC
            YLoulcnKt8Qrm4WIh3p7pggIqo3HLYZ903F/w6tp0d2J4Ji5MMrrk8xVaLu/sPK9pgep6XiusJ+z/LbhWBiDEYwfr3nC0GVTx66hO4HwoHmTI23OKXwL8ZCj
            Zi4hrowSO1Z8eMORgIYOlgPSKAjsYL05L2wkmNnKHzCbtVgpWMDTBoOfBF2WahlMQIOjDmw8gBCBIcplEo5OsEEBAoVxE/10NFqhggWqFJpqzMqNI9cKF6g6
            wIBVZDkBURt8ZYGh7pi7Mhp0zWCjrl8MXQMLHky4cGAMff8CNsy4cVfELDRs4ECZg+PLhTnYqMy5s+fPoDlvDk26tOcVRFKrXr06BAA7
        }
    }

    proc options {this} {
        return [list\
            [list -deletecommand {} {}]\
            [list -draggable draggable Draggable 0 0]\
            [list -titlefont titleFont TitleFont $font::(mediumBold) $font::(mediumBold)]\
        ]
    }

    proc set-deletecommand {this value} {}

    foreach option {-draggable -titlefont} {
        proc set$option {this value} "
            if {\$composite::(\$this,complete)} {
                error {option $option cannot be set dynamically}
            }
        "
    }

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

    proc monitorCell {this array row column} {
        variable ${this}data
        variable ${this}cellRow

        viewer::registerTrace $this $array
        set cell ${array}($row,$column)
        if {[info exists ${this}cellRow($cell)]} return

        set label [viewer::label $array $row $column]

        set row $summaryTable::($this,nextRow)
        set ${this}data($row,0) $label
        array set ${this}data "$row,2 {} $row,3 {} $row,4 {}"
        set ${this}data($row,sum) 0.0
        set ${this}cellRow($cell) $row
        set summaryTable::($this,rowLastWish,$row) [new lastWish "summaryTable::deleteRow $this $cell"]
        incr summaryTable::($this,nextRow)
    }

    proc update {this array args} {
        variable ${this}data
        variable ${this}cellRow

        foreach cell [array names ${this}cellRow] {
            set row [set ${this}cellRow($cell)]
            if {[catch {set $cell} current]} {
                set ${this}data($row,1) ?
            } else {
                set ${this}data($row,1) $current
                set ${this}data($row,2) [format %.2f\
                    [expr\
                        {[set ${this}data($row,sum) [expr {[set ${this}data($row,sum)]+$current}]]/([set ${this}data(updates)]+1)}\
                    ]\
                ]
                set value [set ${this}data($row,3)]
                if {([string length $value]==0)||($current<$value)} {
                    set ${this}data($row,3) $current
                }
                set value [set ${this}data($row,4)]
                if {([string length $value]==0)||($current>$value)} {
                    set ${this}data($row,4) $current
                }
            }
        }
        incr ${this}data(updates)
    }

    proc cells {this} {
        variable ${this}cellRow

        return [array names ${this}cellRow]
    }

    proc dragData {this format} {
        variable ${this}cellRow

        foreach cell [dataTable::dragData $summaryTable::($this,dataTable) $format] {
            regexp {\(([^,]+)} $cell dummy row
            set selected($row) {}
        }
        set lastWishes {}
        foreach row [array names selected] {
            lappend lastWishes $summaryTable::($this,rowLastWish,$row)
        }
        if {([llength $lastWishes]==[array size ${this}cellRow])||([llength $lastWishes]==0)} {
            return $this
        } else {
            return $lastWishes
        }
    }

    proc deleteRow {this cell} {
        variable ${this}data
        variable ${this}cellRow

        set row [set ${this}cellRow($cell)]
        unset ${this}data($row,0) ${this}data($row,1) ${this}data($row,2) ${this}data($row,3) ${this}data($row,4)\
            ${this}data($row,sum) summaryTable::($this,rowLastWish,$row)
        unset ${this}cellRow($cell)
        dataTable::update $summaryTable::($this,dataTable)
    }

}

set rcsId {$Id: freetext.tcl,v 1.9 1998/10/18 21:17:53 jfontain Exp $}

class freeText {

    proc freeText {this parentPath args} composite {
        [new text $parentPath -font $font::(mediumNormal) -wrap word -borderwidth 0 -highlightthickness 0] $args
    } viewer {} {
        set freeText::($this,drop) [new dropSite\
            -path $widget::($this,path) -formats DATACELLS -command "viewer::view $this \$dragSite::data(DATACELLS)"\
        ]
        set freeText::($this,labels) {}
        composite::complete $this
    }

    proc ~freeText {this} {
        delete $freeText::($this,drop)
        catch {delete $freeText::($this,drag)}
        catch {delete $dataTable::($this,selector)}
        eval delete $freeText::($this,labels)
        if {[string length $composite::($this,-deletecommand)]>0} {
            uplevel #0 $composite::($this,-deletecommand)
        }
    }

    proc iconData {} {
        return {
            R0lGODdhKAAoAIQAAHh4eMjMyAAAANDU0Pj8+Hh8eDg4OEBIQLi8uFAIYHAoeHAweGgYeIgQoLgo0KAYuLAYyLAg0GggeNg4+KgYyNhA+LgY2OBI+OBQ+Ngo
            +AAAAAAAAAAAAAAAAAAAAAAAACwAAAAAKAAoAAAF/iAgjmRpnugYAELrvnAsz+0qBHgeDDi/6z6fbjhkBQjIJBKgbDKbyecSaTtCCVJo1ql82gZXQiEsJo+j
            VKOowG673/B4W2UMn693aN7LAuPNgGgEVUg0hodYaTciMGSOTQJzX4Uvj5YEAmWDdZiVl46ZZ5OdLp+gI5uLLJ6mVwIGBwcAhKQtZLaWAqijjWEtCLm7nL21
            lAi4xYXCqr2/x5mlts64rwYGs8OsCMC/0wLPwATbmMt+xDDgnelKuiKpVs3f4L/q9OzljJ703dLf+5mYYF2jda4fv3EvEC6Dx0rcuG0PwzkcR84dwYat7llc
            JSOjqxc2Eogk5jGJAAULcxYwsNGgJcmSmFAucGDjAYQIL0sKkKBAwQQbFCBQOERUhswKQClEsMA0pdOnUKNKdXoBqAOmTadq3ZoSKQusWLmKlYrBBtizaNOq
            RetVwNq3cMFWmGsjg927ePPq3at3boa6fAMLDgx4sGHDK4goXsyYcQgAOw==
        }
    }

    proc options {this} {
        return [list\
            [list -cellindices cellIndices CellIndices {} {}]\
            [list -deletecommand {} {}]\
            [list -draggable draggable Draggable 0 0]\
            [list -endtext endText EndText {} {}]\
            [list -height height Height 1]\
            [list -width width Width 40]\
        ]
    }

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

    proc set-endtext {this value} {
        $widget::($this,path) insert end $value
    }

    proc set-deletecommand {this value} {}

    proc set-draggable {this value} {
        if {$composite::($this,complete)} {
            error {option -draggable cannot be set dynamically}
        }
        if {!$value} return
        set freeText::($this,drag) [new dragSite -path $widget::($this,path) -validcommand "freeText::validateDrag $this 0"]
        dragSite::provide $freeText::($this,drag) OBJECTS "freeText::dragData $this"

        set freeText::($this,selector) [new selector -selectcommand "freeText::setLabelsState $this"]
    }

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

    proc dragData {this format} {
        switch $format {
            OBJECTS {
                set list [selector::selected $freeText::($this,selector)]
                if {[llength $list]>0} {
                    return $list
                } elseif {[empty $this]} {
                    return $this
                } else {
                    return {}
                }
            }
            DATACELLS {
                return [cellsFromLabels $this [selector::selected $freeText::($this,selector)]]
            }
        }
    }

    proc validateDrag {this label x y} {
        if {($label==0)&&[empty $this]} {
            return 1
        } elseif {[lsearch -exact [selector::selected $freeText::($this,selector)] $label]>=0} {
            return 1
        } else {
            return 0
        }
    }

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

    proc monitorCell {this array row column} {
        viewer::registerTrace $this $array
        set cell ${array}($row,$column)
        if {[lsearch -exact [cellsFromLabels $this $freeText::($this,labels)] $cell]>=0} return
        set path $widget::($this,path)
        if {[info exists freeText::($this,nextCellIndex)]} {
            set index [lindex $composite::($this,-cellindices) $freeText::($this,nextCellIndex)]
            if {[string length $index]==0} {
                unset freeText::($this,nextCellIndex)
                set index insert
            } else {
                incr freeText::($this,nextCellIndex)
            }
        } else {
            set index insert
            $path insert $index "[viewer::label $array $row $column]: "
        }
        set label [new label $path $cell]
        set labelPath $label::($label,path)
        switched::configure $label -deletecommand "freeText::deletedLabel $this $array $label"
        if {$composite::($this,-draggable)} {
            set drag [new dragSite -path $labelPath -validcommand "freeText::validateDrag $this $label"]
            dragSite::provide $drag OBJECTS "freeText::dragData $this"
            dragSite::provide $drag DATACELLS "freeText::dragData $this"
            set freeText::($this,drag,$label) $drag
            set selector $freeText::($this,selector)
            selector::add $selector $label
            bind $labelPath <ButtonRelease-1> "selector::select $selector $label"
            bind $labelPath <Control-ButtonRelease-1> "selector::toggle $selector $label"
            bind $labelPath <Shift-ButtonRelease-1> "freeText::extendSelection $this $label"
        }
        lappend freeText::($this,labels) $label
        $path window create $index -window $labelPath
        set freeText::($this,cell,$label) $cell
    }

    proc update {this array args} {
        foreach label $freeText::($this,labels) {
            if {[catch {set $freeText::($this,cell,$label)} value]} {
                switched::configure $label -text ?
            } else {
                switched::configure $label -text $value
            }
        }
    }

    proc deletedLabel {this array label} {
        if {$composite::($this,-draggable)} {
            delete $freeText::($this,drag,$label)
            selector::remove $freeText::($this,selector) $label
        }
        viewer::unregisterTrace $this $array
        ldelete freeText::($this,labels) $label
        unset freeText::($this,cell,$label)
    }

    proc cellsFromLabels {this labels} {
        set cells {}
        foreach label $labels {
            lappend cells $freeText::($this,cell,$label)
        }
        return $cells
    }

    proc cells {this} {
        return [cellsFromLabels $this $freeText::($this,labels)]
    }

    proc setLabelsState {this labels select} {
        foreach label $labels {
            label::select $label $select
        }
    }

    proc extendSelection {this endLabel} {
        set selector $freeText::($this,selector)
        if {[info exists selector::($selector,lastSelected)]} {
            foreach label $freeText::($this,labels) {
                set labelFromPath($label::($label,path)) $label
            }
            set list {}
            foreach {key path index} [$widget::($this,path) dump -window 1.0 end] {
                if {[string length $path]==0} continue
                lappend list $labelFromPath($path)
            }
            set start [lsearch -exact $list $selector::($selector,lastSelected)]
            set end [lsearch -exact $list $endLabel]
            if {$end<$start} {
                set index $start
                set start $end
                set end $index
            }
            selector::clear $selector
            selector::set $selector [lrange $list $start $end] 1
        } else {
            selector::select $selector $endLabel
        }
    }

    proc empty {this} {
        return [expr\
            {([llength $freeText::($this,labels)]==0)&&([string length [string trim [$widget::($this,path) get 1.0 end]]]==0)}\
        ]
    }

    proc initializationConfiguration {this} {
        set options {}
        set text {}
        foreach {key string index} [$widget::($this,path) dump -text 1.0 end] {
            append text $string
        }
        lappend options -endtext $text
        set indices {}
        foreach {key path index} [$widget::($this,path) dump -window 1.0 end] {
            if {[string length $path]==0} continue
            lappend indices $index
        }
        if {[llength $indices]>0} {
            lappend options -cellindices $indices
        }
        return $options
    }

}

class freeText {

    class label {

        proc label {this parentPath cell args} switched {$args} {
            set label [new label $parentPath\
                -font $font::(mediumBold) -relief sunken -padx 0 -pady 0 -borderwidth 1 -cursor top_left_arrow\
            ]
            bind $widget::($label,path) <Destroy> "delete $this"
            set ($this,path) $widget::($label,path)
            set ($this,label) $label
            set ($this,cell) $cell
            switched::complete $this
        }

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

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

        proc set-deletecommand {this value} {}

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

        proc select {this select} {
            if {$select} {
                [set ($this,path)] configure -background white
            } else {
                [set ($this,path)] configure -background $widget::(default,ButtonBackgroundColor)
            }
        }

    }

}


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 =} else {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">1. About this document</A></LI>

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

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

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

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

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

<UL>
<LI>
<A HREF="#draganddrop">5.1.1. Drag and drop</A></LI>

<UL>
<LI>
<A HREF="#dropsites">5.1.1.1. Drop sites</A></LI>

<LI>
<A HREF="#dragsites">5.1.1.2. Drag sites</A></LI>
</UL>

<LI>
<A HREF="#saving">5.1.2. Saving</A></LI>
</UL>

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

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

<UL>
<LI>
<A HREF="#source">6.1. Source</A></LI>

<UL>
<LI>
<A HREF="#namespace">6.1.1. Namespace</A></LI>

<LI>
<A HREF="#configuration">6.1.2. Configuration</A></LI>

<LI>
<A HREF="#variabledata">6.1.3. Variable data</A></LI>
</UL>

<LI>
<A HREF="#installation">6.2. Installation</A></LI>
</UL>

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

<LI>
<A HREF="#misc">8. Miscellaneous information</A></LI>
</UL>
</BODY>
</HTML>
}
set htmlHelpData {
<BODY>
<HTML>
<H3>
<A NAME="about"></A>1. 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>2. 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, textual 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, loaded as the application is launched, each
module interfacing to a specific type of data. The core is written in the
great Tcl language (at <A HREF="http://www.scriptics.com/">http://www.scriptics.com/</A>)
using object oriented techniques thanks to the stooop and scwoop packages
(at <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. Modules can be written in plain Tcl
or C 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 (starting with moodss version 3.0). This way, you
may monitor data coming from any number of heterogeneous sources. Module
names are specified in the command line and cannot be dynamically unloaded.
<P>Versions 4.0 and up add a dashboard functionality: the current configuration
(modules, viewers, poll time, windows sizes and placement, ...) can be
saved in a file at any time, for later reuse (see the -f (--file) command
line switch documentation).
<P>Versions 4.3 and up support asynchronous modules (no polling needed
as module data may change on its own). Note that any number of asynchronous
and regular (synchronous) modules can be simultaneously loaded.
<P>Since module data access is entirely customizable (through C code, Tcl,
HTTP, ...) and since several modules can be loaded at once, applications
for moodss become limitless. For example, comparing a remote database server
CPU load and a network load from a probe on the same graph becomes possible.
<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 described in the COPYRIGHT file or use the main window Help Copyright
menu for more information.
<H3>
<A NAME="required"></A>3. Required software</H3>
If you are using a Linux Redhat system (5.1 or above), then use the moodss
rpm file (available (starting with 4.4) at <A HREF="http://www.mygale.org/~jfontain/">http://www.mygale.org/~jfontain/</A>)
for installation. It includes all the required software (except Tcl/Tk
8.x, of course). If you want to work on the moodss source code, see below,
otherwise you can skip the rest of this section.
<P>For the current version (5.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 2.0 or above (at <A HREF="http://oprs.mchh.siemens.de/tcl/capp/tkTable/">http://oprs.mchh.siemens.de/tcl/capp/tkTable/</A>)<B>*</B></LI>

<LI>
the BLT library version 2.4 (at <A HREF="ftp://ftp.tcltk.com/pub/blt/">ftp://ftp.tcltk.com/pub/blt/</A>)<B>*</B></LI>
</UL>

<DIV ALIGN=right><B>*</B><I> many thanks to the authors for these great
packages</I></DIV>

<P><BR>The pie widgets, stooop and scwoop libraries are included in the
self contained <I>moodss</I> application 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:
<UL>
<LI>
stooop version 3.6.1 or above</LI>

<LI>
switched version 1.4 or above (included in the stooop distribution)</LI>

<LI>
scwoop version 2.5 or above</LI>

<LI>
tkpiechart version 5.2 or above</LI>
</UL>
all at <A HREF="http://www.mygale.org/~jfontain/">http://www.mygale.org/~jfontain/</A>.
<H3>
<A NAME="architecture"></A>4. 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 as required by the Tcl package
implementation.
<P>The core will load one or more modules, whose names were passed as command
line parameters or come from a save file, 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, or asynchronously
for the relevant modules. 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). If a module is synchronous,
it must start updating its data when requested by the core. If a module
is asynchronous, its data may be updated at any time. The synchronous or
asynchronous nature is specified in the configuration data for the module.
<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, pie chart, summary table or free text iconic site, result
in the creation of data viewers. In turn, these viewers can display more
table cells, which when dropped into the viewer, result in the creation
of corresponding data graph lines, chart bars, pie slices, table rows or
text cells.
<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 table or 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 with the help of a
simple internal window manager.
<P>The current configuration (loaded modules, tables and viewers coordinates
and sizes, poll time, main window size, ...) can be saved in a file at
any time, so that an identical dashboard can be relaunched at a later time.
<H3>
<A NAME="core"></A>5. Core</H3>

<H4>
<A NAME="userinterface"></A>5.1. 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, summary table, free text and trash
icons and a message area, as one can see below:
<CENTER>
<P><IMG SRC="moodss1.jpg" ALT="moodss initial main window view" HEIGHT=358 WIDTH=408></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 loaded module(s) along with the
poll time.
<P>The <I>File</I> menu contains the <I>Save</I>, <I>Save As</I> and <I>Exit</I>
menu entries, used to save the current configuration (modules and viewers),
or gracefully quit the moodss application.
<P>The <I>Options</I> menu (may not exist, see below) contains the <I>Poll
time</I> entry which when selected launches the corresponding dialog box,
as shown below:
<CENTER>
<P><IMG SRC="moodss2.jpg" ALT="poll time dialog box" HEIGHT=238 WIDTH=226></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>When several modules are used, the minimum poll time is the greater
of the minimum poll times of all modules. The default poll time (used when
moodss is started) is the greater of the default poll times of all modules.
The available choices in the poll time dialog box is the combination of
all modules poll times.
<P>The <I>Poll time</I> menu entry is available only when needed, which
is not the case if all the loaded modules are asynchronous. If this case,
the <I>Options</I> menu itself is not displayed.
<P>Any data displayed in a table 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>A little arrow indicator is placed to the right of the reference column
title label, pointing up or down depending on whether the sorting order
is decreasing or increasing.
<BR>Table columns can be interactively resized by holding the first mouse
button down on a column border. The mouse cursor is changed to an horizontal
double arrow on column borders to show this capability.
<P>Aside from the main tables, graphical and textual 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, overlapped bars charts
(only available when the BLT version 2.4 library is used), 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>
<BR>&nbsp
<CENTER><TABLE COLS=2 WIDTH="100%" NOSAVE >
<TR ALIGN=CENTER VALIGN=CENTER NOSAVE>
<TD NOSAVE><IMG SRC="graph.jpg" ALT="graph viewer sample" HEIGHT=200 WIDTH=300></TD>

<TD><IMG SRC="overbar.jpg" ALT="overlap bar chart viewer sample" HEIGHT=200 WIDTH=300></TD>
</TR>

<TR ALIGN=CENTER VALIGN=CENTER NOSAVE>
<TD NOSAVE><IMG SRC="sidebar.jpg" ALT="side bar chart viewer sample" HEIGHT=200 WIDTH=300></TD>

<TD><IMG SRC="stackbar.jpg" ALT="stacked bar chart viewer sample" HEIGHT=200 WIDTH=300></TD>
</TR>

<TR ALIGN=CENTER VALIGN=CENTER NOSAVE>
<TD NOSAVE><IMG SRC="2dpie.jpg" ALT="2D pie chart viewer sample" HEIGHT=200 WIDTH=300></TD>

<TD><IMG SRC="3dpie.jpg" ALT="3D pie chart viewer sample" HEIGHT=200 WIDTH=300></TD>
</TR>
</TABLE></CENTER>

<CENTER><TABLE WIDTH="100%" NOSAVE >
<TR ALIGN=CENTER VALIGN=CENTER NOSAVE>
<TD WIDTH="58%" NOSAVE><IMG SRC="sumtable.jpg" ALT="summary table viewer sample" HEIGHT=200 WIDTH=350></TD>

<TD WIDTH="42%" NOSAVE><IMG SRC="freetext.jpg" ALT="free text viewer sample" HEIGHT=200 WIDTH=250></TD>
</TR>
</TABLE></CENTER>

<P>There are 2 textual viewers.
<BR>The summary table displays for each row the cell label, the current,
average, minimum and maximum values since the row was created.
<BR>The free text viewer is an editable Tcl text widget with any number
(including zero) of embedded data cell windows. Data cells can be inserted
one or several at a time through a simple drop, as with the other viewers.
New data cell windows are inserted at the current insertion cursor position.
Data cells can be deleted by selecting then dropping any number of them
into the trash drop site. They can also be deleted using the keyboard Delete
and Backspace keys, which also work on the regular text, as well as the
expected other key bindings. When dropping data cells, each data cell window
is preceded by a relevant label text for the cell, which can later be edited
at any time.
<P>Here is a screen shot of loaded <I>ps</I> and <I>cpustats</I> modules
with several graphical viewers:
<BR>&nbsp
<CENTER>
<H5>
<IMG SRC="moodss3.jpg" ALT="moodss window with graph data viewers" HEIGHT=611 WIDTH=578></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 possible 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 as shown by the quadruple arrow cursor. 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). When
moving or resizing, the message area displays the current coordinates or
size in real time as the mouse is being moved. Further description of this
small window manager functionality is useless, as it behaves like a basic
window manager (let me know if it does not).
<P>Here is another shot featuring a free text viewer with loaded <I>cpustats</I>
and <I>memstats</I> modules:
<CENTER>
<P><IMG SRC="moodss4.jpg" HEIGHT=475 WIDTH=467></CENTER>

<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 which
displays all the loaded modules help texts, <I>Copyright</I> which displays
the GPL (Gnu General Public License) document, <I>Source Versions </I>which
display all the source code file names with their versions and <I>About</I>
general information entries.
<H5>
<A NAME="draganddrop"></A>5.1.1 Drag and drop</H5>
Drag and drop in moodss tries to behave as the now familiar Windows functionality
(no, it doesn't mean I am a Bill Gates fan, as they probably stole the
idea from somebody else anyway :^). For example, to create a graphical
plot, one must first select one or more data cells in a data 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 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
(if there are no bugs, that is :).
<P>In summary, data cells can be dragged from any table or any viewer into
any viewer drop site icon, any viewer or the trash can.
<H6>
<A NAME="dropsites"></A>5.1.1.1. 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>
summary table with one or more data rows created at once</LI>

<LI>
free text with one or more labelled data cell windows created at once</LI>

<LI>
object trash with one or more data viewer elements deleted at once</LI>
</UL>
For example, a graph viewer with 1 curve is created by dropping 1 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 table or other viewers. Dropping one or more cells
directly in the viewer results in corresponding lines, bars, slices or
rows being created and automatically updated. Each new graphical element
is assigned a new and different color.
<P>You may delete one or more viewer elements (graph lines, bar chart bars,
pie charts slices, summary table rows or free text cell window) from a
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 elements, the viewer itself (graph, bar chart, pie
or summary table) is destroyed. The free text viewer can only be deleted
when completely emptied of any text and data cell window:&nbsp;it can then
be dropped into the trash.
<H6>
<A NAME="dragsites"></A>5.1.1.2. Drag sites</H6>
A table is obviously a drag site. One or more cells can be dragged at once
after selection, using the traditional single/shift/control mouse click
technique.
<P>Any viewer is also a drag site. It requires selecting one or more viewer
elements before initiating the drag operation from any selected element
in the viewer. If there are no selected elements, dragging is impossible:
the mouse cursor is not changed into the drag circular cursor.
<P>If a viewer contains no elements, then the viewer itself can be dragged
and dropped into the trash.
<H5>
<A NAME="saving"></A>5.1.2 Saving</H5>
The current application configuration (including existing data viewers)
can be saved in a file, which achieves a dashboard functionality.
<P>Once moodss has been launched with one or several modules and tables
have been moved, resized, viewers created, moved and resized, the current
configuration can be saved in a .moo file, and later reused by passing
the corresponding file name with the -f (--file) command line switch.
<P>For moodss version 4.0 and above, the following information is saved
in the file (which is human readable):
<UL>
<LI>
moodss version</LI>

<LI>
date and time</LI>

<LI>
application window size</LI>

<LI>
poll time</LI>

<LI>
modules</LI>

<LI>
tables positions and sizes</LI>

<LI>
viewers types, positions, sizes and specific data</LI>
</UL>
When using the <I>File Save</I> menu for the first time, and if a file
name was not specified in the command line, the file selector dialog box
appears so that the user may choose a file name (with a .moo extension).
<P>The <I>File Save As</I> menu behaves as expected, with the user always
having to choose a file name.
<P>Once a file name has been specified (either through the command line
or the file selector dialog box), that file name is reused whenever the
<I>File Save</I> menu is used. The <I>File Save As</I> menu may be used
at any time to change the file name.
<H4>
<A NAME="commandline"></A>5.2. 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 not specify the same module more than once in the command line.
<P>You may eventually specify a poll time in seconds using:
<PRE>$ wish moodss -p 25 random</PRE>
Note that when all the specified modules are asynchronous, the poll time
option specifies the preferred interval for graph viewers.
<P>Once saved through the File Save menus (for example in save.moo) , the
configuration can be retrieved using:
<PRE>$ wish moodss -f save.moo</PRE>
which would result in the same modules being loaded, the same viewers displayed
at the same positions and sizes, the same poll time being used, as well
at the same application window size.
<P>Command line options include:
<UL>
<LI>
<B>-f</B> (or <B>--file</B>): specifies a configuration file name (incompatible
with modules)</LI>

<LI>
<B>-h</B> (or <B>--help</B>): displays some help text and exits</LI>

<LI>
<B>-p</B> (or <B>--poll-time</B>): specifies a poll time in seconds</LI>

<LI>
<B>-r</B> (or <B>--read-only</B>): disable viewer creation, editing, ...</LI>

<LI>
<B>-S</B> (or <B>--static</B>): disable internal window manager sizing
and moving</LI>

<LI>
<B>--version</B>: outputs version information and exits</LI>
</UL>

<H3>
<A NAME="modules"></A>6. Modules</H3>
All examples are drawn from the <I>random</I> sample module.
<H4>
<A NAME="source"></A>6.1. 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>6.1.1. 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>
The update procedure is not needed when the module is asynchronous.
<H5>
<A NAME="configuration"></A>6.1.2. 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; 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 is obsolete and no longer used after and including
moodss version 3.5.
<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 is not 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>If the module is asynchronous (data can be updated at any time and not
in response to update procedure invocations (no polling required)), the
pollTimes member must be a single negative integer value representing the
preferred time interval for viewers that require one (only graphs at this
point). For example, if you wish graph viewers to have a display interval
of 10 seconds, use:
<PRE>namespace eval random {
&nbsp;&nbsp;&nbsp; array set data {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ...
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; pollTimes -10
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ...
&nbsp;&nbsp;&nbsp; }
&nbsp;&nbsp;&nbsp; ...
}</PRE>
In this case, the graph viewers time range (knowing that they feature 100
time points) would be 1000 seconds. I guess that the value that you should
specify as the pollTimes member should be the expected average update interval
for your asynchronous data. Note that the graphical viewers x axis always
display properly labelled absolute time ticks in any case.
<P>When several asynchronous modules are loaded with no synchronous modules,
the interval used for all relevant viewers is the average (in absolute
value) of all module intervals. For example, if you load 2 asynchronous
modules, one with a pollTimes member of -10 and the other of -20, then
a 15 seconds interval value is retained. Note that the interval can be
forced through the --poll-time command line argument.
<P>If at least one synchronous module is loaded concurrently with any number
of asynchronous modules, the actual application poll time (the one that
can be set with the then available poll time dialog box) is used.
<P>The <I>visibleColumns</I> member is an optional list that specifies
the table columns that should be displayed. If not specified, all the table
columns are visible.
<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. The specified column must be visible (see
<I>visibleColumns</I>
member documentation above).
<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. When specified, all the columns in the
list must be visible (see <I>visibleColumns</I> member documentation above).
<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.
<P>The views member is optional. If specified, it defines one or more views
to be used in place of the default view. One table will be displayed per
view. Each view is a list of array members, suitable as an argument to
an "array set" command. For each view, 2 members must be defined: <I>visibleColumns</I>
and <I>sort</I> (syntax and usage are identical to the default table members).
<P>For example, a recent <I>random</I> module configuration is as follows:
<PRE>array set data {
&nbsp;&nbsp;&nbsp; updates 0
&nbsp;&nbsp;&nbsp; 0,label name 0,type ascii 0,message {user name}
&nbsp;&nbsp;&nbsp; 1,label cpu 1,type real 1,message {cpu usage in percent}
&nbsp;&nbsp;&nbsp; 2,label disk 2,type integer 2,message {disk usage in megabytes}
&nbsp;&nbsp;&nbsp; 3,label memory 3,type integer 3,message {memory usage in kilobytes}
&nbsp;&nbsp;&nbsp; 4,label command 4,type dictionary 4,message {command name}
&nbsp;&nbsp;&nbsp; pollTimes {10 5 20 30 60 120 300}
&nbsp;&nbsp;&nbsp; sort {1 decreasing}
&nbsp;&nbsp;&nbsp; indexColumns {0 4}
&nbsp;&nbsp;&nbsp; helpText {...}
&nbsp;&nbsp;&nbsp; views {
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; {visibleColumns {0 1 3 4} sort {1 decreasing}}
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; {visibleColumns {0 2 4} sort {2 decreasing}}
&nbsp;&nbsp;&nbsp; }
}</PRE>
In this case, data is presented in 2 tables: one for the CPU and memory
usage, the other for disk usage.
<H5>
<A NAME="variabledata"></A>6.1.3. 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>In case of a synchronous module, 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>In case of an asynchronous module, variable data may be updated at any
time. The <I>update</I> procedure may not exist.
<P>For all module types, 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.
<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.
<P>The random module source code can be made to function asynchronously:
please look into the random.tcl file.
<H4>
<A NAME="installation"></A>6.2. 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.1 "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.1</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-5.x/</I>,
you will find the random module package in <I>/home/joe/moodss-5.x/random/</I>
so that the following will work:
<PRE>$ cd /home/joe/moodss-5.x/
$ 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-4.x/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>7. Future developments</H3>
The following features will eventually be added to the core (also look
at the TODO file):
<UL>
<LI>
more Linux modules</LI>

<LI>
more data viewers</LI>

<LI>
table row and column selection</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>8. Miscellaneous information</H3>
For downloading Tcl software (such as stooop, scwoop, tkpiechart, ...),
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.15 1998/10/11 09:36:58 jfontain Exp $}

array set HMtag_map {
    h1 {size 22 weight bold}
    h2 {size 20 weight bold}
    h3 {size 18 weight bold}
    h4 {size 16 weight bold}
    h5 {size 14 weight bold}
    h6 {weight bold}
}

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

array set HMinsert_map {
    h1 "\n\n" /h1 "\n\n" h2 "\n\n" /h2 "\n\n" h3 "\n\n" /h3 "\n\n" h4 "\n\n" /h4 "\n\n" h5 "\n\n" /h5 "\n\n" h6 "\n\n" /h6 "\n\n"
    pre "\n\n" /pre "\n\n"
}

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) -horizontal 0 -height 100 -width 400]
    pack $widget::($contents,path) -fill both -expand 1

    set widget [new scroll text $panner::($panes,frame2) -horizontal 0 -height 400]
    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.25 1998/10/11 09:32:49 jfontain Exp $}

namespace eval help {

    variable nameAndVersion "
moodss: a Modular Object Oriented Dynamic SpreadSheet
version $::applicationVersion
    "

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

This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version.

This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

(see Copyright under the Help menu for more details)

        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.
    }

    variable copyright {
    TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION

0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License.  The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language.  (Hereinafter, translation is included without limitation in the term "modification".)  Each licensee is addressed as "you".

Activities other than copying, distribution and modification are not covered by this License; they are outside its scope.  The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program).  Whether that is true depends on what the Program does.

1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program.

You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee.. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions:

    a. You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change.

    b. You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License.

    c. If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License.  (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.)

These requirements apply to the modified work as a whole.  If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works.  But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it.

Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program.

In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License.

3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following:

    a. Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or,

    b. Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or,

    c. Accompany it with the information you received as to the offer to distribute corresponding source code.  (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.)

The source code for a work means the preferred form of the work for making modifications to it.  For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable.

If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code.

4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License.  Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License.  However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance.

5. You are not required to accept this License, since you have not signed it.  However, nothing else grants you permission to modify or distribute the Program or its derivative works.  These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it.

6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions.  You may not impose any further restrictions on the recipients' exercise of the rights granted herein.  You are not responsible for enforcing compliance by third parties to this License.

7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License.  If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all.  For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program.

If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances.

It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices.  Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice.

This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License.

8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded.  In such case, this License incorporates the limitation as if written in the body of this License.

9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time.  Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns.

Each version is given a distinguishing version number.  If the Program specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation.  If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation.

10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission.  For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this.  Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally.

    NO WARRANTY

11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW.  EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.  THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU.  SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.

12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
    }
}

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) -horizontal 0]
    $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 -horizontal 0]
    $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

    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 (version [package provide $module]):\n"
        if {[catch {append text [set ${module}::data(helpText)]}]} {
             append text "\nno help available\n"
        }
        append text \n
    }
    simpleTextDialogBox {moodss: Modules Help} $text
}

proc versionsDialogBox {} {
    array set ::versionsData {
        updates 0
        0,label file 0,type ascii 0,message {source file name}
        1,label version 1,type dictionary 1,message {version}
        sort {0 increasing}
        indexColumns 0
    }
    set row 0
    foreach name [array names ::sourceVersion] {
        set ::versionsData($row,0) $name
        set ::versionsData($row,1) $::sourceVersion($name)
        incr row
    }
    set dialog [new dialogBox .\
        -buttons o -default o -title {moodss: Source Versions} -command {unset ::versionsData}\
        -x [winfo pointerx .] -y [winfo pointery .]\
    ]
    set table [new dataTable $widget::($dialog,path) -data ::versionsData]
    incr ::versionsData(updates)
    dialogBox::display $dialog $widget::($table,path)
}

set rcsId {$Id: drag.tcl,v 1.22 1998/10/11 20:40:42 jfontain Exp $}

class dragSite {

    if {![info exists dragSite::(grabber)]} {
        set dragSite::(grabber) $widget::([new frame . -background {} -width 0 -height 0 -cursor circle],path)
        place $dragSite::(grabber) -x -32768 -y -32768
    }

    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"
    }

    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) <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

        grab $dragSite::(grabber)
        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
        bind $dragSite::(grabber) <ButtonRelease-1> "dragSite::drop $this %X %Y"
        bind $dragSite::(grabber) <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}]
            showTopLevel $frame +[expr {[winfo rootx $path]-1}]+[expr {[winfo rooty $path]-1}]
        }
        set dragSite::(lastSite) $site
    }

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

        bind $dragSite::(grabber) <ButtonRelease-1> {}
        bind $dragSite::(grabber) <Button1-Motion> {}
        grab release $dragSite::(grabber)
        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.11 1998/10/09 19:35:44 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.18 1998/07/11 09:56:54 jfontain Exp $}

class canvasWindowManager {

    class handles {

        proc handles {this parentPath args} composite {[new frame $parentPath] $args} {
            if {[string compare [winfo class $parentPath] Canvas]!=0} {
                error "parent must be the manager canvas"
            }
            set ($this,item) [$parentPath create window 0 0 -window $widget::($this,path) -anchor nw]
            set ($this,canvas) $parentPath
            composite::complete $this
        }

        proc ~handles {this} {
            [set ($this,canvas)] delete [set ($this,item)] outline
            catch {delete [set ($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]\
                [list -setheight setHeight SetHeight {} {}]\
                [list -setwidth setWidth SetWidth {} {}]\
                [list -setx setX SetX 0 0]\
                [list -sety setY SetY 0 0]\
                [list -static static Static 0]\
            ]
        }

        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 [set ($this,bindings)]}
            set ($this,bindings) [new bindings $value end]
            bindings::set [set ($this,bindings)] <Visibility>\
                "set canvasWindowManager::handles::($this,partiallyObscured) \[string compare %s VisibilityUnobscured\]"
            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 set-setheight {this value} {
            [set ($this,canvas)] itemconfigure [set ($this,item)] -height $value
        }

        proc set-setwidth {this value} {
            [set ($this,canvas)] itemconfigure [set ($this,item)] -width $value
        }

        proc set-setx {this value} {
            [set ($this,canvas)] coords [set ($this,item)] $value [lindex [[set ($this,canvas)] coords [set ($this,item)]] end]
        }

        proc set-sety {this value} {
            [set ($this,canvas)] coords [set ($this,item)] [lindex [[set ($this,canvas)] coords [set ($this,item)]] 0] $value
        }

        proc set-static {this value} {
            set path $widget::($this,path)
            if {$value} {
                bind $path <Configure> {}
                bind $path <Motion> {}
                bind $path <Enter> {}
                bind $path <Button1-Motion> {}
                bind $path <ButtonPress-1> {}
                bind $path <ButtonRelease-1> "canvasWindowManager::handles::toggleVisibility $this"
                $path configure -cursor arrow
            } else {
                bind $path <Configure> "canvasWindowManager::handles::resize $this %w %h"
                bind $path <Motion> "canvasWindowManager::handles::setCursor $this %x %y"
                bind $path <Enter> "canvasWindowManager::handles::setCursor $this %x %y"
                bind $path <Button1-Motion> "canvasWindowManager::handles::buttonMotion $this %x %y"
                bind $path <ButtonPress-1> "canvasWindowManager::handles::buttonPress $this %x %y"
                bind $path <ButtonRelease-1> "canvasWindowManager::handles::buttonRelease $this"
            }
        }

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

        proc buttonPress {this x y} {
            set canvasWindowManager::handles::(xLast) $x
            set canvasWindowManager::handles::(yLast) $y
            lifoLabel::push $::messenger {}
            createOutline $this
        }

        proc toggleVisibility {this} {
            if {[set ($this,partiallyObscured)]} {
                raise $widget::($this,path)
            } else {
                lower $widget::($this,path)
            }
            catch {raise $composite::($this,-path) $widget::($this,path)}
        }

        proc buttonRelease {this} {
            lifoLabel::pop $::messenger
            if {[info exists (motion)]} {
                updateGeometry $this
                raise $widget::($this,path)
                catch {raise $composite::($this,-path) $widget::($this,path)}
                unset (motion)
            } else {
                toggleVisibility $this
            }
            destroyOutline $this
            unset (xLast) (yLast) (hidden)
        }

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

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

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

        proc setCursor {this x y} {
            if {[info exists (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<[set ($this,topHandleBottom)]} {
                    set cursor top_${side}_corner
                    append direction n
                } elseif {$y>[set ($this,bottomHandleTop)]} {
                    set cursor bottom_${side}_corner
                    append direction s
                } elseif {($y>[set ($this,midHandleTop)])&&($y<[set ($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<[set ($this,leftHandleRight)]} {
                        set cursor ${side}_left_corner
                        append direction w
                    } elseif {$x>[set ($this,rightHandleLeft)]} {
                        set cursor ${side}_right_corner
                        append direction e
                    } elseif {($x>[set ($this,midHandleLeft)])&&($x<[set ($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 ($this,direction) $direction
        }

        proc updateOutline {this x y} {
            lifoLabel::pop $::messenger

            if {[set (hidden)]} {
                positionOutlineInStackingOrder $this raise
            }
            set canvas [set ($this,canvas)]
            set coordinates [$canvas coords [set ($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 [set ($this,direction)]]==0} {
                $canvas move outline [expr {$x-[set (xLast)]}] [expr {$y-[set (yLast)]}]
                lifoLabel::push $::messenger [$canvas coords outline]
                set canvasWindowManager::handles::(xLast) $x
                set canvasWindowManager::handles::(yLast) $y
                return
            }

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

            switch [set ($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 [set ($this,canvas)]
            foreach side {top bottom left right} {
                set frame $widget::([new frame $canvas -background black],path)
                set ($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 [set ($this,item)]]\
                [winfo width $widget::($this,path)] [winfo height $widget::($this,path)]
        }

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

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

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

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

        proc getGeometry {this} {
            set canvas [set ($this,canvas)]
            return [concat\
                [[set ($this,canvas)] coords [set ($this,item)]]\
                [winfo width $widget::($this,path)] [winfo height $widget::($this,path)]\
            ]
        }

    }

}

set rcsId {$Id: canvaswm.tcl,v 1.2 1998/07/11 19:06:36 jfontain Exp $}

class canvasWindowManager {

    proc canvasWindowManager {this canvas} {
        set canvasWindowManager::($this,canvas) $canvas
    }

    proc ~canvasWindowManager {this} {
        variable ${this}handle

        foreach path [array names ${this}handle] {
            delete [set ${this}handle($path)]
        }
        catch {unset ${this}handle}
    }

    proc manage {this path} {
        variable ${this}handle

        set ${this}handle($path) [new handles $canvasWindowManager::($this,canvas) -path $path]
    }

    proc unmanage {this path} {
        variable ${this}handle

        delete [set ${this}handle($path)]
        unset ${this}handle($path)
    }

    proc configure {this path args} {
        variable ${this}handle

        eval composite::configure [set ${this}handle($path)] $args
    }

    proc getGeometry {this path} {
        variable ${this}handle

        return [handles::getGeometry [set ${this}handle($path)]]
    }

}


proc updateTitle {} {
    global pollTimes pollTime modules

    if {[llength $pollTimes]==0} {
        wm title . "moodss: $modules(all,string) data (asynchronous)"
    } else {
        wm title . "moodss: $modules(all,string) data (every $pollTime seconds)"
    }
}

proc createMenuWidget {parentPath readOnly includePollTime} {
    global modules

    set menu [menu $parentPath.menu -tearoff 0]
    $menu add cascade -label File -menu [menu $menu.file -tearoff 0] -underline 0
    if {!$readOnly} {
        $menu.file add command -label Save -command {save 0} -underline 1 -accelerator Alt+S
        bind $parentPath <Alt-s> {save 0}
        $menu.file add command -label {Save As...} -command {save 1} -underline 6 -accelerator Alt+A
        bind $parentPath <Alt-a> {save 1}
    }
    $menu.file add command -label Exit -command exit -underline 1 -accelerator Alt+X
    bind $parentPath <Alt-x> exit
    if {!$readOnly&&$includePollTime} {
        $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(all)"
    $menu.help add command -label Copyright... -underline 0 -command {simpleTextDialogBox {moodss: Copyright} $help::copyright}
    $menu.help add command -label {Source Versions...} -underline 0 -command versionsDialogBox
    $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 createCellsViewer {class cells draggable static {pollTime {}}} {
    global canvas windowManager

    set viewer [new $class $canvas -draggable $draggable]
    set path $widget::($viewer,path)
    if {[string length $pollTime]>0} {
        composite::configure $viewer -interval $pollTime
    }
    canvasWindowManager::manage $windowManager $path
    composite::configure $viewer -deletecommand "canvasWindowManager::unmanage $windowManager $path"
    canvasWindowManager::configure $windowManager $path -static $static
    viewer::view $viewer $cells
    return $viewer
}

proc createDragAndDropZone {parentPath} {
    global canvas pollTime static

    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 "createCellsViewer dataGraph \$dragSite::data(DATACELLS) 1 $static \$pollTime"
    new widgetTip -path $label -text {graph drop site}

if {$::officialBLT} {
    set label [label $frame.overlapBarChart -image [image create photo -data [dataOverlapBarChart::iconData]]]
    pack $label -pady 1 -side left
    new dropSite -path $label -formats DATACELLS\
        -command "createCellsViewer dataOverlapBarChart \$dragSite::data(DATACELLS) 1 $static"
    new widgetTip -path $label -text {overlap bar chart 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 "createCellsViewer dataSideBarChart \$dragSite::data(DATACELLS) 1 $static"
    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 "createCellsViewer dataStackedBarChart \$dragSite::data(DATACELLS) 1 $static"
    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 "createCellsViewer data2DPieChart \$dragSite::data(DATACELLS) 1 $static"
    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 "createCellsViewer data3DPieChart \$dragSite::data(DATACELLS) 1 $static"
    new widgetTip -path $label -text {3D pie chart drop site}

    set label [label $frame.summaryTable -image [image create photo -data [summaryTable::iconData]]]
    pack $label -pady 1 -side left
    new dropSite -path $label -formats DATACELLS -command "createCellsViewer summaryTable \$dragSite::data(DATACELLS) 1 $static"
    new widgetTip -path $label -text {summary table drop site}

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

    set trashData {
        R0lGODlhKAAoAKUAAP8A/8/Lz+/r71FRUZ6anpaSlv/7/wgICL66vkFBQYaChtfT17LA3LaytjAwMFlZWZaant/b3/fz96aipnFxcWlpaWFhYTAoKCAgICgo
        KOfj576yvklJSRAQEBAQCI6Slq6yrp6SnhgYGAAAAI6KjoaKhnl5ecfDx66ipiAoIOfr5ygwMJ6Slnlxce/j5zg4OL7Dx6aint/T38fLz4Z5hvf7/8/Tz66q
        tqairv/z939/f/fz79fLz0lRUXmChllRUSH5BAEAAAAALAAAAAAoACgAAAb+QIBwSBwGisikckkUDAhMYiEaNQwO06ggS00iDIXEQcFcLA5dpUDAaCgch8GD
        DIVEDJJJIp2URBQUFQoWCRcYGRkGihoBCnt8RQYbDxwZhx0eBwcYHyAMIRMDDpBEEwYPGBgiHSOtrh0PJCVhGaRDCw0JHq68vAkDJh0cfBIEHAoNGb3LvR0O
        DlBDJwsTSHcnBRaszNytAxMaa4oGJyRCAn4LBggMBAfd8BwQCxL1AiiPAOrjDRMU8PBSUDghIJyKFcOEBDAQIMKJCQqUAeQW54QEDREKjOACQIOGAhQ4iJgY
        0KIAFgcoFFlIgoKDXSS7UZAggIKIJAJCtFjxLib+NwcuNLwYkARGDAovevpchkFGhBFLEJhIupTbDA2jlBho8K/qsg400CzJ80Cp11Ydhi6JEIBEgm1nW2Hg
        kBDJFwQVHGCI6wqRWGs1ClRIMJLviAQmoCbBY4LDi1R8LUSwYSJJAAE3OhzogDBuBgISYNRCouFEhgHmAFCAWbUCugkvcKLCMYREA7MxNRjQMCFrkRMYog0x
        UCGFzwMcDORYMImYBhYJJHbTgUPGDow8eORKI2AHAkeqzB54QYG6ABkCFgSYESDACOFM0GGr8MCCBQo9FJgowAAHjjUCGODCAjxE0EAHFnSh2wkfkOADDSGw
        oIA/CTgwgH8MKKCAAC5S8MBAASLkw8QJBsgwAQEk0PBDYX4dgAMCrfg2AUqjUaGCAQsgQMIKRCHxT4K2EEEAOjZYIAJHRKQWJBEgCJCDkUtCgoJRHkQJCQkW
        bGTllrYEAQA7
    }
    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 save {ask} {
    global saveFile messenger

    if {$ask||([string length $saveFile]==0)} {
        set file [tk_getSaveFile\
            -title {moodss: Save} -initialdir [pwd] -defaultextension .moo -filetypes {{{moodss data} .moo}} -initialfile $saveFile
        ]
        if {[string length $file]==0} return
        set saveFile $file
    }
    lifoLabel::flash $messenger "saving in $saveFile..."
    set record [new record -file $saveFile]
    record::write $record
    delete $record
}

proc refresh {} {
    global modules updateEvent messenger pollTime

    catch {after cancel $updateEvent}

    if {[llength $modules(synchronous)]==0} return

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

createMenuWidget . $readOnly [llength $pollTimes]
pack [createMessageWidget .] -side bottom -fill x
updateTitle

set scroll [new scroll canvas .]
set canvas $composite::($scroll,scrolled,path)
set width [winfo screenwidth .]
set height [winfo screenheight .]
$canvas configure -background white -width $width -height $height -scrollregion [list 0 0 $width $height] -highlightthickness 0\
    -takefocus 0

set windowManager [new canvasWindowManager $canvas]

if {[info exists initializer]} {
    foreach {width height} [record::sizes $initializer] {}
} else {
    set width 400
    set height 300
}
wm geometry . ${width}x$height

if {!$readOnly} {
    pack [createDragAndDropZone .] -fill x
}
pack $widget::($scroll,path) -fill both -expand 1

set draggable [expr {!$readOnly}]

set x 0
set y 0
foreach module $modules(all) {
    upvar #0 ${module}::data data
    if {[info exists data(views)]} {
        set index 0
        foreach members $data(views) {
            array set view $members
            set table [new dataTable $canvas -data ${module}::data -view ::view -draggable $draggable]
            canvasWindowManager::manage $windowManager $widget::($table,path)
            unset view
            if {[info exists initializer]} {
                foreach {x y width height} [record::tableGeometry $initializer $module $index] {}
                canvasWindowManager::configure $windowManager $widget::($table,path)\
                    -setx $x -sety $y -setwidth $width -setheight $height
            } else {
                canvasWindowManager::configure $windowManager $widget::($table,path) -setx $x -sety $y
                incr x $configuration::(xWindowManagerInitialOffset)
                incr y $configuration::(yWindowManagerInitialOffset)
            }
            canvasWindowManager::configure $windowManager $widget::($table,path) -static $static
            incr index
        }
    } else {
        set table [new dataTable $canvas -data ${module}::data -draggable $draggable]
        canvasWindowManager::manage $windowManager $widget::($table,path)
        if {[info exists initializer]} {
            foreach {x y width height} [record::tableGeometry $initializer $module] {}
            canvasWindowManager::configure $windowManager $widget::($table,path)\
                -setx $x -sety $y -setwidth $width -setheight $height
        } else {
            canvasWindowManager::configure $windowManager $widget::($table,path) -setx $x -sety $y
            incr x $configuration::(xWindowManagerInitialOffset)
            incr y $configuration::(yWindowManagerInitialOffset)
        }
        canvasWindowManager::configure $windowManager $widget::($table,path) -static $static
    }
}

refresh

if {[info exists initializer]} {
    foreach {class cells x y width height switchedOptions} [record::viewersData $initializer] {
        set viewer [eval new $class $canvas $switchedOptions -draggable $draggable]
        canvasWindowManager::manage $windowManager $widget::($viewer,path)
        viewer::view $viewer $cells
        canvasWindowManager::configure $windowManager $widget::($viewer,path)\
            -setx $x -sety $y -setwidth $width -setheight $height -static $static
    }
}