#!/usr/bin/wish



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

set rcsId {$Id: moodss.tcl,v 2.78 2002/01/13 15:49:33 jfontain Exp jfontain $}


if {[llength [info commands option]]>0} {
    option add *BorderWidth 1
    option add *Canvas.BorderWidth 0
    option add *Frame.BorderWidth 0
    option add *Toplevel.BorderWidth 0
    option add *ScrollbarWidth 12
    option add *Checkbutton.selectColor gray
    option add *Radiobutton.selectColor gray
    option add *Menu.selectColor gray
}

proc printUsage {exitCode} {
    puts stderr "Usage: $::argv0 \[OPTION\]... \[MODULE\] \[MODULE\]..."
    puts stderr {  --debug          module errors verbose reporting}
    puts stderr {  -f, --file       configuration file name}
    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 {  --show-modules   try to find available moodss modules}
    puts stderr {  --version        output version information and exit}
    exit $exitCode
}

proc printVersion {} {
    puts "moodss (a Modular Object Oriented Dynamic SpreadSheet) version $global::applicationVersion"
}


set rcsId {$Id: misc.tcl,v 1.5 2002/01/01 11:31:02 jfontain Exp $}


package provide miscellaneous [lindex {$Revision: 1.5 $} 1]


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 static {localName args} {
    set global ::[lindex [info level -1] 0]:$localName
    uplevel upvar #0 $global $localName
    if {![info exists $global]} {
        switch [llength $args] {
            0 return
            1 {set $global [lindex $args 0]}
            default {error {usage: static name ?value?}}
        }
    }
}

proc formattedTime {seconds} {
    set string {}
    set interval [expr {$seconds/86400}]
    if {$interval>0} {
        append string ${interval}d
        set seconds [expr {$seconds%86400}]
    }
    set interval [expr {$seconds/3600}]
    if {$interval>0} {
        append string ${interval}h
        set seconds [expr {$seconds%3600}]
    }
    set interval [expr {$seconds/60}]
    if {$interval>0} {
        append string ${interval}m
        set seconds [expr {$seconds%60}]
    }
    append string ${seconds}s
    return $string
}

set rcsId {$Id: global.tcl,v 2.77 2002/01/19 19:51:18 jfontain Exp $}


namespace eval global {
    variable withGUI [expr {![catch {package present Tk}]}]
    variable debug 0
    if {$withGUI} {
        variable applicationName moodss
        variable applicationVersion 15.7
        variable messenger
        variable scroll
        variable canvas
        variable menu
        variable static
        variable windowManager
        variable fileMenuContextHelper
        variable fileMenuContextHelperSaveIndex
        variable saveFile
        variable xWindowManagerInitialOffset 30
        variable yWindowManagerInitialOffset 20
        variable graphNumberOfIntervals 100
        variable viewerHeight 200
        variable viewerWidth 300
        variable canvasHeight [winfo screenheight .]
        variable canvasWidth [winfo screenwidth .]
        variable canvasBackground white
        variable pieLabeler peripheral
        variable viewerColors {#7FFFFF #7FFF7F #FF7F7F #FFFF7F #7F7FFF #FFBF00 #BFBFBF #FF7FFF #FFFFFF}
        variable fileDirectory [pwd]
    } else {
        variable applicationName moomps
        variable applicationVersion 1.2.1
    }
    variable pollTimes
    variable pollTime
    variable documentationDirectory [file dirname $::argv0]/documentation
    variable printToFile 0
    variable fileToPrintTo moodss.ps
    variable printCommand {lpr -P%P}
    variable printOrientations {landscape portrait}
    variable printOrientation portrait
    variable printPalettes {color gray monochrome}
    variable printPalette color
    variable printPaperSizes [list\
        {A3 (297 x 420 millimeters)} {A4 (210 x 297 millimeters)} {executive (7 1/2 x 10 inches)} {legal (8 1/2 x 14 inches)}\
        {letter (8 1/2 x 11 inches)}\
    ]
    variable printPaperSize [lindex $printPaperSizes end]
    variable login unknown
    catch {set login $::env(USER)}
    catch {set login $::env(LOGNAME)}
    variable fromAddress $login
    variable smtpServers 127.0.0.1
    variable rpm 0
    variable noMail [catch {package require smtp 1.2}]
}

if {$global::withGUI} {

proc updateCanvasSize {args} {
    $global::canvas configure -width $global::canvasWidth -height $global::canvasHeight\
        -scrollregion [list 0 0 $global::canvasWidth $global::canvasHeight]
}

proc updateCanvasBackground {args} {
    $global::canvas configure -background $global::canvasBackground
}

}

set rcsId {$Id: utility.tcl,v 1.33 2002/01/19 16:42:23 jfontain Exp $}


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
}

proc startGatheringPackageDirectories {} {
    catch {rename source _source}
    proc source {file} {
        foreach name [package names] {
            set package($name) {}
        }
        uplevel _source [list $file]
        foreach name [package names] {
            if {![info exists package($name)]} {
                set ::packageDirectory($name) [file dirname $file]
            }
        }
    }
}

proc temporaryFileName {{extension {}} {identifier {}}} {
    if {[string length $identifier]==0} {
        set identifier [pid]
    }
    switch $::tcl_platform(platform) {
        macintosh {
            error {not implemented yet}
        }
        unix {
            foreach directory {/var/tmp /usr/tmp /tmp} {
                if {[file isdirectory $directory]&&[file writable $directory]} break
            }
        }
        windows {
            set directory c:/windows/temp
            catch {set directory $::env(TEMP)}
        }
    }
    set name [file join $directory moodss$identifier]
    if {[string length $extension]>0} {
        append name .$extension
    }
    return $name
}

proc linesCount {string} {
    return [llength [split $string \n]]
}

if {$global::withGUI} {

proc configureWritableTable {path {tabActivateScript {}}} {
    bindtags $path [list $path [winfo toplevel $path]]
    foreach event {
        ButtonPress-1 B1-Motion ButtonRelease-1 Shift-1 Control-1 B1-Enter B1-Leave <Table_Commit> Shift-Up Shift-Down Shift-Left
        Shift-Right KeyPress BackSpace Delete Escape Alt-KeyPress Meta-KeyPress Control-KeyPress Any-Tab
    } {
        bind $path <$event> [bind Table <$event>]
    }
    bind $path <Return> {catch {%W activate active}}
    bind $path <KP_Enter> {catch {%W activate active}}
    bind $path <Left> [bind Table <Control-Left>]
    bind $path <Right> [bind Table <Control-Right>]
    bind $path <Home> [bind Table <Control-a>]
    bind $path <End> [bind Table <Control-e>]
    bind $path <Shift-Tab> "tkTableNextCell %W 0 {$tabActivateScript}"
    bind $path <KP_Tab> "tkTableNextCell %W 1 {$tabActivateScript}"
    bind $path <Tab> "tkTableNextCell %W 1 {$tabActivateScript}"
    if {[string equal $::tcl_platform(platform) unix]} {
        bind $path <ISO_Left_Tab> "tkTableNextCell %W 0 {$tabActivateScript}"
        bind $path <ButtonRelease-2> {tk_tablePaste %W [%W index @%x,%y]}
    }
}

proc adjustTableColumns {table} {
    upvar #0 [$table cget -variable] data

    set label [label .temporary]
    set row [$table cget -roworigin]
    set lastRow [expr {$row+[$table cget -rows]}]
    set column [$table cget -colorigin]
    set lastColumn [expr {$column+[$table cget -cols]}]
    set defaultFont [$table cget -font]
    set titleFont [$table tag cget title -font]
    for {} {$column<$lastColumn} {incr column} {
        set maximum 0
        for {set row [$table cget -roworigin]} {$row<$lastRow} {incr row} {
            if {[string length [$table hidden $row,$column]]>0} continue
            if {[catch {set window [$table window cget $row,$column -window]}]} {
                if {[$table tag includes title $row,$column]} {
                    $label configure -font $titleFont
                } else {
                    $label configure -font $defaultFont
                }
                $label configure -text $data($row,$column)
                set width [winfo reqwidth $label]
            } else {
                set width [expr {[winfo reqwidth $window]+(2*[$table window cget $row,$column -padx])}]
            }
            if {$width>$maximum} {
                set maximum $width
            }
        }
        $table width $column -$maximum
    }
    destroy $label
}

}

proc compareClocks {value1 value2} {
    set value1 [clock scan $value1 -base 0]
    set value2 [clock scan $value2 -base 0]
    if {$value1==$value2} {
        return 0
    } elseif {$value1<$value2} {
        return -1
    } else {
        return 1
    }
}

if {$global::withGUI} {

proc tkTableSkipEmbeddedWindows {path forward} {
    if {$forward} {set parameter 1} else {set parameter -1}
    while {1} {
        set column [$path index active col]
        if {[catch {$path window cget [$path index active] -window}]} break
        ::tk::table::MoveCell $path 0 $parameter
        if {[$path index active col]==$column} break
    }
}

proc tkTableNextCell {path forward {tabActivateScript {}}} {
    set top [$path index origin row]
    set left [$path index origin col]
    set bottom [$path index end row]
    set right [$path index end col]
    catch {
        set row [$path index active row]
        set column [$path index active col]
    }
    if {[info exists row]} {
        if {$forward} {
            ::tk::table::MoveCell $path 0 1
            tkTableSkipEmbeddedWindows $path 1
            if {([$path index active col]==$column)||![catch {$path window cget [$path index active] -window}]} {
                if {$row<$bottom} {
                    $path activate $row,$left
                    ::tk::table::MoveCell $path 1 0
                    tkTableSkipEmbeddedWindows $path 1
                }
            }
        } else {
            ::tk::table::MoveCell $path 0 -1
            tkTableSkipEmbeddedWindows $path 0
            if {([$path index active col]==$column)||![catch {$path window cget [$path index active] -window}]} {
                if {$row>$top} {
                    $path activate $row,$right
                    ::tk::table::MoveCell $path -1 0
                    tkTableSkipEmbeddedWindows $path 0
                }
            }
        }
    } else {
        if {$forward} {
            $path activate $top,$left
            tkTableSkipEmbeddedWindows $path 1
        } else {
            $path activate $bottom,$right
        }
    }
    if {[string length $tabActivateScript]>0} {
        uplevel #0 $tabActivateScript [$path index active row] [$path index active col]
    }
}

}

proc emailAddressError {string} {
    foreach list [mime::parseaddress $string] {
        array set array $list
    }
    return $array(error)
}

proc sendTextEmail {from to subject text} {
    set token [mime::initialize -canonical text/plain -string $text]
    lappend headers -servers [list $global::smtpServers]
    lappend headers -header [list From $from]
    foreach address $to {
        lappend headers -header [list To $address]
    }
    lappend headers -header [list Subject $subject]
    eval smtp::sendmessage $token $headers
}
startGatheringPackageDirectories

set rcsId {$Id: getopt.tcl,v 2.4 2001/12/29 00:32:39 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 equal $switch --]} {
            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]
}

if {[catch\
    {\
        set argv [parseCommandLineArguments\
            {
                -f 1 --file 1 --debug 0 -h 0 -he 0 -hel 0 -help 0 --help 0 -p 1 --poll-time 1 -r 0 --read-only 0 -S 0 --static 0
                --show-modules 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(-h)]||[info exists arguments(-he)]||[info exists arguments(-hel)]||[info exists arguments(-help)]} {
    printUsage 1
}

if {[info exists arguments(--version)]} {
    printVersion
    exit
}

set global::debug [info exists arguments(--debug)]


set rcsId {$Id: entrychk.tcl,v 2.3 2001/12/29 00:32:39 jfontain Exp $}


proc setupEntryValidation {path scripts {mode key}} {
    if {[llength $scripts]==0} return
    $path configure -validate $mode -invalidcommand bell
    foreach script $scripts {
        if {[info exists command]} {
            append command &&
        } else {
            set command "expr \{"
        }
        append command "\[$script\]"
    }
    append command \}
    $path configure -validatecommand $command
}

proc checkUnsignedInteger {string} {
    return [regexp {^[\d]*$} $string]
}

proc checkMaximumLength {length string} {
    return [expr {[string length $string]<=$length}]
}

set rcsId {$Id: preferen.tcl,v 1.17 2001/12/30 15:28:09 jfontain Exp $}


namespace eval preferences {

    variable rcFileName ~/.moodssrc

    proc read "{rcFileName $rcFileName}" {
        if {![file readable $rcFileName]} {
            return {}
        }
        set file [::open $rcFileName]
        set list {}
        while {[gets $file line]>=0} {
            if {[string match #* $line]} continue
            foreach {name value} $line {}
            set name [namespace tail $name]
            variable $name $value
            lappend list $name $value
        }
        close $file
        return $list
    }

    proc save {variables} {
        variable rcFileName

        if {[catch {::open $rcFileName w} file]} {
            tk_messageBox -title moodss -type ok -default ok -icon error -message $file
            return
        }
        set data [record::globalData]
        foreach name $variables {
            append data [list $name [set ::preferences::$name]]\n
        }
        puts -nonewline $file $data
        close $file
    }

}

set rcsId {$Id: config.tcl,v 2.27 2001/12/29 00:32:39 jfontain Exp $}


namespace eval configuration {

if {$global::withGUI} {

    variable container
    variable interface
    variable hierarchy {
        canvas canvas.size canvas.colors canvas.printing viewers viewers.colors viewers.graphs viewers.pies
        thresholds thresholds.email
    }
    variable configure {1 1 1 0 1 1 1 1 0 0}
    variable helpMessage
    set helpMessage(preferences) "Preferences for the user: $global::login"
    set helpMessage(configuration) {Configuration for the current view.}

    variable entryIcons
    lappend entryIcons [image create photo -data {
        R0lGODlhEAANAPIAAAAAAH9/f7+/v///AP///wAAAAAAAAAAACH+JEZpbGUgd3JpdHRlbiBieSBBZG9iZSBQaG90b3Nob3CoIDUuMAAsAAAAABAADQAAAzNI
        Gsz6kAQxqAjxzcpvc1KWBUDYnRQZWmilYi37EmztlrAt43R8mzrO60P8lAiApHK5TAAAOw==
    }]
    lappend entryIcons [image create photo -data {
        R0lGODlhEAANAPIAAAAAAH9/f7+/v///////AAAAAAAAAAAAACH+JEZpbGUgd3JpdHRlbiBieSBBZG9iZSBQaG90b3Nob3CoIDUuMAAsAAAAABAADQAAAzk4
        Gsz6cIQ44xqCZCGbk4MmclAAgNs4ml7rEaxVAkKc3gTAnBO+sbyQT6M7gVQpk9HlAhgHzqhUmgAAOw==
    }]

}

    proc load {arrayList} {
        foreach {name value} $arrayList {
            set ::global::$name $value
        }
    }

if {$global::withGUI} {

    proc edit {preferencesMode} {
        variable hierarchy
        variable configure
        variable container
        variable interface
        variable tree
        variable preferences
        variable helpMessage
        variable dialog
        variable entryIcons

        set preferences $preferencesMode

        set objects {}

        set title {moodss: }
        if {$preferences} {
            append title Preferences
        } else {
            append title Configuration
        }
        set dialog [new dialogBox .grabber\
            -buttons hoc -default o -title $title -x [winfo pointerx .] -y [winfo pointery .] -enterreturn 0\
            -command configuration::done -helpcommand configuration::help -deletecommand {grab release .grabber} -die 0\
        ]
        grab .grabber
        lappend objects [linkedHelpWidgetTip $composite::($dialog,help,path)]

        set frame [frame $widget::($dialog,path).frame]

        set tree [blt::hierbox $frame.tree\
            -font $font::(mediumBold) -separator . -selectmode single -selectbackground lightgray -hideroot 1 -borderwidth 1\
            -highlightthickness 0 -takefocus 0 -width 150\
        ]
        set container [frame $frame.container -borderwidth 1 -relief sunken]

        set message [createMessage $container.message]
        if {$preferences} {
            $message configure -text $helpMessage(preferences)
        } else {
            $message configure -text $helpMessage(configuration)
        }
        pack $message -fill both -expand 1

        bindtags $tree [list $tree [winfo toplevel $tree] all]
        $tree bind all <Double-ButtonPress-1> {}
        $tree bind all <Shift-ButtonPress-1> {}
        $tree bind all <Control-ButtonPress-1> {}
        $tree bind all <B1-Motion> {}
        $tree bind all <ButtonRelease-1> "$tree toggle current; $tree toggle current"

        catch {unset interface(current)}

        foreach entry $hierarchy specific $configure {
            if {!$preferences&&!$specific} continue
            set index [$tree insert end $entry]
            regsub -all {\.} $entry :: interface($index,class)
            $interface($index,class)::initialize
            $tree entry configure $index -opencommand "configuration::open $index" -icons $entryIcons
        }

        pack $tree -side left -fill y -padx 2
        pack $container -fill both -expand 1 -padx 2

        dialogBox::display $dialog $frame

        wm geometry $widget::($dialog,path) 500x300

        bind $frame <Destroy> "delete $objects"
    }

    proc open {index} {
        variable container
        variable interface

        if {[info exists interface(current)]&&![$interface($interface(current),class)::check]} return
        eval destroy [winfo children $container]
        set frame [frame $container.frame]
        pack $frame -fill both -expand 1
        $interface($index,class)::edit $frame
        set interface(current) $index
    }

    proc done {} {
        variable interface
        variable preferences
        variable variables
        variable dialog

        if {[info exists interface(current)]&&![$interface($interface(current),class)::check]} return
        foreach name [array names interface *,class] {
            $interface($name)::apply
        }
        if {$preferences} {
            preferences::save $variables(1)
        }
        delete $dialog
    }

    proc help {} {
        variable interface
        variable preferences

        if {[info exists interface(current)]} {
            $interface($interface(current),class)::help
        } elseif {$preferences} {
            generalHelpWindow #core.preferences
        } else {
            generalHelpWindow #core.configuration
        }
    }

    proc createMessage {path args} {
        message $path -width [winfo screenwidth .] -font $font::(mediumNormal) -justify left
        eval $path configure $args
        return $path
    }

    proc initialize {name} {
        variable preferences

        if {$preferences} {
            if {![info exists ::preferences::$name]} {
                set ::preferences::$name [set ::global::$name]
            }
            return [set ::preferences::$name]
        } else {
            return [set ::global::$name]
        }
    }

    proc apply {name value} {
        variable preferences

        set namespaces ::global
        if {$preferences} {
            lappend namespaces ::preferences
        }
        foreach namespace $namespaces {
            if {![info exists ${namespace}::$name]||($value!=[set ${namespace}::$name])} {
                set ${namespace}::$name $value
            }
        }
    }

    proc variables {preferences} {
        variable variables

        return $variables($preferences)
    }

    namespace eval canvas {

        proc initialize {} {}

        proc edit {parentPath} {
            set message [configuration::createMessage $parentPath.message -text {Canvas configuration}]
            pack $message -fill both -expand 1
        }

        proc check {} {
            return 1
        }

        proc apply {} {}

        proc variables {} {return {}}

        proc help {} {
            generalHelpWindow #configuration.canvas
        }

        namespace eval size {

            proc variables {} {
                return {canvasHeight canvasWidth}
            }

            proc initialize {} {
                variable height [configuration::initialize canvasHeight]
                variable width [configuration::initialize canvasWidth]
            }

            proc edit {parentPath} {
                variable height
                variable width
                variable message

                set message [configuration::createMessage $parentPath.message -text {Enter size (in pixels):}]
                grid $message -sticky nsew -row 0 -column 0 -columnspan 100
                grid rowconfigure $parentPath 0 -weight 1

                grid columnconfigure $parentPath 0 -weight 1

                if {$::tcl_version<8.4} {
                    set widthEntry [new spinEntry $parentPath -font $font::(mediumBold) -width 4 -list {640 800 1024 1280 1600}]
                    spinEntry::set $widthEntry $width
                    grid $widget::($widthEntry,path) -row 1 -column 2
                    set path $composite::($widthEntry,entry,path)
                } else {
                    set path [spinbox $parentPath.widthEntry -font $font::(mediumBold) -width 4 -values {640 800 1024 1280 1600}]
                    $path set $width
                    grid $path -row 1 -column 2
                }
                $path configure -textvariable configuration::canvas::size::width
                setupEntryValidation $path {{checkMaximumLength 4 %P} {checkUnsignedInteger %P}}
                grid [label $parentPath.width -font $font::(mediumBold) -text width:] -row 1 -column 1 -padx 2
                grid columnconfigure $parentPath 3 -weight 1

                if {$::tcl_version<8.4} {
                    set heightEntry [new spinEntry $parentPath -font $font::(mediumBold) -width 4 -list {400 480 600 768 1024 1280}]
                    spinEntry::set $heightEntry $height
                    grid $widget::($heightEntry,path) -row 1 -column 5
                    set path $composite::($heightEntry,entry,path)
                } else {
                    set path\
                        [spinbox $parentPath.heightEntry -font $font::(mediumBold) -width 4 -values {400 480 600 768 1024 1280}]
                    $path set $height
                    grid $path -row 1 -column 5
                }
                $path configure -textvariable configuration::canvas::size::height
                setupEntryValidation $path {{checkMaximumLength 4 %P} {checkUnsignedInteger %P}}
                grid [label $parentPath.height -font $font::(mediumBold) -text height:] -row 1 -column 4 -padx 2
                grid columnconfigure $parentPath 6 -weight 1

                grid [button $parentPath.apply -text Apply -command configuration::canvas::size::apply]\
                    -row 2 -column 0 -columnspan 100
                grid rowconfigure $parentPath 2 -weight 1

                if {$::tcl_version<8.4} {
                    bind $message <Destroy> "delete $widthEntry $heightEntry"
                }
            }

            proc check {} {
                variable height
                variable width
                variable message

                set valid 1
                foreach item {height width} {
                    if {[string length [set $item]]==0} {
                        set text "please set $item."
                        set valid 0
                        break
                    }
                    if {[set $item]==0} {
                        set text "$item cannot be set to 0."
                        set valid 0
                        break
                    }
                }
                if {!$valid} {
                    $message configure -font $::font::(mediumBold) -text $text
                    bell
                }
                return $valid
            }

            proc apply {} {
                variable height
                variable width

                if {![check]} return
                configuration::apply canvasHeight $height
                configuration::apply canvasWidth $width
            }

            proc help {} {
                generalHelpWindow #configuration.canvas.size
            }

        }

        namespace eval colors {

            proc variables {} {
                return canvasBackground
            }

            proc initialize {} {
                variable background [configuration::initialize canvasBackground]
            }

            proc edit {parentPath} {
                variable background
                variable colorViewer

                set message [configuration::createMessage $parentPath.message -text {Background color:}]
                grid $message -sticky nsew -row 0 -column 0 -columnspan 100
                grid rowconfigure $parentPath 0 -weight 1

                grid columnconfigure $parentPath 0 -weight 1

                set colorViewer\
                    [button $parentPath.choose -text Choose... -command "configuration::canvas::colors::choose $parentPath"]
                updateColorViewer
                grid $colorViewer -row 1 -column 1
                grid [button $parentPath.apply -text Apply -command configuration::canvas::colors::apply] -row 1 -column 2

                grid columnconfigure $parentPath 1 -weight 1
                grid columnconfigure $parentPath 2 -weight 1
                grid columnconfigure $parentPath 3 -weight 1

                grid rowconfigure $parentPath 2 -weight 1
            }

            proc check {} {
                return 1
            }

            proc apply {} {
                variable background

                if {![check]} return
                configuration::apply canvasBackground $background
            }

            proc updateColorViewer {} {
                variable colorViewer
                variable background

                foreach {red green blue} [winfo rgb $colorViewer $background] {}
                if {($red+$green+$blue)>=(32768*3)} {
                    $colorViewer configure -foreground black
                } else {
                    $colorViewer configure -foreground white
                }
                $colorViewer configure -background $background
            }

            proc choose {parentPath} {
                variable background

                set choice [tk_chooseColor -initialcolor $background -title {Choose color:} -parent $parentPath]
                if {[string length $choice]>0} {
                    set background $choice
                    updateColorViewer
                }
            }

            proc help {} {
                generalHelpWindow #configuration.canvas.colors
            }

        }

        namespace eval printing {

            variable helpText {}

            proc variables {} {
                return {printToFile fileToPrintTo printCommand printOrientation printPalette printPaperSize}
            }

            proc initialize {} {
                variable toFile [configuration::initialize printToFile]
                variable printFile [configuration::initialize fileToPrintTo]
                variable command [configuration::initialize printCommand]
                variable orientation [configuration::initialize printOrientation]
                variable palette [configuration::initialize printPalette]
                variable size [configuration::initialize printPaperSize]
            }

            proc edit {parentPath} {
                variable helpText
                variable toFile
                variable printFile
                variable command
                variable orientation
                variable palette
                variable size

                set objects {}

                set row 0
                set message [configuration::createMessage $parentPath.message -text {Printing setup:}]
                grid $message -sticky nsew -row $row -column 0 -columnspan 3
                grid rowconfigure $parentPath $row -weight 1

                incr row
                radiobutton $parentPath.toCommand -variable configuration::canvas::printing::toFile -value 0 -text Command:
                grid $parentPath.toCommand -row $row -column 0 -sticky w
                entry $parentPath.command -textvariable configuration::canvas::printing::command
                grid $parentPath.command -row $row -column 1 -columnspan 2 -sticky ew

                incr row
                radiobutton $parentPath.toFile -variable configuration::canvas::printing::toFile -value 1 -text {to File:}
                grid $parentPath.toFile -row $row -column 0 -sticky w
                entry $parentPath.file -textvariable configuration::canvas::printing::printFile
                grid $parentPath.file -row $row -column 1 -sticky ew
                button $parentPath.browse -text Browse... -command "configuration::canvas::printing::inquirePrintFile $parentPath"
                grid $parentPath.browse -row $row -column 2 -sticky ew
                if {$toFile} {
                    $parentPath.toFile invoke
                } else {
                    $parentPath.toCommand invoke
                }

                incr row
                grid [label $parentPath.orientation -text Orientation:] -row $row -column 0 -sticky w
                set entry\
                    [new comboEntry $parentPath -font $widget::option(entry,font) -list $global::printOrientations -editable 0]
                lappend objects $entry
                composite::configure $entry entry -textvariable configuration::canvas::printing::orientation
                composite::configure $entry button -listheight [llength $global::printOrientations]
                composite::configure $entry button scroll -selectmode single
                grid $widget::($entry,path) -row $row -column 1 -columnspan 2 -sticky ew

                incr row
                grid [label $parentPath.palette -text Palette:] -row $row -column 0 -sticky w
                set entry [new comboEntry $parentPath -font $widget::option(entry,font) -list $global::printPalettes -editable 0]
                lappend objects $entry
                composite::configure $entry entry -textvariable configuration::canvas::printing::palette
                composite::configure $entry button -listheight [llength $global::printPalettes]
                composite::configure $entry button scroll -selectmode single
                grid $widget::($entry,path) -row $row -column 1 -columnspan 2 -sticky ew

                incr row
                grid [label $parentPath.size -text {Paper size:}] -row $row -column 0 -sticky w
                set entry [new comboEntry $parentPath -font $widget::option(entry,font) -list $global::printPaperSizes -editable 0]
                lappend objects $entry
                composite::configure $entry entry -textvariable configuration::canvas::printing::size
                composite::configure $entry button -listheight [llength $global::printPaperSizes]
                composite::configure $entry button scroll -selectmode single
                grid $widget::($entry,path) -row $row -column 1 -columnspan 2 -sticky ew

                incr row
                set message [configuration::createMessage $parentPath.help -text $helpText]
                grid $message -sticky nsew -row $row -column 0 -columnspan 3
                grid rowconfigure $parentPath $row -weight 1

                bind $message <Destroy> "delete $objects"
            }

            proc inquirePrintFile {parentPath} {
                variable printFile

                set file [tk_getSaveFile\
                    -title {moodss: File to print to} -parent $parentPath -initialdir [file dirname $printFile]\
                    -defaultextension .ps -filetypes {{Postscript .ps} {{All files} *}} -initialfile $printFile\
                ]
                if {[string length $file]>0} {
                    set printFile $file
                }
            }

            proc check {} {
                return 1
            }

            proc apply {} {
                variable toFile
                variable printFile
                variable command
                variable orientation
                variable palette
                variable size

                configuration::apply printToFile $toFile
                configuration::apply fileToPrintTo $printFile
                configuration::apply printCommand $command
                configuration::apply printOrientation $orientation
                configuration::apply printPalette $palette
                configuration::apply printPaperSize $size
            }

            proc help {} {
                generalHelpWindow #preferences.canvas.printing
            }

        }

    }


    namespace eval viewers {

        proc initialize {} {}

        proc edit {parentPath} {
            set message [configuration::createMessage $parentPath.message -text {Viewers configuration}]
            pack $message -fill both -expand 1
        }

        proc check {} {
            return 1
        }

        proc apply {} {}

        proc variables {} {return {}}

        proc help {} {
            generalHelpWindow #configuration.viewers
        }

        namespace eval colors {

            variable helpText {}

            proc variables {} {
                return viewerColors
            }

            proc initialize {} {
                variable colors [configuration::initialize viewerColors]
            }

            proc edit {parentPath} {
                variable helpText
                variable colorsFrame

                set message [configuration::createMessage $parentPath.message -text {Change colors:}]
                grid $message -sticky nsew -row 0 -column 0 -columnspan 100
                grid rowconfigure $parentPath 0 -weight 1

                grid columnconfigure $parentPath 0 -weight 1

                set colorsFrame [frame $parentPath.colors -borderwidth 1 -background black]
                refresh
                grid $colorsFrame -row 1 -column 0

                set message [configuration::createMessage $parentPath.help -text $helpText]
                grid $message -sticky nsew -row 2 -column 0 -columnspan 100
                grid rowconfigure $parentPath 2 -weight 1
            }

            proc refresh {} {
                variable colors
                variable colorsFrame

                eval destroy [winfo children $colorsFrame]
                set index 0
                foreach color $colors {
                    set button [button $colorsFrame.$index -background $color -activebackground $color -borderwidth 1]
                    $button configure -command "configuration::viewers::colors::choose $index"
                    pack $button -side left
                    incr index
                }
            }

            proc choose {index} {
                variable colors
                variable colorsFrame

                set button $colorsFrame.$index
                set background [tk_chooseColor -initialcolor [$button cget -background] -title {Choose color:} -parent $button]
                if {[string length $background]>0} {
                    $button configure -background $background
                    set colors [lreplace $colors $index $index $background]
                }
            }

            proc check {} {
                return 1
            }

            proc apply {} {
                variable colors
                variable colorsFrame

                if {![check]} return
                if {![info exists colorsFrame]} return
                configuration::apply viewerColors $colors
            }

            proc help {} {
                generalHelpWindow #configuration.viewers.colors
            }

        }

        namespace eval graphs {

            variable helpText {}

            proc variables {} {
                return graphNumberOfIntervals
            }

            proc initialize {} {
                variable numberOfSamples [configuration::initialize graphNumberOfIntervals]
            }

            proc edit {parentPath} {
                variable helpText
                variable numberOfSamples
                variable message

                set message [configuration::createMessage $parentPath.message -text "Enter number of samples\nfor data graphs:"]
                grid $message -sticky nsew -row 0 -column 0 -columnspan 100
                grid rowconfigure $parentPath 0 -weight 1

                grid columnconfigure $parentPath 0 -weight 1

                if {$::tcl_version<8.4} {
                    set entry [new spinEntry $parentPath -font $font::(mediumBold) -width 4 -list {20 50 100 150 200 300 500 1000}]
                    spinEntry::set $entry $numberOfSamples
                    grid $widget::($entry,path) -row 1 -column 2
                    set path $composite::($entry,entry,path)
                } else {
                    set path [spinbox $parentPath.entry -font $font::(mediumBold) -width 4 -values {20 50 100 150 200 300 500 1000}]
                    $path set $numberOfSamples
                    grid $path -row 1 -column 2
                }
                $path configure -textvariable configuration::viewers::graphs::numberOfSamples
                setupEntryValidation $path {{checkMaximumLength 4 %P} {checkUnsignedInteger %P}}

                grid [label $parentPath.width -font $font::(mediumBold) -text samples:] -row 1 -column 1 -padx 2

                grid columnconfigure $parentPath 3 -weight 1

                set message [configuration::createMessage $parentPath.help -text $helpText]
                grid $message -sticky nsew -row 2 -column 0 -columnspan 100
                grid rowconfigure $parentPath 2 -weight 1

                if {$::tcl_version<8.4} {
                    bind $message <Destroy> "delete $entry"
                }
            }

            proc check {} {
                variable numberOfSamples
                variable message

                set valid 1
                if {[string length $numberOfSamples]==0} {
                    set text {please set number of samples.}
                    set valid 0
                } elseif {$numberOfSamples==0} {
                    set text {number of samples cannot be set to 0.}
                    set valid 0
                }
                if {!$valid} {
                    $message configure -font $::font::(mediumBold) -text $text
                    bell
                }
                return $valid
            }

            proc apply {} {
                variable numberOfSamples

                if {![check]} return
                configuration::apply graphNumberOfIntervals $numberOfSamples
            }

            proc help {} {
                generalHelpWindow #configuration.viewers.graphs
            }

        }

        namespace eval pies {

            variable helpText {}

            proc variables {} {
                return pieLabeler
            }

            proc initialize {} {
                variable labeler [configuration::initialize pieLabeler]
            }

            proc edit {parentPath} {
                variable helpText

                set message [configuration::createMessage $parentPath.message -text {Choose labeler type for data pies:}]
                grid $message -sticky nsew -row 0 -column 0 -columnspan 100
                grid rowconfigure $parentPath 0 -weight 1

                grid columnconfigure $parentPath 0 -weight 1

                set button [radiobutton $parentPath.box -variable ::configuration::viewers::pies::labeler -value box -text box]
                grid $button -row 1 -column 1
                set button [radiobutton $parentPath.peripheral\
                    -variable ::configuration::viewers::pies::labeler -value peripheral -text peripheral\
                ]
                grid $button -row 1 -column 2

                grid columnconfigure $parentPath 3 -weight 1

                set message [configuration::createMessage $parentPath.help -text $helpText]
                grid $message -sticky nsew -row 2 -column 0 -columnspan 100
                grid rowconfigure $parentPath 2 -weight 1
            }

            proc check {} {
                return 1
            }

            proc apply {} {
                variable labeler

                if {![check]} return
                configuration::apply pieLabeler $labeler
            }

            proc help {} {
                generalHelpWindow #configuration.viewers.pies
            }

        }

    }

    namespace eval thresholds {

        proc initialize {} {}

        proc edit {parentPath} {
            set message [configuration::createMessage $parentPath.message -text {Thresholds configuration}]
            pack $message -fill both -expand 1
        }

        proc check {} {
            return 1
        }

        proc apply {} {}

        proc variables {} {return {}}

        proc help {} {
            generalHelpWindow #preferences.thresholds
        }

        namespace eval email {

            variable helpText {}

            proc variables {} {
                return {fromAddress smtpServers}
            }

            proc initialize {} {
                variable from [configuration::initialize fromAddress]
                variable servers [configuration::initialize smtpServers]
            }

            proc edit {parentPath} {
                variable servers
                variable list
                variable parent $parentPath

                set row 0
                set message [configuration::createMessage $parentPath.message -text {Mail settings:}]
                grid $message -sticky nsew -row $row -column 0 -columnspan 2
                grid rowconfigure $parentPath $row -weight 1
                incr row
                set label [label $parentPath.from -text {From address:}]
                if {$global::noMail} {
                    $label configure -foreground $widget::option(button,disabledforeground)
                }
                grid $label -row $row -column 0 -sticky w
                set entry [entry $parentPath.address -textvariable configuration::thresholds::email::from]
                if {$global::noMail} {
                    $entry configure -state disabled
                }
                grid $entry -row $row -column 1 -sticky ew
                incr row
                set label [label $parentPath.out -text {Outgoing mail SMTP servers:}]
                if {$global::noMail} {
                    $label configure -foreground $widget::option(button,disabledforeground)
                }
                grid $label -row $row -column 0 -sticky nw
                set list [new listEntry $parentPath -list $servers]
                if {$global::noMail} {
                    composite::configure $list -state disabled
                }
                grid $widget::($list,path) -row $row -column 1 -sticky nsew
                incr row
                grid rowconfigure $parentPath $row -weight 1
                bind $message <Destroy> "delete $list; unset configuration::thresholds::email::list"
            }

            proc check {} {
                variable from
                variable parent

                if {!$global::noMail&&([string length [emailAddressError $from]]>0)} {
                    tk_messageBox -parent $parent -title {moodss: Email error} -type ok -icon error\
                        -message "$from: [emailAddressError $from]"
                    return 0
                }
                return 1
            }

            proc apply {} {
                variable from
                variable servers
                variable list

                configuration::apply fromAddress $from
                if {[info exists list]} {
                    set servers [composite::cget $list -list]
                }
                configuration::apply smtpServers $servers
            }

            proc help {} {
                generalHelpWindow #preferences.thresholds.email
            }

        }
    }

    variable variables
    set variables(0) {}
    set variables(1) {}
    foreach entry $hierarchy specific $configure {
        regsub -all {\.} $entry :: class
        if {$specific} {
            set variables(0) [concat $variables(0) [${class}::variables]]
        }
        set variables(1) [concat $variables(1) [${class}::variables]]
    }

}

}
configuration::load [preferences::read]

if {[string equal $tcl_platform(platform) unix]} {
    if {[lsearch -exact $auto_path /usr/lib]<0} {
        lappend auto_path /usr/lib /usr/lib/moodss
    }
    lappend auto_path $::tcl_pkgPath/moodss
    if {!$global::rpm} {
        lappend auto_path [pwd]
    }
} else {
    lappend auto_path $::tcl_libPath/moodss [pwd]
}
package require msgcat
namespace import msgcat::*
package require internationalization

if 1 {


package require Tcl 8.3

package provide stooop 4.3

catch {rename proc _proc}

namespace eval ::stooop {
    variable check
    variable trace

    set check(code) {}
    if {[info exists ::env(STOOOPCHECKALL)]&&$::env(STOOOPCHECKALL)} {
        array set ::env\
            {STOOOPCHECKPROCEDURES 1 STOOOPCHECKDATA 1 STOOOPCHECKOBJECTS 1}
    }
    set check(procedures) [expr {\
        [info exists ::env(STOOOPCHECKPROCEDURES)]&&\
        $::env(STOOOPCHECKPROCEDURES)\
    }]
    set check(data) [expr {\
        [info exists ::env(STOOOPCHECKDATA)]&&$::env(STOOOPCHECKDATA)\
    }]
    set check(objects) [expr {\
        [info exists ::env(STOOOPCHECKOBJECTS)]&&$::env(STOOOPCHECKOBJECTS)\
    }]
    if {$check(procedures)} {
        append check(code) {::stooop::checkProcedure;}
    }
    if {[info exists ::env(STOOOPTRACEALL)]} {
        set ::env(STOOOPTRACEPROCEDURES) $::env(STOOOPTRACEALL)
        set ::env(STOOOPTRACEDATA) $::env(STOOOPTRACEALL)
    }
    if {[info exists ::env(STOOOPTRACEPROCEDURES)]} {
        set trace(procedureChannel) $::env(STOOOPTRACEPROCEDURES)
        if {![regexp {^(stdout|stderr)$} $trace(procedureChannel)]} {
            set trace(procedureChannel) [open $::env(STOOOPTRACEPROCEDURES) w+]
        }
        set trace(procedureFormat)\
            {class: %C, procedure: %p, object: %O, arguments: %a}
        catch {set trace(procedureFormat) $::env(STOOOPTRACEPROCEDURESFORMAT)}
        append check(code) {::stooop::traceProcedure;}
    }
    if {[info exists ::env(STOOOPTRACEDATA)]} {
        set trace(dataChannel) $::env(STOOOPTRACEDATA)
        if {![regexp {^(stdout|stderr)$} $trace(dataChannel)]} {
            set trace(dataChannel) [open $::env(STOOOPTRACEDATA) w+]
        }
        set trace(dataFormat) {class: %C, procedure: %p, array: %A, object: %O, member: %m, operation: %o, value: %v}
        catch {set trace(dataFormat) $::env(STOOOPTRACEDATAFORMAT)}
        set trace(dataOperations) rwu
        catch {set trace(dataOperations) $::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 {[string is integer $classOrId]} {
            if {[catch {\
                set fullClass([set id [incr newId]]) $fullClass($classOrId)\
            }]} {
                error "invalid object identifier $classOrId"
            }
            uplevel $fullClass($classOrId)::_copy $id $classOrId
        } else {
            set constructor ${classOrId}::[namespace tail $classOrId]
            uplevel $constructor [set id [incr newId]] $args
            set fullClass($id) [namespace qualifiers\
                [uplevel namespace which -command $constructor]\
            ]
        }
        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
        array unset ${fullClass}:: $id,*
    }

    _proc classof {id} {
        variable fullClass

        return $fullClass($id)
    }

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

_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 equal $namespace ::]} {
                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 equal [uplevel namespace which -command $keyword] ::proc]} {
        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 equal $class $procedure]} {
        error "cannot make class $fullClass constructor virtual"
    }
    if {[string equal ~$class $procedure]} {
        error "cannot make class $fullClass destructor virtual"
    }
    if {![string equal [lindex $arguments 0] this]} {
        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 equal $class $procedure]} {
        if {![string equal [lindex $arguments 0] this]} {
            error "class $fullClass constructor first argument must be this"
        }
        if {[string equal [lindex $arguments 1] copy]} {
            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 equal ~$class $procedure]} {
        if {[llength $arguments]!=1} {
            error "class $fullClass destructor must have 1 argument exactly"
        }
        if {![string equal [lindex $arguments 0] this]} {
            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 check
    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 equal [lindex $arguments end] args]} {
        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 {}
$check(code)
"
    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 (\$this,_derived) \$(\$[::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 check
    variable fullBases

    set body \
"::variable {}
$check(code)
$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 check
    variable pureVirtual

    if {[info exists pureVirtual]} {
        if {$pureVirtual} {
            _proc ${fullClass}::$procedure $arguments \
"::variable {}
$check(code)
::uplevel \$(\$this,_derived)::$procedure \[::lrange \[::info level 0\] 1 end\]
"
        } else {
            _proc ${fullClass}::_$procedure $arguments \
"::variable {}
$check(code)
$body
"
            _proc ${fullClass}::$procedure $arguments \
"::variable {}
$check(code)
if {!\[::catch {::info body \$(\$this,_derived)::$procedure}\]} {
::return \[::uplevel \$(\$this,_derived)::$procedure \[::lrange \[::info level 0\] 1 end\]\]
}
::uplevel ${fullClass}::_$procedure \[::lrange \[::info level 0\] 1 end\]
"
        }
    } else {
        _proc ${fullClass}::$procedure $arguments \
"::variable {}
$check(code)
$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 trace
        variable check

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

    if {$::stooop::check(procedures)} {
        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) {}
            }
        }
    }

    if {$::stooop::check(objects)} {
        _proc invokingProcedure {} {
            if {[catch {set procedure [lindex [info level -2] 0]}]} {
                return {top level}
            } elseif {[string length $procedure]==0} {
                return "namespace [uplevel 2 namespace current]"
            } else {
                return [uplevel 3 namespace which -command $procedure]
            }
        }
    }

    if {$::stooop::check(procedures)||$::stooop::check(objects)} {
        catch {rename ::stooop::new ::stooop::_new}
        _proc ::stooop::new {classOrId args} {
            variable newId
            variable check

            if {$check(procedures)} {
                variable fullClass
                variable interface
            }
            if {$check(objects)} {
                variable creator
            }
            if {$check(procedures)} {
                if {[string is integer $classOrId]} {
                    set fullName $fullClass($classOrId)
                } else {
                    set constructor ${classOrId}::[namespace tail $classOrId]
                    catch {$constructor}
                    set fullName [namespace qualifiers\
                        [uplevel namespace which -command $constructor]\
                    ]
                    set fullClass([expr {$newId+1}]) $fullName
                }
                if {[info exists interface($fullName)]} {
                    error "class $fullName with pure virtual procedures should not be instanciated"
                }
            }
            if {$check(objects)} {
                set creator([expr {$newId+1}]) [invokingProcedure]
            }
            return [uplevel ::stooop::_new $classOrId $args]
        }
    }

    if {$::stooop::check(objects)} {
        _proc ::stooop::delete {args} {
            variable fullClass
            variable deleter

            set procedure [invokingProcedure]
            foreach id $args {
                uplevel ::stooop::deleteObject $fullClass($id) $id
                unset fullClass($id)
                set deleter($id) $procedure
            }
        }
    }

    _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 equal $class $procedure]} {
            set procedure constructor
        } elseif {[string equal ~$class $procedure]} {
            set procedure destructor
        }
        if {[string equal [lindex [info args $fullProcedure] 0] this]} {
            set thisParameter [lindex $list 1]
        }
    }

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

        debugInformation class qualifiedClass procedure qualifiedProcedure this
        if {![info exists this]} return
        if {[string equal $procedure constructor]} return
        if {![info exists fullClass($this)]} {
            error "$this is not a valid object identifier"
        }
        set fullName [string trimleft $fullClass($this) :]
        if {[string equal $fullName $qualifiedClass]} 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 trace

        debugInformation class qualifiedClass procedure qualifiedProcedure this
        set text $trace(procedureFormat)
        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 $trace(procedureChannel) $text
    }

    _proc ::stooop::checkData {array name operation} {
        scan $name %u,%s identifier member
        if {[info exists member]&&[string equal $member _derived]} 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 equal $array ::${qualifiedClass}::]} {
                error\
                    "class access violation in class $qualifiedClass namespace"
            }
            return
        }
        if {[string equal $qualifiedProcedure ::stooop::copy]} return
        if {![string equal $array ::${qualifiedClass}::]} {
            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 trace

        scan $name %u,%s identifier member
        if {[info exists member]&&[string equal $member _derived]} return

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

        debugInformation class qualifiedClass procedure qualifiedProcedure this
        set text $trace(dataFormat)
        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 equal $operation u]} {
            regsub -all %v $text {} text
        } else {
            regsub -all %v $text [uplevel set ${array}($name)] text
        }
        puts $trace(dataChannel) $text
    }

    if {$::stooop::check(objects)} {
        _proc ::stooop::printObjects {{pattern *}} {
            variable fullClass
            variable creator

            puts "stooop::printObjects invoked from [invokingProcedure]:"
            foreach id [lsort -integer [array names fullClass]] {
                if {[string match $pattern $fullClass($id)]} {
                    puts "$fullClass($id)\($id\) + $creator($id)"
                }
            }
        }

        _proc ::stooop::record {} {
            variable fullClass
            variable checkpointFullClass

            puts "stooop::record invoked from [invokingProcedure]"
            catch {unset checkpointFullClass}
            array set checkpointFullClass [array get fullClass]
        }

        _proc ::stooop::report {{pattern *}} {
            variable fullClass
            variable checkpointFullClass
            variable creator
            variable deleter

            puts "stooop::report invoked from [invokingProcedure]:"
            set checkpointIds [lsort -integer [array names checkpointFullClass]]
            set currentIds [lsort -integer [array names fullClass]]
            foreach id $currentIds {
                if {\
                    [string match $pattern $fullClass($id)]&&\
                    ([lsearch -exact $checkpointIds $id]<0)\
                } {
                    puts "+ $fullClass($id)\($id\) + $creator($id)"
                }
            }
            foreach id $checkpointIds {
                if {\
                    [string match $pattern $checkpointFullClass($id)]&&\
                    ([lsearch -exact $currentIds $id]<0)\
                } {
                    puts "- $checkpointFullClass($id)\($id\) - $deleter($id) + $creator($id)"
                }
            }
        }
    }

}
}
namespace import stooop::*
if 1 {

package provide switched 2.2


::stooop::class switched {

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

    proc ~switched {this} {}

    ::stooop::virtual proc options {this}

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

    proc configure {this args} {
        if {[llength $args]==0} {
            return [descriptions $this]
        }
        foreach {option value} $args {
            if {![info exists ($this,$option)]} {
                error "$($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 equal $($this,$option) $value]} {
                $($this,_derived)::set$option $this [set ($this,$option) $value]
            }
        }
    }

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

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

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

}
}


set rcsId {$Id: module.tcl,v 2.30 2001/12/29 00:32:39 jfontain Exp $}


class module {

    proc module {this name index} {
        if {[string length $index]==0} {
            set index [newIndex $name]
        } else {
            addIndex $name $index
        }
        set ($this,name) $name
        set ($this,index) $index
    }

    proc ~module {this} {
        if {$($this,terminate)} {
            ::$($this,namespace)::terminate
        }
        if {[info exists ($this,interpreter)]} {
            switch $($this,type) {
                perl {
                    perl::interp delete $($this,interpreter)
                }
                python {
                    python::interp delete $($this,interpreter)
                }
                default {
                    interp delete $($this,interpreter)
                }
            }
        }
        if {[info exists ($this,namespace)]} {
            namespace delete ::$($this,namespace)
        }
        deleteIndex $this
    }

    proc newIndex {name} {
        variable indices

        if {![info exists indices($name)]} {
            set indices($name) {}
        }
        set new 0
        foreach index $indices($name) {
            if {$index!=$new} break
            incr new
        }
        set indices($name) [lsort -integer [concat $indices($name) $new]]
        return $new
    }

    proc addIndex {name index} {
        variable indices

        if {![info exists indices($name)]} {
            set indices($name) $index
            return
        }
        if {[lsearch -exact $indices($name) $index]>=0} {
            error "trying to add an existing index: $index"
        }
        set indices($name) [lsort -integer [concat $indices($name) $index]]
    }

    proc deleteIndex {this} {
        variable indices

        set name $($this,name)
        ldelete indices($name) $($this,index)
        if {[llength $indices($name)]==0} {
            unset indices($name)
        }
    }

    proc load {this} {
        set name $($this,name)
        set index $($this,index)
        if {$index==0} {
            set namespace $name
        } else {
            set namespace ${name}<$index>
        }

        set directory [pwd]
        cd $::packageDirectory($name)

        set interpreter [interp create]
        $interpreter eval {
            proc bgerror {error} {
                puts stderr $::errorInfo
                exit 1
            }
        }
        $interpreter eval "set auto_path [list $::auto_path]"
        catch {$interpreter eval {package require {}}}
        $interpreter eval {rename source _source}; $interpreter alias source ::module::source $this $interpreter
        namespace eval ::$namespace {}
        set ($this,namespace) $namespace
        set ($this,terminate) 0
        set ::${namespace}::data(updates) -2147483648
        $interpreter eval "package require $name"
        switch $($this,type) {
            perl - python {
                interp delete $interpreter
                validateColumnTitles $this
            }
            default {
                set ($this,interpreter) $interpreter
                loadTcl $this
            }
        }
        cd $directory
    }

    proc loadTcl {this} {
        set name $($this,name)
        set interpreter $($this,interpreter)
        set namespace $($this,namespace)
        namespace eval ::$namespace [subst -nocommands {proc update {args} {$interpreter eval ::${name}::update \$args}}]
        set ($this,initialize) [procedureExists $this initialize]
        if {$($this,initialize)} {
            namespace eval ::$namespace [subst -nocommands {
                proc initialize {arguments} {
                    $interpreter eval "
                        array set _options [list \$arguments]
                        ::${name}::initialize _options
                        unset _options
                    "
                }
            }]
        }
        set ($this,terminate) [procedureExists $this terminate]
        if {$($this,terminate)} {
            proc ::${namespace}::terminate {} "$interpreter eval ${name}::terminate"
        }
        set ($this,version) [$interpreter eval "package provide $name"]
        synchronize $this
        validateColumnTitles $this
        $interpreter alias exit exit
        $interpreter alias _updated ::module::updated $this
        $interpreter eval "trace variable ::${name}::data(updates) w _updated"
        $interpreter alias pushMessage ::modules::pushMessage $name $namespace
        $interpreter alias popMessage ::modules::popMessage
        $interpreter alias flashMessage ::modules::flashMessage $name $namespace
        $interpreter alias traceMessage ::modules::trace $name $namespace
    }

    proc updated {this args} {
        set namespace $($this,namespace)
        set updates [$($this,interpreter) eval "set ::$($this,name)::data(updates)"]
        if {$updates<=[set ::${namespace}::data(updates)]} return
        if {$global::withGUI} {
            lifoLabel::push $global::messenger "$namespace data update..."
            update idletasks
        }
        array unset ::${namespace}::data {[0-9]*,[0-9]*}
        synchronize $this {[0-9]*,[0-9]*}
        set ::${namespace}::data(updates) $updates
        if {$global::withGUI} {
            lifoLabel::pop $global::messenger
        }
    }

    proc clear {this} {
        set namespace $($this,namespace)
        array unset ::${namespace}::data {[0-9]*,[0-9]*}
        set ::${namespace}::data(updates) [set ::${namespace}::data(updates)]
    }

    proc synchronize {this {pattern *}} {
        set namespace $($this,namespace)
        set interpreter $($this,interpreter)
        set name $($this,name)
        switch $($this,type) {
            perl {
                array set ::${namespace}::data [$interpreter eval hash_string(%${name}::data)]
            }
            python {
                array set ::${namespace}::data [$interpreter eval formstring($name.form)]
            }
            default {
                array set ::${namespace}::data [$interpreter eval "array get ::${name}::data {$pattern}"]
            }
        }
    }

    proc validateColumnTitles {this} {
        foreach {name label} [array get ::$($this,namespace)::data *,label] {
            if {[string first ? $label]>=0} {
                scan $name %u column
                puts stderr "in $($this,namespace) module, column $column label contains a ? character: \"$label\""
                exit 1
            }
        }
    }

    proc procedureExists {this name} {
        return [$($this,interpreter) eval\
            [subst -nocommands {expr {[string length [namespace eval ::$($this,name) {info proc $name}]]>0}}]\
        ]
    }

    proc source {this interpreter file} {
        switch [file extension $file] {
            .pm {
                set ($this,type) perl
                loadPerl $this $file
                $interpreter eval "package provide $($this,name) $($this,version)"
            }
            .py {
                set ($this,type) python
                loadPython $this $file
                $interpreter eval "package provide $($this,name) $($this,version)"
            }
            default {
                set ($this,type) tcl
                $interpreter eval _source [list $file]
            }
        }
    }

    proc loadPerl {this file} {
        set name $($this,name)
        set namespace $($this,namespace)
        if {[catch {package require tclperl 2} message]} {
            error "$message\nis the tclperl package installed?"
        }
        set interpreter [perl::interp new]
        set ($this,interpreter) $interpreter
        $interpreter eval "use $name"
        $interpreter eval $perl::utilityFunctions
        array set ::${namespace}::data [$interpreter eval hash_string(%${name}::data)]
        if {$global::withGUI} {
            proc ::${namespace}::update {} "
                variable data
                lifoLabel::push $global::messenger {$namespace data update...}
                $interpreter eval ${name}::update()
                set updates \[$interpreter eval \\$${name}::data{updates}\]
                if {\$updates>\$data(updates)} {
                    array unset data {\[0-9\]*,\[0-9\]*}
                    array set data \[$interpreter eval array_string(@${name}::data)\]
                    set data(updates) \$updates
                }
                lifoLabel::pop $global::messenger
            "
        } else {
            proc ::${namespace}::update {} "
                variable data
                $interpreter eval ${name}::update()
                set updates \[$interpreter eval \\$${name}::data{updates}\]
                if {\$updates>\$data(updates)} {
                    array unset data {\[0-9\]*,\[0-9\]*}
                    array set data \[$interpreter eval array_string(@${name}::data)\]
                    set data(updates) \$updates
                }
            "
        }
        set ($this,initialize) [$interpreter eval int(defined(&${name}::initialize))]
        if {[info exists ${namespace}::data(switches)]} {
            array set argumentRequired [set ${namespace}::data(switches)]
        }
        if {$($this,initialize)} {
            if {![info exists argumentRequired]} {
                puts stderr "in $name module, initialize subroutine requires switches to be defined"
                exit 1
            }
            proc ::${namespace}::initialize {arguments} "
                array set argumentRequired [list [array get argumentRequired]]
                set argument {}
                foreach {name value} \$arguments {
                    if {!\$argumentRequired(\$name)} {
                        set value 1
                    } else {
                        regsub -all {\\\\} \$value {\\\\\\\\} value
                        regsub -all ' \$value {\\\\\\'} value
                    }
                    if {\[string length \$argument\]>0} {append argument ,}
                    append argument '\$name','\$value'
                }
                $interpreter eval ${name}::initialize(\$argument)
            "
        }
        set ($this,terminate) [$interpreter eval int(defined(&${name}::terminate))]
        if {$($this,terminate)} {
            proc ::${namespace}::terminate {} "$interpreter eval ${name}::terminate()"
        }
        set ($this,version) [$interpreter eval \$${name}::VERSION]
    }

    proc loadPython {this file} {
        set name $($this,name)
        set namespace $($this,namespace)
        if {[catch {package require tclpython2 2.0.1} message]&&[catch {package require tclpython 2} message]} {
            error "$message\nis the tclpython2 or tclpython package installed?"
        }
        set interpreter [python::interp new]
        set ($this,interpreter) $interpreter

        $interpreter eval "import sys\nsys.path.insert(0, '.')"
        $interpreter eval {from types import FunctionType}
        $interpreter eval {import re}
        $interpreter eval "import $name"
        $interpreter eval $python::utilityFunctions
        array set ::${namespace}::data [$interpreter eval formstring($name.form)]
        if {$global::withGUI} {
            proc ::${namespace}::update {} "
                variable data
                lifoLabel::push $global::messenger {$namespace data update...}
                $interpreter eval $name.update()
                set updates \[$interpreter eval {$name.form\['updates'\]}]
                if {\$updates>\$data(updates)} {
                    array unset data {\[0-9\]*,\[0-9\]*}
                    array set data \[$interpreter eval datastring($name.data)\]
                    set data(updates) \$updates
                }
                lifoLabel::pop $global::messenger
            "
        } else {
            proc ::${namespace}::update {} "
                variable data
                $interpreter eval $name.update()
                set updates \[$interpreter eval {$name.form\['updates'\]}]
                if {\$updates>\$data(updates)} {
                    array unset data {\[0-9\]*,\[0-9\]*}
                    array set data \[$interpreter eval datastring($name.data)\]
                    set data(updates) \$updates
                }
            "
        }
        set ($this,initialize) [$interpreter eval "try: type($name.initialize) == FunctionType\nexcept: 0"]
        if {[info exists ${namespace}::data(switches)]} {
            array set argumentRequired [set ${namespace}::data(switches)]
        }
        if {$($this,initialize)} {
            if {![info exists argumentRequired]} {
                puts stderr "in $name module, initialize subroutine requires switches to be defined"
                exit 1
            }
            proc ::${namespace}::initialize {arguments} "
                array set argumentRequired [list [array get argumentRequired]]
                set argument {}
                foreach {name value} \$arguments {
                    if {!\$argumentRequired(\$name)} {
                        set value 1
                    } else {
                        regsub -all {\\\\} \$value {\\\\\\\\} value
                        regsub -all ' \$value {\\\\\\'} value
                    }
                    if {\[string length \$argument\]>0} {append argument ,}
                    append argument '\$name':'\$value'
                }
                $interpreter eval $name.initialize({\$argument})
            "
        }
        set ($this,terminate) [$interpreter eval "try: type($name.terminate) == FunctionType\nexcept: 0"]
        if {$($this,terminate)} {
            proc ::${namespace}::terminate {} "$interpreter eval $name.terminate()"
        }
        set ($this,version) [$interpreter eval $name.__version__]
    }

}

set rcsId {$Id: modperl.tcl,v 1.4 2001/12/29 00:32:39 jfontain Exp $}


namespace eval module::perl {

    variable utilityFunctions {

        sub array_string {                                     # return string usable by Tcl array set command, from Perl data array
            my @data = @_;
            my $string = '';
            for my $row (0 .. $#data) {
                for my $column (0 .. $#{$data[$row]}) {
                    my $value = qq($data[$row][$column]);
                    $value =~ s/"/\\"/g;                                      # embedded quotes allowed in value but must be escaped
                    $string .= " $row,$column \"$value\"";
                }
            }
            return $string;
        }

        sub hash_string {                                       # return string usable by Tcl array set command, from Perl data hash
            my %data = @_;
            my $string = '';
            while (my ($key, $value) = each %data) {
                if ($key =~ /^(pollTimes|indices|indexColumns)$/) {                         # Perl arrays transformed into Tcl lists
                    $string .= " $key {@{$value}}";
                } elsif ($key eq 'columns') {
                    for my $column (0 .. $#{$value}) {
                        while (my ($key, $value) = each %{$$value[$column]}) {
                            $value =~ s/"/\\"/g;                            # embedded quotes allowed in message but must be escaped
                            $string .= " $column,$key \"$value\"";
                        }
                    }
                } elsif ($key eq 'views') {
                    $string .= ' views {';
                    for my $view (0 .. $#{$value}) {
                        $string .= ' {';
                        while (my ($key, $value) = each %{$$value[$view]}) {
                            $string .= " $key";
                            if ($key eq 'swap') {                                                                   # simple boolean
                                $string .= " $value";
                            } elsif ($key eq 'sort') {                                                                   # sort hash
                                my ($key, $value) = %$value;                                                 # keep first entry only
                                $string .= " {$key $value}";
                            } else {                                                                                 # indices array
                                $string .= " {@{$value}}";
                            }
                        }
                        $string .= '}';
                    }
                    $string .= '}';
                } elsif ($key eq 'sort') {                                                                               # sort hash
                    $string .= " $key {";
                    my ($key, $value) = %$value;                                                             # keep first entry only
                    $string .= "$key $value";
                    $string .= '}';
                } elsif ($key eq 'switches') {                                # Perl hash transformed into Tcl array compatible list
                    $string .= " $key {";
                    while (my ($key, $value) = each %$value) {
                        $string .= " $key $value";
                    }
                    $string .= '}';
                } else {
                    $value =~ s/"/\\"/g;                                      # embedded quotes allowed in value but must be escaped
                    $string .= " $key \"$value\"";
                }
            }
            return $string;
        }
     }

}

set rcsId {$Id: modpython.tcl,v 1.4 2001/12/29 00:32:39 jfontain Exp $}


namespace eval module::python {

variable utilityFunctions {

import string

def columnstring(dictionary, index):
    "return a Tcl array compatible initialization list for column data"
    pairs = ''
    for (key, value) in dictionary.items():
        pairs = pairs + ' ' + str(index) + ',' + str(key) + ' "' + string.replace(str(value), '"', '\\"') + '"'
    return pairs

def liststring(list):
    "return a Tcl list from a python list (values must contain alphanumeric characters only)"
    string = ''
    for index in range(len(list)):
        string = string + ' ' + str(list[index])
    return string

def viewsstring(list):
    "return a Tcl array compatible initialization list for views data"
    pairs = ''
    for index in range(len(list)):
        pairs = pairs + ' {'
        for (key, value) in list[index].items():
            pairs = pairs + ' ' + str(key)
            if key == 'swap':                                                                                       # simple boolean
                pairs = pairs + ' ' + str(value)
            elif key == 'sort':
                for (column, direction) in value.items():
                    pairs = pairs + ' {' + str(column) + ' ' + str(direction) + '}'
                    break                                                                                    # keep first entry only
            else:                                                                                                     # indices list
                pairs = pairs + ' {' + liststring(value) + '}'
        pairs = pairs + '}'
    return pairs

def dictionarystring(dictionary):
    "return a Tcl array compatible initialization list from a python dictionary"
    "(keys and values must contain alphanumeric characters only)"
    pairs = ''
    for (key, value) in dictionary.items():
        pairs = pairs + ' ' + str(key) + ' ' + str(value)
    return pairs

def formstring(dictionary):
    "return a Tcl array compatible initialization list from module form dictionary"
    pairs = ''
    for (key, value) in dictionary.items():
        if key == 'columns':
            for index in range(len(value)):
                pairs = pairs + columnstring(value[index], index)
        elif re.match('^(indexColumns|indices|pollTimes)$', key):
            pairs = pairs + ' ' + key + ' {' + liststring(value) + '}'
        elif key == 'sort':
            for (column, direction) in value.items():
                pairs = pairs + ' sort {' + str(column) + ' ' + str(direction) + '}'
                break                                                                                        # keep first entry only
        elif key == 'switches':
            pairs = pairs + ' ' + key + ' {' + dictionarystring(value) + '}'
        elif key == 'views':
            pairs = pairs + ' ' + key + ' {' + viewsstring(value) + '}'
        else:
            pairs = pairs + ' "' + str(key) + '" "' + string.replace(str(value), '"', '\\"') + '"'
    return pairs

def datastring(list):
    "return a Tcl array compatible initialization list from module data list of lists"
    pairs = ''
    for row in range(len(list)):
        for column in range(len(list[row])):
            pairs = pairs + ' ' + str(row) + ',' + str(column) + ' "' + string.replace(str(list[row][column]), '"', '\\"') + '"'
    return pairs

}

}

set rcsId {$Id: modules.tcl,v 2.43 2001/12/29 00:32:39 jfontain Exp $}


class modules {

    class instance {

        proc instance {this module index} {
            set ($this,module) $module
            set ($this,loaded) [new module $module $index]
        }

        proc ~instance {this} {
            delete $($this,loaded)
        }

        proc load {this} {
            set loaded $($this,loaded)
            module::load $loaded
            set namespace $module::($loaded,namespace)
            set ($this,namespace) $namespace
            catch {set ($this,switches) [set ::${namespace}::data(switches)]}
            set ($this,initialize) $module::($loaded,initialize)
            set ($this,version) $module::($loaded,version)
            initialize $this
        }

        proc initialize {this} {
            set namespace $($this,namespace)
            if {![catch {set ${namespace}::data(identifier)} identifier]} {
                if {![modules::validName $identifier]} {
                    foreach {name index} [modules::decoded $namespace] {}
                    puts stderr "\"$name\" module identifier: \"$identifier\" contains invalid characters"
                    exit 1
                }
                set ($this,identifier) $identifier
            }
            catch {set ($this,times) [set ${namespace}::data(pollTimes)]}
            catch {set ($this,views) [set ${namespace}::data(views)]}
        }

        proc synchronize {this} {
            module::synchronize $($this,loaded)
            initialize $this
        }

        proc empty {this} {
            module::clear $($this,loaded)
        }

    }


    set (instances) {}

    proc modules {this} error

    proc source {interpreter package file} {
        switch [file extension $file] {
            .py {
                if {[catch {package require tclpython2 2.0.1}]&&[catch {package require tclpython 2}]} return
                set python [python::interp new]
                $python eval "import sys\nsys.path.insert(0, '.')"
                $python eval "import $package"
                $interpreter eval "namespace eval $package {catch {set data(updates) [$python eval $package.form\['updates'\]]}}"
                catch {
                    set text [$python eval $package.form\['helpText'\]]
                    $interpreter eval [list namespace eval $package [list set data(helpText) $text]]
                }
                $interpreter eval "package provide $package [$python eval $package.__version__]"
                python::interp delete $python
            }
            .pm {
                if {[catch {package require tclperl 2}]} return
                set perl [perl::interp new]
                $perl eval "use $package"
                $interpreter eval "namespace eval $package {catch {set data(updates) [$perl eval \$${package}::data{updates}]}}"
                catch {
                    set text [$perl eval \$${package}::data{helpText}]
                    $interpreter eval [list namespace eval $package [list set data(helpText) $text]]
                }
                $interpreter eval "package provide $package [$perl eval \$${package}::VERSION]"
                perl::interp delete $perl
            }
            default {
                $interpreter eval _source [list $file]
            }
        }
    }

    proc available {{command {}}} {
        set directory [pwd]
        set packages {}
        foreach package [package names] {
            if {[regexp\
{^(BLT|Tk|Tkined|Tktable|Tnm|apacheutilities|http|internationalization|mime|msgcat|opt|scwoop|smtp|stooop|switched|tcllib|tclperl|tclpython|tclpython2|tcltest|tkpiechart)$}\
                $package\
            ]} continue
            if {![info exists ::packageDirectory($package)]} continue
            cd $::packageDirectory($package)
            set interpreter [interp create]
            $interpreter eval "set auto_path [list $::auto_path]"
            catch {$interpreter eval {package require {}}}
            $interpreter eval {rename source _source}; $interpreter alias source ::modules::source $interpreter $package
            if {\
                ![catch {$interpreter eval "package require $package"}]&&\
                [$interpreter eval info exists ::${package}::data(updates)]\
            } {
                lappend packages $package
                set switches {}
                catch {set switches [$interpreter eval "set ::${package}::data(switches)"]}
                set switches [list $switches]
                if {[string length $command]>0} {
                    regsub -all %M $command $package string
                    regsub -all %S $string $switches string
                    uplevel #0 $string
                }
            }
            interp delete $interpreter
        }
        cd $directory
        return [lsort $packages]
    }

    proc printAvailable {} {
        puts {searching for module packages, please wait...}
        foreach package [available] {
            puts -nonewline "$package: possibly in"
            set count 0
            foreach directory $::auto_path {
                if {[file readable [file join $directory $package pkgIndex.tcl]]} {
                    if {$count>0} {
                        puts -nonewline ,
                    }
                    puts -nonewline " [file join $directory $package]"
                    incr count
                }
            }
            puts {}
        }
    }

    proc parse {arguments} {
        if {[llength $arguments]==0} return
        set name [lindex $arguments 0]
        set arguments [lrange $arguments 1 end]
        foreach {name index} [decoded $name] {}
        if {![info exists ::packageDirectory($name)]} {
            error "error: \"$name\" is not a valid moodss module name"
        }
        if {![validName $name]} {
            error "\"$name\" module name contains invalid characters"
        }
        if {$global::withGUI} {
            lifoLabel::push $global::messenger "loading $name..."
            update idletasks
        } elseif {$global::debug} {
            writeLog "loading $name..."
        }
        set instance [new instance $name $index]
        if {[catch {instance::load $instance} message]} {
            if {$global::debug} {
                set information $::errorInfo
            }
            if {$global::withGUI} {
                lifoLabel::pop $global::messenger
            }
            delete $instance
            if {$global::debug} {
                error $information
            } else {
                error "module \"$name\" load error:\n$message"
            }
        }
        if {$global::withGUI} {
            lifoLabel::pop $global::messenger
        }
        set help [expr {[lsearch -exact $arguments --help]>=0}]
        if {[info exists instance::($instance,switches)]} {
            if {[llength $instance::($instance,switches)]==0} {
                error "module \"$name\" switches are empty"
            }
            if {$help} {
                displayHelpMessage $name $instance::($instance,switches)
                exit
            }
            if {[catch {set next [parseCommandLineArguments $instance::($instance,switches) $arguments options]} message]} {
                delete $instance
                error "module \"$name\" options error: $message"
            }
            if {!$instance::($instance,initialize)} {
                error "module \"$name\" has no initialize procedure"
            }
            set instance::($instance,options) [array get options]
            set instance::($instance,arguments) [lrange $arguments 0 [expr {[llength $arguments]-[llength $next]-1}]]
            set arguments $next
        } else {
            if {$help} {
                displayHelpMessage $name
                exit
            }
            set instance::($instance,arguments) {}
        }
        lappend (instances) $instance
        parse $arguments
        update idletasks
    }

    proc helpHTMLData {name} {
        set noHelpText {no help available}
        foreach instance $(instances) {
            set namespace $instance::($instance,namespace)
            foreach {module index} [decoded $namespace] {}
            if {[string compare $module $name]} continue
            if {![info exists text]} {
                set text $noHelpText
                catch {set text [set ${namespace}::data(helpText)]}
                set version $instance::($instance,version)
            }
            lappend arguments $instance::($instance,arguments)
        }
        set header "<b>$name </b>"
        append header {module version}
        if {[info exists text]} {
            append header " <i>$version</i>, "
            append header instances:
            append header <ol>
            foreach argument $arguments {
                append header <li>
                if {[llength $argument]==0} {
                    append header {<i>with no options</i>}
                } else {
                    append header <b>$argument</b>
                }
                append header </li>
            }
            append header </ol>
        } else {
            foreach {version text} [versionAndHelpText $name] {}
            if {[string length $text]==0} {
                set text $noHelpText
            }
            append header " <i>$version</i>"
        }
        append header <br><br>
        if {[regsub -nocase <body> $text <body>$header text]>0} {
            regsub -nocase {<title>.*</title>} $text {} text
            return $text
        } else {
            regsub -all \n $text <br> text
            return ${header}$text
        }
    }

    proc versionAndHelpText {name} {
        set directory [pwd]
        cd $::packageDirectory($name)
        set interpreter [interp create]
        $interpreter eval "set auto_path [list $::auto_path]"
        catch {$interpreter eval {package require {}}}
        $interpreter eval {rename source _source}; $interpreter alias source ::modules::source $interpreter $name
        $interpreter eval "package require $name"
        set version [$interpreter eval "package provide $name"]
        set text {}
        catch {set text [$interpreter eval "namespace eval $name {set data(helpText)}"]}
        interp delete $interpreter
        cd $directory
        return [list $version $text]
    }

    proc initialize {} {
        foreach instance $(instances) {
            if {!$instance::($instance,initialize)} continue
            set namespace $instance::($instance,namespace)
            if {$global::withGUI} {
                lifoLabel::push $global::messenger "initializing $namespace..."
                update idletasks
            } elseif {$global::debug} {
                writeLog "initializing $namespace module..."
            }
            set error 0
            if {[info exists instance::($instance,options)]} {
                if {[catch {::${namespace}::initialize $instance::($instance,options)} message]} {
                    if {$global::debug} {
                        set information $::errorInfo
                    }
                    set error 1
                }
            } else {
                if {[catch ::${namespace}::initialize message]} {
                    if {$global::debug} {
                        set information $::errorInfo
                    }
                    set error 1
                }
            }
            if {$global::withGUI} {
                lifoLabel::pop $global::messenger
            }
            if {$error} {
                unload $instance
                if {$global::debug} {
                    error $information
                } else {
                    error "module \"$namespace\" initialize error:\n$message"
                }
            } else {
                instance::synchronize $instance
            }
            set instance::($instance,initialize) 0
        }
        update idletasks
    }

    proc setPollTimes {{override {}}} {
        if {[llength $(instances)]==0} {
            set global::pollTimes {}
            set global::pollTime 0
            return
        }
        set default 0
        set minimum 0
        foreach instance $(instances) {
            set times $instance::($instance,times)
            if {[llength $times]==0} {
                error "module $instance::($instance,namespace) 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 $instance::($instance,namespace)
            }
            foreach time $times {
                set data($time) {}
            }
        }
        set global::pollTimes [lsort -integer [array names data]]
        set global::pollTimes [lrange $global::pollTimes [lsearch -exact $global::pollTimes $minimum] end]
        set global::pollTime $default
        if {[string length $override]>0} {
            if {$override<$minimum} {
                puts stderr "$::argv0: minimum poll time is $minimum seconds for module $minimumModule"
                exit 1
            }
            set global::pollTime $override
        }
        if {$global::pollTime==0} { 
            set sum 0
            set number 0
            foreach interval [array names intervals] {
                incr sum $interval
                incr number
            }
            set global::pollTime [expr {round(double($sum)/-$number)}]
        }
    }

    proc identifier {array} {
        variable nextIndex

        set namespace [namespaceFromArray $array]
        foreach instance $(instances) {
            if {[string equal $namespace $instance::($instance,namespace)]} {
                if {[info exists instance::($instance,identifier)]} {
                    return $instance::($instance,identifier)
                }
                foreach {module index} [decoded $namespace] {}
                if {[string length $index]>0} {
                    return $namespace
                }
                break
            }
        }
        return {}
    }

    proc decoded {name} {
        set index {}
        scan $name {%[^<]<%u>} name index
        return [list $name $index]
    }

    proc validName {string} {
        return [regexp {^[\w @%&*()=+:.-]+$} $string]
    }

    proc displayHelpMessage {name {switches {}}} {
        puts -nonewline "$name module usage:"
        if {[llength $switches]==0} {
            puts -nonewline { <no arguments allowed>}
        } else {
            foreach {switch argument} $switches {
                puts -nonewline " \[$switch"
                if {$argument} {
                    puts -nonewline { argument}
                }
                puts -nonewline \]
            }
        }
        puts {}
    }

    proc loaded {} {
        if {[llength $(instances)]==0} {
            return {}
        }
        foreach instance $(instances) {
            lappend list [list $instance $instance::($instance,namespace)]
        }
        set return {}
        foreach list [lsort -dictionary -index 1 $list] {
            foreach {instance namespace} $list {}
            lappend return $namespace
            set switches {}
            catch {set switches $instance::($instance,switches)}
            if {[llength $switches]==0} {
                lappend return {}
            } else {
                catch {unset argument}
                foreach {switch required} $switches {
                    set argument($switch) $required
                }
                set arguments $instance::($instance,arguments)
                set length [llength $arguments]
                set list {}
                for {set index 0} {$index<$length} {incr index} {
                    set item [lindex $arguments $index]
                    lappend list $item
                    if {$argument($item)} {
                        lappend list 1 [lindex $arguments [incr index]]
                    } else {
                        lappend list 0 1
                    }
                }
                lappend return $list
            }
        }
        return $return
    }

    proc names {} {
        set list {}
        foreach instance $(instances) {
            set module $instance::($instance,module)
            if {[lsearch -exact $list $module]<0} {
                lappend list $module
            }
        }
        return $list
    }

    proc unload {instance} {
        ldelete (instances) $instance
        delete $instance
    }

    proc namespaceFromArray {name} {
        return [string trimleft [namespace qualifiers [namespace which -variable $name]] :]
    }

    proc trace {module namespace message} {
        foreach instance $(instances) {
            if {[string equal $instance::($instance,module) trace]} {
                set traceNamespace $instance::($instance,namespace)
                ::${traceNamespace}::update $module $namespace $message
            }
        }
    }

    proc flashMessage {module namespace message {seconds 1}} {
        if {$global::withGUI} {
            ::lifoLabel::flash $::global::messenger $message $seconds
        } else {
            writeLog "$namespace: $message"
        }
        trace $module $namespace $message
    }

    proc pushMessage {module namespace message} {
        if {$global::withGUI} {
            ::lifoLabel::push $::global::messenger $message
        } else {
            writeLog "$namespace: $message"
        }
        trace $module $namespace $message
    }

    proc popMessage {} {
        if {$global::withGUI} {
            ::lifoLabel::pop $::global::messenger
        }
    }

}

if {[info exists arguments(--show-modules)]} {
    modules::printAvailable
    exit
}

if 1 {
set rcsId {$Id: scwoutil.tcl,v 1.2 1999/12/27 16:29:56 jfontain Exp $}

proc showTopLevel {path geometry} {
    wm geometry $path $geometry
    wm deiconify $path
}
set rcsId {$Id: scwoop.tcl,v 3.8 2001/06/04 15:17:29 jfontain Exp $}


package provide scwoop 4.0

class widget {

    proc widget {this path} {
        set ($this,path) $path
    }

    proc ~widget {this} {}

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

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

    set option() {}
    trace variable option r ::widget::checkOption

    proc checkOption {array index operations} {
        variable option

        if {![info exists option($index)]} {
            scan $index {%[^,],%s} type name
            $type .temporary
            set option($index) [.temporary cget -$name]
            destroy .temporary
        }
    }

}


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)}
    }
}
if {$::tcl_version>=8.4} {
    class spinbox {
        proc spinbox {this parentPath args} widget {[eval ::spinbox $parentPath.$this $args]} {}
        proc ~spinbox {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 ($this,base) $base
    set ($this,base,path) $widget::($base,path)
    set ($this,_children) {}
    set ($this,complete) 0
    set ($this,initialArguments) $args
}

proc composite::~composite {this} {
    eval delete [lsort -integer -decreasing $($this,_children)] $($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 $($this,[lindex $args 0]) [lrange $args 1 end]]
    }
    foreach {option value} $args {
        if {![info exists ($this,$option)]} {
            error "$($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 equal $($this,$option) $value]} {
            $($this,_derived)::set$option $this [set ($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 ($this,$name)]} {
            error "\"$name\" member name already exists in composite layer"
        }
        set ($this,$name) $child
        set ($this,$name,path) $widget::($child,path)
        lappend ($this,_children) $child
    }
}

proc composite::complete {this} {
    foreach description [options $this] {
        set option [lindex $description 0]
        set ($this,$option) [set default [lindex $description 1]]
        if {[llength $description]<3} {
            set initialize($option) {}
        } elseif {![string equal $default [lindex $description 2]]} {
            set ($this,$option) [lindex $description 2]
            set initialize($option) {}
        }
    }
    foreach {option value} $($this,initialArguments) {
        if {[catch {string compare $($this,$option) $value} different]} {
            error "$($this,_derived): unknown option \"$option\""
        }
        if {$different} {
            set ($this,$option) $value
            set initialize($option) {}
        }
    }
    unset ($this,initialArguments)
    foreach option [array names initialize] {
        $($this,_derived)::set$option $this $($this,$option)
    }
    set ($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 ($this,$args)]} {
                error "$($this,_derived): unknown option \"$args\""
            }
            return $($this,$args)
        }
        default {
            return [eval widget::cget $($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 $($this,base) $option $value}
        foreach child $($this,_children) {
            catch {widget::configure $child $option $value}
        }
    }
}

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

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

proc composite::managingOrder {this name1 name2} {
    return [expr {$($this,$name1)-$($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 2.1 1999/08/15 19:56:22 jfontain Exp $}


class bindings {
    proc bindings {this widget index} {
        ::set ($this,widget) $widget
        bindtags $widget [linsert [bindtags $widget] $index bindings($this)]
    }
    proc ~bindings {this} {
        if {![winfo exists ($this,widget)]} return
        ::set tags [bindtags $($this,widget)]
        ::set index [lsearch -exact $tags bindings($this)]
        bindtags $($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 2.7 2002/01/05 16:46:05 jfontain Exp $}


class widgetTip {

    variable screenWidth [winfo screenwidth .]
    variable screenHeight [winfo screenheight .]
    variable xOffset 7
    variable yOffset 10

    class topLabel {

        proc topLabel {this parentPath args} composite {
            [new toplevel $parentPath -highlightbackground black -highlightthickness 1] $args
        } {
            composite::manage $this [new label $widget::($this,path) -justify left] 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 Black Black]\
                [list -borderwidth 1 1]\
                [list -background $widget::option(button,background) $widget::option(button,background)]\
                [list -font $widget::option(button,font) $widget::option(button,font)]\
                [list -foreground $widget::option(button,foreground) $widget::option(button,foreground)]\
                [list -text {} {}]\
                [list -wraplength 300]\
            ]
        }

        foreach option {-background -font -foreground -text -wraplength} {
            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 (label)]} {
        set (label) [new topLabel . -font $widget::option(entry,font) -background #FFFFBF]
        set (path) $widget::($(label),path)
        wm withdraw $(path)
        bind all <ButtonPress> {widgetTip::globalEvent %W}
        bind all <KeyPress> {widgetTip::globalEvent %W}
        set (xLast) -1
        set (yLast) -1
    }

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

    proc ~widgetTip {this} {
        disable $this
        if {[info exists ($this,bindings)]} {
            delete $($this,bindings)
        }
    }

    proc options {this} {
        return [list\
            [list -font $widget::option(entry,font) $widget::option(entry,font)]\
            [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"
        set ($this,bindings) $bindings
    }

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

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

    proc show {this x y} {
        variable screenWidth
        variable screenHeight
        variable xOffset
        variable yOffset

        set path $(path)
        widget::configure $(label) -font $switched::($this,-font) -text $switched::($this,-text)
        update idletasks
        set size [winfo reqwidth $path]
        set delta [expr {$screenWidth-$x-$xOffset-$size}]
        if {$delta<0} {
            incr x -$xOffset
            incr x -$size
        } else {
            incr x $xOffset
        }
        set size [winfo reqheight $path]
        set delta [expr {$screenHeight-$y-$yOffset-$size}]
        if {$delta<0} {
            incr y -$yOffset
            incr y -$size
        } else {
            incr y $yOffset
        }
        showTopLevel $path +$x+$y
        update idletasks
        raise $path
    }

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

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

}
set rcsId {$Id: arrowbut.tcl,v 2.5 2000/11/01 11:56:00 jfontain Exp $}


class arrowButton {}

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

proc arrowButton::~arrowButton {this} {}

proc arrowButton::options {this} {
    return [list\
        [list -activebackground $widget::option(button,activebackground) $widget::option(button,activebackground)]\
        [list -background $widget::option(button,background) $widget::option(button,background)]\
        [list -borderwidth $widget::option(button,borderwidth) $widget::option(button,borderwidth)]\
        [list -command {} {}]\
        [list -direction down]\
        [list -disabledforeground $widget::option(button,disabledforeground) $widget::option(button,disabledforeground)]\
        [list -foreground $widget::option(button,foreground) $widget::option(button,foreground)]\
        [list -height $widget::option(scrollbar,width) $widget::option(scrollbar,width)]\
        [list -highlightbackground $widget::option(button,highlightbackground) $widget::option(button,highlightbackground)]\
        [list -highlightcolor $widget::option(button,highlightcolor) $widget::option(button,highlightcolor)]\
        [list -highlightthickness $widget::option(button,highlightthickness) $widget::option(button,highlightthickness)]\
        [list -repeatdelay 0 0]\
        [list -state normal]\
        [list -takefocus 1]\
        [list -width $widget::option(scrollbar,width) $widget::option(scrollbar,width)]\
    ]
}

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

proc arrowButton::set-state {this value} {
    set path $widget::($this,path)
    switch $value {
        normal {
            $path itemconfigure $($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 {
            $path itemconfigure $($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 $($this,triangle) 0 0 [expr {2*$insideWidth}] 0 $insideWidth $insideWidth
        }
        u* {
            set insideWidth [maximum [expr {$insideWidth/4}] 1]
            $widget::($this,path) coords $($this,triangle) 0 0 [expr {2*$insideWidth}] 0 $insideWidth -$insideWidth
        }
        l* {
            set insideHeight [maximum [expr {$insideHeight/4}] 1]
            $widget::($this,path) coords $($this,triangle) 0 0 0 [expr {2*$insideHeight}] -$insideHeight $insideHeight
        }
        r* {
            set insideHeight [maximum [expr {$insideHeight/4}] 1]
            $widget::($this,path) coords $($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 $($this,triangle)]
    $widget::($this,path) move $($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 ($this,active) 1
}

proc arrowButton::deactivate {this} {
    $widget::($this,path) configure -background $composite::($this,-background)
    set ($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 $($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 ($this,event)]} {
        after cancel $($this,event)
        unset ($this,event)
    }
}

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

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

proc arrowButton::processTimer {this} {
    if {$($this,buttonPressed)} {
        startTimer $this
        invoke $this 0
    } else {
        unset ($this,event)
    }
}

proc arrowButton::maximum {a b} {return [expr {$a>$b?$a:$b}]}
    if {$tcl_version<8.4} {
set rcsId {$Id: spinent.tcl,v 2.3 2000/11/01 12:01:25 jfontain Exp $}


class spinEntry {}

proc spinEntry::spinEntry {this parentPath args} composite {
    [new frame $parentPath -highlightthickness $widget::option(button,highlightthickness)] $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::option(scrollbar,repeatdelay)\
        ] decrease\
        [new arrowButton $path\
            -direction up -takefocus 0 -command "spinEntry::increase $this" -height 4 -highlightthickness 0\
            -repeatdelay $widget::option(scrollbar,repeatdelay)\
        ] 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 {} {}]\
        [list -editable 1 1]\
        [list -font $widget::option(button,font)]\
        [list -justify $widget::option(entry,justify) $widget::option(entry,justify)]\
        [list -list {} {}]\
        [list -range {} {}]\
        [list -repeatdelay $widget::option(scrollbar,repeatdelay) $widget::option(scrollbar,repeatdelay)]\
        [list -side left]\
        [list -state normal]\
        [list -width $widget::option(entry,width) $widget::option(entry,width)]\
    ]
}

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 ($this,minimum) [lindex $composite::($this,-range) 0]
    ::set ($this,maximum) [lindex $composite::($this,-range) 1]
    ::set ($this,increment) [lindex $composite::($this,-range) 2]
    if {[catch {expr {$($this,maximum)-$($this,minimum)+$($this,increment)}}]} {
        error {option -range arguments must be numeric values}
    }
    if {[string length [$composite::($this,entry,path) get]]==0} {
        set $this $($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 ($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 $($this,minimum)
        ::set maximum $($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 equal $composite::($this,-state) normal]} {
        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 2.6 2001/01/25 20:58:27 jfontain Exp $}


class panner {
    set (default,HandleSize) 8
}

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

proc panner::~panner {this} {}

proc panner::options {this} {
    return [list\
        [list -handlesize $(default,HandleSize)]\
        [list -handleplacement 0.9 0.9]\
        [list -orient vertical]\
        [list -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 ($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 ($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 (line) [frame $path.line -background black -height 1 -width [winfo width $path]]
        set (minimum) [winfo rooty $path]
        set (maximum) [expr {$(minimum)+[winfo height $path]-1}]
    } else {
        bind $handle <Motion> "panner::horizontalMotion $this %X"
        set (line) [frame $path.line -background black -width 1 -height [winfo height $path]]
        set (minimum) [winfo rootx $path]
        set (maximum) [expr {$(minimum)+[winfo width $path]-1}]
    }
}

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

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

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

proc panner::horizontalMotion {this xRoot} {
    place $(line) -x [expr {[clip $xRoot]-$(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 {$($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 $($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 {$($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 $($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 $($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==$($this,lastManagerSize)} {
        return
    }
    set ($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 -$($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: scroll.tcl,v 2.7 2000/11/01 12:00:50 jfontain Exp $}



class scroll {

    proc scroll {this scrollableClass parentPath args} composite {[new frame $parentPath] $args} {
        variable ${this}first
        variable ${this}last

        set path $widget::($this,path)
        composite::manage $this [new $scrollableClass $path] scrolled\
            [new scrollbar $path -orient horizontal -highlightthickness 0] horizontal\
            [new scrollbar $path -highlightthickness 0] 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 -ipadx 0
        grid rowconfigure $path 0 -weight 1
        grid columnconfigure $path 0 -weight 1

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

        for {set index -1} {$index>=-3} {incr index -1} {
            set ${this}first(0,1,$index) -2147483648
            set ${this}last(0,1,$index) -2147483648
            set ${this}first(1,0,$index) -2147483648
            set ${this}last(1,0,$index) -2147483648
        }

        composite::complete $this
    }

    proc ~scroll {this} {}

    proc options {this} {
        return [list\
            [list -automatic 1 1]\
            [list -scrollbarborderwidth $widget::option(scrollbar,borderwidth) $widget::option(scrollbar,borderwidth)]\
            [list\
                -scrollbarelementborderwidth\
                $widget::option(scrollbar,elementborderwidth) $widget::option(scrollbar,elementborderwidth)\
            ]\
            [list -scrollbarwidth $widget::option(scrollbar,width) $widget::option(scrollbar,width)]\
            [list -height $widget::option(canvas,height)]\
            [list -horizontal $($this,1,0,map) $($this,1,0,map)]\
            [list -vertical $($this,0,1,map) $($this,0,1,map)]\
            [list -width $widget::option(canvas,width)]\
        ]
    }

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

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

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

    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 $($this,$row,$column,path)
        foreach {previousFirst previousLast} [$path get] {}
        if {($first==$previousFirst)&&($last==$previousLast)} return
        $path set $first $last
        set visible [llength [grid info $path]]
        if {[repetition $this $row $column $first $last]||!$composite::($this,-automatic)||(($last-$first)<1)} {
            if {!$visible&&$($this,$row,$column,map)} {
                grid $path -row $row -column $column -sticky nsew
                grid $composite::($this,filler,path) -sticky nsew -column 1 -row 1
            }
        } else {
            grid remove $path
            set visible [llength [grid info $($this,$column,$row,path)]]
            if {!$visible} {
                grid remove $composite::($this,filler,path)
            }
        }
    }

    proc repetition {this row column first last} {
        variable ${this}first
        variable ${this}last

        set return [expr {\
            ($first==[set ${this}first($row,$column,-2)])&&\
            ($last==[set ${this}last($row,$column,-2)])&&\
            ([set ${this}first($row,$column,-1)]==[set ${this}first($row,$column,-3)])&&\
            ([set ${this}last($row,$column,-1)]==[set ${this}last($row,$column,-3)])\
        }]
        set ${this}first($row,$column,-3) [set ${this}first($row,$column,-2)]
        set ${this}last($row,$column,-3) [set ${this}last($row,$column,-2)]
        set ${this}first($row,$column,-2) [set ${this}first($row,$column,-1)]
        set ${this}last($row,$column,-2) [set ${this}last($row,$column,-1)]
        set ${this}first($row,$column,-1) $first
        set ${this}last($row,$column,-1) $last

        return $return
    }

}
set rcsId {$Id: combobut.tcl,v 2.4 2000/11/01 11:58:14 jfontain Exp $}


class comboButton {}

proc comboButton::comboButton {this parentPath args} composite {
    [new arrowButton $parentPath -command "comboButton::popupListBox $this"] $args
} {
    composite::manage $this [new toplevel [winfo toplevel $parentPath] -cursor right_ptr] shell
    set shellPath $composite::($this,shell,path)
    if {$widget::option(menu,borderwidth)==0} {
        $shellPath configure -highlightbackground black -highlightthickness 1
    } else {
        $shellPath configure -relief $widget::option(menu,relief) -borderwidth $widget::option(menu,borderwidth)
    }
    bind $shellPath <Escape> "comboButton::unpopListBox $this"
    bind $shellPath <Any-ButtonRelease> "comboButton::unpopListBox $this"
    wm overrideredirect $shellPath 1
    wm withdraw $shellPath

    composite::manage $this [new scrollList $shellPath] scroll
    widget::configure $composite::($this,scroll) base -highlightthickness 0
    widget::configure $composite::($this,scroll) listbox -borderwidth 0
    pack $composite::($this,scroll,path) -fill both -expand 1

    set listboxPath $composite::($composite::($this,scroll),listbox,path)
    set sequence "comboButton::invokeCommand $this; comboButton::unpopListBox $this"
    bind $listboxPath <ButtonRelease-1> $sequence
    bind $listboxPath <KeyRelease-space> $sequence
    bind $listboxPath <Return> $sequence
    bind $listboxPath <KP_Enter> $sequence

    bindtags $composite::($composite::($this,scroll),scrollbar,path) Scrollbar

    composite::complete $this
}

proc comboButton::~comboButton {this} {}

proc comboButton::options {this} {
    return [list\
        [list -command {} {}]\
        [list -font $widget::option(button,font) $widget::option(button,font)]\
        [list -list {}]\
        [list -listheight 3]\
        [list -reference {} {}]\
        [list -state normal]\
        [list -takefocus {} {}]\
    ]
}

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

proc comboButton::set-font {this value} {
    widget::configure $composite::($this,scroll) -font $value
}

proc comboButton::set-list {this value} {
    if {[llength $value]==0} {
        widget::configure $composite::($this,base) -state disabled
    } else {
        widget::configure $composite::($this,base) -state normal
    }
    widget::configure $composite::($this,scroll) -list $value
}

foreach option {-state -takefocus} {
    proc comboButton::set$option {this value} "widget::configure \$composite::(\$this,base) $option \$value"
}

proc comboButton::set-listheight {this value} {
    widget::configure $composite::($this,scroll) -height $value
}

proc comboButton::set-reference {this value} {}

proc comboButton::set-borderwidth {this value} {
    widget::configure $composite::($this,base) -borderwidth $value
}

proc comboButton::popupListBox {this} {
    set shellPath $composite::($this,shell,path)
    if {[winfo exists $composite::($this,-reference)]} {
        set path $composite::($this,-reference)
        set border 0
        catch {set border [$path cget -highlightthickness]}
        set x [expr {[winfo rootx $path]+$border}]
        wm geometry $shellPath [expr {[winfo width $path]-(2*$border)}]x[winfo reqheight $shellPath]
    } else {
        set path $widget::($this,path)
        set x [expr {[winfo rootx $path]+[winfo width $path]-[winfo reqwidth $shellPath]}]
    }
    if {$x<0} {
        set x 0
    }
    showTopLevel $shellPath +$x+[expr {[winfo rooty $path]+[winfo height $path]}]
    update idletasks
    raise $shellPath
    set (previousGrab) [grab current $shellPath]
    grab -global $shellPath
    set ($this,focus) [focus]
    focus $composite::($this,scroll,path)
}

proc comboButton::unpopListBox {this} {
    set path $composite::($this,shell,path)
    if {![winfo ismapped $path]} {
        return
    }
    wm withdraw $path
    if {[string length $(previousGrab)]>0} {
        grab $(previousGrab)
        unset (previousGrab)
    } else {
        grab release $path
    }
    catch {focus $($this,focus)}
    unset ($this,focus)
}

proc comboButton::invokeCommand {this} {
    if {[string length $composite::($this,-command)]==0} {
        return
    }
    set selection [scrollList::curselection $composite::($this,scroll)]
    if {[string length $selection]==0} {
        uplevel #0 $composite::($this,-command) [list {}]
    } else {
        uplevel #0 $composite::($this,-command) [list [scrollList::get $composite::($this,scroll) $selection]]
    }
}
set rcsId {$Id: scrolist.tcl,v 1.24 2000/11/01 12:00:32 jfontain Exp $}


class scrollList {}

proc scrollList::scrollList {this parentPath args} composite {
    [new frame $parentPath -highlightthickness $widget::option(button,highlightthickness)] $args
} {
    composite::manage $this [new listbox $widget::($this,path) -highlightthickness 0] listbox
    set listboxPath $composite::($this,listbox,path)

    bind $widget::($this,path) <FocusIn> "focus $listboxPath"
    bind $listboxPath <Button2-Motion> break
    pack $listboxPath -fill both -expand 1

    composite::manage $this\
        [new scrollbar $widget::($this,path) -command "$listboxPath yview" -highlightthickness 0 -takefocus 0] scrollbar
    widget::configure $composite::($this,listbox) -yscrollcommand "scrollList::updateScrollbar $this"

    composite::complete $this
}

proc scrollList::~scrollList {this} {}

proc scrollList::options {this} {
    return [list\
        [list -font $widget::option(listbox,font) $widget::option(listbox,font)]\
        [list -height $widget::option(listbox,height) $widget::option(listbox,height)]\
        [list -list {} {}]\
        [list -selectmode $widget::option(listbox,selectmode) $widget::option(listbox,selectmode)]\
        [list -width $widget::option(listbox,width) $widget::option(listbox,width)]\
    ]
}

proc scrollList::set-list {this value} {
    set listboxPath $composite::($this,listbox,path)
    $listboxPath delete 0 end
    eval $listboxPath insert 0 $value
    $listboxPath activate 0
}

foreach option {-font -height -selectmode -width} {
    proc scrollList::set$option {this value} "\$composite::(\$this,listbox,path) configure $option \$value"
}

foreach command {activate bbox curselection delete get index insert nearest scan see selection size} {
    proc scrollList::$command {this args} "eval \$composite::(\$this,listbox,path) $command \$args"
}

proc scrollList::updateScrollbar {this first last} {
    if {($last-$first)<1} {
        $composite::($this,scrollbar,path) set $first $last
        pack $composite::($this,scrollbar,path) -fill y -before $composite::($this,listbox,path) -side right
    } else {
        pack forget $composite::($this,scrollbar,path)
    }
}
set rcsId {$Id: comboent.tcl,v 2.4 2000/11/01 11:58:32 jfontain Exp $}


class comboEntry {}

proc comboEntry::comboEntry {this parentPath args} composite {
    [new frame $parentPath -highlightthickness $widget::option(button,highlightthickness)] $args
} {
    composite::manage $this\
        [new entry $widget::($this,path) -highlightthickness 0] entry\
        [new comboButton $widget::($this,path) -command "comboEntry::selected $this" -reference $widget::($this,path)] button
    widget::configure $composite::($this,button) base -highlightthickness 0
    grid $composite::($this,entry,path) -column 0 -row 0 -sticky nsew
    grid $composite::($this,button,path) -column 1 -row 0 -sticky nsew
    grid columnconfigure $widget::($this,path) 0 -weight 1
    grid rowconfigure $widget::($this,path) 0 -weight 1
    composite::complete $this
}

proc comboEntry::~comboEntry {this} {}

proc comboEntry::options {this} {
    return [list\
        [list -command {} {}]\
        [list -editable 1 1]\
        [list -font $widget::option(button,font)]\
        [list -justify $widget::option(entry,justify) $widget::option(entry,justify)]\
        [list -list {} {}]\
        [list -state normal]\
        [list -width $widget::option(entry,width) $widget::option(entry,width)]\
    ]
}

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

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

proc comboEntry::set-editable {this value} {
    comboEntry::setStates $this
    comboEntry::setBindings $this
}

proc comboEntry::set-font {this value} {
    $composite::($this,entry,path) configure -font $value
    widget::configure $composite::($this,button) -font $value
}

proc comboEntry::set-list {this value} {
    widget::configure $composite::($this,button) -list $value
}

proc comboEntry::set-state {this value} {
    if {![regexp {^(disabled|normal)$} $value]} {
        error "bad state value \"$value\": must be normal or disabled"
    }
    setStates $this
    setBindings $this
}

proc comboEntry::set-troughcolor {this value} {
    widget::configure $composite::($this,button) -troughcolor $value
}

proc comboEntry::setStates {this} {
    if {[string equal $composite::($this,-state) disabled]} {
        widget::configure $composite::($this,button) -state disabled -takefocus 0
        if {$::tcl_version<8.4} {
            widget::configure $composite::($this,entry) -state disabled
        } else {
            widget::configure $composite::($this,entry) -state readonly
        }
    } else {
        if {$composite::($this,-editable)} {
            widget::configure $composite::($this,button) -takefocus 0
            widget::configure $composite::($this,entry) -state normal
        } else {
            widget::configure $composite::($this,button) -takefocus 1
            if {$::tcl_version<8.4} {
                widget::configure $composite::($this,entry) -state disabled
            } else {
                widget::configure $composite::($this,entry) -state readonly
            }
        }
    }
}

proc comboEntry::setBindings {this} {
    if {[string equal $composite::($this,-state) normal]&&$composite::($this,-editable)} {
        bind $composite::($this,entry,path) <Down> "comboButton::popupListBox $composite::($this,button)"
        bind $composite::($this,entry,path) <Return> "comboEntry::invoke $this"
        bind $composite::($this,entry,path) <KP_Enter> "comboEntry::invoke $this"
    } else {
        bind $composite::($this,entry,path) <Down> {}
        bind $composite::($this,entry,path) <Return> {}
        bind $composite::($this,entry,path) <KP_Enter> {}
    }
}

proc comboEntry::selected {this choice} {
    widget::configure $composite::($this,entry) -state normal
    set $this $choice
    setStates $this
    if {[string length $composite::($this,-command)]>0} {
        uplevel #0 $composite::($this,-command) [list $choice]
    }
}

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

proc comboEntry::set {this text} {
    $composite::($this,entry,path) delete 0 end
    $composite::($this,entry,path) insert 0 $text
}

proc comboEntry::get {this text} {
    return [$composite::($this,entry,path) get]
}
set rcsId {$Id: optimenu.tcl,v 2.3 2000/11/01 11:59:27 jfontain Exp $}


class optionMenu {}

proc optionMenu::optionMenu {this parentPath args} composite {[new button $parentPath -state disabled] $args} {
    set path $widget::($this,path)
    grid rowconfigure $path 0 -weight 1
    grid columnconfigure $path 0 -weight 1
    composite::manage $this [new label $path] label
    grid $composite::($this,label,path) -column 0 -row 0 -sticky nsew
    grid columnconfigure $path 1 -minsize $widget::option(button,borderwidth)
    composite::manage $this [new frame $path\
        -background $widget::option(button,background) -relief $widget::option(button,relief)\
        -borderwidth $widget::option(button,borderwidth) -width 12 -height 8\
    ] stub
    set stubPath $composite::($this,stub,path)
    grid $stubPath -column 2 -row 0
    grid columnconfigure $path 3 -minsize 8

    bind $path <Enter> "if {!\$tk_strictMotif} {$stubPath configure -background $widget::option(button,activebackground)}"
    bind $path <Leave> "if {!\$tk_strictMotif} {$stubPath configure -background $widget::option(button,background)}"

    composite::manage $this [new toplevel [winfo toplevel $parentPath] -cursor right_ptr] shell
    set shellPath $composite::($this,shell,path)
    if {$widget::option(menu,borderwidth)==0} {
        $shellPath configure -highlightbackground black -highlightthickness 1
    } else {
        $shellPath configure -relief $widget::option(menu,relief) -borderwidth $widget::option(menu,borderwidth)
    }
    wm overrideredirect $shellPath 1
    wm withdraw $shellPath

    global embed_args
    if {[info exists embed_args]} {
        set sequence <ButtonRelease-1>
    } else {
        set sequence <ButtonPress-1>
        bind $composite::($this,label,path) $sequence "optionMenu::popChoices $this"
    }
    bind $path $sequence "optionMenu::popChoices $this"
    bind $composite::($this,stub,path) $sequence "optionMenu::popChoices $this"
    set ($this,selectedLabelIndex) 0
    composite::complete $this
}

proc optionMenu::~optionMenu {this} {}

proc optionMenu::options {this} {
    return [list\
        [list -choices {} {}]\
        [list -command {} {}]\
        [list -font $widget::option(menu,font) $widget::option(menu,font)]\
        [list -takefocus 1]\
        [list -text {} {}]\
    ]
}

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

proc optionMenu::set-font {this value} {
    $composite::($this,label,path) configure -font $value
    set-choices $this $composite::($this,-choices)
}

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

proc optionMenu::set-choices {this value} {
    set path $composite::($this,shell,path)
    foreach label [winfo children $path] {
        destroy $label
    }
    set index 0
    set width 0
    foreach choice $composite::($this,-choices) {
        set label [label $path.$index -text $choice -relief flat -font $composite::($this,-font)]
        if {[winfo reqwidth $label]>$width} {
            set width [winfo reqwidth $label]
        }
        bind $label <Enter> "optionMenu::select $this $index"
        pack $label -fill x
        incr index
    }
    grid columnconfigure $widget::($this,path) 0 -minsize $width
    showTopLevel $path 0x0
    update idletasks
    wm withdraw $path
    wm geometry $path {}
}

proc optionMenu::set-takefocus {this value} {
    set path $widget::($this,path)
    switch $value {
        0 {
            bind $path <space> {}
            bind $path <Return> {}
            bind $path <KP_Enter> {}
            bind $path <Up> {}
            bind $path <Down> {}
            bind $path <Escape> {}
        }
        1 {
            bind $path <space> "optionMenu::processSpaceKey $this"
            bind $path <Return> "optionMenu::unpopChoices $this; optionMenu::checkSelection $this"
            bind $path <KP_Enter> [bind $path <Return>]
            bind $path <Up> "optionMenu::selectPrevious $this"
            bind $path <Down> "optionMenu::selectNext $this"
            bind $path <Escape> "optionMenu::unpopChoices $this"
        }
        default {
            error "bad takefocus value \"$value\": must be 0 or 1"
        }
    }
    $path configure -takefocus $value
}

proc optionMenu::popChoices {this} {
    if {[llength $composite::($this,-choices)]==0} {
        return
    }
    update idletasks
    set shellPath $composite::($this,shell,path)

    set choicesLabel [lindex [winfo children $composite::($this,shell,path)] $($this,selectedLabelIndex)]
    $choicesLabel configure -relief $widget::option(menu,relief)

    set labelPath $composite::($this,label,path)
    set x [expr {[winfo rootx $labelPath]-$widget::option(menu,borderwidth)}]
    if {$x<0} {
        set x 0
    }
    set y [expr {[winfo rooty $labelPath]+(([winfo height $labelPath]-[winfo height $choicesLabel])/2)-[winfo y $choicesLabel]}]
    if {$y<0} {
        set y 0
    }
    showTopLevel $shellPath\
        [expr {[winfo width $labelPath]+(2*$widget::option(menu,borderwidth))}]x[winfo reqheight $shellPath]+$x+$y
    update idletasks
    raise $shellPath
    set (previousGrab) [grab current $shellPath]
    global embed_args
    if {[info exists embed_args]} {
        bind $shellPath <ButtonRelease-1> "optionMenu::unpopChoices $this; optionMenu::checkSelection $this"
        grab $shellPath
    } else {
        after 300 "bind $shellPath <ButtonRelease-1> {optionMenu::unpopChoices $this; optionMenu::checkSelection $this}"
        grab -global $shellPath
    }
}

proc optionMenu::unpopChoices {this} {
    set path $composite::($this,shell,path)
    if {![winfo ismapped $path]} {
        return
    }
    wm withdraw $path
    if {[string length $(previousGrab)]>0} {
        grab $(previousGrab)
        unset (previousGrab)
    } else {
        grab release $path
    }
    bind $path <ButtonRelease-1> {}
}

proc optionMenu::checkSelection {this} {
    set selection {}
    foreach label [winfo children $composite::($this,shell,path)] {
        if {[string equal [$label cget -relief] $widget::option(menu,relief)]} {
            set selection [$label cget -text]
            break
        }
    }
    if {[string length $selection]>0} {
        composite::configure $this -text $selection
        invokeCommand $this $selection
    }
}

proc optionMenu::invokeCommand {this choice} {
    if {[string length $composite::($this,-command)]>0} {
        uplevel #0 $composite::($this,-command) [list $choice]
    }
}

proc optionMenu::configureChoices {this args} {
    foreach label [winfo children $composite::($this,shell,path)] {
        eval $label configure $option $args
    }
}

proc optionMenu::select {this index} {
    if {![winfo ismapped $composite::($this,shell,path)]} {
        return
    }
    set labels [winfo children $composite::($this,shell,path)]
    if {$index<0} {
        set index 0
    } elseif {$index>=[llength $labels]} {
        set index [expr {[llength $labels]-1}]
    }
    [lindex $labels $($this,selectedLabelIndex)] configure -background $widget::option(menu,background)\
        -foreground $widget::option(menu,foreground) -relief flat
    [lindex $labels $index] configure -background $widget::option(menu,activebackground)\
        -foreground $widget::option(menu,activeforeground) -relief $widget::option(menu,relief)
    set ($this,selectedLabelIndex) $index
}

proc optionMenu::selectPrevious {this} {
    select $this [expr {$($this,selectedLabelIndex)-1}]
}

proc optionMenu::selectNext {this} {
    select $this [expr {$($this,selectedLabelIndex)+1}]
}

proc optionMenu::processSpaceKey {this} {
    if {[winfo ismapped $composite::($this,shell,path)]} {
        unpopChoices $this
        checkSelection $this
    } else {
        popChoices $this
    }
}
}
if 1 {
set rcsId {$Id: pielabel.tcl,v 2.3 2001/01/13 14:50:07 jfontain Exp $}

class pieLabeler {

    set (default,font) {Helvetica -12}

    proc pieLabeler {this canvas args} {
        ::set ($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 label {this args}

    virtual proc labelBackground {this args}

    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 2.6 2001/12/29 14:20:32 jfontain Exp $}


class pieBoxLabeler {

    proc pieBoxLabeler {this canvas args} pieLabeler {$canvas $args} switched {$args} {
        ::set ($this,array) [::new canvasLabelsArray $canvas]
        switched::complete $this
    }

    proc ~pieBoxLabeler {this} {
        ::delete $($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) -selectrelief sunken]\
        ]
        canvasLabelsArray::manage $($this,array) $label
        $pieLabeler::($this,canvas) addtag pieLabeler($this) withtag canvasLabelsArray($($this,array))
        switched::configure $label -text [switched::cget $label -text]:
        ::set ($this,selected,$label) 0
        return $label
    }

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

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

    proc label {this label args} {
        ::set text [switched::cget $label -text]
        if {[llength $args]==0} {
            regexp {^(.*):} $text dummy text
            return $text
        } else {
            regsub {^.*:} $text [lindex $args 0]: text
            switched::configure $label -text $text
        }
    }

    proc labelBackground {this label args} {
        if {[llength $args]==0} {
            return [switched::cget $label -textbackground]
        } else {
            switched::configure $label -textbackground [lindex $args 0]
        }
    }

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

    proc update {this left top right bottom} {
        ::set canvas $pieLabeler::($this,canvas)
        ::set array $($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}]
        canvasLabelsArray::update $array
    }

    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($($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: relirect.tcl,v 1.2 2001/02/11 22:06:40 jfontain Exp $}


class canvasReliefRectangle {

    proc canvasReliefRectangle {this canvas args} switched {$args} {
        set ($this,topLeft) [$canvas create line 0 0 0 0 0 0 -tags canvasReliefRectangle($this)]
        set ($this,bottomRight) [$canvas create line 0 0 0 0 0 0 -tags canvasReliefRectangle($this)]
        set ($this,canvas) $canvas
        switched::complete $this
    }

    proc ~canvasReliefRectangle {this} {
        $($this,canvas) delete canvasReliefRectangle($this)
    }

    proc options {this} {
        return [list\
            [list -background white]\
            [list -coordinates {0 0 0 0} {0 0 0 0}]\
            [list -relief flat flat]\
        ]
    }

    proc set-background {this value} {
        set intensity 65535
        foreach {red green blue} [winfo rgb $($this,canvas) $value] {}
        if {(($red*0.5*$red)+($green*1.0*$green)+($blue*0.28*$blue))<($intensity*0.05*$intensity)} {
            set ($this,dark) [format {#%04X%04X%04X}\
                [expr {($intensity+(3*$red))/4}] [expr {($intensity+(3*$green))/4}] [expr {($intensity+(3*$blue))/4}]\
            ]
        } else {
            set ($this,dark) [format {#%04X%04X%04X} [expr {(60*$red)/100}] [expr {(60*$green)/100}] [expr {(60*$blue)/100}]]
        }
        if {$green>($intensity*0.95)} {
            set ($this,light) [format {#%04X%04X%04X} [expr {(90*$red)/100}] [expr {(90*$green)/100}] [expr {(90*$blue)/100}]]
        } else {
            set tmp1 [expr {(14*$red)/10}]
            if {$tmp1>$intensity} {set tmp1 $intensity}
            set tmp2 [expr {($intensity+$red)/2}]
            set lightRed [expr {($tmp1>$tmp2)?$tmp1:$tmp2}]
            set tmp1 [expr {(14*$green)/10}]
            if {$tmp1>$intensity} {set tmp1 $intensity}
            set tmp2 [expr {($intensity+$green)/2}]
            set lightGreen [expr {($tmp1>$tmp2)?$tmp1:$tmp2}]
            set tmp1 [expr {(14*$blue)/10}]
            if {$tmp1>$intensity} {set tmp1 $intensity}
            set tmp2 [expr {($intensity+$blue)/2}]
            set lightBlue [expr {($tmp1>$tmp2)?$tmp1:$tmp2}]
            set ($this,light) [format {#%04X%04X%04X} $lightRed $lightGreen $lightBlue]
        }
        update $this
    }

    proc set-coordinates {this value} {
        foreach {left top right bottom} $value {}
        $($this,canvas) coords $($this,topLeft) $left $bottom $left $top $right $top
        $($this,canvas) coords $($this,bottomRight) $right $top $right $bottom $left $bottom
    }

    proc set-relief {this value} {
        if {![info exists ($this,dark)]} return
        update $this
    }

    proc update {this} {
        switch $switched::($this,-relief) {
            flat {
                $($this,canvas) itemconfigure canvasReliefRectangle($this) -fill $switched::($this,-background)
            }
            raised {
                $($this,canvas) itemconfigure $($this,topLeft) -fill $($this,light)
                $($this,canvas) itemconfigure $($this,bottomRight) -fill $($this,dark)
            }
            sunken {
                $($this,canvas) itemconfigure $($this,topLeft) -fill $($this,dark)
                $($this,canvas) itemconfigure $($this,bottomRight) -fill $($this,light)
            }
            default {
                error "bad relief value \"$value\": must be flat, raised or sunken"
            }
        }
    }

}
set rcsId {$Id: canlabel.tcl,v 2.6 2001/06/29 18:28:23 jfontain Exp $}


class canvasLabel {

    proc canvasLabel {this canvas args} switched {$args} {
        set ($this,canvas) $canvas
        set ($this,origin) [$canvas create image 0 0 -tags canvasLabel($this)]
        set ($this,selectRectangle) [$canvas create rectangle 0 0 0 0 -tags canvasLabel($this)]
        set ($this,rectangle) [$canvas create rectangle 0 0 0 0 -tags canvasLabel($this)]
        set ($this,text) [$canvas create text 0 0 -tags canvasLabel($this)]
        switched::complete $this
    }

    proc ~canvasLabel {this} {
        eventuallyDeleteRelief $this
        $($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 10 10]\
            [list -font {Helvetica -12}]\
            [list -foreground black black]\
            [list -justify left left]\
            [list -minimumwidth 0 0]\
            [list -padding 2 2]\
            [list -scale {1 1} {1 1}]\
            [list -select 0 0]\
            [list -selectrelief flat flat]\
            [list -stipple {} {}]\
            [list -text {} {}]\
            [list -textbackground {} {}]\
            [list -width 0 0]\
        ]
    }

    proc set-background {this value} {
        $($this,canvas) itemconfigure $($this,rectangle) -fill $value
    }

    proc set-bordercolor {this value} {
        $($this,canvas) itemconfigure $($this,rectangle) -outline $value
    }

    proc set-borderwidth {this value} {
        if {![string equal $switched::($this,-selectrelief) flat]&&($value>1)} {
            error "border width greater than 1 is not supported with $switched::($this,-selectrelief) select relief"
        }
        $($this,canvas) itemconfigure $($this,selectRectangle) -width $value
        $($this,canvas) itemconfigure $($this,rectangle) -width $value
        update $this
    }

    proc set-foreground {this value} {
        $($this,canvas) itemconfigure $($this,text) -fill $value
    }

    proc set-scale {this value} {
        update $this
    }

    proc set-stipple {this value} {
        $($this,canvas) itemconfigure $($this,rectangle) -stipple $value
    }

    foreach option {-anchor -bulletwidth -minimumwidth -padding -select -textbackground} {
        proc set$option {this value} {update $this}
    }

    foreach option {-font -justify -text -width} {
        proc set$option {this value} "
            \$(\$this,canvas) itemconfigure \$(\$this,text) $option \$value
            update \$this
        "
    }

    proc set-selectrelief {this value} {
        if {![regexp {^(flat|raised|sunken)$} $value]} {
            error "bad relief value \"$value\": must be flat, raised or sunken"
        }
        if {[string equal $value flat]} {
            eventuallyDeleteRelief $this
        } else {
            if {$switched::($this,-borderwidth)>1} {
                error "border width greater than 1 is not supported with $value select relief"
            }
        }
        update $this
    }

    proc eventuallyDeleteRelief {this} {
        if {[info exists ($this,relief)]} {
            delete $($this,relief)
            unset ($this,relief)
        }
    }

    proc updateRelief {this coordinates} {
        if {$switched::($this,-select)} {
            set relief $switched::($this,-selectrelief)
            if {[string equal $relief flat]} {
                eventuallyDeleteRelief $this
            } else {
                set canvas $($this,canvas)
                if {![info exists ($this,relief)]} {
                    set ($this,relief) [new canvasReliefRectangle $canvas -relief $relief]
                    set reliefTag canvasReliefRectangle($($this,relief))
                    foreach tag [$canvas gettags canvasLabel($this)] {
                        $canvas addtag $tag withtag $reliefTag
                    }
                }
                set background $switched::($this,-textbackground)
                if {[string length $background]==0} {
                    set background [$canvas cget -background]
                }
                switched::configure $($this,relief) -background $background -coordinates {0 0 0 0}
                switched::configure $($this,relief) -coordinates $coordinates
            }
        } else {
            eventuallyDeleteRelief $this
        }
    }

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

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

        set border [$canvas itemcget $rectangle -width]
        set textBox [$canvas bbox $text]
        set textWidth [expr {[lindex $textBox 2]-[lindex $textBox 0]}]
        set padding [winfo fpixels $canvas $switched::($this,-padding)]
        set bulletWidth [winfo fpixels $canvas $switched::($this,-bulletwidth)]

        $canvas itemconfigure $selectRectangle -fill {} -outline {}

        set width [expr {$bulletWidth+$border+$padding+$textWidth}]
        set halfHeight [expr {(([lindex $textBox 3]-[lindex $textBox 1])/2.0)+$border}]
        if {$width<$switched::($this,-minimumwidth)} {
            set width $switched::($this,-minimumwidth)
        }
        set halfWidth [expr {$width/2.0}]
        set left [expr {$x-$halfWidth}]
        set top [expr {$y-$halfHeight}]
        set right [expr {$x+$halfWidth}]
        set bottom [expr {$y+$halfHeight}]
        $canvas coords $text [expr {$left+$bulletWidth+$border+$padding+($textWidth/2.0)}] $y
        $canvas coords $selectRectangle $left $top $right $bottom
        $canvas coords $rectangle $left $top [expr {$left+$bulletWidth}] $bottom
        $canvas itemconfigure $selectRectangle\
            -fill $switched::($this,-textbackground) -outline $switched::($this,-textbackground)
        updateRelief $this [list [expr {$left+$bulletWidth+1}] $top $right $bottom]
        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 $selectRectangle $xDelta $yDelta
        $canvas move $text $xDelta $yDelta
        if {[info exists ($this,relief)]} {
            $canvas move canvasReliefRectangle($($this,relief)) $xDelta $yDelta
        }
        eval $canvas scale canvasLabel($this) $x $y $switched::($this,-scale)
    }

}
set rcsId {$Id: labarray.tcl,v 2.3 2001/01/14 13:09:55 jfontain Exp $}


class canvasLabelsArray {

    proc canvasLabelsArray {this canvas args} switched {$args} {
        set ($this,canvas) $canvas
        set ($this,origin) [$canvas create image 0 0 -tags canvasLabelsArray($this)]
        set ($this,labels) {}
        switched::complete $this
    }

    proc ~canvasLabelsArray {this} {
        eval ::delete $($this,labels)
        $($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 ($this,width) [winfo fpixels $($this,canvas) $value]
        update $this
    }

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

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

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

    proc position {this label index} {
        set canvas $($this,canvas)
        foreach {x y} [$canvas coords $($this,origin)] {}
        set column [expr {$index%2}]
        set halfWidth [expr {$($this,width)/2.0}]
        switch $switched::($this,-justify) {
            left {
                set x [expr {$x+($column*$halfWidth)}]
                set anchor nw
            }
            right {
                set x [expr {$x+(($column+1)*$halfWidth)}]
                set anchor ne
            }
            default {
                set x [expr {$x+((1.0+(2*$column))*$($this,width)/4)}]
                set anchor n
            }
        }
        set y [expr {$y+[columnHeight $this $column [expr {$index/2}]]}]
        switched::configure $label -anchor $anchor -minimumwidth [expr {$halfWidth-2}]
        foreach {xDelta yDelta} [$canvas coords canvasLabel($label)] {}
        $canvas move canvasLabel($label) [expr {$x-$xDelta}] [expr {$y-$yDelta}]
    }

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

    proc columnHeight {this column {rows 2147483647}} {
        set canvas $($this,canvas)
        set length [llength $($this,labels)]
        set height 0
        for {set index $column; set row 0} {($index<$length)&&($row<$rows)} {incr index 2; incr row} {
            set coordinates [$canvas bbox canvasLabel([lindex $($this,labels) $index])]
            incr height [expr {[lindex $coordinates 3]-[lindex $coordinates 1]}]
        }
        return $height
    }

    proc height {this} {
        return [maximum [columnHeight $this 0] [columnHeight $this 1]]
    }

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

}
set rcsId {$Id: perilabel.tcl,v 2.6 2001/12/29 14:20:32 jfontain Exp $}


class piePeripheralLabeler {

    variable PI 3.14159265358979323846

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

    proc ~piePeripheralLabeler {this} {
        ::delete $($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\
                -justify $switched::($this,-justify) -bulletwidth $switched::($this,-bulletwidth)\
                -font $switched::($this,-font) -selectrelief sunken\
            ]\
        ]
        canvasLabelsArray::manage $($this,array) $label
        $canvas addtag pieLabeler($this) withtag canvasLabelsArray($($this,array))
        ::set ($this,textItem,$label) $text
        ::set ($this,slice,$label) $slice
        ::set ($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 (anchor,[anglePosition [expr {$index*45}]]) $anchor
        incr index
    }
    unset index anchor

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

    proc label {this label args} {
        if {[llength $args]==0} {
            return [switched::cget $label -text]
        } else {
            switched::configure $label -text [lindex $args 0]
        }
    }

    proc labelBackground {this label args} {
        if {[llength $args]==0} {
            return [switched::cget $label -textbackground]
        } else {
            switched::configure $label -textbackground [lindex $args 0]
        }
    }

    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 $(anchor,[anglePosition $angle])
    }

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

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

    proc update {this left top right bottom} {
        ::set canvas $pieLabeler::($this,canvas)
        ::set array $($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}]
        canvasLabelsArray::update $array
        foreach label [canvasLabelsArray::labels $array] {
            position $this $($this,textItem,$label) $($this,slice,$label)
        }
    }

    proc room {this arrayName} {
        upvar $arrayName data

        ::set data(left) [expr {$($this,valueWidth)+$switched::($this,-offset)}]
        ::set data(right) $data(left)
        ::set data(top) [expr {$switched::($this,-offset)+$($this,valueHeight)}]
        ::set box [$pieLabeler::($this,canvas) bbox canvasLabelsArray($($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 2.2 2001/12/30 11:25:44 jfontain Exp $}


class slice {
    variable PI 3.14159265358979323846
}

proc slice::slice {this canvas xRadius yRadius args} switched {$args} {
    set ($this,canvas) $canvas
    set ($this,xRadius) $xRadius
    set ($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)
    }
    $($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)&&($value>0)} {
        update $this
    }
}

proc slice::set-startandextent {this value} {
    foreach {start extent} $value {}
    set ($this,start) [normalizedAngle $start]
    if {$extent<0} {
        set ($this,extent) 0
    } elseif {$extent>=360} {
        set ($this,extent) [expr {360-pow(10,-$::tcl_precision+3)}]
    } else {
        set ($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 $($this,canvas)
    set xRadius $($this,xRadius)
    set yRadius $($this,yRadius)
    set bottomColor $switched::($this,-bottomcolor)
    set ($this,origin) [$canvas create image -$xRadius -$yRadius -tags slice($this)]
    if {$switched::($this,-height)>0} {
        set ($this,startBottomArcFill) [$canvas create arc\
            0 0 0 0 -style chord -extent 0 -fill $bottomColor -outline $bottomColor -tags slice($this)\
        ]
        set ($this,startPolygon) [$canvas create polygon 0 0 0 0 0 0 -fill $bottomColor -tags slice($this)]
        set ($this,startBottomArc) [$canvas create arc 0 0 0 0 -style arc -extent 0 -fill black -tags slice($this)]

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

        set ($this,startLeftLine) [$canvas create line 0 0 0 0 -tags slice($this)]
        set ($this,startRightLine) [$canvas create line 0 0 0 0 -tags slice($this)]
        set ($this,endLeftLine) [$canvas create line 0 0 0 0 -tags slice($this)]
        set ($this,endRightLine) [$canvas create line 0 0 0 0 -tags slice($this)]
    }
    set ($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 $($this,canvas)
    set coordinates [$canvas coords $($this,origin)]
    set xRadius $($this,xRadius)
    set yRadius $($this,yRadius)
    $canvas coords $($this,origin) -$xRadius -$yRadius
    $canvas coords $($this,topArc) -$xRadius -$yRadius $xRadius $yRadius
    $canvas itemconfigure $($this,topArc) -start $($this,start) -extent $($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 $($this,start)
    set extent $($this,extent)

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

    $canvas itemconfigure $($this,startBottomArcFill) -extent 0
    $canvas coords $($this,startBottomArcFill) -$xRadius -$yRadius $xRadius $yRadius
    $canvas move $($this,startBottomArcFill) 0 $height
    $canvas itemconfigure $($this,startBottomArc) -extent 0
    $canvas coords $($this,startBottomArc) -$xRadius -$yRadius $xRadius $yRadius
    $canvas move $($this,startBottomArc) 0 $height
    $canvas coords $($this,startLeftLine) 0 0 0 0
    $canvas coords $($this,startRightLine) 0 0 0 0
    $canvas itemconfigure $($this,endBottomArcFill) -extent 0
    $canvas coords $($this,endBottomArcFill) -$xRadius -$yRadius $xRadius $yRadius
    $canvas move $($this,endBottomArcFill) 0 $height
    $canvas itemconfigure $($this,endBottomArc) -extent 0
    $canvas coords $($this,endBottomArc) -$xRadius -$yRadius $xRadius $yRadius
    $canvas move $($this,endBottomArc) 0 $height
    $canvas coords $($this,endLeftLine) 0 0 0 0
    $canvas coords $($this,endRightLine) 0 0 0 0
    $canvas coords $($this,startPolygon) 0 0 0 0 0 0 0 0
    $canvas coords $($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 $($this,startBottomArcFill) -start $start -extent $extent
                $canvas itemconfigure $($this,startBottomArc) -start $start -extent $extent
                $canvas coords $($this,startPolygon) $startX $startY $endX $endY $endX $endBottom $startX $startBottom
                $canvas coords $($this,startLeftLine) $startX $startY $startX $startBottom
                $canvas coords $($this,startRightLine) $endX $endY $endX $endBottom
            }
        } else {
            if {$start<0} {
                $canvas itemconfigure $($this,startBottomArcFill) -start 0 -extent $start
                $canvas itemconfigure $($this,startBottomArc) -start 0 -extent $start
                $canvas coords $($this,startPolygon) $startX $startY $xRadius 0 $xRadius $height $startX $startBottom
                $canvas coords $($this,startLeftLine) $startX $startY $startX $startBottom
                $canvas coords $($this,startRightLine) $xRadius 0 $xRadius $height

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

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

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

    set data(start) $($this,start)
    set data(extent) $($this,extent)
    foreach {x y} $switched::($this,-scale) {}
    set data(xRadius) [expr {$x*$($this,xRadius)}]
    set data(yRadius) [expr {$y*$($this,yRadius)}]
    set data(height) [expr {$y*$switched::($this,-height)}]
    foreach {x y} [$($this,canvas) coords $($this,origin)] {}
    set data(xCenter) [expr {$x+$data(xRadius)}]
    set data(yCenter) [expr {$y+$data(yRadius)}]
}
set rcsId {$Id: selector.tcl,v 2.2 2000/07/30 19:43:48 jfontain Exp $}


class selector {

    proc selector {this args} switched {$args} {
        ::set ($this,order) 0
        switched::complete $this
    }

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

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

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

    proc set-selectcommand {this value} {}

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

        ::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
            }
            ::set ${this}order($index) $($this,order)
            incr ($this,order)
        }
        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
        variable ${this}order

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

    proc ordered {this index1 index2} {
        variable ${this}order

        return [expr {[::set ${this}order($index1)]-[::set ${this}order($index2)]}]
    }


    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 ($this,lastSelected) [lindex $indices end]
    }

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

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

        ::set select {}
        ::set deselect {}
        foreach index $indices {
            if {[::set ${this}selected($index)]} {
                lappend deselect $index
                ::set ${this}selected($index) 0
                if {[info exists ($this,lastSelected)]&&($index==$($this,lastSelected))} {
                    ::unset ($this,lastSelected)
                }
            } else {
                lappend select $index
                ::set ${this}selected($index) 1
                ::set ($this,lastSelected) $index
            }
            ::set ${this}order($index) $($this,order)
            incr ($this,order)
        }
        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 value} [array get ${this}selected] {
            if {$value} {
                lappend list $index
            }
        }
        return [lsort -command "ordered $this" $list]
    }

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

        return [lsort -command "ordered $this" [array names ${this}selected]]
    }

}

set rcsId {$Id: objselec.tcl,v 1.8 1999/10/02 20:53:05 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 [lsort -integer [selector::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
        }
    }

}
set rcsId {$Id: pie.tcl,v 2.8 2001/08/27 17:09:55 jfontain Exp $}


package provide tkpiechart 6.3

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

proc pie::pie {this canvas x y args} switched {$args} {
    set ($this,canvas) $canvas
    set ($this,colorIndex) 0
    set ($this,slices) {}
    set ($this,origin) [$canvas create image $x $y -tags pie($this)]
    switched::complete $this
    complete $this
}

proc pie::~pie {this} {
    if {[info exists ($this,title)]} {
        $($this,canvas) delete $($this,title)
    }
    delete $($this,labeler)
    eval delete $($this,slices) $($this,backgroundSlice)
    if {[info exists ($this,selector)]} {
        delete $($this,selector)
    }
    $($this,canvas) delete $($this,origin)
}

proc pie::options {this} {
    return [list\
        [list -background {} {}]\
        [list -colors $(colors) $(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 ($this,thickness) [winfo fpixels $($this,canvas) $value]
}

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

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

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

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

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

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

    set slice [new slice\
        $canvas [expr {$($this,initialWidth)/2}] [expr {$($this,initialHeight)/2}] -startandextent "$start 0"\
        -height $($this,thickness) -topcolor $color -bottomcolor [darken $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 ($this,slices) $slice

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

    update $this

    if {$switched::($this,-selectable)} {
        if {![info exists ($this,selector)]} {
            set ($this,selector) [new objectSelector -selectcommand "pie::setLabelsState $this"]
        }
        set selector $($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 $($this,slices) $slice]
    if {$index<0} {
        error "invalid slice $slice for pie $this"
    }
    set ($this,slices) [lreplace $($this,slices) $index $index]
    set extent $slice::($slice,extent)
    delete $slice
    foreach following [lrange $($this,slices) $index end] {
        slice::rotate $following $extent
    }
    pieLabeler::delete $($this,labeler) $($this,sliceLabel,$slice)
    if {$switched::($this,-selectable)} {
        selector::remove $($this,selector) $($this,sliceLabel,$slice)
    }
    unset ($this,sliceLabel,$slice)
    update $this
}

proc pie::sizeSlice {this slice unitShare {valueToDisplay {}}} {
    set index [lsearch -exact $($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 $($this,labeler) $($this,sliceLabel,$slice) $valueToDisplay
    } else {
        pieLabeler::set $($this,labeler) $($this,sliceLabel,$slice) $unitShare
    }

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

proc pie::labelSlice {this slice text} {
    pieLabeler::label $($this,labeler) $($this,sliceLabel,$slice) $text
    update $this
}

proc pie::setSliceLabelBackground {this slice text} {
    pieLabeler::labelBackground $($this,labeler) $($this,sliceLabel,$slice) $text
}

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

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

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

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

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

    catch ::tk::Darken
    if {[llength [info procs ::tk::Darken]]>0} {
        proc darken {color percent} {::tk::Darken $color $percent}
    } else {
        proc darken {color percent} {::tkDarken $color $percent}
    }
}
}
package require Tktable 2.7
package require BLT 2.4

wm protocol . WM_DELETE_WINDOW exit
wm command . [concat $argv0 $argv]
wm group . .


set rcsId {$Id: font.tcl,v 2.8 2001/12/29 00:32:39 jfontain Exp jfontain $}



class font {
    catch {widget::widget}

    set (mediumBold) [eval font create [font actual $widget::option(button,font)]]
    font configure $(mediumBold) -weight bold
    set (mediumNormal) [eval font create [font actual $(mediumBold)]]
    font configure $(mediumNormal) -weight normal
    set (mediumItalic) [eval font create [font actual $(mediumNormal)]]
    font configure $(mediumItalic) -slant italic
    set (smallNormal) [eval font create [font actual $(mediumNormal)]]
    font configure $(smallNormal) -size [expr {round(0.8*[font actual $(mediumNormal) -size])}]
    set (tinyNormal) [font create -family helvetica -size 7]
}


set rcsId {$Id: scrollbl.tcl,v 2.8 2001/12/29 00:32:39 jfontain Exp $}


class scrollingLabel {

    proc scrollingLabel {this parentPath args} composite {[new frame $parentPath] $args} {
        composite::manage $this [new label $widget::($this,path) -font $widget::option(button,font) -justify left] label
        composite::complete $this
        bind $widget::($this,path) <Configure> "scrollingLabel::refresh $this %w"
    }

    proc ~scrollingLabel {this} {}

    proc options {this} {
        return [list\
            [list -font $widget::option(button,font) $widget::option(button,font)]\
            [list -interval 15 15]\
            [list -step 1]\
            [list -text {}]\
            [list -width 0 0]\
        ]
    }

    proc set-interval {this value} {}

    proc set-step {this value} {
        set ($this,step) -$value
    }

    proc set-font {this value} {
        $composite::($this,label,path) configure -font $value
        refresh $this [winfo width $widget::($this,path)]
    }

    proc set-text {this value} {
        $composite::($this,label,path) configure -text $value
        refresh $this [winfo width $widget::($this,path)]
    }

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

    proc refresh {this width} {
        if {![info exists ($this,step)]} return
        set ($this,textWidth) [winfo reqwidth $composite::($this,label,path)]
        $widget::($this,path) configure -height [winfo reqheight $composite::($this,label,path)]
        place $composite::($this,label,path) -anchor nw -x [set ($this,x) 0] -y 0
        if {$width<$($this,textWidth)} {
            scroll $this $width
        } else {
            catch {after cancel $($this,event)}
        }
    }

    proc scroll {this width} {
        set interval $composite::($this,-interval)
        if {(($($this,step)<0)&&($($this,x)<($width-$($this,textWidth))))||(($($this,step)>0)&&($($this,x)>0))} {
            set ($this,step) [expr {-$($this,step)}]
            set interval [expr {20*$interval}]
        }
        place $composite::($this,label,path) -x [incr ($this,x) $($this,step)]
        catch {after cancel $($this,event)}
        set ($this,event) [after $interval "scrollingLabel::scroll $this $width"]
    }

}





::stooop::class xifo {
    proc xifo {this size} {
        set ($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]>=$($this,size)} {
            unset ${this}data($($this,first))
            incr ($this,first)
        }
        set ${this}data([incr ($this,last)]) $data
    }

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

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

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

    ::stooop::virtual proc out {this}

    ::stooop::virtual proc data {this}
}

::stooop::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
    }
}

::stooop::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
    }
}


set rcsId {$Id: lifolbl.tcl,v 2.10 2001/12/29 00:32:39 jfontain Exp $}



class lifoLabel {
    variable header [mc Message:]
}

proc lifoLabel::lifoLabel {this parentPath args} composite {
    [new frame $parentPath -relief sunken -borderwidth $widget::option(button,borderwidth)] $args
} {
    variable header

    set path $widget::($this,path)
    composite::manage $this [new label $path -font {helvetica -12 bold} -text $header] header [new frame $path] separator\
        [new scrollingLabel $path -font {helvetica -12}] body
    pack $composite::($this,header,path) $composite::($this,separator,path) -side left -anchor nw
    pack $composite::($this,body,path) -fill x -expand 1
    set ($this,lifo) [new lifo]
    composite::complete $this
}

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

proc lifoLabel::options {this} {
    variable header

    return [list\
        [list -borderwidth $widget::option(button,borderwidth) $widget::option(button,borderwidth)]\
        [list -font {helvetica -12} {helvetica -12}]\
        [list -header $header $header]\
        [list -headerfont {helvetica -12 bold} {helvetica -12 bold}]\
        [list -relief sunken sunken]\
        [list -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::configure $composite::($this,body) -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::cget $composite::($this,body) -text]]]>0} {
        xifo::in $($this,lifo) $current
    }
    composite::configure $composite::($this,body) -text $string
}

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

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

set rcsId {$Id: dialog.tcl,v 2.14 2001/12/29 00:32:39 jfontain Exp $}


class dialogBox {}

proc dialogBox::dialogBox {this parentPath args} composite {[new toplevel $parentPath] $args} {
    set path $widget::($this,path)
    wm group $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] ok [new button $buttons -text Cancel] cancel\
        [new button $buttons -text Help] help [new button $buttons -text Close] close
    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 "dialogBox::close $this"
    composite::complete $this
}

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

proc dialogBox::options {this} {
    return [list\
        [list -buttons o]\
        [list -command {} {}]\
        [list -default {} {}]\
        [list -deletecommand {} {}]\
        [list -die 1 1]\
        [list -enterreturn 1 1]\
        [list -grab local]\
        [list -helpcommand {} {}]\
        [list -otheractions {} {}]\
        [list -title {Dialog box}]\
        [list -transient 1]\
        [list -x 0]\
        [list -y 0]\
    ]
}

proc dialogBox::set-buttons {this value} {
    set path $widget::($this,path)
    if {$composite::($this,complete)} {
        error {option -buttons cannot be set dynamically}
    }
    if {![regexp {^[chox]+$} $value]} {
        error "bad buttons value \"$value\": must be a combination of c, h, o and x"
    }
    if {[string first h $value]>=0} {
        pack $composite::($this,help,path) -side left -expand 1 -pady 3 -padx 3
        widget::configure $composite::($this,help) -command "dialogBox::help $this"
        bind $path <F1> "dialogBox::help $this"
        new buttonKeysLink $composite::($this,help,path) F1 $widget::($this,path)
    }
    set ok [expr {[string first o $value]>=0}]
    if {$ok} {
        pack $composite::($this,ok,path) -side left -expand 1 -pady 3
        widget::configure $composite::($this,ok) -command "dialogBox::oked $this"
        bind $path <KeyRelease-Return> "dialogBox::oked $this 1"
        bind $path <KeyRelease-KP_Enter> "dialogBox::oked $this 1"
        new buttonKeysLink $composite::($this,ok,path) {Return KP_Enter} $widget::($this,path)
    }
    set cancel [expr {[string first c $value]>=0}]
    if {$cancel} {
        pack $composite::($this,cancel,path) -side left -expand 1 -pady 3
        widget::configure $composite::($this,cancel) -command "dialogBox::close $this"
        bind $path <KeyRelease-Escape> "dialogBox::close $this"
        new buttonKeysLink $composite::($this,cancel,path) Escape $widget::($this,path)
    }
    if {[string first x $value]>=0} {
        pack $composite::($this,close,path) -side left -expand 1 -pady 3
        widget::configure $composite::($this,close) -command "dialogBox::close $this"
        set keys {}
        if {!$ok} {
            lappend keys Return KP_Enter
            bind $path <KeyRelease-Return> "dialogBox::close $this 1"
            bind $path <KeyRelease-KP_Enter> "dialogBox::close $this 1"
        }
        if {!$cancel} {
            lappend keys Escape
            bind $path <KeyRelease-Escape> "dialogBox::close $this"
        }
        if {[llength $keys]>0} {
            new buttonKeysLink $composite::($this,close,path) $keys $widget::($this,path)
        }
    }
    addOtherActions $this
}

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}
        x {$composite::($this,close,path) configure -default active}
        default {
            error "bad default value \"$value\": must be o, c or x"
        }
    }
}

proc dialogBox::set-command {this value} {}
proc dialogBox::set-deletecommand {this value} {}
proc dialogBox::set-die {this value} {}
proc dialogBox::set-helpcommand {this value} {}
proc dialogBox::set-enterreturn {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::set-otheractions {this value} {
    addOtherActions $this
}

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

proc dialogBox::oked {this {enterOrReturn 0}} {
    if {$enterOrReturn&&!$composite::($this,-enterreturn)} return
    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::close {this {enterOrReturn 0}} {
    if {$enterOrReturn&&!$composite::($this,-enterreturn)} return
    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
}

proc dialogBox::help {this} {
    if {[string length $composite::($this,-helpcommand)]>0} {
        uplevel #0 $composite::($this,-helpcommand)
    }
}

proc dialogBox::addOtherActions {this} {
    set list $composite::($this,-otheractions)
    if {([llength $list]==0)||[info exists ($this,otherActionsAdded)]} return
    set buttons $composite::($this,buttons,path)
    set index 0
    foreach {label command} $list {
        pack [button $buttons.$index -text $label -command $command] -side left -expand 1 -pady 3 -padx 3
        incr index
    }
    set ($this,otherActionsAdded) {}
}

set rcsId {$Id: listentry.tcl,v 1.8 2001/12/29 00:32:39 jfontain Exp $}


class listEntry {

    proc listEntry {this parentPath args} composite {
        [new frame $parentPath -borderwidth 1 -highlightthickness 1 -relief sunken] $args
    } {
        set path $widget::($this,path)
        composite::manage $this [new table $path\
            -variable listEntry::${this}data -font $font::(mediumNormal) -cursor {} -bordercursor {} -highlightthickness 0 -rows 1\
            -cols 1 -anchor w -sparsearray 0 -colstretchmode last -browsecommand "listEntry::activated $this %r"\
            -validate 1 -validatecommand "listEntry::validate $this %W"\
        ] table [new scrollbar $path -highlightthickness 0] scroll
        set path $composite::($this,table,path)

        $path configure -ipadx 2 -borderwidth {0 0 1 0}
        $path tag configure active -background {} -relief sunken
        $path tag configure sel -background {}
        $path tag configure lastrow -background {} -borderwidth {0 0 1 1}

        configureWritableTable $path
        foreach key {Return KP_Enter} {
            bind $path <$key> "listEntry::enter $this; [bind $path <Tab>]"
        }
        pack $path -side left -fill both -expand 1
        pack $composite::($this,scroll,path) -fill y -expand 1
        $composite::($this,scroll,path) configure -command "$path yview"
        $path configure -yscrollcommand "$composite::($this,scroll,path) set"
        composite::complete $this
    }

    proc ~listEntry {this} {}

    proc options {this} {
        return [list\
            [list -height 3]\
            [list -list {}]\
            [list -state normal normal]\
            [list -width 10 10]\
        ]
    }

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

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

        if {[info exists ($this,internal)]} {
            unset ($this,internal)
            return
        }
        if {[llength $value]==0} {
            set value {{}}
        }
        catch {unset ${this}data}
        set row 0
        foreach cell $value {
            set ${this}data($row,0) $cell
            incr row
        }
        $composite::($this,table,path) configure -rows $row
        drawBottomLine $this
    }

    proc set-state {this value} {
        set path $composite::($this,table,path)
        switch $value {
            disabled {
                $path configure -state disabled
                bind $path <ButtonPress-1> {}
            }
            normal {
                $path configure -state normal
                bind $path <ButtonPress-1> [bind Table <ButtonPress-1>]
            }
            default {
                error "bad state value \"$value\": must be normal or disabled"
            }
        }
    }

    proc set-width {this value} {
        $composite::($this,table,path) width 0 $value
    }

    proc enter {this} {
        variable ${this}data

        set path $composite::($this,table,path)
        catch {$path activate active}
        set rows [$path cget -rows]
        set row [$path index active row]
        if {$row==($rows-1)&&([string length [set ${this}data($row,0)]]>0)} {
            $path configure -rows [expr {$rows+1}]
            set ${this}data($rows,0) {}
            $path activate $rows,0
            $path see $rows,0
        }
    }

    proc clean {this} {
        variable ${this}data

        set path $composite::($this,table,path)
        set rows [$path cget -rows]
        set delete {}
        for {set row 0} {$row<$rows} {incr row} {
            set ${this}data($row,0) [string trim [set ${this}data($row,0)]]
            if {[$path cget -rows]<=1} break
            if {[string length [set ${this}data($row,0)]]==0} {
                append delete $row
            }
        }
        if {[llength $delete]>0} {
            eval $path delete rows $delete
        }
    }

    proc activated {this row} {
        variable ${this}data

        set path $composite::($this,table,path)
        set ${this}data($row,0) [string trim [set ${this}data($row,0)]]
        if {([string length [set ${this}data($row,0)]]>0)||($row<([$path cget -rows]-1))} {
            clean $this
        }
        drawBottomLine $this
    }

    proc drawBottomLine {this} {
        set path $composite::($this,table,path)
        catch {$path tag row {} [$path tag row lastrow]}
        $path tag row lastrow [$path index end row]
    }

    proc synchronize {this} {
        variable ${this}data

        set list {}
        foreach cell [lsort -dictionary [array names ${this}data *,*]] {
            set value [set ${this}data($cell)]
            if {[string length $value]>0} {
                lappend list $value
            }
        }
        set ($this,internal) {}; composite::configure $this -list $list
    }

    proc validate {this path} {
        after idle "
            $path activate active
            listEntry::synchronize $this
        "
        return 1
    }

}

set rcsId {$Id: viewer.tcl,v 2.14 2002/01/16 20:38:54 jfontain Exp $}


class viewer {

    set (list) {}

    proc viewer {this} {
        lappend (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}
        if {[info exists ($this,drop)]} {
            delete $($this,drop)
        }
        ldelete (list) $this
    }

    virtual proc supportedTypes {this}

    proc view {this cells} {
        foreach cell $cells {
            parse $cell array row column type
            if {![info exists $array]} continue
            if {[lsearch -exact [supportedTypes $this] $type]<0} {
                lifoLabel::flash $global::messenger "cannot display data of type $type"
if {$global::withGUI} bell
                return
            }
            lappend data($array) $row $column
        }
        foreach {array list} [array get data] {
            foreach {row column} $list {
                monitorCell $this $array $row $column
if {$global::withGUI} {
                setCellColor $this $array $row $column [thresholds::cellColor $array $row $column]
            }
}
        }
        foreach array [array names data] {
            update $this $array
        }
    }

    virtual proc monitorCell {this array row column}

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

        if {([scan $dataCell {%[^(](%u,%u)} array row column]!=3)||($row<0)||($column<0)} {
            error "\"$dataCell\" is not a valid array cell"
        }
        set type [set ${array}($column,type)]
    }

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

    proc label {array row column} {
        set label {}
        set identifier [modules::identifier $array]
        if {[string length $identifier]>0} {
            set label "$identifier: "
        }
        if {[catch {set ${array}(indexColumns)} columns]} {
            set columns 0
        }
        foreach index $columns {
            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 {}
    }

if {$global::withGUI} {

    proc setupDropSite {this path} {
        set ($this,drop) [new dropSite -path $path -formats {DATACELLS VIEWER KILL} -command "viewer::handleDrop $this"]
    }

    proc handleDrop {this} {
        if {![catch {set dragSite::data(DATACELLS)} data]} {
            view $this $data
        } elseif {![catch {set dragSite::data(VIEWER)} data]} {
            mutate $this $data
        } elseif {[info exists dragSite::data(KILL)]} {
            delete $this
        }
    }

    proc mutate {this class} {
        if {[string equal $class [classof $this]]} return
        set viewer [eval new $class $global::canvas -draggable [composite::cget $this -draggable]]
        foreach list [composite::configure $viewer] {
            if {[string equal [lindex $list 0] -interval]} {
                composite::configure $viewer -interval $global::pollTime
                break
            }
        }
        set cells {}
        set count 0
        foreach cell [cells $this] {
            if {[info exists $cell]} {
                lappend cells $cell
            }
            incr count
        }
        if {[llength $cells]>0} {
            view $viewer $cells
        }
        if {[llength $cells]<$count} {
            lifoLabel::flash $global::messenger {some data cells no longer exist}
        }
        foreach {x y width height} [canvasWindowManager::getGeometry $global::windowManager $widget::($this,path)] {}
        set level [canvasWindowManager::getStackLevel $global::windowManager $widget::($this,path)]
        delete $this
        manageViewer $viewer 1 -static $global::static -setx $x -sety $y -setwidth $width -setheight $height -level $level
    }

    proc changeAllCellsColor {array row column color} {
       foreach viewer $(list) {
           setCellColor $viewer $array $row $column $color
       }
    }

    virtual proc setCellColor {this array row column color}

}

    proc numericType {type} {
        switch $type {
            integer - real {return 1}
            default {return 0}
        }
    }

}

set rcsId {$Id: keyslink.tcl,v 2.4 2001/12/29 00:32:39 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 ($this,bindings) $bindings
    }
    proc ~buttonKeysLink {this} {
        delete $($this,bindings)
    }
}

set rcsId {$Id: help.tcl,v 2.17 2002/01/13 22:14:50 jfontain Exp $}

namespace eval help {

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

    variable description {
Copyright  1997-2002 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 version 2 as published by the Free Software Foundation (at http://www.gnu.org).

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.

        jfontain@free.fr


This software uses the following extensions:

    - the BLT library by George Howlett
    - the tkTable widget by Jeffrey Hobbs
    - the MIME/SMTP library (part of tcllib) by Marshall Rose
    - the stooop OO extension by me
    - the scwoop widget library by me
    - the tkpiechart widget by me

Thank you so very much to these authors (except me :-) for their great work.


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

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

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

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

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

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

}

proc simpleTextDialogBox {title text} {
    set dialog [new dialogBox . -buttons o -default o -title $title -x [winfo pointerx .] -y [winfo pointery .]]
    set widget [new scroll text $widget::($dialog,path) -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 columnconfigure $frame 0 -weight 1
    grid columnconfigure $frame 1 -weight 1
    grid rowconfigure $frame 0 -weight 0
    grid rowconfigure $frame 1 -weight 0
    grid rowconfigure $frame 2 -weight 1

    grid [label $frame.icon -image [image create photo -data [dataGraph::iconData]] -relief sunken] -row 0 -column 0 -padx 2
    grid [label $frame.name -text $help::nameAndVersion] -row 0 -column 1
    grid [frame $frame.separator -relief sunken -borderwidth 1 -height 2] -row 1 -column 0 -columnspan 2 -sticky ew
    grid $widget::($text,path) -row 2 -column 0 -columnspan 2 -sticky nsew

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

proc linkedHelpWidgetTip {path} {
    return [new widgetTip\
        -path $path\
        -text "display the relevant section in the\ngeneral help window (may take some\ntime if the window is not yet opened)"\
    ]
}

set rcsId {$Id: threshold.tcl,v 1.89 2002/01/19 16:47:02 jfontain Exp $}


class thresholds {

    variable levelColor
    array set levelColor {debug blue info white notice yellow warning orange error red critical red alert red emergency red}
    set (levels) {debug info notice warning error critical alert emergency}
    set (colors) {red orange yellow white green cyan blue ? {}}

    variable help
    set help(active) "whether the threshold\ncondition is ckeched"
    set help(type) "threshold type\n(click for next type)"
    set help(level) "importance level (used by\nmoomps for system logging\nand included in email alert)"
    set help(color) "color showing threshold\ncondition occured\n(click to edit)"
    set help(value) {threshold value}
    set help(source) "data description\n(can be edited)"

if {$global::withGUI} {

    set (default,button,background) $widget::option(button,background)
    variable screenIcon [image create photo -data {
        R0lGODlhFQARAKUAAPgA+JiYmAAAAOjw8NjY2ODg4NDQ0MjIyMDAwLi4uKioqKiomFhYWOjo6NjY0Ojk4NDQwMjAyFhscPDw8Pj4+ODs8GBgYMjEsGBYYDh4
        gEiQmDBscDhQUBBESMjc4KjM0IjAwHiwuFigqCiEkAhweABYaNDo6ODg2HBscICEaIiIiLCwsAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
        AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAVABEAAAbwQIAwEBAYj0hkQAgIDAiFAoFgOCASCcWCaGAsAw2H9BElQA4RrJYg8QYmFAp8
        MhlMGo1KI9qwWLwCcnZ1eFEOBBcHVhIWGEVyGRqSGRsbHB2YHQUIfoB1GhUUFR4fICEiIyQlFREWbUV3Eh4VJh+lIqiqm52wDRukth8hIRqpJQWtr4EOG8Gm
        p8WqDQmMgAMFGyHP0KkkJCetjUVPHCKnuMXdx5x/RQ0EHRIZEpUb3qqayYANFw0PeCcanAgY5cSVNgKKVEikCIFDhwkiPEQgISGAhEQyatwYwAuTAAZQpFAR
        YAWCFQFUpEDBEsUSIUEAADs=
    }]

}

    proc thresholds {this args} switched {$args} viewer {} {
        variable singleton
        variable thresholds {}

        if {[info exists singleton]} {
            error {only 1 thresholds object can exist}
        }
        switched::complete $this
    }

    proc ~thresholds {this} {
        error {not implemented}
    }

    proc options {this} {
        return [list [list -configurations {} {}]]
    }

if {$global::withGUI} {

    proc iconData {} {
        return {
            R0lGODdhJAAkAKUAAPj8+Hh4eHh8eHBIAPj0wAAAAPDssOjkqODgoPgAAODYmNjUkNDMiNDEgMjAeMC4cMC0aJicmLisYLCkWKigUKiYSKCUQJiMOICEgJiE
            MIiQiJCAKJCYkIh4IKCkoKisqLi8uMDEwMjQyNDY0ODk4Ojs6AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
            AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACwAAAAAJAAkAAAG/kCAcCgMEI/G4zBZVBKZSijy6RwKqgAp8bosCr7gsHhMHmuFXGdauT5bseujYEDPYgHxrZM+
            IBAGAkllg2N8focDBQGLVXlvAHQGkpOSgG5ocJAHm5ydlneOmJB8CKWmnwAJqqusra6rAwqys3yqfLe4ubkLvAsDvLiNWFADDMZ0x4GgQrddzA3QgHMNqIvW
            YgMO2g4D1gFz29wFc3SKjGoDD+rrA3jM7FdX0peQEPb39oD1+VxcEXZVBuAbCIEOPn3unH0LM0CCw4d0HkqUkKiMtSMDJmjcKC3jRo0IRTXBSKGkSWnMTJYM
            mXDkkAEVYsqswBJmTJYtARYoMMCCj8+fFhLtHMqzHNGjR8EMuMC0qbQxQwmFwUAVw4AMWDNIq8q1q1evGsKGHbChLCCxaNOqXcuhrdsBHaS5nUu3rl0PePN6
            oCNAr9+/gPV+GEx48JfCiBMrLgyisePHkCNLnhyisuXLmDNr3iyis+fPoEOLHj2itOnTqFOrXk2itevXsGPLnl2itu3buHPr3h0EADs=
        }
    }

}

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

    proc set-configurations {this value} {
        set ($this,initializeIndex) 0                                        
    }

if {$global::withGUI} {

    proc edit {} {
        variable singleton
        variable thresholds
        variable screenIcon

        set this $singleton
        if {[info exists ($this,dialog)]} {
            raise $widget::($($this,dialog),path)
            return
        }
        set dialog [createDialog $this]
        set frame [frame $widget::($dialog,path).frame]
        set panes [new panner $frame -panes 3]
        set ($this,panes) $panes
        pack $widget::($panes,path) -fill both -expand 1

        pack [createTable $this $panner::($panes,frame1)] -anchor nw -fill both -expand 1

        set details [frame $panner::($panes,frame2).details]
        set ($this,cellLabel) [label $details.cellLabel -font $font::(mediumBold) -text {Original cell:} -state disabled]
        grid $($this,cellLabel) -row 0 -column 0 -sticky nw
        set ($this,cell) [label $details.cell -font $font::(mediumNormal) -relief sunken -width 20]
        grid $($this,cell) -row 0 -column 1 -sticky nwe -padx 5
        set ($this,emailsLabel) [label $details.emailsLabel -font $font::(mediumBold) -text Emails: -state disabled]
        grid $($this,emailsLabel) -row 0 -column 2 -sticky ne
        set ($this,emails) [new listEntry $details -width 20 -height 2 -state disabled]
        if {$global::noMail} {
            $details.emailsLabel configure -state disabled
        }
        grid $widget::($($this,emails),path) -row 0 -column 3 -rowspan 3 -columnspan 100 -sticky nwe
        set ($this,emailShot) 0
        set ($this,shot) [checkbutton $details.shot -image $screenIcon -variable thresholds::($this,emailShot) -state disabled]
        grid $($this,shot) -row 1 -column 2 -sticky nw
        lappend ($this,objects) [new widgetTip -path $($this,shot) -text "attach screen shot\nto email message"]
        set ($this,currentLabel) [label $details.currentLabel -font $font::(mediumBold) -text {Current value:} -state disabled]
        grid $($this,currentLabel) -row 1 -column 0 -sticky nw
        set ($this,current) [label $details.current -font $font::(mediumNormal) -relief sunken -width 20]
        grid $($this,current) -row 1 -column 1 -sticky nwe -padx 5

        grid columnconfigure $details 1 -weight 1
        grid columnconfigure $details 3 -weight 2
        pack $details -fill x -expand 0

        set ($this,scriptLabel) [label $panner::($panes,frame2).scriptLabel -font $font::(mediumBold) -text Script: -state disabled]
        pack $($this,scriptLabel) -anchor nw
        set ($this,script) [new scroll text $panner::($panes,frame2) -height 50]
        pack $widget::($($this,script),path) -fill both -expand 1
        set ($this,scriptText) $composite::($($this,script),scrolled,path)
        $($this,scriptText) configure -state disabled

        set ($this,testLabel) [label $panner::($panes,frame3).testLabel\
            -font $font::(mediumBold) -text {Test trace:} -state disabled\
        ]
        pack $($this,testLabel) -anchor nw
        set ($this,test) [new scroll text $panner::($panes,frame3) -height 50]
        pack $widget::($($this,test),path) -fill both -expand 1
        set ($this,testText) $composite::($($this,test),scrolled,path)
        $($this,testText) configure -state disabled

        pack [frame $frame.separator3 -relief sunken -borderwidth 1 -height 2] -pady 2 -fill x

        set buttons [frame $frame.buttons]
        set ($this,testButton) [button $buttons.test -text Test -command "thresholds::test $this" -state disabled]
        place $($this,testButton) -anchor n -relx 0.3
        set ($this,deleteButton) [button $buttons.delete -text Delete -command "thresholds::delete $this" -state disabled]
        place $($this,deleteButton) -anchor n -relx 0.7
        $buttons configure -height [winfo reqheight $($this,testButton)]
        pack $buttons -fill x -expand 0

        set ($this,selector) [new objectSelector -selectcommand "thresholds::setRowsState $this"]
        set script [bind $($this,tablePath) <ButtonPress-1>]
        bind $($this,tablePath) <ButtonPress-1> "if {\[thresholds::select $this \[%W index @0,%y row\]\]} {$script}"
        dialogBox::display $dialog $frame

        set ($this,dialog) $dialog
        foreach threshold [lsort -command threshold::comparison -decreasing $thresholds] {
            display $this $threshold
        }
        adjustTableColumns $($this,tablePath)
        drawTableLimits $this
    }

}

    proc monitorCell {this array row column} {
        variable thresholds

        viewer::registerTrace $this $array
        set cell ${array}($row,$column)
        set length [llength $switched::($this,-configurations)]
        if {$length>0} {
            set threshold\
                [eval new threshold $cell [lindex $switched::($this,-configurations) $($this,initializeIndex)]]
            if {[incr ($this,initializeIndex)]==$length} {
                switched::configure $this -configurations {}
                unset ($this,initializeIndex)
            }
        } else {
            set threshold [new threshold $cell]
            switched::configure $threshold\
                -label [viewer::label $threshold::($threshold,array) $threshold::($threshold,row) $threshold::($threshold,column)]
        }
        lappend thresholds $threshold
        if {[info exists ($this,dialog)]} {
            set (held,$threshold) {}
            display $this $threshold
        }
    }

if {$global::withGUI} {

    proc display {this threshold} {
        variable data
        variable number

        set path $($this,tablePath)
        set row [expr {[$path cget -rows]-1}]
        $path configure -rows [expr {$row+2}]
        set background [$path cget -background]
        set font [$path cget -font]

        set data($row,$number(threshold)) $threshold
        $path spans $row,$number(active) 0,$(hiddenColumns)

        set data($row,$number(active)) [switched::cget $threshold -active]
        set button $path.$threshold,active
        checkbutton $button\
            -activebackground $background -highlightthickness 0 -variable thresholds::data($row,$number(active)) -takefocus 0
        bind $button <ButtonRelease-1> "thresholds::select $this \[thresholds::row $this $threshold\]"
        $path window configure $row,$number(active)\
            -window $button -padx 1 -pady 2 -relief sunken -borderwidth {1 0 1 0} -sticky nsew

        set data($row,$number(type)) [switched::cget $threshold -type]
        set label $path.$threshold,type
        label $label -image [threshold::typeImage $data($row,$number(type))]
        bind $label <ButtonRelease-1> "
            thresholds::circleType $this $number(type) $label $threshold
            thresholds::select $this \[thresholds::row $this $threshold\]
        "
        $path window configure $row,$number(type) -window $label -relief sunken -pady 2 -borderwidth {1 0 1 0}

        set data($row,$number(level)) [switched::cget $threshold -level]
        set menu [new optionMenu $path -font $font::(tinyNormal) -choices $(levels) -text [switched::cget $threshold -level]]
        composite::configure $menu base -highlightthickness 0
        $path window configure $row,$number(level)\
            -window $widget::($menu,path) -padx 1 -pady 2 -relief sunken -borderwidth {1 0 1 0} -sticky nsew
        lappend ($this,objects) $menu

        set data($row,$number(color)) [switched::cget $threshold -color]
        set button [createColorsMenuButton $this $path $threshold]
        bind $button <ButtonPress-1> "+ thresholds::select $this \[thresholds::row $this $threshold\]"
        $path window configure $row,$number(color)\
            -window $button -padx 1 -pady 2 -relief sunken -borderwidth {1 0 1 0} -sticky nsew
        composite::configure $menu -command "thresholds::updateLevel $this $threshold $button"

        set data($row,$number(value)) [switched::cget $threshold -value]
        set data($row,$number(source)) [switched::cget $threshold -label]
        $path height $row [linesCount $data($row,$number(source))]
        set data($row,$number(addresses)) [switched::cget $threshold -addresses]
        set data($row,$number(script)) [switched::cget $threshold -script]
        set data($row,$number(label))\
            [viewer::label $threshold::($threshold,array) $threshold::($threshold,row) $threshold::($threshold,column)]
        set data($row,$number(emailShot)) [switched::cget $threshold -emailshot]
        ::update idletasks
        adjustTableColumns $path
        ::update idletasks
        drawTableLimits $this
    }

}

    proc update {this array args} {
        variable thresholds

        if {[info exists ($this,dialog)]} {
            if {[info exists ($this,selected)]} {
                updateCurrentValue $this $($this,selected)
            }
        } else {
            foreach threshold $thresholds {
                threshold::check $threshold $array
            }
        }
    }

    proc updateCurrentValue {this row} {
        variable data
        variable number

        set threshold $data($row,$number(threshold))
        set value ?
        catch {set value [set $threshold::($threshold,cell)]}
        $($this,current) configure -text $value
    }

if {$global::withGUI} {

    proc createDialog {this} {
        variable geometry

        set dialog [new dialogBox .\
            -buttons hoc -default o -title [mc {moodss: Thresholds}] -die 0 -grab release -enterreturn 0\
            -x [winfo pointerx .] -y [winfo pointery .] -helpcommand {generalHelpWindow #menus.edit.thresholds}\
            -command "thresholds::done $this 0" -deletecommand "thresholds::done $this 1"\
        ]
        set ($this,helpTip) [linkedHelpWidgetTip $composite::($dialog,help,path)]
        if {[info exists geometry]} {
            wm geometry $widget::($dialog,path) $geometry
        }
        bind $widget::($dialog,path) <Configure> "set thresholds::geometry \[wm geometry $widget::($dialog,path)\]"
        return $dialog
    }

    proc createTable {this parentPath} {
        variable data
        variable help
        variable number

        set scroll [new scroll table $parentPath -height 110]
        set ($this,scrolledTable) $scroll
        set path $composite::($scroll,scrolled,path)
        $path configure -variable thresholds::data -font $font::(mediumNormal) -colstretchmode last -cursor {} -bordercursor {}\
            -highlightthickness 1 -titlerows 1 -roworigin -1 -rows 1 -sparsearray 0 -exportselection 0
        set column 0
        foreach title {active threshold addresses script label emailShot type level color value source} {
            set data(-1,$column) $title
            set number($title) $column
            incr column
        }
        $path configure -cols [llength [array names data -1,*]]
        foreach {cell title} [array get data -1,*] {
            if {![info exists help($title)]} continue
            set label [label $path.$cell -font $font::(mediumBold) -text $title]
            $path window configure $cell -window $label -padx 1 -pady 1 -sticky nsew
            lappend ($this,objects) [new widgetTip -path $label -text $help($title)]
        }
        set (hiddenColumns) [expr {$number(type)-$number(active)-1}]
        $path spans -1,$number(active) 0,$(hiddenColumns)
        configureWritableTable $path "thresholds::selectionFromTab $this"
        $path tag configure active -background {} -foreground black -relief sunken

        $path configure -borderwidth {1 0 1 0}
        $path tag configure sel -background {} -foreground black -borderwidth {1 0 2 1}
        $path tag configure lastselectedcell -borderwidth {1 1 2 1}
        $path tag raise lastselectedcell sel
        $path tag configure lastcell -borderwidth 1
        $path tag configure lastcolumn -borderwidth {1 1 1 0}
        $path tag configure lastrow -borderwidth {1 0 1 1}
        $path tag col lastcolumn $number(source)
        set ($this,drop) [new dropSite -path $path -formats DATACELLS -command "viewer::view $this \$dragSite::data(DATACELLS)"]
        set ($this,tablePath) $path
        drawTableLimits $this
        return $widget::($scroll,path)
    }

    proc done {this destroy} {
        variable data
        variable thresholds
        variable deleted
        variable number

        if {$destroy} {
            eval ::delete $($this,helpTip) $($this,selector) $($this,objects) $($this,emails) $($this,script) $($this,test)\
                $($this,panes) $($this,scrolledTable) $($this,drop)
            unset ($this,dialog) ($this,tablePath) ($this,helpTip) ($this,selector) ($this,objects) ($this,emails) ($this,cell)\
                 ($this,current) ($this,script) ($this,scriptText) ($this,test) ($this,testText) ($this,panes)\
                 ($this,scrolledTable) ($this,drop)

            catch {unset ($this,selected)}
            unset data
            foreach threshold $thresholds {
                if {[info exists (held,$threshold)]} {
                    ldelete thresholds $threshold
                    ::delete $threshold
                }
            }
            if {[info exists deleted]} {
                foreach threshold $deleted {
                    if {[info exists (held,$threshold)]} continue
                    lappend thresholds $threshold
                }
                unset deleted
            }
            array unset {} held,*
            set thresholds [lsort -command threshold::comparison $thresholds]
        } else {
            if {[info exists ($this,selected)]} {
                set row $($this,selected)
                set data($row,$number(addresses)) [composite::cget $($this,emails) -list]
                if {![checkEmails $this $row]} return
            }
            foreach {name threshold} [array get data "\[0-9\]*,$number(threshold)"] {
                scan $name %u row
                if {[info exists ($this,selected)]&&($row==$($this,selected))} {
                    set data($row,$number(addresses)) [composite::cget $($this,emails) -list]
                    set data($row,$number(script)) [string trim [$($this,scriptText) get 1.0 end]]
                    set data($row,$number(emailShot)) $($this,emailShot)
                }
                switched::configure $threshold -active $data($row,$number(active)) -type $data($row,$number(type))\
                    -color $data($row,$number(color)) -level $data($row,$number(level)) -value $data($row,$number(value))\
                    -label $data($row,$number(source)) -addresses $data($row,$number(addresses))\
                    -script $data($row,$number(script)) -emailshot $data($row,$number(emailShot))
            }
            if {[info exists deleted]} {
                foreach threshold $deleted {
                    viewer::unregisterTrace $this $threshold::($threshold,array)
                    ::delete $threshold
                }
                unset deleted
            }
            array unset {} held,*
            ::delete $($this,dialog)
        }
    }

}

    proc cells {this} {
        variable thresholds

        set cells {}
        foreach threshold $thresholds {
            lappend cells $threshold::($threshold,cell)
        }
        return $cells
    }

    proc initializationConfiguration {this} {
        variable thresholds

        set arguments {}
        foreach threshold $thresholds {
            set list {}
            foreach configuration [switched::configure $threshold] {
                foreach {option default value} $configuration {}
                lappend list $option $value
            }
            lappend arguments $list
        }
        return [list -configurations $arguments]
    }

if {$global::withGUI} {

    proc test {this} {
        variable data
        variable number

        set row $($this,selected)
        set threshold $data($row,$number(threshold))
        catch {$($this,tablePath) activate active}
        set script [string trim [$($this,scriptText) get 1.0 end]]
        set emails [composite::cget $($this,emails) -list]
        set temporary [new threshold $threshold::($threshold,cell)\
            -active $data($row,$number(active)) -type $data($row,$number(type)) -color $data($row,$number(color))\
            -level $data($row,$number(level)) -value $data($row,$number(value)) -label $data($row,$number(source))\
            -addresses $emails -script $script -emailshot $($this,emailShot)\
        ]
        $($this,testText) configure -state normal
        $($this,testText) insert end [threshold::test $temporary]\n
        $($this,testText) see end
        $($this,testText) configure -state disabled
        ::delete $temporary
    }

    proc delete {this} {
        variable thresholds
        variable deleted
        variable data
        variable number

        set path $($this,tablePath)
        set row $($this,selected)
        deselect $this $row
        set threshold $data($row,$number(threshold))
        $path delete rows $row
        ldelete thresholds $threshold
        lappend deleted $threshold
        array unset data [llength $thresholds],\[0-9\]*
        $path activate -1,0
        drawTableLimits $this
    }

    proc setRowsState {this rows select} {
        drawTableLimits $this
        set path $($this,tablePath)
        set right [expr {[$path cget -cols]-1}]
        if {$select} {
            foreach row $rows {
                $path selection set $row,0 $row,$right
                embeddedWindowsBorder $this $row {1 0 2 1}
                $path tag row sel $row
                $path tag cell lastselectedcell $row,$right
            }
        } else {
            foreach row $rows {
                $path selection clear $row,0 $row,$right
                embeddedWindowsBorder $this $row {1 0 1 0}
                $path tag row {} $row
                $path tag cell {} $row,$right
            }
        }
    }

    proc circleType {this column label threshold} {
        variable data

        set row [row $this $threshold]
        $label configure -image [threshold::typeImage [set data($row,$column) [threshold::nextType $data($row,$column)]]]
    }

    proc row {this threshold} {
        variable data
        variable number

        foreach {name value} [array get data "\[0-9\]*,$number(threshold)"] {
            if {$value==$threshold} {
                scan $name %u row
                return $row
            }
        }
        error "row not found for threshold $threshold"
    }

    proc select {this row} {
        variable data
        variable number

        if {$row<0} {
            return 1
        }
        set noChange 0
        if {[info exists ($this,selected)]} {
            set selected $($this,selected)
            set data($selected,$number(addresses)) [composite::cget $($this,emails) -list]
            set data($selected,$number(script)) [string trim [$($this,scriptText) get 1.0 end]]
            set data($selected,$number(emailShot)) $($this,emailShot)
            set noChange [expr {$row==$selected}]
        }
        if {$noChange} {
            return 1
        }
        if {[info exists selected]&&![checkEmails $this $selected]} {
            return 0
        }
        set ($this,selected) $row
        selector::select $($this,selector) $row
        $($this,testButton) configure -state normal
        $($this,deleteButton) configure -state normal
        if {!$global::noMail} {
            $($this,emailsLabel) configure -state normal
            composite::configure $($this,emails) -state normal
            $($this,shot) configure -state normal
        }
        composite::configure $($this,emails) -list $data($row,$number(addresses))
        $($this,cellLabel) configure -state normal
        $($this,cell) configure -text $data($row,$number(label))
        $($this,currentLabel) configure -state normal
        $($this,scriptLabel) configure -state normal
        $($this,scriptText) configure -state normal
        $($this,scriptText) delete 1.0 end
        $($this,scriptText) insert 1.0 $data($row,$number(script))
        $($this,testLabel) configure -state normal
        $($this,testText) configure -state normal
        $($this,testText) delete 1.0 end
        $($this,testText) configure -state disabled
        set ($this,emailShot) $data($row,$number(emailShot))
        updateCurrentValue $this $row
        return 1
    }

    proc deselect {this row} {
        if {$row<0} return
        unset ($this,selected)
        selector::deselect $($this,selector) $row
        composite::configure $($this,emails) -list {} -state disabled
        $($this,cellLabel) configure -state disabled
        $($this,currentLabel) configure -state disabled
        $($this,emailsLabel) configure -state disabled
        $($this,scriptLabel) configure -state disabled
        $($this,scriptText) configure -state disabled
        $($this,testLabel) configure -state disabled
        $($this,testButton) configure -state disabled
        $($this,deleteButton) configure -state disabled
        $($this,cell) configure -text {}
        $($this,current) configure -text {}
        set ($this,emailShot) 0
        $($this,shot) configure -state disabled
    }

    proc chooseColor {this button row value} {
        variable data
        variable number

        switch $value {
            {} {
                set color $data($row,$number(color))
                if {[string length $color]==0} {
                    set color $(default,button,background)
                }
                set color [tk_chooseColor -initialcolor $color -title {Choose color:} -parent $widget::($($this,dialog),path)]
                if {[string length $color]==0} return
                $button configure -text {} -background $color -activebackground $color
            }
            ? {
                $button configure -text ? -background $(default,button,background) -activebackground $(default,button,background)
                set color {}
            }
            default {
                $button configure -text {} -background $value -activebackground $value
                set color $value
            }
        }
        set data($row,$number(color)) $color
    }

    proc createColorsMenuButton {this parentPath threshold} {
        variable data
        variable number

        set button $parentPath.$threshold,color
        set row [row $this $threshold]
        set initialColor $data($row,$number(color))
        menubutton $button -relief raised -borderwidth 0 -highlightthickness 0 -indicatoron 1 -font $font::(smallNormal)
        if {[string length $initialColor]==0} {
            $button configure -text ? -background $(default,button,background) -activebackground $(default,button,background)
        } else {
            $button configure -text {} -background $initialColor -activebackground $initialColor
        }
        set menu [menu $button.menu -tearoff 0]
        set rows 0
        set index 0
        foreach color $(colors) {
            switch $color {
                {} {
                    $menu add command -label ...
                }
                ? {
                    $menu add command -label { ?}
                }
                default {
                    $menu add command -label {   } -background $color -activebackground $color
                }
            }
            $menu entryconfigure $index -hidemargin 1 -command [list thresholds::chooseColor $this $button $row $color]
            if {$rows>=3} {
                $menu entryconfigure $index -columnbreak 1
                set rows 0
            }
            incr rows
            incr index
        }
        $menu configure -postcommand "thresholds::updateMenu $this $menu $threshold"
        $button configure -menu $menu
        return $button
    }

    proc updateMenu {this menu threshold} {
        variable data
        variable number

        set color $data([row $this $threshold],$number(color))
        if {[string length $color]==0} {
            set color $(default,button,background)
        }
        $menu entryconfigure end -background $color -activebackground $color
    }

    proc updateLevel {this threshold colorsMenu value} {
        variable data
        variable number
        variable levelColor

        set row [row $this $threshold]
        if {[string equal $levelColor($data($row,$number(level))) $data($row,$number(color))]} {
            chooseColor $this $colorsMenu $row $levelColor($value)
        }
        set data($row,$number(level)) $value
    }

}

    proc setCellColor {this array row column color} {}

    proc cellColor {array row column} {
        variable thresholds

        set color {}
        foreach threshold $thresholds {
            if {\
                [info exists threshold::($threshold,cellColor)]&&[switched::cget $threshold -active]&&\
                [string equal $threshold::($threshold,array) $array]&&\
                [string equal $threshold::($threshold,row) $row]&&[string equal $threshold::($threshold,column) $column]\
            } {
                set color $threshold::($threshold,cellColor)
            }
        }
        return $color
    }

if {$global::withGUI} {

    proc selectionFromTab {this row column} {
        select $this $row
    }

    proc drawTableLimits {this} {
        variable number

        set path $($this,tablePath)
        set previous [$path tag row lastrow]
        if {[llength $previous]>0} {
            $path tag row {} $previous
            embeddedWindowsBorder $this $previous {1 0 1 0}
        }
        catch {$path tag cell {} [$path tag cell lastcell]}
        set row [$path index end row]
        if {$row<0} {
            $path configure -borderwidth {1 0 1 1}
            $path window configure -1,$number(source) -borderwidth 1
        } else {
            $path configure -borderwidth {1 0 1 0}
            $path window configure -1,$number(source) -borderwidth {1 1 1 0}
            $path tag row lastrow $row
            $path tag cell lastcell [$path index end]
            embeddedWindowsBorder $this $row {1 0 1 1}
        }
    }

    proc embeddedWindowsBorder {this row widths} {
        variable number

        set path $($this,tablePath)
        $path window configure $row,$number(active) -borderwidth $widths
        $path window configure $row,$number(type) -borderwidth $widths
        $path window configure $row,$number(color) -borderwidth $widths
        $path window configure $row,$number(level) -borderwidth $widths
    }

    proc reset {this} {
        variable thresholds

        if {[info exists ($this,dialog)]} {
            ::delete $($this,dialog)
        }
        foreach threshold $thresholds {
            viewer::unregisterTrace $this $threshold::($threshold,array)
            ::delete $threshold
        }
        set thresholds {}
    }

}

    proc checkEmails {this row} {
        variable data
        variable number

        set errors {}
        foreach email $data($row,$number(addresses)) {
            set message [emailAddressError $email]
            if {[string length $message]==0} continue
            append errors "$email: $message\n"
        }
        if {[string length $errors]>0} {
            tk_messageBox -parent $widget::($($this,dialog),path) -title {moodss: Email error} -type ok -icon error -message $errors
            return 0
        } else {
            return 1
        }
    }

    proc activeEmails {this} {
        variable thresholds

        set number 0
        foreach threshold $thresholds {
            if {![switched::cget $threshold -active]} continue
            incr number [llength [switched::cget $threshold -addresses]]
        }
        return $number
    }


}

set ::thresholds::singleton [new thresholds]


class thresholds {

    class threshold {

if {$global::withGUI} {

        set (image,differ) [image create photo -data\
            R0lGODlhFAAKAKEAAPgA+AAAAHh8ePgAACH5BAEAAAAALAAAAAAUAAoAAAIjhBGnqW18mHANQkTV2E3YAIbbEJYhNXZXFS0Z5gJTtj7vnRUAOw==\
        ]
        set (image,down) [image create photo -data\
            R0lGODlhFAAKAPEAAP8A/wAAAPgAAHh8eCH5BAEAAAAALAAAAAAUAAoAAAIdhB2ny9i/EpyiwoAzrkL7x02TJIlKMJSmkaqmthQAOw==\
        ]
        set (image,equal) [image create photo -data\
            R0lGODlhFAAKAKEAAPgA+Hh8eAAAAPgAACH5BAEAAAAALAAAAAAUAAoAAAIdhI+pq8F/BDSjoiCN2HzX0YXMd2VTYp6Ho7auUQAAOw==\
        ]
        set (image,unknown) [image create photo -data\
            R0lGODlhFAAKAKEAAPgA+Hh8eAAAAPgAACH5BAEAAAAALAAAAAAUAAoAAAIghB+iG+euHojyUCiqtnm7pDTPQJalYqbb5bWuwb5TVxUAOw==\
        ]
        set (image,up) [image create photo -data\
            R0lGODlhFAAKAPEAAP8A/wAAAHh8ePgAACH5BAEAAAAALAAAAAAUAAoAAAIehI8QG+ku1psmRPqawmd4yoSBN4jhRHKJpiJsW8EFADs=\
        ]

}

        set (mailMessage) \
{"%s" data value is now "%v",
which triggered the "%T" threshold of "%t".}
        set (logMessage) {"%s" = "%v" (triggered "%T" threshold "%t")}
        set (types) {differ down equal unknown up}

        proc threshold {this cell args} switched {$args} {
            set ($this,cell) $cell
            viewer::parse $cell ($this,array) ($this,row) ($this,column) ($this,cellType)
            set ($this,numeric) [viewer::numericType $($this,cellType)]
            set ($this,active) 0
            switched::complete $this
        }

        proc ~threshold {this} {
            if {$($this,active)&&$($this,colored)} {
                changeAllCellsColor $($this,array) $($this,row) $($this,column) {}
            }
        }

        proc options {this} {
            return [list\
                [list -active 0 0]\
                [list -addresses {} {}]\
                [list -color white]\
                [list -emailshot 0 0]\
                [list -label {} {}]\
                [list -level info info]\
                [list -script {} {}]\
                [list -type up up]\
                [list -value {} {}]\
            ]
        }

        proc set-active {this value} {
            if {$value} {
                check $this $($this,array)
            } elseif {$($this,active)} {
                if {$($this,colored)} {
                    changeAllCellsColor $($this,array) $($this,row) $($this,column) {}
                    set ($this,cellColor) {}
                }
                set ($this,active) 0
            }
        }

        proc set-addresses {this value} {}

        proc set-color {this value} {
            set ($this,colored) [string length $value]
            if {$($this,active)} {
                changeAllCellsColor $($this,array) $($this,row) $($this,column) $value
                set ($this,cellColor) $value
            }
        }

        proc set-emailshot {this value} {}

        proc set-label {this value} {}

        proc set-level {this value} {
            if {[lsearch -exact $thresholds::(levels) $value]<0} {
                error {invalid level value}
            }
        }

        proc set-script {this value} {}

        proc set-type {this value} {
            check $this $($this,array)
        }

        proc set-value {this value} {
            check $this $($this,array)
        }

        proc nextType {type} {
            set index [lsearch -exact $(types) $type]
            if {[incr index]>=[llength $(types)]} {
                set index 0
            }
            return [lindex $(types) $index]
        }

        proc typeImage {type} {
            return $(image,$type)
        }

        proc check {this array} {
            if {!$switched::($this,-active)} return
            if {![string equal $array $($this,array)]} return
            set threshold [string trim $switched::($this,-value)]
            catch {set value [set $($this,cell)]}
            set condition 0
            if {![info exists value]||([string equal $value ?]&&$($this,numeric))} {
                if {[string equal $switched::($this,-type) unknown]} {
                    act $this {} ?
                    set condition 1
                }
            } else {
                if {![string equal $switched::($this,-type) unknown]&&[compare $this $threshold $value]} {
                    act $this $threshold $value
                    set condition 1
                }
            }
            if {$($this,colored)&&($condition!=$($this,active))} {
                if {$condition} {
                    changeAllCellsColor $($this,array) $($this,row) $($this,column) $switched::($this,-color)
                    set ($this,cellColor) $switched::($this,-color)
                } else {
                    changeAllCellsColor $($this,array) $($this,row) $($this,column) {}
                    set ($this,cellColor) {}
                }
            }
            set ($this,active) $condition
        }

if {$global::withGUI} {

        proc test {this} {
            if {[string equal $switched::($this,-type) unknown]} {
                act $this {} ?
                return $($this,output)
            }
            set threshold [string trim $switched::($this,-value)]
            if {[string length $threshold]==0} {
                switch $($this,cellType) {
                    clock {set threshold [clock format [clock seconds]]}
                    integer {set threshold 10}
                    real {set threshold 10.0}
                }
            }
            if {[string equal $switched::($this,-type) equal]} {
                act $this $threshold $threshold
                return $($this,output)
            }
            switch $($this,cellType) {
                ascii - dictionary {
                    switch $switched::($this,-type) {
                        down {act $this $threshold {}}
                        differ - up {act $this $threshold ${threshold}~}
                    }
                }
                clock {
                    switch $switched::($this,-type) {
                        down {act $this $threshold [clock format [expr {[clock scan $threshold]-1}]]}
                        differ - up {act $this $threshold [clock format [expr {[clock scan $threshold]+1}]]}
                    }
                }
                integer - real {
                    switch $switched::($this,-type) {
                        down {act $this $threshold [expr {$threshold-1}]}
                        differ - up {act $this $threshold [expr {$threshold+1}]}
                    }
                }
            }
            return $($this,output)
        }

}

        proc replacePercents {this threshold value text} {
            regsub -all %% $text \001 text
            set label [viewer::label $($this,array) $($this,row) $($this,column)]
            regsub -all %c $text $label text
            regsub -all %s $text $switched::($this,-label) text
            regsub -all %t $text $threshold text
            regsub -all %T $text $switched::($this,-type) text
            regsub -all %v $text $value text
            regsub -all \001 $text % text
            return $text
        }

        proc compare {this threshold value} {
            return [compare-$($this,cellType) $switched::($this,-type) $threshold $value]
        }

        proc compare-ascii {type threshold value} {
            switch $type {
                differ {return [string compare -nocase $value $threshold]}
                down {return [expr {[string compare -nocase $value $threshold]<0}]}
                equal {return [string equal -nocase $value $threshold]}
                up {return [expr {[string compare -nocase $value $threshold]>0}]}
            }
        }

        proc compare-clock {type threshold value} {
            if {[string length $threshold]==0} {
                return 0
            }
            switch $type {
                differ {return [expr {[compareClocks $value $threshold]!=0}]}
                down {return [expr {[compareClocks $value $threshold]<0}]}
                equal {return [expr {[compareClocks $value $threshold]==0}]}
                up {return [expr {[compareClocks $value $threshold]>0}]}
            }
        }

        proc compare-dictionary {type threshold value} {
            switch $type {
                differ {return [string compare $value $threshold]}
                down {return [lindex [lindex [lsort -dictionary -index 0 [list [list $value 0] [list $threshold 1]]] 1] 1]}
                equal {return [string equal $value $threshold]}
                up {return [lindex [lindex [lsort -dictionary -index 0 [list [list $value 0] [list $threshold 1]]] 0] 1]}
            }
        }

        proc compareNumbers {type threshold value} {
            if {[string length $threshold]==0} {
                return 0
            }
            switch $type {
                differ {return [expr {$value!=$threshold}]}
                down {return [expr {$value<$threshold}]}
                equal {return [expr {$value==$threshold}]}
                up {return [expr {$value>$threshold}]}
            }
        }

        proc compare-integer {type threshold value} {
            return [compareNumbers $type $threshold $value]
        }

        proc compare-real {type threshold value} {
            return [compareNumbers $type $threshold $value]
        }

        proc act {this threshold value} {
            set ($this,output) {}
            if {[string length $switched::($this,-script)]>0} {
                set script [replacePercents $this $threshold $value $switched::($this,-script)]
                if {[catch {exec 2>@ stdout sh -c $script} ($this,output)]} {
                    modules::trace thresholds thresholds "$switched::($this,-label): $($this,output)"
                }
            }
            if {!$global::withGUI} {
                writeLog\
                    "($switched::($this,-level)) [replacePercents $this $threshold $value $(logMessage)]" $switched::($this,-level)
            }
            if {!$global::noMail&&[llength $switched::($this,-addresses)]>0} {
                if {$switched::($this,-emailshot)&&$global::withGUI} {
                    set shot [print::createTemporaryCanvasShot]
                    set token [mime::initialize -canonical multipart/mixed -parts [list\
                            [mime::initialize\
                                -canonical text/plain -string [replacePercents $this $threshold $value $(mailMessage)]\
                            ]\
                            [mime::initialize -canonical image/gif -file $shot]\
                        ]\
                    ]
                } else {
                    set token\
                        [mime::initialize -canonical text/plain -string [replacePercents $this $threshold $value $(mailMessage)]]
                }
                lappend headers -servers [list $global::smtpServers]
                lappend headers -header [list From $global::fromAddress]
                foreach address $switched::($this,-addresses) {
                    lappend headers -header [list To $address]
                }
                lappend headers -header [list Subject "$global::applicationName threshold $switched::($this,-level) message"]
                if {[catch {eval smtp::sendmessage $token $headers} error]} {
                    set message "SMTP error: $error"
                    if {[string length $($this,output)]>0} {
                        append ($this,output) \n
                    }
                    append ($this,output) $message
                    if {$global::withGUI} {
                        modules::trace thresholds thresholds $message
                    } else {
                        writeLog $message error
                    }
                } else {
                    foreach list $error {
                        foreach {address code message} $list {
                            set message "$switched::($this,-label): on \"$address\", SMTP $code error: $message"
                            if {[string length $($this,output)]>0} {
                                append ($this,output) \n
                            }
                            append ($this,output) $message
                            if {$global::withGUI} {
                                modules::trace thresholds thresholds $message
                            } else {
                                writeLog $message error
                            }
                        }
                    }
                }
                mime::finalize $token -subordinates all
                if {[info exists shot]} {
                    file delete $shot
                }
            }
        }

        proc comparison {threshold1 threshold2} {
            variable level

            if {![info exists level]} {
                set index 0
                foreach name $thresholds::(levels) {
                    set level($name) $index
                    incr index
                }
                unset name index
            }
            set level1 $level($switched::($threshold1,-level))
            set level2 $level($switched::($threshold2,-level))
            if {$level1==$level2} {
                if {\
                    [string equal $($threshold1,cell) $($threshold2,cell)]&&\
                    [string equal $switched::($threshold1,-type) $switched::($threshold2,-type)]\
                } {
                    set value1 [string trim $switched::($threshold1,-value)]
                    set value2 [string trim $switched::($threshold2,-value)]
                    if {[compare $threshold1 $value2 $value1]} {
                        return 1
                    } elseif {[compare $threshold1 $value1 $value2]} {
                        return -1
                    }
                }
                return 0
            } elseif {$level1<$level2} {
                return -1
            } else {
                return 1
            }
        }

    }

}

set rcsId {$Id: gui.tcl,v 2.38 2002/01/13 22:14:03 jfontain Exp $}


proc updateTitle {} {
    set names [modules::names]
    if {[llength $names]==0} {
        wm title . moodss
        wm iconname . moodss
        return
    }
    if {[llength $global::pollTimes]==0} {
        wm title . [format [mc {moodss: %s data (asynchronous)}] [commaSeparatedString $names]]
    } else {
        wm title . [format [mc {moodss: %s data (every %u seconds)}] [commaSeparatedString $names] $global::pollTime]
    }
    wm iconname . "moodss $names"
}

proc underlineRemoved {string indexName} {
    upvar $indexName index

    set indices 0
    regexp -indices _ $string indices
    set index [expr {[lindex $indices 0]-1}]
    regsub _ $string {} string
    return $string
}

proc createMenuWidget {parentPath readOnly includePollTime} {
    set menu [menu $parentPath.menu -tearoff 0]
    set global::menu $menu
    frame $menu.bound
    set help(bar) [new menuContextHelp $menu]
    lappend objects $help(bar)
    set index(bar) -1

    menu $menu.file -tearoff 0
    set global::fileMenuContextHelper [new menuContextHelp $menu.file]
    lappend objects $global::fileMenuContextHelper
    set index(file) -1

    set string [underlineRemoved [mc F_ile] underline]
    $menu add cascade -label $string -menu $menu.file -underline $underline
    menuContextHelp::set $help(bar) [incr index(bar)] [mc {file related operations}]

    set string [underlineRemoved [mc O_pen] underline]
    $menu.file add command -label $string... -command reload -underline $underline -accelerator Ctrl+O
    bind $parentPath <Control-o> reload
    menuContextHelp::set $global::fileMenuContextHelper [incr index(file)] [mc {load and replace modules from a file}]

    if {!$readOnly} {
        set string [underlineRemoved [mc S_ave] underline]
        $menu.file add command -label $string -command {save 0} -underline $underline -accelerator Ctrl+S
        bind $parentPath <Control-s> {save 0}
        set global::fileMenuContextHelperSaveIndex [incr index(file)]
        updateFileSaveMenuHelp $global::saveFile

        set string [underlineRemoved [mc {Save A_s}] underline]
        $menu.file add command -label $string... -command {save 1} -underline $underline -accelerator Ctrl+A
        bind $parentPath <Control-a> {save 1}
        menuContextHelp::set $global::fileMenuContextHelper [incr index(file)]\
            [mc {input file for saving configuration and viewers layout}]
    }

    set string [underlineRemoved [mc M_odules] underline]
    $menu.file add cascade -label $string -menu [menu $menu.file.modules -tearoff 0] -underline $underline
    menuContextHelp::set $global::fileMenuContextHelper [incr index(file)] [mc {operations on modules}]

    set moduleNames [modules::names]

    set help(modules) [new menuContextHelp $menu.file.modules]
    lappend objects $help(modules)
    set index(modules) -1
    set disable 1
    if {$readOnly} {
        if {[llength $moduleNames]>0} {
            set disable 0
            set string [underlineRemoved [mc Load_ed] underline]
            $menu.file.modules add command -label $string... -command {new moduleOperations display} -underline $underline
            menuContextHelp::set $help(modules) [incr index(modules)] [mc {view loaded modules and their options}]
        }
    } else {
        set disable 0
        set string [underlineRemoved [mc L_oad] underline]
        $menu.file.modules add command -label $string... -command {new moduleOperations load} -underline $underline
        menuContextHelp::set $help(modules) [incr index(modules)] [mc {load new module instances}]
        if {[llength $moduleNames]>0} {
            set string [underlineRemoved [mc M_anage] underline]
            $menu.file.modules add command -label $string... -command {new moduleOperations manage} -underline $underline
            menuContextHelp::set $help(modules) [incr index(modules)] [mc {display module instances and eventually unload}]
        }
    }
    if {$disable} {
        $menu.file entryconfigure $index(file) -state disabled
    }

    set string [underlineRemoved [mc P_rint] underline]
    $menu.file add command -label $string... -command print::printOrSaveCanvas -underline $underline -accelerator Ctrl+P
    bind $parentPath <Control-p> print::printOrSaveCanvas
    menuContextHelp::set $global::fileMenuContextHelper [incr index(file)] [mc {print or save canvas area to file in postscript}]
    if {![string equal $::tcl_platform(platform) unix]} {
        $menu.file entryconfigure $index(file) -state disabled
    }
    $menu.file add separator
    incr index(file)
    set string [underlineRemoved [mc E_xit] underline]
    $menu.file add command -label $string -command exit -underline $underline -accelerator Ctrl+Q
    menuContextHelp::set $global::fileMenuContextHelper [incr index(file)] [mc {close main window and exit program}]
    bind $parentPath <Control-q> exit

    if {!$readOnly} {
        set string [underlineRemoved [mc E_dit] underline]
        $menu add cascade -label $string -menu [menu $menu.edit -tearoff 0] -underline $underline
        set help(edit) [new menuContextHelp $menu.edit]
        lappend objects $help(edit)
        menuContextHelp::set $help(bar) [incr index(bar)] [mc {content editing, configuration and preferences}]

        set string [underlineRemoved [mc T_hresholds] underline]
        $menu.edit add command -label $string... -command {thresholds::edit} -underline $underline
        menuContextHelp::set $help(edit) 0 [mc {edit data thresholds}]

        set string [underlineRemoved [mc C_onfiguration] underline]
        $menu.edit add command -label $string... -command {configuration::edit 0} -underline $underline
        menuContextHelp::set $help(edit) 1 [mc {edit current configuration}]

        set string [underlineRemoved [mc N_ew] underline]
        $menu.edit add cascade -label $string -menu [menu $menu.edit.new -tearoff 0] -underline $underline
        set help(new) [new menuContextHelp $menu.edit.new]
        lappend objects $help(new)
        menuContextHelp::set $help(edit) 2 [mc {create empty data viewers}]

        set string [underlineRemoved [mc {G_raph Chart}] underline]
        $menu.edit.new add command -label $string... -underline $underline\
            -command "createCellsViewer dataGraph {} 1 $global::static \$global::pollTime"
        menuContextHelp::set $help(new) 0 [mc {create an empty graph chart data viewer}]

        set string [underlineRemoved [mc {Stacked Graph C_hart}] underline]
        $menu.edit.new add command -label $string... -underline $underline\
            -command "createCellsViewer dataStackedGraph {} 1 $global::static \$global::pollTime"
        menuContextHelp::set $help(new) 1 [mc {create an empty stacked graph chart data viewer}]

        set string [underlineRemoved [mc {O_verlap Bar Chart}] underline]
        $menu.edit.new add command -label $string... -underline $underline\
            -command "createCellsViewer dataOverlapBarChart {} 1 $global::static"
        menuContextHelp::set $help(new) 2 [mc {create an empty overlap bar chart data viewer}]

        set string [underlineRemoved [mc {Side B_ar Chart}] underline]
        $menu.edit.new add command -label $string... -underline $underline\
            -command "createCellsViewer dataSideBarChart {} 1 $global::static"
        menuContextHelp::set $help(new) 3 [mc {create an empty side bar chart data viewer}]

        set string [underlineRemoved [mc {S_tacked Bar Chart}] underline]
        $menu.edit.new add command -label $string... -underline $underline\
            -command "createCellsViewer dataStackedBarChart {} 1 $global::static"
        menuContextHelp::set $help(new) 4 [mc {create an empty stacked bar chart data viewer}]

        set string [underlineRemoved [mc {2_D Pie Chart}] underline]
        $menu.edit.new add command -label $string... -underline $underline\
            -command "createCellsViewer data2DPieChart {} 1 $global::static"
        menuContextHelp::set $help(new) 5 [mc {create an empty 2D pie chart data viewer}]

        set string [underlineRemoved [mc {3_D Pie Chart}] underline]
        $menu.edit.new add command -label $string... -underline $underline\
            -command "createCellsViewer data3DPieChart {} 1 $global::static"
        menuContextHelp::set $help(new) 6 [mc {create an empty 3D pie chart data viewer}]

        set string [underlineRemoved [mc {Summary T_able}] underline]
        $menu.edit.new add command -label $string... -underline $underline\
            -command "createCellsViewer summaryTable {} 1 $global::static"
        menuContextHelp::set $help(new) 7 [mc {create an empty summary table data viewer}]

        set string [underlineRemoved [mc {F_ree Text}] underline]
        $menu.edit.new add command -label $string... -underline $underline\
            -command "createCellsViewer freeText {} 1 $global::static"
        menuContextHelp::set $help(new) 8 [mc {create an empty free text data viewer}]

        $menu.edit add separator
        set string [underlineRemoved [mc P_references] underline]
        $menu.edit add command -label $string... -command {configuration::edit 1} -underline $underline
        menuContextHelp::set $help(edit) 4 [mc {edit application-wide preferences}]
    }

    if {!$readOnly&&$includePollTime} {
        set string [underlineRemoved [mc V_iew] underline]
        $menu add cascade -label $string -menu [menu $menu.view -tearoff 0] -underline $underline
        set help(options) [new menuContextHelp $menu.view]
        lappend objects $help(options)
        menuContextHelp::set $help(bar) [incr index(bar)] [mc {data visualization settings}]

        set string [underlineRemoved [mc R_efresh] underline]
        $menu.view add command -label $string -command {after idle ::refresh} -underline $underline -accelerator Ctrl+R
        bind $parentPath <Control-r> {after idle ::refresh}
        menuContextHelp::set $help(options) 0 [mc {refresh display of all synchronous modules}]
        set string [underlineRemoved [mc {P_oll Time}] underline]
        $menu.view add command -label $string... -command inquirePollTime -underline $underline
        menuContextHelp::set $help(options) 1 [mc {change poll time for all synchronous modules}]
    }

    set string [underlineRemoved [mc H_elp] underline]
    $menu add cascade -label $string -menu [menu $menu.help -tearoff 0] -underline $underline
    set help(help) [new menuContextHelp $menu.help]
    lappend objects $help(help)
    set index(help) -1
    menuContextHelp::set $help(bar) [incr index(bar)] [mc {help on moodss and modules}]

    set string [underlineRemoved [mc G_lobal] underline]
    $menu.help add command -label $string... -underline 0 -accelerator F1 -command generalHelpWindow
    bind $parentPath <F1> generalHelpWindow
    menuContextHelp::set $help(help) [incr index(help)] [mc {global help for user}]

    if {[llength $moduleNames]>0} {
        set string [underlineRemoved [mc M_odules] underline]
        $menu.help add cascade -label $string -menu [menu $menu.help.modules -tearoff 0] -underline $underline
        menuContextHelp::set $help(help) [incr index(help)] [mc {help on loaded modules}]
        set help(modulesHelp) [new menuContextHelp $menu.help.modules]
        lappend objects $help(modulesHelp)
        set index(modulesHelp) -1
        foreach module $moduleNames {
            $menu.help.modules add command -label $module... -command "moduleHelpWindow $module \[modules::helpHTMLData $module\]"
            menuContextHelp::set $help(modulesHelp) [incr index(modulesHelp)]\
                [format [mc {display %s module documentation}] $module]
        }
    }

    set string [underlineRemoved [mc A_bout] underline]
    $menu.help add command -label $string... -underline $underline -command aboutDialogBox
    menuContextHelp::set $help(help) [incr index(help)] [mc {display author and general information}]

    $parentPath configure -menu $menu

    bind $menu.bound <Destroy> "delete $objects"
}

proc updateFileSaveMenuHelp {file} {
    if {[string length $file]==0} {
        set string [mc {input file for saving configuration and viewers layout}]
    } else {
        set string [format [mc {into %s file, save configuration and viewers layout}] $file]
    }
    menuContextHelp::set $global::fileMenuContextHelper $global::fileMenuContextHelperSaveIndex $string
}

proc createMessageWidget {parentPath} {
    set global::messenger [new lifoLabel $parentPath -headerfont $font::(mediumBold) -font $font::(mediumNormal)]
    composite::configure $global::messenger body -width 200
    return $widget::($global::messenger,path)
}

proc dragEcho {data format} {
    return $data
}

proc createDragAndDropZone {parentPath} {
    set frame [frame $parentPath.drops]

    set label [label $frame.graph -image applicationIcon -relief sunken]
    pack $label -pady 1 -side left
    new dropSite -path $label -formats DATACELLS\
        -command "createCellsViewer dataGraph \$dragSite::data(DATACELLS) 1 $global::static \$global::pollTime"
    new widgetTip -path $label -text [mc "graph chart\ndrag'n'drop site"]
    set drag [new dragSite -path $label]
    dragSite::provide $drag VIEWER {dragEcho ::dataGraph}

    set label [label $frame.stackedGraph -image [image create photo -data [dataStackedGraph::iconData]] -relief sunken]
    pack $label -pady 1 -side left
    new dropSite -path $label -formats DATACELLS\
        -command "createCellsViewer dataStackedGraph \$dragSite::data(DATACELLS) 1 $global::static \$global::pollTime"
    new widgetTip -path $label -text [mc "stacked graph chart\ndrag'n'drop site"]
    set drag [new dragSite -path $label]
    dragSite::provide $drag VIEWER {dragEcho ::dataStackedGraph}

    set label [label $frame.overlapBarChart -image [image create photo -data [dataOverlapBarChart::iconData]] -relief sunken]
    pack $label -pady 1 -side left
    new dropSite -path $label -formats DATACELLS\
        -command "createCellsViewer dataOverlapBarChart \$dragSite::data(DATACELLS) 1 $global::static"
    new widgetTip -path $label -text [mc "overlap bar chart\ndrag'n'drop site"]
    set drag [new dragSite -path $label]
    dragSite::provide $drag VIEWER {dragEcho ::dataOverlapBarChart}

    set label [label $frame.sideBarChart -image [image create photo -data [dataSideBarChart::iconData]] -relief sunken]
    pack $label -pady 1 -side left
    new dropSite -path $label -formats DATACELLS\
        -command "createCellsViewer dataSideBarChart \$dragSite::data(DATACELLS) 1 $global::static"
    new widgetTip -path $label -text [mc "side bar chart\ndrag'n'drop site"]
    set drag [new dragSite -path $label]
    dragSite::provide $drag VIEWER {dragEcho ::dataSideBarChart}

    set label [label $frame.stackedBarChart -image [image create photo -data [dataStackedBarChart::iconData]] -relief sunken]
    pack $label -pady 1 -side left
    new dropSite -path $label -formats DATACELLS\
        -command "createCellsViewer dataStackedBarChart \$dragSite::data(DATACELLS) 1 $global::static"
    new widgetTip -path $label -text [mc "stacked bar chart\ndrag'n'drop site"]
    set drag [new dragSite -path $label]
    dragSite::provide $drag VIEWER {dragEcho ::dataStackedBarChart}

    set label [label $frame.2DPieChart -image [image create photo -data [data2DPieChart::iconData]] -relief sunken]
    pack $label -pady 1 -side left
    new dropSite -path $label -formats DATACELLS\
        -command "createCellsViewer data2DPieChart \$dragSite::data(DATACELLS) 1 $global::static"
    new widgetTip -path $label -text [mc "2D pie chart\ndrag'n'drop site"]
    set drag [new dragSite -path $label]
    dragSite::provide $drag VIEWER {dragEcho ::data2DPieChart}

    set label [label $frame.3DPieChart -image [image create photo -data [data3DPieChart::iconData]] -relief sunken]
    pack $label -pady 1 -side left
    new dropSite -path $label -formats DATACELLS\
        -command "createCellsViewer data3DPieChart \$dragSite::data(DATACELLS) 1 $global::static"
    new widgetTip -path $label -text [mc "3D pie chart\ndrag'n'drop site"]
    set drag [new dragSite -path $label]
    dragSite::provide $drag VIEWER {dragEcho ::data3DPieChart}

    set label [label $frame.summaryTable -image [image create photo -data [summaryTable::iconData]] -relief sunken]
    pack $label -pady 1 -side left
    new dropSite -path $label -formats DATACELLS\
        -command "createCellsViewer summaryTable \$dragSite::data(DATACELLS) 1 $global::static"
    new widgetTip -path $label -text [mc "summary table\ndrag'n'drop site"]
    set drag [new dragSite -path $label]
    dragSite::provide $drag VIEWER {dragEcho ::summaryTable}

    set label [label $frame.freeText -image [image create photo -data [freeText::iconData]] -relief sunken]
    pack $label -pady 1 -side left
    new dropSite -path $label -formats DATACELLS\
        -command "createCellsViewer freeText \$dragSite::data(DATACELLS) 1 $global::static"
    new widgetTip -path $label -text [mc "free text\ndrag'n'drop site"]
    set drag [new dragSite -path $label]
    dragSite::provide $drag VIEWER {dragEcho ::freeText}

    set label [label $frame.threshold -image [image create photo -data [thresholds::iconData]] -relief sunken]
    pack $label -pady 1 -side left
    new dropSite -path $label -formats DATACELLS -command\
        {thresholds::edit; viewer::view $thresholds::singleton $dragSite::data(DATACELLS)}
    new widgetTip -path $label -text [mc {threshold drop site}]

    set eraserData {
        R0lGODdhJAAkAKUAAPj4+Hh4eLi4uMiAKLhQAPDouPDksOjYoOjQmOjMkODAgOC8eNiwaPj8+Ojw6ODg4NjY2MDIwNioYNikWLCwsNCYSFCQqJigmJCQkNCQ
        QODo6NDg6Mjg4IiIiAAAAHB4cMiIMGhoaMDY2MjY4GBgYMh8IEhQSLDQ2EBAQKjI0LjQ2Dg4OCAoIKDAyJC4yIi4wICAgHiwuKDI0IiQiJjAyJCYkJiYmKCg
        oKioqICwwMDAwMjQyNDY0HiouOjo6AAAACwAAAAAJAAkAAAG/kCAcCgMEI/G4zBZVBKZSijy6VxWAVKqFRvoer9dwZULBlfF1cGAwJ5ux0p1wWA4HNrNN3xI
        KMzrBwgICQR5eV5oVX10doIJCQoKhWRfewAEX46QCgsLDAQNWnsBDg8PEBBdm50Mn25wpKaoERECAawMEhITk4cBiU+yELQCAhQUAbm7ExWFZVcW0dG1xhQX
        FxgBE8wVGb1YYxYaG+Qc0cfXGBgdHhXd3qJK4uQb5hoaFtjrHR8eGRkgQHxL8kWMhXIc7I3bYKEDvw8hQngAocaDh2dEDibkIOIgvREjLEAMQYKEhwElCFzU
        I8RCQhEwPZIDCdICSRImPKS8+MtQ/kuYIk6ckEmzpgWcJlB4UInIl4WgQlMcLApSRTRzKFCssMjVohkLUVNIpaqi7NWQK1aw4BlmC1ixKVpYoFlWhdCzVtWy
        7blFbIu/c0fUFTo0sF0Lawu6+evChYXBhAsLLju0q+XLjV88jhw1GuW7e8uAeaGZM9xohMVa2AujtevXrWOADZtChgzUcOXuncG7t+/es+HaphEtt+4vNZIr
        X75c+HDiFuL+Jb7Xxo3r2LNnty2DhnfHFqZ7X/3FBo7z6NOr906jMXj2jcl7sVGsvv37xdzHt9C+cQ75Xdigw4AEFmjggO79Z0GC/1W3w4MQRighhC7koGCF
        FspWHQ8cJ3bo4Yce5iCbBRnGoGF5pqSo4oosjmhiDD30AGAANvhg44045qhjEAA7
    }
    set label [label $frame.eraser -image [image create photo -data $eraserData] -relief sunken]
    pack $label -pady 1 -side right
    new dropSite -path $label -formats OBJECTS -command "eval delete \$dragSite::data(OBJECTS)"
    new widgetTip -path $label -text [mc "objects deletion\ndrag'n'drop site"]
    set drag [new dragSite -path $label]
    dragSite::provide $drag KILL list

    return $frame
}

proc inquirePollTime {} {
    set dialog [new dialogBox .grabber\
        -buttons hoc -default o -title [mc {moodss: Poll Time}] -die 0 -x [winfo pointerx .] -y [winfo pointery .]\
        -helpcommand {generalHelpWindow #menus.view.polltime} -deletecommand {grab release .grabber}\
    ]
    grab .grabber
    lappend objects [linkedHelpWidgetTip $composite::($dialog,help,path)]
    set frame [frame $widget::($dialog,path).frame]
    set minimum [lindex $global::pollTimes 0]
    set message [message $frame.message\
        -width [winfo screenwidth .] -font $font::(mediumNormal) -justify center\
        -text [format [mc {Enter new poll time (greater than %u):}] $minimum]
    ]
    pack $message

    if {$::tcl_version<8.4} {
        set entry [new spinEntry $frame -width 4 -list $global::pollTimes -side right]
        spinEntry::set $entry $global::pollTime
        setupEntryValidation $composite::($entry,entry,path) {{checkUnsignedInteger %P}}
        pack $widget::($entry,path) -anchor e -side left -expand 1 -padx 2
        lappend objects $entry
    } else {
        set entry [spinbox $frame.spinbox -font $font::(mediumBold) -width 4 -values $global::pollTimes]
        $entry set $global::pollTime
        setupEntryValidation $entry {{checkUnsignedInteger %P}}
        pack $entry -anchor e -side left -expand 1 -padx 2
    }

    pack [label $frame.label -text [mc seconds]] -anchor w -side right -expand 1 -padx 2
    dialogBox::display $dialog $frame
    widget::configure $dialog -command "
        if {$::tcl_version<8.4} {
            set time \[spinEntry::get $entry\]
        } else {
            set time \[$entry get\]
        }
        if {\$time<$minimum} {
            bell
            $message configure -text \[format \[mc {Enter new poll time\n(must be greater than %u):}\] $minimum\]
        } else {
            if {\$time!=\$global::pollTime} {
                set global::pollTime \$time
                viewer::updateInterval \$time
                updateTitle
                refresh
            }
            delete $dialog
        }
    "
    bind $frame <Destroy> "delete $objects"
}

frame .grabber

pack [createMessageWidget .] -side bottom -fill x
update

wm title . {moodss: loading modules...}


set rcsId {$Id: record.tcl,v 2.14 2002/01/10 09:50:35 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 globalData {} {
        append data "version $global::applicationVersion\n"
        set seconds [clock seconds]
        append data "date [clock format $seconds -format %D] time [clock format $seconds -format %T]\n"
        return $data
    }

if {$global::withGUI} {

    proc data {{snapshot 0}} {
        if {!$snapshot} {
            set data [globalData]
        }
        append data "configuration \{\n"
        foreach name [configuration::variables 0] {
            append data "    [list $name [set ::global::$name]]\n"
        }
        append data \}\n
        set path $::widget::($global::scroll,path)
        append data "width [winfo width $path] height [winfo height $path]\n"
        append data "pollTime $global::pollTime\n"
        append data "modules \{\n"
        foreach instance $modules::(instances) {
            set namespace $modules::instance::($instance,namespace)
            append data "    $namespace \{\n"
            append data "        arguments \{$modules::instance::($instance,arguments)\}\n"
            append data "        tables \{\n"
            foreach table $dataTable::(list) {
                if {![string equal $namespace [namespace qualifiers [composite::cget $table -data]]]} continue
                foreach {x y width height} [canvasWindowManager::getGeometry $global::windowManager $widget::($table,path)] {}
                set level [canvasWindowManager::getStackLevel $global::windowManager $widget::($table,path)]
                append data "            $table \{\n"
                append data "                x $x y $y width $width height $height level $level\n"
                foreach {switch value} [dataTable::initializationConfiguration $table] {
                    append data "                $switch [list $value]\n"
                }
                append data "            \}\n"
            }
            append data "        \}\n"
            append data "    \}\n"
        }
        append data \}\n
        append data "viewers \{\n"
        foreach viewer $viewer::(list) {
            append data "    $viewer \{\n"
            set class [classof $viewer]
            append data "        class $class\n"
            if {![string equal $class ::thresholds]} {
                foreach {x y width height} [canvasWindowManager::getGeometry $global::windowManager $widget::($viewer,path)] {}
                set level [canvasWindowManager::getStackLevel $global::windowManager $widget::($viewer,path)]
                append data "        x $x y $y width $width height $height level $level\n"
            }
            append data "        cells {[viewer::cells $viewer]}\n"
            foreach {switch value} [viewer::initializationConfiguration $viewer] {
                append data "        $switch [list $value]\n"
            }
            append data "    \}\n"
        }
        append data \}
        return $data
    }

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

}

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

        if {[string length $switched::($this,-file)]==0} {
            error {-file option undefined}
        }
        if {[catch {set file [open $switched::($this,-file)]} message]} {
            puts stderr $message
            exit 1
        }
        if {![regexp {^(version [1-9]\d*\.\d+(\.\d+)*)$} [gets $file]]} {
            puts stderr "file $switched::($this,-file) is not a valid moodss save file"
            exit 1
        }
        seek $file 0
        array set ${this}data [::read $file]
        close $file
    }

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

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

    proc modulesWithArguments {this} {
        set list {}
        foreach module [modules $this] {
            moduleData $this $module data
            eval lappend list $module $data(arguments)
        }
        return $list
    }

    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 id [lsort -integer [array names data]] {
            catch {unset viewer}
            set viewer(level) {}
            array set viewer $data($id)
            set options {}
            foreach {name value} [array get viewer -*] {
                lappend options $name $value
            }
            if {[string equal $viewer(class) ::thresholds]} {
                lappend list $viewer(class) $viewer(cells) {} {} {} {} {} $options
            } else {
                lappend list $viewer(class) $viewer(cells) $viewer(x) $viewer(y) $viewer(width) $viewer(height) $viewer(level)\
                    $options
            }
        }
        return $list
    }

    proc moduleData {this module dataName} {
        variable ${this}data
        upvar $dataName data

        array set all [set ${this}data(modules)]
        array set data $all($module)
    }

    proc tableData {this module creationIndex dataName} {
        variable ${this}data
        upvar $dataName data

        moduleData $this $module moduleData
        array set tablesData $moduleData(tables)
        unset moduleData
        set data(level) {}
        set index [lindex [lsort -integer [array names tablesData]] $creationIndex]
        if {[string length $index]>0} {
            array set data $tablesData([lindex [lsort -integer [array names tablesData]] $creationIndex])
            return 1
        } else {
            return 0
        }
    }

    proc tableWindowManagerData {this module creationIndex} {
        if {![tableData $this $module $creationIndex data]} {
            return {}
        }
        return [list $data(x) $data(y) $data(width) $data(height) $data(level)]
    }

    proc tableOptions {this module creationIndex} {
        if {![tableData $this $module $creationIndex data]} {
            return {}
        }
        set options {}
        foreach {name value} [array get data -*] {
            lappend options $name $value
        }
        return $options
    }

    proc configurationData {this} {
        variable ${this}data

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

    proc snapshot {} {
        set (data) [data 1]
    }

    proc changed {} {
        if {[info exists (data)]} {
            return [string compare $(data) [data 1]]
        } else {
            return 0
        }
    }

}

proc loadFromFile {{name {}}} {
    foreach instance $modules::(instances) {
        dynamicallyUnloadModule $modules::instance::($instance,namespace)
    }
    if {[llength $modules::(instances)]>0} {
        error {internal moodss error: please report to author with error trace}
    }
    foreach viewer $viewer::(list) {
        if {[string equal [classof $viewer] ::thresholds]} {
            thresholds::reset $viewer
        } else {
            delete $viewer
        }
    }
    set global::saveFile $name
    set global::fileDirectory [file dirname $name]
    set initializer [new record -file $name]
    record::read $initializer
    configuration::load [record::configurationData $initializer]
    modules::parse [record::modulesWithArguments $initializer]
    set modules::(initialized) [record::modules $initializer]
    return $initializer
}

proc reload {} {
    if {[record::changed]} {
        switch [inquireSaving] {
            yes {
                save
                if {[record::changed]} return
            }
            cancel return
        }
    }
    set file [tk_getOpenFile\
        -title {moodss: Open} -initialdir $global::fileDirectory -defaultextension .moo -filetypes {{{moodss data} .moo}}\
    ]
    if {[string length $file]==0} return
    set global::fileDirectory [file dirname $file]
    if {[info exists ::initializer]} {
        delete $::initializer
    }
    set ::initializer [loadFromFile $file]
    foreach {width height} [record::sizes $::initializer] {}
    composite::configure $global::scroll -width $width -height $height
    modules::initialize
    modules::setPollTimes [record::pollTime $::initializer]
    foreach instance $modules::(instances) {
        displayModule $instance $::draggable
    }
    summaryTable::reset
    createSavedViewers $::initializer
    updateTitle
    destroy $global::menu
    createMenuWidget . $::readOnly [llength $global::pollTimes]
    refresh
    update
    record::snapshot
}

if {[info exists arguments(-f)]} {
    set initializer [loadFromFile $arguments(-f)]
} else {
    set global::saveFile {}
}

if {[catch {modules::parse $argv} message]} {
    puts stderr $message
    exit 1
}

wm title . {moodss: initializing modules...}

if {[catch modules::initialize message]} {
    puts stderr $message
    exit 1
}


set rcsId {$Id: canvhand.tcl,v 2.14 2002/01/12 15:29:57 jfontain Exp $}

class canvasWindowManager {

    class handles {

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

        proc ~handles {this} {
            $($this,canvas) delete $($this,item) outline
        }

        proc options {this} {
            return [list\
                [list -background $widget::option(button,background) $widget::option(button,background)]\
                [list -borderwidth 3]\
                [list -handlesize 7 7]\
                [list -path {} {}]\
                [list -relief ridge]\
                [list -setheight {} {}]\
                [list -setwidth {} {}]\
                [list -setx 0 0]\
                [list -sety 0 0]\
                [list -static 0]\
                [list -title {} {}]\
            ]
        }

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

        proc set-path {this value} {
            if {$($this,filled)} {
                error {cannot manage more than 1 widget}
            }
            if {![winfo exists $value]} {
                error "invalid widget: \"$value\""
            }
            set path $widget::($this,path)
            pack $value -in $path -side bottom -fill both -expand 1
            stack $this raise
            set ($this,filled) 1
        }

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

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

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

        proc set-setheight {this value} {
            $($this,canvas) itemconfigure $($this,item) -height $value
        }

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

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

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

        proc set-static {this value} {
            updateBindings $this $value
        }

        proc set-title {this value} {
            if {![info exists ($this,label)]} {
                set ($this,label) [label $widget::($this,path).label -pady 0 -font $font::(smallNormal) -background gray -anchor w]
                pack $($this,label) -side top -fill x -before $composite::($this,-path)
                if {[string length $composite::($this,-path)>0]} {
                    pack $($this,label) -before $composite::($this,-path)
                }
            }
            $($this,label) configure -text $value
            updateBindings $this $composite::($this,-static)
        }

        proc updateBindings {this static} {
            set path $widget::($this,path)
            if {$static} {
                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 left_ptr
            } 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"
            }
            bind $path <ButtonRelease-2> "canvasWindowManager::handles::toggleVisibility $this"
            if {[info exists ($this,label)]} {
                set path $($this,label)
                if {$static} {
                    $path configure -cursor left_ptr
                    bind $path <Button1-Motion> {}
                    bind $path <ButtonPress-1> {}
                    bind $path <ButtonRelease-1> "canvasWindowManager::handles::toggleVisibility $this"
                } else {
                    $path configure -cursor fleur
                    bind $path <Button1-Motion> "canvasWindowManager::handles::buttonMotion $this %x %y"
                    bind $path <ButtonPress-1> "
                        set canvasWindowManager::handles::($this,direction) {}
                        canvasWindowManager::handles::buttonPress $this %x %y
                    "
                    bind $path <ButtonRelease-1> "canvasWindowManager::handles::buttonRelease $this"
                }
                bind $path <ButtonRelease-2> "canvasWindowManager::handles::toggleVisibility $this"
            }
        }

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

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

        proc toggleVisibility {this} {
            if {[canvasWindowManager::raisedOnTop $($this,manager) $composite::($this,-path)]} {
                stack $this lower
            } else {
                stack $this raise
            }
        }

        proc buttonRelease {this} {
            lifoLabel::pop $global::messenger
            if {[info exists (motion)]} {
                updateGeometry $this
                stack $this raise
                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-$($this,topHandleBottom)}]
            set ($this,midHandleTop) [maximum [expr {$height/3}] [expr {$($this,topHandleBottom)+$size}]]
            set ($this,midHandleBottom) [minimum [expr {(2*$height)/3}] [expr {$($this,bottomHandleTop)-$size}]]

            set halfWidth [expr {$width/2}]
            set ($this,leftHandleRight) [minimum $size $halfWidth]
            set ($this,rightHandleLeft) [expr {$width-$($this,leftHandleRight)}]
            set ($this,midHandleLeft) [maximum [expr {$width/3}] [expr {$($this,leftHandleRight)+$size}]]
            set ($this,midHandleRight) [minimum [expr {(2*$width)/3}] [expr {$($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<$($this,topHandleBottom)} {
                    set cursor top_${side}_corner
                    append direction n
                } elseif {$y>$($this,bottomHandleTop)} {
                    set cursor bottom_${side}_corner
                    append direction s
                } elseif {($y>$($this,midHandleTop))&&($y<$($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<$($this,leftHandleRight)} {
                        set cursor ${side}_left_corner
                        append direction w
                    } elseif {$x>$($this,rightHandleLeft)} {
                        set cursor ${side}_right_corner
                        append direction e
                    } elseif {($x>$($this,midHandleLeft))&&($x<$($this,midHandleRight))} {
                        set cursor ${side}_side
                    } else {
                        set cursor fleur
                        set direction {}
                    }
                }
            }
            if {![string equal $cursor [$widget::($this,path) cget -cursor]]} {
                $widget::($this,path) configure -cursor $cursor
                update idletasks
            }
            set ($this,direction) $direction
        }

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

            if {$(hidden)} {
                stackOutline $this raise
            }
            set canvas $($this,canvas)
            set coordinates [$canvas coords $($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 [maximum [$canvas cget -width] [winfo width $canvas]]
            if {($xFrame+$x)>=$width} {
                set x [expr {$width-$xFrame-1}]
            }
            set height [maximum [$canvas cget -height] [winfo height $canvas]]
            if {($yFrame+$y)>=$height} {
                set y [expr {$height-$yFrame-1}]
            }

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

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

            switch $($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 $($this,canvas)
            foreach side {top bottom left right} {
                set frame [frame $canvas.${side}outline -background black]
                set ($side,item) [$canvas create window 0 0 -window $frame -width 0 -height 0 -anchor nw -tags outline]
            }
            stackOutline $this lower
            eval displayOutline $this [$canvas coords $($this,item)]\
                [winfo width $widget::($this,path)] [winfo height $widget::($this,path)]
        }

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

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

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

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

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

        proc stack {this order} {
            $order $widget::($this,path)
            if {[string length $composite::($this,-path)]>0} {
                raise $composite::($this,-path) $widget::($this,path)
            }
            canvasWindowManager::stacked $($this,manager) $composite::($this,-path) [string compare $order lower]
        }

        proc stackLower {this handles} {
            lower $widget::($this,path) $widget::($handles,path)
            if {[string length $composite::($this,-path)]>0} {
                raise $composite::($this,-path) $widget::($this,path)
            }
        }

    }

}

set rcsId {$Id: canvaswm.tcl,v 2.6 2002/01/13 15:47:46 jfontain Exp $}

class canvasWindowManager {

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

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

        foreach {name handle} [array get ${this}data handle,*] {
            delete $handle
        }
        catch {unset ${this}data}
    }

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

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

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

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

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

        array set value $args
        if {![catch {string length $value(-level)} length]&&($length>0)} {
            set names [array names ${this}data relativeStackingLevel,*]
            if {[llength $names]>0} {
                foreach name $names {
                    set pathFrom([set ${this}data($name)]) [lindex [split $name ,] end]
                }
                foreach level [lsort -integer [array names pathFrom]] {
                    if {$level>$value(-level)} {
                        handles::stackLower [set ${this}data(handle,$path)] [set ${this}data(handle,$pathFrom($level))]
                        break
                    }
                }
            }
            set ${this}data(relativeStackingLevel,$path) $value(-level)
        }
        catch {unset value(-level)}
        eval composite::configure [set ${this}data(handle,$path)] [array get value]
    }

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

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

    proc getStackLevel {this path} {
        variable ${this}data

        return [set ${this}data(relativeStackingLevel,$path)]
    }

    proc relativeStackingLevels {this} {
        variable ${this}data

        set list {}
        foreach {name value} [array get ${this}data relativeStackingLevel,*] {
            lappend list $value
        }
        return [lsort -integer $list]
    }

    proc stacked {this path raised} {
        variable ${this}data

        set levels [relativeStackingLevels $this]
        if {[llength $levels]==0} {
            set ${this}data(relativeStackingLevel,$path) 0
        } elseif {$raised} {
            set ${this}data(relativeStackingLevel,$path) [expr {[lindex $levels end]+1}]
        } else {
            set ${this}data(relativeStackingLevel,$path) [expr {[lindex $levels 0]-1}]
        }
    }

    proc raisedOnTop {this path} {
        variable ${this}data

        return [expr {[set ${this}data(relativeStackingLevel,$path)]>=[lindex [relativeStackingLevels $this] end]}]
    }

    proc raiseNext {this} {
    }

}

set rcsId {$Id: colorlab.tcl,v 1.5 2001/12/29 00:32:39 jfontain Exp $}


class colorLabels {

    proc colorLabels {this parentPath args} composite {[::new frame $parentPath] $args} {
        set ($this,labels) {}
        composite::complete $this
    }

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

    proc options {this} {
        return [list\
            [list -colorheight 0 0]\
        ]
    }

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

    proc new {this args} {
        set label [eval ::new label $widget::($this,path) -colorheight $composite::($this,-colorheight) $args]
        lappend ($this,labels) $label
        refresh $this
        return $label
    }

    proc delete {this label} {
        ldelete ($this,labels) $label
        ::delete $label
        refresh $this
    }

    proc refresh {this} {
        set path $widget::($this,path)
        catch {eval grid forget [grid slaves $path]}
        set row 0
        foreach label $($this,labels) {
            grid $widget::($label,path) -row $row -sticky new
            incr row
            grid rowconfigure $path $row -minsize 1
            incr row
        }
    }

}


class colorLabels {

    class label {

        proc label {this parentPath args} composite {[new frame $parentPath] $args} {
            set path $widget::($this,path)
            composite::manage $this [new frame $path -highlightbackground black -highlightthickness 1 -width 11] frame\
                [new label $path -font $font::(mediumNormal) -anchor nw -justify left -padx 2] label
            pack $composite::($this,frame,path) -side left
            pack $composite::($this,label,path) -fill both -expand 1
            composite::complete $this
        }

        proc ~label {this} {}

        proc options {this} {
            return [list\
                [list -background {} {}]\
                [list -color {} {}]\
                [list -colorheight 0 0]\
                [list -relief flat flat]\
                [list -text {} {}]\
            ]
        }

        proc set-background {this value} {
            if {[string length $value]==0} {
                set value $widget::option(label,background)
            }
            $composite::($this,label,path) configure -background $value
        }

        proc set-color {this value} {
            $composite::($this,frame,path) configure -background $value
        }

        proc set-colorheight {this value} {
            update $this
        }

        proc set-relief {this value} {
             $composite::($this,label,path) configure -relief $value
        }

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

        proc update {this} {
            set height $composite::($this,-colorheight)
            if {$height<=0} {
                set height [winfo reqheight $composite::($this,label,path)]
            }
            $composite::($this,frame,path) configure -height $height
        }

        proc height {this} {
            return [winfo reqheight $composite::($this,label,path)]
        }

    }

}

set rcsId {$Id: blt2d.tcl,v 2.20 2001/12/29 00:32:39 jfontain Exp $}


class blt2DViewer {

    proc blt2DViewer {this parentPath path {labelsColorHeight 0}} viewer {} {
        pack propagate $parentPath 0
        $path configure -cursor {} -plotpadx 2 -plotpady 2
        $path yaxis configure -tickshadow {} -title {} -tickfont $font::(smallNormal)
        $path legend configure -hide 1
        set labels [new colorLabels $parentPath -colorheight $labelsColorHeight]
        viewer::setupDropSite $this $parentPath
        set ($this,elements) {}
        set ($this,colorIndex) 0
        set ($this,path) $path
        set ($this,labels) $labels
    }

    proc ~blt2DViewer {this} {
        if {[info exists ($this,drag)]} {
            delete $($this,drag)
        }
        eval delete $($this,elements)
        if {[info exists ($this,selector)]} {
            delete $($this,selector)
        }
        delete $($this,labels)
    }

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

    proc dragData {this format} {
        set legends [selector::selected $($this,selector)]
        set selectedElements {}
        foreach element $($this,elements) {
            if {[lsearch -exact $legends $($this,legend,$element)]<0} continue
            lappend selectedElements $element
        }
        switch $format {
            OBJECTS {
                if {[llength $selectedElements]>0} {
                    return $selectedElements
                } elseif {[llength $($this,elements)]==0} {
                    return $this
                } else {
                    return {}
                }
            }
            DATACELLS {
                return [cellsFromElements $this $selectedElements]
            }
        }
    }

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

    proc monitorCell {this array row column} {
        set cell ${array}($row,$column)
        if {[lsearch -exact [cellsFromElements $this $($this,elements)] $cell]>=0} return
        viewer::registerTrace $this $array
        set color [lindex $global::viewerColors $($this,colorIndex)]
        set element [newElement $this $($this,path) -color $color]
        set labels $($this,labels)
        if {[llength $($this,elements)]==0} {
            pack $widget::($labels,path) -side right -anchor n -padx 2 -pady 2 -before $($this,path)
        }
        set legend [colorLabels::new $labels -color $color]
        switched::configure $element -deletecommand "blt2DViewer::deletedElement $this $array $element"
        set ($this,colorIndex) [expr {($($this,colorIndex)+1)%[llength $global::viewerColors]}]
        lappend ($this,elements) $element
        set ($this,label,$element) [viewer::label $array $row $column]
        set ($this,legend,$element) $legend
        set ($this,cell,$element) $cell
        if {$composite::($this,-draggable)} {
            set labelPath $composite::($legend,label,path)
            set drag [new dragSite -path $labelPath -validcommand "blt2DViewer::validateDrag $this $legend"]
            dragSite::provide $drag OBJECTS "blt2DViewer::dragData $this"
            dragSite::provide $drag DATACELLS "blt2DViewer::dragData $this"
            set ($this,drag,$element) $drag
            set selector $($this,selector)
            selector::add $selector $legend
            bind $labelPath <ButtonRelease-1> "selector::select $selector $legend"
            bind $labelPath <Control-ButtonRelease-1> "selector::toggle $selector $legend"
            bind $labelPath <Shift-ButtonRelease-1> "selector::extend $selector $legend"
        }
        if {[string first ? $($this,label,$element)]>=0} {
            set ($this,relabel,$element) {}
        }
    }

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

    proc deletedElement {this array element} {
        viewer::unregisterTrace $this $array
        ldelete ($this,elements) $element
        if {$composite::($this,-draggable)} {
            delete $($this,drag,$element)
            selector::remove $($this,selector) $($this,legend,$element)
        }
        colorLabels::delete $($this,labels) $($this,legend,$element)
        if {[llength $($this,elements)]==0} {
            pack forget $widget::($($this,labels),path)
        }
        unset ($this,cell,$element) ($this,label,$element) ($this,legend,$element)
    }

    proc update {this array args} {
        updateTimeDisplay $this [set seconds [clock seconds]]
        foreach element $($this,elements) {
            set cell $($this,cell,$element)
            if {[string first $array $cell]<0} continue
            if {[catch {set value [set $cell]}]} {
                updateElement $this $element $seconds ?
                composite::configure $($this,legend,$element) -text "$($this,label,$element): ?"
            } else {
                if {[info exists ($this,relabel,$element)]} {
                    viewer::parse $cell array row column type
                    set label [viewer::label $array $row $column]
                    set ($this,label,$element) $label
                    if {[string first ? $label]<0} {
                        unset ($this,relabel,$element)
                    }
                }
                updateElement $this $element $seconds $value
                composite::configure $($this,legend,$element) -text "$($this,label,$element): $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 $($this,cell,$element)
        }
        return $cells
    }

    proc setLegendsState {this legends select} {
        if {$select} {
            set relief sunken
        } else {
            set relief flat
        }
        foreach legend $legends {
            composite::configure $legend -relief $relief
        }
    }

    proc allowDrag {this} {
        set ($this,drag) [new dragSite -path $($this,path) -validcommand "blt2DViewer::validateDrag $this 0"]
        dragSite::provide $($this,drag) OBJECTS "blt2DViewer::dragData $this"
        set ($this,selector) [new objectSelector -selectcommand "blt2DViewer::setLegendsState $this"]
    }

    proc setCellColor {this array row column color} {
        set cell ${array}($row,$column)
        foreach element $($this,elements) {
            if {[string equal $($this,cell,$element) $cell]} {
                composite::configure $($this,legend,$element) -background $color
                return
            }
        }
    }

}

set rcsId {$Id: databar.tcl,v 2.17 2001/12/29 00:32:39 jfontain Exp $}


class dataBarChart {

    proc dataBarChart {this parentPath args} composite {[new frame $parentPath] $args} blt2DViewer {
        $widget::($this,path) [blt::barchart $widget::($this,path).bar\
            -title {} -bottommargin 6 -topmargin 3 -bufferelements 0 -plotborderwidth 1\
            -plotbackground $widget::option(button,background)\
        ]
    } {
        set path $widget::($this,path).bar
        $path grid off
        $path xaxis configure -hide 1
        pack $path -side left -fill both -expand 1
        set ($this,path) $path
        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 0 0]\
            [list -height $global::viewerHeight]\
            [list -mode normal normal]\
            [list -width $global::viewerWidth]\
        ]
    }

    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} {
        $($this,path) configure -barmode $value
    }

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

    virtual proc updateElement {this element seconds value} {
        if {[string equal $value ?]} {
            element::update $element 0
        } else {
            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} {
            $($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 {} {}]\
            ]
        }

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

        proc set-deletecommand {this value} {}

        proc update {this y} {
            $($this,path) element configure $this -ydata $y
        }

    }

}

class dataSideBarChart {

    proc dataSideBarChart {this parentPath args} dataBarChart {$parentPath $args} {
        composite::configure $this -mode aligned
    }

    proc ~dataSideBarChart {this} {}

    proc iconData {} {
        return {
            R0lGODdhJAAkAMYAAPj4+Hh4ePj8+DBgGHh8eKDweAAAAJjscJjkcJDgaJDcaIjYaIjUYIDMYIDEWHjAWHi8WHBIAHC4UOjUSHC0UODMQGisSNjEQNjASGCk
            SNC4SGCgQMiwSFiYQMioSFiYOMCgSFiQOLiYSFCMOLiQSICEgFCIMLCMSBBgeIiQiEiEMKiESMDQ2JCYkEiAKKh8SKjA0KCkoEB4KKB0SJC0wKisqJhsSLi8
            uEBwIJhkSHiouMDEwDhsIJBcSGCYsMjQyNDY0ODk4Ojs6AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
            AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
            AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACwAAAAAJAAkAAAH/oAAgoOCAYSHhoeDiYWKhIyKkIiPhAIDl5iZk44AkIkBAQQDBaSlpAMG
            oKqrrK2ggpYHsrOyAwSUnJ6VAwi9vr22uI66g5YJx8jHwYucnbigogrS09KorteusAML3N3cy425wgCWDObn5uDO4szFAw3w8fDqkuOfoe/y8dbY/a/kAxwI
            HCiQXjNi2h4oXKhQHQEB7MJpg0CxIsUBETJq3LgpHLQBEkKKDIlxgsmTJiOk8qeNgsuXLjFWmElzZoRb7SQCtMCzJ0+MF4IKDXoTok5Ilnz6xIihqdOmRXOu
            +5ihqtWqGDVo3apVJQGWADeIHSsWI4ezaM/etLerg9u3/m4xephLd+5aqUgHfNjLdy9GEIADA456VJCBwwNCKF6sGKOIx5AfqzxMuTJlApgHjNjMeTNGEqBD
            g76JubTp0iVSDzDBujVrjCdiy44dAYXt27hTl0jBe4CK38B/Y1xBvDjx2iySK0+OggDvFtAHuJhOfTrGF9izY68No7v37s2hxxg/QIb58+YxzljPfn1tGvDj
            w28+vob98ujPY7TBvz//9/LF15x9NxQ4AA4IJoggRjk06GCDtekg4YQSNlfgDhgOwMOGHG6IUQ8ghghibT6UaGKJzWH4w4qZtIjRRjDiJmNzKwJhIxCn5ajj
            jqbZGMSPQAYp5JBEFinEkUgmB6nkkkw2GQgAOw==
        }
    }

}

class dataStackedBarChart {

    proc dataStackedBarChart {this parentPath args} dataBarChart {$parentPath $args} {
        composite::configure $this -mode stacked
    }

    proc ~dataStackedBarChart {this} {}

    proc iconData {} {
        return {
            R0lGODdhJAAkAKUAAPj4+Hh4eHh8eDBgGPj8+KjweAAAAJjkcJDYaIjMYIDAWDg4OHi0UGioSGCgQFiUOHBIAPDYSOjMQODESNi4SNCwSMioSMCcSLiUSLCI
            SBBgeLDY6KDQ4ICEgJDE2IiQiIi80JCYkHi0yKCkoHCswKisqGCguLi8uFiYsMDEwEiQqMjQyNDY0ODk4Ojs6AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
            AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACwAAAAAJAAkAAAG/kCAcCgMEI/G4zBZVBKZSiiSKFAOrtisdrsFEKqAgFgwKJjP6LQaPTAIBOIhYXCo2+/4/H0g
            +B7nCIGCg4SFg3x+RHMJjI2Oj5COAwFfBGFjAwqam5ydnpwDC29wcgMMp6ipqqupk5WKAw2ys7S1trSufbAOvL2+v8C+uZZiAWQPyMnKy8zKoaNMBBDT1NXW
            19eUunIQEd7f4OHi4BDaltwS6err7O3r5a/FAhAT9fb3+Pn3EKJv0RAUAgocSLDgQHjbhEirwLChw4cQHSI8pxCChYsYM2rcmHHipTcQLogcSbKkSZL8oHHD
            wLKly5cwXXrklqGmzZs4c96cqVCDv8+fQIMKFWoOgIGjBjRsWMq0qdOnTTUgPTpKgAYOWLNq3cpVq4aqAjqI7aDBg9mzaNOqRft1bIcPcD9oAEG3rt27eO1+
            jfshhN8QGkQIHky4sGHCX/+GGMF4hAYSkCNLnkxZ8tfGI0poLqHBhOfPoEOLBv11c4kTqE9oQMG6tevXsF1/TX0ihe0UGlTo3s27t2/eX2+nWEF8xdDjyH8K
            KL6ChXPnYKNLny7gOYsW2LNr3869u3cX4MOLH0++vPkgADs=
        }
    }

    proc updateElement {this element seconds value} {
        if {[string equal $value ?]} {
            dataBarChart::element::update $element 0
        } else {
            dataBarChart::element::update $element [expr {abs($value)}]
        }
    }

}

class dataOverlapBarChart {

    proc dataOverlapBarChart {this parentPath args} dataBarChart {$parentPath $args} {
        composite::configure $this -mode overlap
    }

    proc ~dataOverlapBarChart {this} {}

    proc iconData {} {
        return {
            R0lGODdhJAAkAMYAAPj4+Hh4ePj8+DBgIHh8eKDweAAAAJjscJjocJDgcJDgaIjYaIjUaIDQYIDMYIDIYHjEWHjAWHBIAHC8WOjQQHC0UODIQGiwUNjEQNi8
            QGCoSNC0QGCkSMisQFigQMikQFicQMCgQFiYQLiYQFCQOLiQQICEgLCIQBBgeIiQiEiMOKiAQLjI0JCYkEiEMKh8QKCkoECAMKB0QKC4yKisqEB8MJhsQIio
            uLi8uEB4KJhkQMDEwDh0KJBcQHCgsMjQyODk4NDY0Ojs6AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
            AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
            AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACwAAAAAJAAkAAAH/oAAgoOCAYSHhoeDiYWKhIyKkIiPhAIDl5iZmQCSlIuFAQQDBaSlpqQD
            BgGrrK2urIKWB7O0tbMDBJ2fu7EDCL/Awb+4uo28AJYJysvMygOrjsbGq6IK1tfY1qm5r92wyAML4uPk4s/FnJ69DOzt7uzn0enHlg329/j28dGQidQDDgIK
            HBhwm7eDvR4oXMhQ4T5H/SoNgECxokWKDyOpAxeho0cJIEOKFLnRX6gBE1KqlEChpcuXLSWoOpjIUoWbOCVY2Mmz504JBI5BsnShqFEJGJIqXZoUqFCJRo9m
            mEq16lQJAQRIm/dPg9evEjaIHUtWrExu3npxWMtWQoe3/nDjvsWqdd5WSx7y6pXwoa/fv33pbh06AIThwxJCKF7MWLFgu/MMSB4gorJlCSMya96cWabkz6Al
            Exg9gITp0xJKqF7NWjXQ0bBjjzZBu/Rp0xJO6N6tG4Xv38CB0zaRovgAFciTS1jBvDlzFCyiS58eHQWB4i2yD3DBvbuEF+DDg4dOvbz17DDSD4jBvr0EGfDj
            w0cxo779+/Wtp6fBf0CN/wBKYMOABA6Iwg0IJqgggtbxh8ODA+Qg4YQS6GDhhRYeuOCG1j24w4cD8CDiiBL0YOKJJqLgw4ostriidR/+IKMml4wkUnA4/kaA
            jED0CIRsQAYpZGxBBOHjkUgmEKnkkj4K4eSTUEYp5ZRUBgIAOw==
        }
    }

}

set rcsId {$Id: graph.tcl,v 2.11 2001/12/29 00:32:39 jfontain Exp $}


class bltGraph {

    proc bltGraph {this path} {
        $path xaxis configure -tickfont $font::(smallNormal) -title {} -rotate 90 -command bltGraph::axisTime -tickshadow {}
        bind $path <Configure> "bltGraph::resized $this"
        set marker [$path marker create polygon -fill {} -coords {-Inf Inf Inf Inf Inf -Inf -Inf -Inf}]
        $path crosshairs configure -color blue
        $path marker bind $marker <Enter> "bltGraph::enterPlotArea $path %x %y"
        $path marker bind $marker <Leave> "bltGraph::leavePlotArea $path"
        set ($this,path) $path
        set ($this,plotWidth) 0
    }

    proc ~bltGraph {this} {}

    proc setRange {this value} {
        set ($this,range) $value
    }

    proc xAxisUpdate {this currentTime} {
        if {($($this,plotWidth)==0)||($($this,range)==0)} return
        $($this,path) xaxis configure -min [expr {$currentTime-$($this,range)}] -max $currentTime
    }

    proc axisTime {path value} {
        set value [expr {round($value)}]
        if {($value%60)==0} {
            return [clock format $value -format %H:%M]
        } else {
            return [clock format $value -format %T]
        }
    }

    proc updateGraduations {this} {
        if {$($this,plotWidth)==0} return
        set minimum [expr {(2*6*$($this,range))/$($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
        }
        $($this,path) xaxis configure -stepsize $step -subdivisions $division
        xAxisUpdate $this [clock seconds]
    }

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

    proc enterPlotArea {path x y} {
        $path configure -cursor tcross
        $path crosshairs on
        bind $path <Any-Motion> "bltGraph::processMotion $path %x %y"
        lifoLabel::push $global::messenger "[axisTime $path $x] $y"
    }

    proc leavePlotArea {path} {
        $path configure -cursor {}
        $path crosshairs off
        bind $path <Any-Motion> {}
        lifoLabel::pop $global::messenger
    }

    proc processMotion {path x y} {
        $path crosshairs configure -position @$x,$y
        foreach {x y} [$path invtransform $x $y] {}
        lifoLabel::pop $global::messenger
        lifoLabel::push $global::messenger "[axisTime $path $x] $y"
    }

}

set rcsId {$Id: datagraf.tcl,v 2.21 2002/01/19 16:51:18 jfontain Exp $}


class dataGraph {

    proc dataGraph {this parentPath args} composite {[new frame $parentPath] $args} blt2DViewer {
        $widget::($this,path) [blt::stripchart $widget::($this,path).graph\
            -title {} -topmargin 3 -bufferelements 0 -plotborderwidth 1 -plotbackground black\
        ] 5
    } {
        set path $widget::($this,path).graph
        $path pen create void -linewidth 0 -symbol none
        set graph [new bltGraph $path]
        pack $path -side left -fill both -expand 1
        set ($this,graph) $graph
        composite::complete $this
    }

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

    proc iconData {} {
        return {
            R0lGODdhJAAkAKUAAPj8+Hh4eDBgIDBgGKDscJDcaIjQYHjAWDg4OHC0UGikSFiYQHh8eHBIAPDcSODQQNjEONC8MMiwMMCoKLicIAAAABBgeICEgKjU4JCY
            kLi8uIiQiJjI2IjA0NDY0KCkoIC4yKisqHCwwGikuMDEwFicsMjQyODk4Ojs6AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
            AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACwAAAAAJAAkAAAG/kCAcCgMEI/G4zBZVBKZSijy6VxWAVKqFRsICL7dsNgrGAjGAbMZLRQQ3gKs0v0mxId0eBNf
            6BfORF9+fl+Cg4BQAgaLi3cAioyRkoxnRklhAgeamoWbnJmem18IpGKBCaipqmAIX6tnCExZjwq1trWVAbFkYF0IWnMCC8PDlXtje8dovL1jDMvQVbthwFHV
            Sg3Z2VNVULMA2Q7i4g3X1ZdiDQ/r7OsNaNrv0F1EDRD3+PnbAdn65d5HGkQYOFAbwYICDxLctkVIAwkQIcrjF7GixYrllDWYwHFCA1Igs3XsGG+kx2lJGlBY
            +e7XE5UrKUzkF1OmpYDZfEWJF4DBzxKeN5HQcxkllk8iz3btqcC0qdOnUKNKZUDVglWqWLMysHpVK1cLWhlcuGABg1kLGdKqTVvWLAYLGuJqaHtW7NgLGzZY
            4MCXA1y5c/f25ft1sF8GefOy7cCYsQUPkC00nkx5MlgGaz9otgCic2eunkF8De25q+bTIVKHsCCitevXXa3CvsxAtWrAc0fo3q2btoaqXLHilkuiuHGrJZIn
            v2y8uNbm0EmYmE7dxNavVKtr374dsnfvYb+LH0/+hPnz6NOrX88ehfv38OPLn08/CAA7
        }
    }

    proc options {this} {
        set samples [expr {$global::graphNumberOfIntervals+1}]
        return [list\
            [list -deletecommand {} {}]\
            [list -draggable 0 0]\
            [list -height $global::viewerHeight]\
            [list -interval 5]\
            [list -samples $samples $samples]\
            [list -width $global::viewerWidth]\
        ]
    }

    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} {
        bltGraph::setRange $($this,graph) [expr {($composite::($this,-samples)-1)*$value}]
        bltGraph::updateGraduations $($this,graph)
    }

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

    proc newElement {this path args} {
        return [eval new element $path $composite::($this,-interval) $args]
    }

    proc updateTimeDisplay {this seconds} {
        bltGraph::xAxisUpdate $($this,graph) $seconds
    }

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

}


class dataGraph {

    class element {

        proc element {this path interval args} switched {$args} {
            variable x$this
            variable y$this
            variable weight$this

            set dots [expr {$global::graphNumberOfIntervals+1}]
            blt::vector create x${this}($dots)
            blt::vector create y${this}($dots)
            blt::vector create weight${this}($dots)
            if {[string equal $::tcl_platform(platform) windows]} {
                $path element create $this -label {} -symbol none -xdata x$this -ydata y$this
            } else {
                $path element create $this -label {} -symbol none -xdata x$this -ydata y$this\
                    -weight weight$this -styles {{void 0 0}}
            }
            set ($this,path) $path
            set ($this,interval) $interval
            switched::complete $this
        }

        proc ~element {this} {
            variable x$this
            variable y$this
            variable weight$this

            blt::vector destroy x$this y$this weight$this
            $($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 {} {}]\
            ]
        }

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

        proc set-deletecommand {this value} {}

        proc update {this x y} {
            variable x$this
            variable y$this
            variable weight$this

            if {[set x${this}(end)]==0} {
                if {[string equal $y ?]} return
                set x${this}(end) [expr {$x-$($this,interval)}]
                set y${this}(end) $y
                unset ($this,interval)
            }
            x$this delete 0
            y$this delete 0
            weight$this delete 0
            x$this append $x
            if {[string equal $y ?]} {
                y$this append [set y${this}(end)]
                weight$this append 0
            } else {
                y$this append $y
                weight$this append 1
            }
        }

    }

}

set rcsId {$Id: stagraph.tcl,v 2.17 2001/12/29 00:32:39 jfontain Exp $}


class dataStackedGraph {

    proc dataStackedGraph {this parentPath args} composite {[new frame $parentPath] $args} blt2DViewer {
        $widget::($this,path) [blt::barchart $widget::($this,path).graph\
            -title {} -barmode stack -topmargin 3 -bufferelements 0 -plotborderwidth 1 -plotbackground black -barwidth 0\
        ]
    } {
        set path $widget::($this,path).graph
        $path grid off
        set graph [new bltGraph $path]
        pack $path -side left -fill both -expand 1
        set ($this,graph) $graph
        composite::complete $this
    }

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

    proc iconData {} {
        return {
            R0lGODdhJAAkAKUAAPj8+Hh4eDBgIDBgGHh8eKDocKjweJjgaJDYaIjQYAAAAIDIWHjAWHi4UHCwUHBIAGioSPDYSGCgQOjQSFiYQODISFCQOODESNi8SNC4
            SNCwSMisSMCkSMCcSLiYSBBgeLCQSLDY6ICEgKDQ4LCMSIiQiJjI2KiESJCYkIjA0KCkoIC4yKisqHiwwLi8uGiouMDEwGCgsMjQyNDY0ODk4Ojs6AAAAAAA
            AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACwAAAAAJAAkAAAG/kCAcCgMEI/G4zBZVBKZSijy6RQ0lQLBwHrcbpdFglhQEBAC4jRBYGgbzGm22xyoQ8nlO77A
            L2f3fGYAUgACB4dchYeLjI2LgoQCCJMIf5SXmJmQRWhrCZ+goaKjoQIKYnVEAgusra6vsK4CRpEMtre4ubq4s4NYDcDBwsPEwpuDnQIOy8zNzs/NpqhQCg8Q
            EA/Z2dfc3d7cvYQPEdkR5uYPEurr7O0S4UoPE/P09A8U+Pna9/kUx3ViHlQYSLBgNgsWshl8gNCCtDNQHlyYSLHixGwWKWqDd+QBho8gQ4ocGfIBrXgZUqpc
            ybLlygcEfCELqKGmzZs4c958cAoi8JEHG4IKHUq06FCTMn9yWMq0qdOnTZGK60C1qtWrWK3ClKmgazUPYMOK9fCh7IexZM3y9NozYFkQcOPC/RCibogPcuna
            /aCGgIi/Ij6MGPGBhGHDZQcrJmx2MWG/gEtILvHBhOUPJzJXtsy5s+fLBCaXQEEaxYcUqFOYTc26tWu+pVGomK3iw4rbuHPr3p2bL20VLIKz+NCiuPHjyJMf
            5yuchYvnLj68mE69uvXr1flCdwGjO4wPMcKLH0++/Hi+3mHIWC/DrPv38OOXJcBexoz79/vq38+fAP4ZNAQo4IAEFmjggTUkqOCCDDbo4INBAAA7
        }
    }

    proc options {this} {
        set samples [expr {$global::graphNumberOfIntervals+1}]
        return [list\
            [list -deletecommand {} {}]\
            [list -draggable 0 0]\
            [list -height $global::viewerHeight]\
            [list -interval 5]\
            [list -samples $samples $samples]\
            [list -width $global::viewerWidth]\
        ]
    }

    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} {
        bltGraph::setRange $($this,graph) [expr {($composite::($this,-samples)-1)*$value}]
        bltGraph::updateGraduations $($this,graph)
    }

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

    proc updateTimeDisplay {this seconds} {
        bltGraph::xAxisUpdate $($this,graph) $seconds
    }

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

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

}


class dataStackedGraph {

    class element {

        proc element {this path args} switched {$args} {
            variable x$this
            variable y$this

            blt::vector create x${this}(0)
            blt::vector create y${this}(0)
            $path element create $this -label {} -xdata x$this -ydata y$this
            set ($this,path) $path
            switched::complete $this
        }

        proc ~element {this} {
            variable x$this
            variable y$this

            blt::vector destroy x$this y$this
            $($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 {} {}]\
            ]
        }

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

        proc set-deletecommand {this value} {}

        proc update {this x y} {
            variable x$this
            variable y$this

            set path $($this,path)
            set minimum [$path xaxis cget -min]
            set length [llength [x$this search 0 $minimum]]
            incr length -2
            catch {
                x$this delete :$length
                y$this delete :$length
            }
            set void [string equal $y ?]
            set fill 0
            if {[x$this length]>0} {
                blt::vector create add(0)
                add seq [set x${this}(end)] $x [expr {([$path xaxis cget -max]-$minimum)/[$path extents plotwidth]/2}]
                add delete 0
                if {[add length]<=1} {
                    blt::vector destroy add
                } else {
                    set fill 1
                }
            }
            if {$fill} {
                x$this append add
                blt::vector create limits(0)
                if {$void} {
                    limits append 0 0
                } else {
                    limits append [set y${this}(end)] [expr {abs($y)}]
                }
                limits populate add [expr {[add length]-1}]
                add delete 0
                y$this append add
                blt::vector destroy add limits
            } else {
                x$this append $x
                if {$void} {
                    y$this append 0
                } else {
                    y$this append [expr {abs($y)}]
                }
            }
        }

    }

}

set rcsId {$Id: datapie.tcl,v 2.23 2001/12/29 00:32:39 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 ($this,slices) {}
        viewer::setupDropSite $this $path

        composite::complete $this

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

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

    proc options {this} {
        return [list\
            [list -deletecommand {} {}]\
            [list -draggable 0 0]\
            [list -height 200]\
            [list -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 ($this,drag) [new dragSite -path $widget::($this,path) -validcommand "dataPieChart::validateDrag $this"]
        dragSite::provide $($this,drag) OBJECTS "dataPieChart::dragData $this"
        dragSite::provide $($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 $($this,pie)]
        switch $format {
            OBJECTS {
                if {[llength $slices]>0} {
                    return $slices
                } elseif {[llength $($this,slices)]==0} {
                    return $this
                } else {
                    return {}
                }
            }
            DATACELLS {
                return [cellsFromSlices $this $slices]
            }
        }
    }

    proc validateDrag {this x y} {
        if {[llength $($this,slices)]==0} {
            return 1
        }
        return [expr {[lsearch -exact [slice::selected $($this,pie)] [slice::current $($this,pie)]]>=0}]
    }

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

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

    proc update {this array args} {
        set cells [cellsFromSlices $this $($this,slices)]
        set sum 0.0
        foreach cell $cells {
            if {![info exists $cell]||[string equal [set $cell] ?]} continue
            set sum [expr {$sum+abs([set $cell])}]
        }
        foreach slice $($this,slices) cell $cells {
            if {![info exists $cell]||[string equal [set $cell] ?]||($sum==0)} {
                slice::update $slice 0 ?
            } else {
                if {[info exists ($this,relabel,$slice)]} {
                    viewer::parse $cell array row column type
                    set label [viewer::label $array $row $column]
                    switched::configure $slice -label $label
                    if {[string first ? $label]<0} {
                        unset ($this,relabel,$slice)
                    }
                }
                set value [expr {abs([set $cell])/$sum}]
                slice::update $slice $value "[format %.1f [expr {$value*100}]] %"
            }
        }
    }

    proc deletedSlice {this array slice} {
        viewer::unregisterTrace $this $array
        ldelete ($this,slices) $slice
        unset ($this,cell,$slice)
    }

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

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

    proc setCellColor {this array row column color} {
        set cell ${array}($row,$column)
        foreach slice $($this,slices) {
            if {[string equal $($this,cell,$slice) $cell]} {
                switched::configure $slice -labelbackground $color
                return
            }
        }
    }

}

class dataPieChart {

    class slice {

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

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

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

        proc set-deletecommand {this value} {}

        proc set-label {this value} {
            pie::labelSlice $($this,pie) $($this,slice) $value
        }

        proc set-labelbackground {this value} {
            pie::setSliceLabelBackground $($this,pie) $($this,slice) $value
        }

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

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

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

    }

}

class data2DPieChart {

    proc data2DPieChart {this parentPath args} dataPieChart {
        $parentPath 0 -width $global::viewerWidth -height $global::viewerHeight $args
    } {}

    proc ~data2DPieChart {this} {}

    proc iconData {} {
        return {
            R0lGODdhJAAkAKUAAPj4+Hh4eDBgIHBIAKDwePDYSJjwcOjQQJjocODIQJDgcODIOJDgaODAOIjgaNjAOIjYaNi4MIjYYNCwMIDQYMioKEBIQHjIWBBgeKjQ
            4HjAWKDI2HDAWJjI0HDAUJDA0HC4UIi4yPj8+Gi4UIC4yAAAAGiwUHiwwHh8eGiwSHCouICEgGCoSGiouIiQiGCgsJCYkGiguFiYsKCkoFiYqKisqLi8uMDE
            wMjQyNDY0ODk4Ojs6AAAAAAAAAAAAAAAACwAAAAAJAAkAAAG/kCAcCgMEI/G4zBZVBKZSijy6VxWAVKqFRvoer9dgVgwKIPP4GpSTGgLCvBCebpViw14vODA
            78+bdU4CCISFCHt9iQOAgGiDhoUCCZOUlANoXUoCCpydnQILoaKjl1pHAgypqqsCDa6vsA2LgUMCDre4uQIPvL2+D7ONXgIQxcbHEAIRy8zNy5dptRLT1NUS
            AhPZ2tvZwVICFOHi4+HY3OcTs9/k7BQCFfDx8vHqRWHt5O/z+xUDFl+1LggcSFAgmTIIEyY08q2gwwsYMkicSHEiBoanNGjcyFEDhg0gQ4oUeRGLvQACOKhc
            yZIDhg4wY8qUieGfFyICPOjcuRPD3IefQIMGvYjxFIijSJFiCMG0qVOnF0WY1DSiqtURGEho3cqVK1GpSUqIFSvAhNmzJjCcWMu2bVsMY+OimEtXQIq7eDGo
            2Mu3L18MdAOjWEG48AoBLBKzwNCisePHjgEPNkzYheXLlhEnxvCis+fPnSVjxgyjtGnTYjDEkMG6tWsMkk/LnkG7tu0ZsGno3q0bNt3bt2sIH05cOArYyJHT
            Lc68ho3n0KNHF0xXunXoN7Jr3869u/fvOMKLH0++vPnzOdKrX8++vfv3OuLLn0+/vv37O/Lr38+/v///QQAAOw==
        }
    }

}

class data3DPieChart {

    proc data3DPieChart {this parentPath args} dataPieChart {
        $parentPath 20 -width $global::viewerWidth -height $global::viewerHeight $args
    } {}

    proc ~data3DPieChart {this} {}

    proc iconData {} {
        return {
            R0lGODdhJAAkAKUAAPj8+Hh4eDBgIHBIAKD0ePDcSJjwcOjUQJjscODMQJDocODIOJDkaNjAOIjgaNi8MIjcaNC0MIjYYNCwKIDUYMioKIDQYHh8eHjMWBBg
            eKjU4HjIWJjM2EBIQHjEWJDE0HDAUIjAyHC8UIC4yDh8KGi4UHi0wDB4kGi0SHCsuGCwSGiouGCoSGCsSGCgsAAAAFiYqICEgIiQiJCYkKCkoKisqLi8uMDE
            wMjQyNDY0ODk4Ojs6AAAAAAAAAAAAAAAACwAAAAAJAAkAAAG/kCAcCgMEI/G4zBZVBKZSijy6VxWAVKqFRvoer9dgVgwKA/A6G/VOCa4BYV4waxtXsWGvF5w
            6PsPZXaCSgIIhoeGAgmLjIwDWFpoAgqUlZUCC5mam2dpRwIMoaKjAg2mp6gNj1tEAg6vsLEOAg+1tre1q5CfEL2+vxACEcPExcO6SV4CEszNzswCE9LT1NOd
            XkMCFNvc3dsCFeHi4+KrUgIW6err6WRm7/ADF7vZGPb3+PYZGvz9/v0Z5iULs6GgwYMbMnBYyLBhwwwd1AgR4KGixYseMnzYyLFjxwxGzoEYSbIkiAwhUqpc
            uRIkvYkCRMicOTPDiJs4c+bM4HJg7AABJASUGEp0aAYTSJMqTZrhBESJAIAGRUG1KooMKbJq3Zq1qdOQn0iIFaCirNkMK9KqXbvC69eXE8UGZdGibgYXePPq
            deEWpEAhLwK/kDpWDIsMMBIrhsGT54nHTgULvkCZMmG5AhprdgvZaeXPMUKLviyWc+fTAS+IFi2jtWsZYuSSMH36cerXrmfo3q07dunanXlS5s2bhvHjyMfQ
            diqcMvLnNaJLnx79wubGn6lrt8G9u3fvnz9/H9/9hvnz6NOrX88eh/v38OPLn08/h/37+PPr389fh///AAYo4IAE7mDggQgmqOCCDAYBADs=
        }
    }

}

set rcsId {$Id: sumtable.tcl,v 2.22 2001/12/29 00:32:39 jfontain Exp $}


class summaryTable {

    set (nextDataIndex) 0

if {$global::withGUI} {
    proc summaryTable {this parentPath args} composite {[new frame $parentPath] $args} viewer {} {
        composite::complete $this
        constructor $this
    }
} else {
    proc summaryTable {this args} switched {$args} viewer {} {
        switched::complete $this
        constructor $this
    }
}

    proc constructor {this} {
        variable $($this,dataName)

        array set $($this,dataName) {
            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 ($this,nextRow) 0
if {$global::withGUI} {
        set table [new dataTable $widget::($this,path)\
            -data summaryTable::$($this,dataName) -draggable $composite::($this,-draggable)\
            -titlefont $composite::($this,-titlefont) -columnwidths $composite::($this,-columnwidths)\
        ]
        viewer::setupDropSite $this $dataTable::($table,tablePath)
        if {$composite::($this,-draggable)} {
            dragSite::provide $dataTable::($table,drag) OBJECTS "summaryTable::dragData $this"
            dragSite::provide $dataTable::($table,drag) DATACELLS "summaryTable::dragData $this"
        }
        pack $widget::($table,path) -fill both -expand 1
        set ($this,dataTable) $table
}
    }

    proc ~summaryTable {this} {
        variable [set dataName $($this,dataName)]
if {$global::withGUI} {
        variable ${this}cellRow
        foreach {name wish} [array get {} $this,rowLastWish,*] {
            delete $wish
        }
        delete $($this,dataTable)
        catch {unset ${this}cellRow}
}
        incr ${dataName}(updates)
        unset $dataName
        if {[string length $composite::($this,-deletecommand)]>0} {
            uplevel #0 $composite::($this,-deletecommand)
        }

    }

    proc reset {} {
        set (nextDataIndex) 0
    }

if {$global::withGUI} {
        proc iconData {} {
            return {
            R0lGODdhJAAkAOMAAPj8+Hh4eAAAAHh8eNjc2ICEgIiQiJCYkKCkoKisqLi8uMDEwMjQyNDY0ODk4Ojs6CwAAAAAJAAkAAAE/hDIKQO99s5cNeUaiH2aYJ5o
            qqZbFQyDQBDDbN/1jRMmDIMymm43nNUEg84lmCs2h8ckQARA+q7YLBapDLxiAGF4TAjXyOSj9UeRAZLl+BiOLie505JZzj/z93hUa1qEWYEuMExFRotCPT5A
            jItPOlFKbZJOjZZ5S4WfW1IZXol7daZ/joNSEm50f69od6J6Yql+dZyCoLwxtFNfipObPKuYQsPDh0uZUMTLbb2gyyy2uamAKleup3bdb1VZBeMFAqjX3VHk
            4wbtBqvSoe7tB/UHwprKA/b1CP4I+Jzp++cvgcEEASs9G3DQoIKHClZInNgD4sMFGDHGA5URI4OPIyBDihxJsmSDkyhTqlzJsqWDlzBjypxJs+aDmzhz6tzJ
            s2cEADs=
        }
    }
}

    proc options {this} {
if {$global::withGUI} {
        set font $font::(mediumBold)
} else {
        set font {}
}
        return [list\
            [list -columnwidths {} {}]\
            [list -dataindex {}]\
            [list -deletecommand {} {}]\
            [list -draggable 0 0]\
            [list -titlefont $font $font]\
        ]
    }

if {$global::withGUI} {
    proc set-columnwidths {this value} {
        if {![info exists ($this,dataTable)]} return
        composite::configure $($this,dataTable) -columnwidths $value
    }
} else {
    proc set-columnwidths {this value} {}
}

    proc set-dataindex {this value} {
if {$global::withGUI} {
        set complete $composite::($this,complete)
} else {
        set complete $switched::($this,complete)
}
        if {$complete} {
            error {option -dataindex cannot be set dynamically}
        }
        if {[string length $value]>0} {
            if {$value<$(nextDataIndex)} {
                error "specified data index ($value) is lower than internal summary table index"
            }
            set (nextDataIndex) $value
        }
        set ($this,dataName) $(nextDataIndex)data
        incr (nextDataIndex)
    }

    proc set-deletecommand {this value} {}

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

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

    proc monitorCell {this array row column} {
        variable [set dataName $($this,dataName)]
        variable ${this}cellRow

        set cell ${array}($row,$column)
        if {[info exists ${this}cellRow($cell)]} return
        viewer::registerTrace $this $array
        set label [viewer::label $array $row $column]
        set row $($this,nextRow)
        set ${dataName}($row,0) $label
        if {[catch {set $cell} current]} {
            set ${dataName}($row,1) ?
        } else {
            set ${dataName}($row,1) $current
        }
        array set $dataName [list $row,2 ? $row,3 ? $row,4 ?]
        set ${dataName}($row,updates) 0
        set ${dataName}($row,sum) 0.0
        set ${this}cellRow($cell) $row
if {$global::withGUI} {
        set ($this,rowLastWish,$row) [new lastWish "summaryTable::deleteRow $this $cell"]
}
        incr ($this,nextRow)
        if {[string first ? $label]>=0} {
            set ($this,relabel,$row) {}
        }
        set ${dataName}(updates) 0
    }

    proc update {this array args} {
        variable [set dataName $($this,dataName)]
        variable ${this}cellRow

        foreach {cell row} [array get ${this}cellRow] {
            if {[string first $array $cell]<0} continue
            if {[catch {set $cell} current]||[string equal $current ?]} {
                set ${dataName}($row,1) ?
            } else {
                if {[info exists ($this,relabel,$row)]} {
                    viewer::parse $cell array cellRow cellColumn type
                    set label [viewer::label $array $cellRow $cellColumn]
                    set ${dataName}($row,0) $label
                    if {[string first ? $label]<0} {
                        unset ($this,relabel,$row)
                    }
                }
                set ${dataName}($row,1) $current
                set sum [expr {[set ${dataName}($row,sum)]+$current}]
                set ${dataName}($row,2) [format %.2f [expr {$sum/[incr ${dataName}($row,updates)]}]]
                set value [set ${dataName}($row,3)]
                if {[string equal $value ?]||($current<$value)} {
                    set ${dataName}($row,3) $current
                }
                set value [set ${dataName}($row,4)]
                if {[string equal $value ?]||($current>$value)} {
                    set ${dataName}($row,4) $current
                }
                set ${dataName}($row,sum) $sum
            }
        }
        incr ${dataName}(updates)
    }

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

        return [array names ${this}cellRow]
    }

if {$global::withGUI} {
    proc dragData {this format} {
        variable ${this}cellRow

        switch $format {
            OBJECTS {
                foreach cell [dataTable::dragData $($this,dataTable) $format] {
                    regexp {\(([^,]+)} $cell dummy row
                    set selected($row) {}
                }
                set lastWishes {}
                foreach row [array names selected] {
                    lappend lastWishes $($this,rowLastWish,$row)
                }
                if {[llength $lastWishes]==0} {
                    return $this
                } else {
                    return $lastWishes
                }
            }
            DATACELLS {
                foreach {cell row} [array get ${this}cellRow] {
                    set original($row) $cell
                }
                set cells {}
                foreach cell [dataTable::dragData $($this,dataTable) DATACELLS] {
                    viewer::parse $cell array row column type
                    if {$column==1} {
                        lappend cells $original($row)
                    } else {
                        lappend cells $cell
                    }
                }
                return $cells
            }
        }
    }
}

    proc deleteRow {this cell} {
        variable [set dataName $($this,dataName)]
        variable ${this}cellRow

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

    proc initializationConfiguration {this} {
        scan $($this,dataName) %u index
        set list [list -dataindex $index]
        foreach {option value} [dataTable::initializationConfiguration $($this,dataTable)] {
            if {[string equal $option -columnwidths]} {
                lappend list -columnwidths $value
                break
            }
        }
        return $list
    }

if {$global::withGUI} {
    proc setCellColor {this array row column color} {
        variable [set dataName $($this,dataName)]
        variable ${this}cellRow

        set source ${array}($row,$column)
        foreach {cell row} [array get ${this}cellRow] {
            if {[string equal $cell $source]} {
                dataTable::setCellColor $($this,dataTable) $row 1 $color
                return
            }
        }
    }
} else {
    proc setCellColor {this array row column color} {}
}

}

set rcsId {$Id: freetext.tcl,v 2.19 2001/12/29 00:32:39 jfontain Exp $}


class freeText {

    proc freeText {this parentPath args} composite {
        [new text $parentPath -font $font::(mediumNormal) -wrap word -borderwidth 0 -highlightthickness 0] $args
    } viewer {} {
        viewer::setupDropSite $this $widget::($this,path)
        set ($this,labels) {}
        composite::complete $this
    }

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

    proc iconData {} {
        return {
            R0lGODdhJAAkAIQAAPj8+Hh4eHh8eAAAANjc2Dg4OJicmICEgIiQiJCYkKCkoKisqLi8uMDEwMjQyNDY0ODk4Ojs6AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
            AAAAAAAAAAAAAAAAAAAAAAAAACwAAAAAJAAkAAAF/iAgjmJAnuY5pqVKsiqMvu4o1MBd6y0QBIKgcEgsGoU/mQ3HUzWVpOZJGqWpBtisdsvd9n7CAWFMLpvP
            5MFQJka73QMRFdB+29NyV/1uH5hSYEF7fHAFQyeDZViEfj56b1gGfI1QdVpjkYuYWWl/JUNtkQaLnKQDBqOhhkFsZKgEmaeps2OvlI+bWbSxkoqeV5uovLCn
            kWa3PqDBxKliw5oDqwKtucS8klq2v4hlqJLe370E4JjbJImEx79c6X1bROjtmEQH9fXx8mr2Bwj9/fjt1PhDkKBgwS4IE2IRYDCBgocQj0iUCFHBgosYM2rc
            yLEjg48gQ4ocSbJkg5MoK1OqXMmypYOXMGPKnEmz5oObOHPq3MmzJ4SfQIMKHUq0aISjSJMqXcq0aQgAOw==
        }
    }

    proc options {this} {
        return [list\
            [list -cellindices {} {}]\
            [list -deletecommand {} {}]\
            [list -draggable 0 0]\
            [list -endtext {} {}]\
            [list -height 1]\
            [list -width 40]\
        ]
    }

    proc set-cellindices {this value} {
        if {$composite::($this,complete)} {
            error {option -cellindices cannot be set dynamically}
        }
        set ($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 ($this,drag) [new dragSite -path $widget::($this,path) -validcommand "freeText::validateDrag $this 0"]
        dragSite::provide $($this,drag) OBJECTS "freeText::dragData $this"
        set ($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 $($this,selector)]
                if {[llength $list]>0} {
                    return $list
                } elseif {[empty $this]} {
                    return $this
                } else {
                    return {}
                }
            }
            DATACELLS {
                return [cellsFromLabels $this [selector::selected $($this,selector)]]
            }
        }
    }

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

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

    proc monitorCell {this array row column} {
        viewer::registerTrace $this $array
        set path $widget::($this,path)
        if {[info exists ($this,nextCellIndex)]} {
            set index [lindex $composite::($this,-cellindices) $($this,nextCellIndex)]
            if {[string length $index]==0} {
                unset ($this,nextCellIndex)
                set index insert
            } else {
                incr ($this,nextCellIndex)
            }
        } else {
            set index insert
            $path insert $index "[viewer::label $array $row $column]: "
        }
        set label [new label $path]
        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 ($this,drag,$label) $drag
            set selector $($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 ($this,labels) $label
        $path window create $index -window $labelPath
        set ($this,cell,$label) ${array}($row,$column)
    }

    proc update {this array args} {
        foreach label $($this,labels) {
            set cell $($this,cell,$label)
            if {[string first $array $cell]<0} continue
            if {[info exists $cell]} {
                switched::configure $label -text [set $cell]
            } else {
                switched::configure $label -text ?
            }
        }
    }

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

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

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

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

    proc extendSelection {this endLabel} {
        set selector $($this,selector)
        if {[info exists selector::($selector,lastSelected)]} {
            foreach label $($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 $($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 [string trimright $text]
        foreach {key path index} [$widget::($this,path) dump -window 1.0 end] {
            if {[string length $path]==0} continue
            set position($path) $index
        }
        if {[info exists position]} {
            foreach label $($this,labels) {
                lappend indices $position($label::($label,path))
            }
            lappend options -cellindices $indices
        }
        return $options
    }

    proc setCellColor {this array row column color} {
        set cell ${array}($row,$column)
        foreach label $($this,labels) {
            if {[string equal $($this,cell,$label) $cell]} {
                switched::configure $label -background $color
            }
        }
    }

}

class freeText {

    class label {

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

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

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

        proc set-background {this value} {
            if {[string length $value]==0} {
                $($this,path) configure -background $widget::option(label,background)
            } else {
                $($this,path) configure -background $value
            }
        }

        proc set-deletecommand {this value} {}

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

        proc select {this select} {
            if {$select} {
                $($this,path) configure -relief sunken
            } else {
                $($this,path) configure -relief flat
            }
        }

    }

}

set rcsId {$Id: drag.tcl,v 2.8 2002/01/19 11:54:12 jfontain Exp $}

class dragSite {

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

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

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

        unset ${this}provider
        if {[string length $switched::($this,-path)]>0} {
            delete $($this,bindings)
            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 ($this,bindings) [new bindings $value end]
        bindings::set $($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 $($this,bindings) <Button1-Motion> {}
        set command $switched::($this,-validcommand)
        if {([string length $command]>0)&&![uplevel #0 $command $xWidget $yWidget]} return
        set (x) $xWidget
        set (y) $yWidget
        set (X) $xRoot
        set (Y) $yRoot
        bindings::set $($this,bindings) <Button1-Motion> "dragSite::start $this %X %Y"
    }

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

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

        grab $(grabber)
        update idletasks

        set (highlightFrame) [new toplevel . -background {} -highlightthickness 1 -highlightbackground black]
        wm withdraw $widget::($(highlightFrame),path)
        wm overrideredirect $widget::($(highlightFrame),path) 1
        set (dropRegions) [dropSite::regions [array names ${this}provider]]
        set (lastSite) 0
        bind $(grabber) <ButtonRelease-1> "dragSite::drop $this %X %Y"
        bind $(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 $(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==$(lastSite)} {
            return
        } elseif {($site==0)||[string equal $switched::($site,-path) $switched::($this,-path)]} {
            wm withdraw $widget::($(highlightFrame),path)
        } else {
            set frame $widget::($(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 (lastSite) $site
    }

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

        bind $(grabber) <ButtonRelease-1> {}
        bind $(grabber) <Button1-Motion> {}
        grab release $(grabber)
        update idletasks

        delete $(highlightFrame)
        unset (lastSite)

        set site [dropSite $xRoot $yRoot]
        unset (dropRegions)
        if {($site==0)||[string equal $switched::($site,-path) $switched::($this,-path)]} {
            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 (x) (y) (X) (Y)
        dropSite::dropped $site
        unset data
    }
}

set rcsId {$Id: drop.tcl,v 2.7 2001/12/29 00:32:39 jfontain Exp $}

class dropSite {
    set (list) {}

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

    proc ~dropSite {this} {
        set index [lsearch -exact $(list) $this]
        set (list) [lreplace $(list) $index $index]
        if {[string length $switched::($this,-path)]>0} {
            delete $($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 ($this,bindings) [new bindings $value end]
        set ($this,visible) 1
        bindings::set $($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 $(list) {
            if {[catch {winfo viewable $switched::($site,-path)} viewable]} continue
            if {!$viewable||!$($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: menuhelp.tcl,v 2.6 2001/12/29 00:32:39 jfontain Exp $}

class menuContextHelp {

    proc menuContextHelp {this menu} {
        if {[info exists ::tk::Priv]} {
            bind $menu <<MenuSelect>> "menuContextHelp::selected $this \$::tk::Priv(activeItem)"
        } else {
            bind $menu <<MenuSelect>> "menuContextHelp::selected $this \$::tkPriv(activeItem)"
        }
        ::set ($this,active) -1
        ::set ($this,menu) $menu
    }

    proc ~menuContextHelp {this} {
        variable ${this}string

        bind $($this,menu) <<MenuSelect>> {}
        catch {unset ${this}string}
    }

    proc set {this item string} {
        variable ${this}string

        ::set ${this}string($item) $string
    }

    proc selected {this item} {
        variable ${this}string

        if {[string equal $item none]} {
            ::set item -1
        }
        if {$item==$($this,active)} return
        lifoLabel::pop $global::messenger
        if {$item>=0} {
            if {[catch {::set ${this}string($item)} string]} {
                lifoLabel::push $global::messenger $item
            } else {
                lifoLabel::push $global::messenger $string
            }
        }
        ::set ($this,active) $item
    }

}

set rcsId {$Id: printcap.tcl,v 2.4 2001/12/29 00:32:39 jfontain Exp $}


namespace eval printerCapability {

    proc parseDatabase {aliasesName defaultName {fileName /etc/printcap}} {
        upvar $aliasesName aliases
        upvar $defaultName default

        if {[catch {set file [open $fileName]}]} return
        set find lp
        catch {set find [string trim $::env(PRINTER)]}
        set new 1
        while {[gets $file line]>=0} {
            set line [string trim $line]
            if {[string match #* $line]} continue
            if {$new} {
                set index 0
                foreach alias [split [string trim $line {:\\}] |] {
                    set alias [string trim $alias]
                    if {$index==0} {
                        set name $alias
                        set aliases($name) {}
                    } else {
                        lappend aliases($name) $alias
                    }
                    if {[string equal $alias $find]} {
                        set default $name
                    }
                    incr index
                }
            }
            set new [expr {![string match {*\\} $line]}]
        }
        close $file
    }

}

set rcsId {$Id: prntview.tcl,v 2.8 2001/12/29 00:32:39 jfontain Exp $}


class printViewer {

    set ::env(DISPLAY) [winfo screen .]
    set (pixelsPerInch) [winfo pixels . 1i]
    set (pixelsPerMillimeter) [expr {$(pixelsPerInch)/25.4}]
    set (margin) 10
    set (offset) 3
    set (pageHeight) 130
    set (pageWidth) 100

    proc printViewer {this parentPath args} composite {[new frame $parentPath -background gray] $args} {
        set path $widget::($this,path)
        set ($this,shadow) [frame $path.shadow -background black]
        set ($this,sheet) [frame $path.sheet -container 1 -background white]
        scan [winfo id $($this,sheet)] 0x%x ($this,id) 
        set ($this,height) [expr {round($(pageHeight)*$(pixelsPerMillimeter))}]
        set ($this,width) [expr {round($(pageWidth)*$(pixelsPerMillimeter))}]
        composite::complete $this
    }

    proc ~printViewer {this} {
        terminateProcess $this
        if {$composite::($this,-deletefile)} {
            file delete $composite::($this,-file)
        }
    }

    proc options {this} {
        return [list\
            [list -deletefile 0 0]\
            [list -file {} {}]\
            [list -pageheight $(pageHeight)]\
            [list -pagewidth $(pageWidth)]\
            [list -zoom 1 1]\
        ]
    }

    proc set-deletefile {this value} {}

    proc set-file {this value} {}

    proc set-pageheight {this value} {
        set ($this,height) [expr {round($value*$(pixelsPerMillimeter))}]
        displaySheet $this
    }
    proc set-pagewidth {this value} {
        set ($this,width) [expr {round($value*$(pixelsPerMillimeter))}]
        displaySheet $this
    }

    proc set-zoom {this value} {}

    proc terminateProcess {this} {
        catch {puts $($this,channel) quit}
        catch {close $($this,channel)}
    }

    proc displaySheet {this} {
        set ratio $composite::($this,-zoom)
        set width [expr {round($($this,width)*$ratio)}]
        set height [expr {round($($this,height)*$ratio)}]
        place $($this,sheet) -x $(margin) -y $(margin) -width $width -height $height
        place $($this,shadow) -x [expr {$(margin)+$(offset)}] -y [expr {$(margin)+$(offset)}] -width $width -height $height
        $widget::($this,path) configure\
            -width [expr {$width+(2*$(margin))+$(offset)}] -height [expr {$height+(2*$(margin))+$(offset)}]
    }

    proc refresh {this} {
        if {[string length $composite::($this,-file)]==0} return
        terminateProcess $this
        displaySheet $this
        set ratio $composite::($this,-zoom)
        set width [expr {round($($this,width)*$ratio)}]
        set height [expr {round($($this,height)*$ratio)}]
        set pixelsPerInch [expr {round($(pixelsPerInch)*$ratio)}]
        set ($this,channel) [open\
            "|gs -q -sDEVICE=x11 -dWindowID=$($this,id) -g${width}x$height -r$pixelsPerInch -dBATCH -dNOPROMPT\
                $composite::($this,-file)"\
            w\
        ]
        fconfigure $($this,channel) -blocking 0
    }

}

set rcsId {$Id: print.tcl,v 2.32 2001/12/29 00:32:39 jfontain Exp $}


namespace eval print {

    variable dotsPerMillimeter [expr {72/25.4}]
    variable helpMessage {Print the window to a printer device or to a file, in Postscript.}
    variable previewerWindow .grabber.printPreviewer


    proc printOrSaveCanvas {} {
        variable printToFile $global::printToFile
        variable printCommand $global::printCommand
        variable fileToPrintTo $global::fileToPrintTo
        variable printOrientation $global::printOrientation
        variable printPalette $global::printPalette
        variable printPaperSize $global::printPaperSize
        variable helpMessage
        variable printer

        set objects {}

        set dialog [new dialogBox .grabber\
            -buttons hoc -default o -title {moodss: Print} -die 0 -x [winfo pointerx .] -y [winfo pointery .]\
            -helpcommand {generalHelpWindow #menus.file.print} -deletecommand {grab release .grabber}\
        ]
        grab .grabber

        lappend objects [linkedHelpWidgetTip $composite::($dialog,help,path)]

        set toplevel $widget::($dialog,path)
        set frame [frame $toplevel.frame]

        set row 0
        message $frame.help -width [winfo screenwidth .] -font $font::(mediumNormal) -justify left -text $helpMessage
        grid $frame.help -pady 5 -row $row -column 0 -columnspan 3

        incr row
        radiobutton $frame.toCommand -variable print::printToFile -value 0
        grid $frame.toCommand -row $row -column 0 -sticky w

        if {[string first %P $printCommand]<0} {
            $frame.toCommand configure -text {with Command:}
            entry $frame.command -textvariable print::printCommand
            grid $frame.command -row $row -column 1 -sticky ew
        } else {
            $frame.toCommand configure -text {to Printer:}
            printerCapability::parseDatabase aliases default
            catch {unset printer}
            catch {set printer [printerFormattedEntry $default $aliases($default)]}
            set entries {}
            foreach name [lsort -dictionary [array names aliases]] {
                lappend entries [printerFormattedEntry $name $aliases($name)]
            }
            set entry [new comboEntry $frame -font $widget::option(entry,font) -list $entries]
            lappend objects $entry
            composite::configure $entry entry -textvariable print::printer
            if {[llength $entries]<=3} {
                composite::configure $entry button -listheight [llength $entries]
            }
            composite::configure $entry button scroll -selectmode single
            grid $widget::($entry,path) -row $row -column 1 -sticky ew
        }

        set button [button $frame.preview -text Preview... -command "wm withdraw $toplevel; print::preview; wm deiconify $toplevel"]
        if {[catch {exec gs --version} version]} {
            $button configure -state disabled
            lappend objects [new widgetTip -path $button -text {could not get gs version}]
        } elseif {[package vcompare $version 5.20]<0} {
            $button configure -state disabled
            lappend objects [new widgetTip -path $button -text {requires gs version above 5.20}]
        }
        grid $button -row $row -column 2 -sticky ew
        incr row
        radiobutton $frame.toFile -variable print::printToFile -value 1 -text {or to File:}
        grid $frame.toFile -row $row -column 0 -sticky w
        entry $frame.file -textvariable print::fileToPrintTo
        grid $frame.file -row $row -column 1 -sticky ew
        button $frame.browse -text Browse... -command "print::inquireFileToPrintTo $frame"
        grid $frame.browse -row $row -column 2 -sticky ew
        if {$printToFile} {
            $frame.toFile invoke
        } else {
            $frame.toCommand invoke
        }

        incr row
        grid [label $frame.orientation -text Orientation:] -row $row -column 0 -sticky w
        set entry [new comboEntry $frame -font $widget::option(entry,font) -list $global::printOrientations -editable 0]
        lappend objects $entry
        composite::configure $entry entry -textvariable print::printOrientation
        composite::configure $entry button -listheight [llength $global::printOrientations]
        composite::configure $entry button scroll -selectmode single
        grid $widget::($entry,path) -row $row -column 1 -columnspan 2 -sticky ew

        incr row
        grid [label $frame.palette -text Palette:] -row $row -column 0 -sticky w
        set entry [new comboEntry $frame -font $widget::option(entry,font) -list $global::printPalettes -editable 0]
        lappend objects $entry
        composite::configure $entry entry -textvariable print::printPalette
        composite::configure $entry button -listheight [llength $global::printPalettes]
        composite::configure $entry button scroll -selectmode single
        grid $widget::($entry,path) -row $row -column 1 -columnspan 2 -sticky ew

        incr row
        grid [label $frame.size -text {Paper size:}] -row $row -column 0 -sticky w
        set entry [new comboEntry $frame -font $widget::option(entry,font) -list $global::printPaperSizes -editable 0]
        lappend objects $entry
        composite::configure $entry entry -textvariable print::printPaperSize
        composite::configure $entry button -listheight [llength $global::printPaperSizes]
        composite::configure $entry button scroll -selectmode single
        grid $widget::($entry,path) -row $row -column 1 -columnspan 2 -sticky ew

        dialogBox::display $dialog $frame
        widget::configure $dialog -command "delete $dialog; print::updateGlobals; update; print::print"

        bind $frame <Destroy> "print::cleanup $objects"
    }

    proc printerFormattedEntry {name aliases} {
        set string $name
        set first 1
        foreach alias $aliases {
            if {$first} {
                append string { (}
                set first 0
            } else {
                append string {, }
            }
            append string $alias
        }
        if {!$first} {
            append string )
        }
        return $string
    }

    proc cleanup {args} {
        variable previewerWindow

        catch {destroy $previewerWindow}
        eval delete $args
    }

    proc inquireFileToPrintTo {parentPath} {
        set file [tk_getSaveFile\
            -title {moodss: Print to file} -parent $parentPath -initialdir [file dirname $print::fileToPrintTo]\
            -defaultextension .ps -filetypes {{Postscript .ps} {{All files} *}} -initialfile $print::fileToPrintTo\
        ]
        if {[string length $file]>0} {
            set print::fileToPrintTo $file
        }
    }

    proc updateGlobals {} {
        variable printToFile
        variable printCommand
        variable fileToPrintTo
        variable printOrientation
        variable printPalette
        variable printPaperSize

        set global::printToFile $printToFile
        set global::printCommand $printCommand
        set global::fileToPrintTo $fileToPrintTo
        set global::printOrientation $printOrientation
        set global::printPalette $printPalette
        set global::printPaperSize $printPaperSize
    }

    proc canvasPrintArea {} {
        set canvas $global::canvas
        foreach {left top right bottom} [$canvas cget -scrollregion] {}
        set width [expr {$right-$left}]
        set height [expr {$bottom-$top}]
        foreach {minimum maximum} [$canvas xview] {}
        set left [expr {$left+($minimum*$width)}]
        foreach {minimum maximum} [$canvas yview] {}
        set top [expr {$top+($minimum*$height)}]
        scan [winfo geometry $canvas] %ux%u width height
        set right [expr {$left+$width}]
        set bottom [expr {$top+$height}]
        set box [$canvas bbox all]
        if {[llength $box]>0} {
            foreach {boundsLeft boundsTop boundsRight boundsBottom} [$canvas bbox all] {}
            if {$boundsLeft>$left} {set left $boundsLeft}
            if {$boundsRight<$right} {set right $boundsRight}
            if {$boundsTop>$top} {set top $boundsTop}
            if {$boundsBottom<$bottom} {set bottom $boundsBottom}
        }
        return [list $left $top [expr {$right-$left}] [expr {$bottom-$top}]]
    }

    proc postscriptOptions {{gsOutput 0} {pageWidthName {}} {pageHeightName {}}} {
        variable printOrientation
        variable printPaperSize
        variable printPalette
        variable dotsPerMillimeter
        if {[string length $pageWidthName]>0} {
            upvar $pageWidthName pageWidth
        }
        if {[string length $pageHeightName]>0} {
            upvar $pageHeightName pageHeight
        }

        update
        foreach {left top width height} [canvasPrintArea] {}

        set inch 25.4
        set margin [expr {$inch/2}]
        switch -glob $printPaperSize {
            A3* {
                set pageWidth 297
                set pageHeight 420
            }
            A4* {
                set pageWidth 210
                set pageHeight 297
            }
            executive* {
                set pageWidth [expr {7.5*$inch}]
                set pageHeight [expr {10*$inch}]
            }
            legal* {
                set pageWidth [expr {8.5*$inch}]
                set pageHeight [expr {14*$inch}]
            }
            default {
                set pageWidth [expr {8.5*$inch}]
                set pageHeight [expr {11*$inch}]
            }
        }
        set pageX ${margin}m
        set rotate [string equal $printOrientation landscape]
        if {$rotate} {
            set pageY ${margin}m
        } else {
            set pageY [expr {$pageHeight-$margin}]m
        }
        if {$rotate} {
            set value $pageWidth
            set pageWidth $pageHeight
            set pageHeight $value
            unset value
            if {$gsOutput} {
                set pageY [expr {$pageHeight-$margin}]m
            }
        }
        set printWidth [expr {($pageWidth-(2*$margin))*$dotsPerMillimeter}]
        set printHeight [expr {($pageHeight-(2*$margin))*$dotsPerMillimeter}]
        set ratio 1
        if {$printWidth<$width} {
            set ratio [expr {$printWidth/$width}]
        }
        if {($printHeight<$height)&&(($printHeight/$height)<$ratio)} {
            set ratio [expr {$printHeight/$height}]
        }
        if {$gsOutput} {
            set rotate 0
        }
        set options [list\
            -colormode $printPalette -rotate $rotate -x $left -y $top -width $width -height $height\
            -pageanchor nw -pagex $pageX -pagey $pageY\
        ]
        if {$ratio<1} {
            lappend options -pagewidth [expr {$ratio*$width}] -pageheight [expr {$ratio*$height}]
        }
        return $options
    }

    proc print {} {
        variable printToFile
        variable fileToPrintTo
        variable printCommand
        variable printer

        blt::busy hold .
        set options [postscriptOptions]
        if {$printToFile} {
            lifoLabel::push $global::messenger "printing to file $fileToPrintTo..."
        } else {
            lifoLabel::push $global::messenger printing...
        }
        update idletasks
        if {$printToFile} {
            lappend options -file $fileToPrintTo
            eval $global::canvas postscript $options
        } else {
            set data [eval $global::canvas postscript $options]
            if {[string first %P $printCommand]<0} {
                set command $printCommand
            } else {
                regsub -all %P $printCommand [scan $printer %s] command
            }
            if {[catch {set channel [open |$command w]} message]} {
                tk_messageBox -title {moodss: Error when printing} -type ok -icon error -message $message
            } else {
                puts -nonewline $channel $data
                close $channel
            }
        }
        lifoLabel::pop $global::messenger
        blt::busy forget .
    }

    proc preview {} {
        variable previewerWindow
        variable viewer
        variable zoomRatio

        if {![winfo exists $previewerWindow]} {
            toplevel $previewerWindow
            wm resizable $previewerWindow 0 0
            wm group $previewerWindow .
            wm title $previewerWindow {moodss: Print preview...}
            set viewer [new printViewer $previewerWindow -deletefile 1]

            set menu [menu $previewerWindow.menu -tearoff 0]
            $previewerWindow configure -menu $menu
            menu $menu.zoom -tearoff 0
            $menu add cascade -label Zoom -menu $menu.zoom -underline 0
            set zoomRatio 100%
            foreach {label value} {10 0.1 25 0.25 50 0.5 75 0.75 100 1 200 2 500 5} {
                $menu.zoom add radiobutton -label $label% -variable ::print::zoomRatio\
                    -command "composite::configure $viewer -zoom $value; printViewer::refresh $viewer"
            }
            $menu.zoom add command -label Close -underline 0 -command "destroy $previewerWindow"

            frame $previewerWindow.bound
            bind $previewerWindow.bound <Destroy> "delete $viewer"
            pack $widget::($viewer,path)
        }
        lower $previewerWindow
        blt::busy hold .
        lifoLabel::push $global::messenger "previewing with gs..."
        update idletasks
        set options [postscriptOptions 1 width height]
        lappend options -file [set file [temporaryFileName]]
        eval $global::canvas postscript $options
        wm deiconify $previewerWindow
        raise $previewerWindow
        composite::configure $viewer -file $file -pagewidth $width -pageheight $height
        printViewer::refresh $viewer
        lifoLabel::pop $global::messenger
        blt::busy forget .
    }

    proc createTemporaryCanvasShot {} {
        update idletasks
        foreach {left top width height} [canvasPrintArea] {}
        set file [temporaryFileName png]
        set channel [open\
            "|gs -q -dBATCH -dNOPROMPT -sDEVICE=png256 -g${width}x${height} -r$printViewer::(pixelsPerInch) -sOutputFile=$file -"\
            w\
        ]
        $global::canvas postscript -colormode color -x 0 -y 0 -width $width -height $height -pageanchor sw -pagex 0 -pagey 0\
            -channel $channel
        close $channel
        return $file
    }

}
set rcsId {$Id: scroller.tcl,v 2.2 2000/11/01 12:01:09 jfontain Exp $}


class scroller {

    proc scroller {this parentPath args} composite {[new scroll canvas $parentPath] $args} {
        set ($this,canvasPath) $composite::($composite::($this,base),scrolled,path)
        composite::complete $this
    }

    proc ~scroller {this} {}

    proc options {this} {
        return [list\
            [list\
                -scrollbarelementborderwidth\
                $widget::option(scrollbar,elementborderwidth) $widget::option(scrollbar,elementborderwidth)\
            ]\
            [list -height 0 0]\
            [list -width 0 0]\
            [list -xscrollincrement $widget::option(canvas,xscrollincrement) $widget::option(canvas,xscrollincrement)]\
            [list -yscrollincrement $widget::option(canvas,yscrollincrement) $widget::option(canvas,yscrollincrement)]\
        ]
    }

    proc display {this path} {
        if {[string length $path]==0} {
            $($this,canvasPath) delete all
            bind $($this,displayed) <Configure> {}
            catch {unset ($this,displayed)}
            return
        }
        if {[info exists ($this,displayed)]} {
            error "scroller \"$this\" already displays widget \"$($this,displayed)\""
        }
        if {![string equal $widget::($this,path) [winfo parent $path]]} {
            error "displayed widget \"$path\" must be a child of scroller \"$this\" path"
        }
        set ($this,displayed) $path
        set canvas $($this,canvasPath)
        raise $path $canvas
        $canvas create window 0 0 -window $path -anchor nw
        bind $path <Configure> "$canvas configure -width %w -height %h -scrollregion {0 0 %w %h}"
    }

    foreach option {-scrollbarelementborderwidth -height -width} {
        proc set$option {this value} "composite::configure \$composite::(\$this,base) $option \$value"
    }

    proc set-xscrollincrement {this value} {
        $($this,canvasPath) configure -xscrollincrement $value
    }

    proc set-yscrollincrement {this value} {
        $($this,canvasPath) configure -yscrollincrement $value
    }

}

set rcsId {$Id: modgui.tcl,v 2.24 2001/12/29 00:32:39 jfontain Exp $}


class moduleOperations {

    proc moduleOperations {this action} {
        if {[info exists (displayed)]} {
            delete $($(displayed),dialog)
        }
        set (displayed) $this
        set dialog [new dialogBox .\
            -buttons hx -default x -helpcommand "moduleOperations::help $this" -x [winfo pointerx .] -y [winfo pointery .]\
            -grab release -deletecommand "delete $this"\
        ]
        wm geometry $widget::($dialog,path) 400x200
        composite::configure $dialog help -state disabled
        set frame [frame $widget::($dialog,path).frame]

        set ($this,label) [label $frame.label -font $font::(mediumNormal)]
        grid $($this,label) -row 0 -column 0 -sticky nw -columnspan 2
        set list [new scrollList $frame -font $font::(mediumBold) -width 0]
        grid $widget::($list,path) -row 1 -column 0 -sticky nws

        set entries [frame $frame.entries]
        set container [table $entries.container\
            -colstretchmode last -rows 0 -cols 2 -highlightthickness 0 -takefocus 0 -borderwidth 0 -cursor {} -bordercursor {}\
            -padx 1 -pady 1 -state disabled -exportselection 0\
        ]
        $container tag configure sel -background {}
        set scroll [scrollbar $entries.scroll -orient vertical -highlightthickness 0]
        $container configure -yscrollcommand "moduleOperations::updateScrollBar $scroll"
        $scroll configure -command "$container yview"
        grid rowconfigure $entries 0 -weight 1
        grid columnconfigure $entries 0 -weight 1
        grid $container -row 0 -column 0 -sticky nsew
        set ($this,container) $container

        grid rowconfigure $frame 1 -weight 1
        grid columnconfigure $frame 1 -weight 1
        grid $entries -row 1 -column 1 -columnspan 2 -sticky nsew

        dialogBox::display $dialog $frame
        set ($this,dialog) $dialog
        set ($this,frame) $frame
        set ($this,list) $list
        set ($this,action) $action
        switch $action {
            display {
                composite::configure $dialog -title {moodss: Loaded modules}
                loaded $this
            }
            load {
                composite::configure $dialog -otheractions [list Load "moduleOperations::load $this"]
                composite::configure $dialog -title {moodss: Load modules}
                discover $this
            }
            manage {
                composite::configure $dialog -otheractions [list Unload "moduleOperations::unload $this"]
                composite::configure $dialog -title {moodss: Manage modules}
                loaded $this
            }
            default error
        }
        set ($this,module) {}
    }

    proc ~moduleOperations {this} {
        delete $($this,list)
        unset (displayed)
    }

    proc discover {this} {
        if {![info exists (discoveredModules)]} {
            $($this,label) configure -text {Searching for modules... Found:}
            $($this,frame) configure -cursor watch
            update idletasks
            modules::available "
                lappend moduleOperations::(discoveredModules) %M
                set moduleOperations::(%M,discoveredSwitches) %S
                scrollList::insert $($this,list) 0 %M
                update idletasks
            "
            $($this,frame) configure -cursor {}
        }
        if {[info exists (discoveredModules)]} {
            $($this,label) configure -text {Select available module:}
            update idletasks
            set modules [lsort -dictionary $(discoveredModules)]
            foreach module $modules {
                foreach {option argument} [set ($module,switches) $($module,discoveredSwitches)] {
                    if {$argument} {
                        set ($this,$module,$option) {}
                    } else {
                        set ($this,$module,$option) 0
                    }
                }
            }
            composite::configure $($this,list) -list $modules
            bind $composite::($($this,list),listbox,path) <<ListboxSelect>> "moduleOperations::selection $this"
        } else {
            $($this,label) configure -text {Found no modules:}
        }
    }

    proc selection {this} {
        set index [lindex [scrollList::curselection $($this,list)] 0]
        if {[string length $index]==0} return
        set module [scrollList::get $($this,list) $index]
        if {[string equal $module $($this,module)]} return
        composite::configure $($this,dialog) help -state normal
        set table $($this,container)
        if {[string equal $($this,action) load]} {
            set state normal
        } else {
            set state disabled
        }
        cleanOptions $this
        set row 0
        $table configure -rows [expr {[llength $($module,switches)]/2}]
        set width 0
        foreach {option argument} $($module,switches) {
            set label [label $table.$row,0 -font $font::(mediumBold) -text $option]
            $table window configure $row,0 -window $label
            if {[winfo reqwidth $label]>$width} {
                set width [winfo reqwidth $label]
            }
            if {$argument} {
                set path [entry $table.$row,1\
                    -font $font::(mediumNormal) -width 0 -textvariable moduleOperations::($this,$module,$option) -state $state\
                ]
                $table window configure $row,1 -window $path -sticky ew
            } else {
                set path [checkbutton $table.$row,1 -variable moduleOperations::($this,$module,$option) -state $state]
                $table window configure $row,1 -window $path -sticky w
            }
            incr row
        }
        if {$row==0} {
            set label [label $table.$row,0 -font $font::(mediumItalic) -text {no options}]
            $table window configure $row,0 -window $label
            $table window configure $row,1 -window [label $table.$row,1] -sticky ew
            set width [winfo reqwidth $label]
        }
        $table width 0 -$width
        set ($this,module) $module
    }

    proc load {this} {
        set module $($this,module)
        if {[string length $module]==0} return
        set string $module
        foreach {option argument} $($module,switches) {
            if {$argument} {
                if {[string length $($this,$module,$option)]>0} {
                    append string " $option [list $($this,$module,$option)]"
                }
            } else {
                if {$($this,$module,$option)} {
                    append string " $option"
                }
            }
        }
        if {[catch {dynamicallyLoadModules $string} message]} {
            tk_messageBox -title {moodss: Error loading module} -type ok -icon error -message $message
        }
    }

    proc loaded {this} {
        $($this,label) configure -text {Select loaded module:}
        cleanOptions $this
        foreach {namespace options} [modules::loaded] {
            lappend namespaces $namespace
            set switches {}
            foreach {switch argument value} $options {
                lappend switches $switch $argument
                set ($this,$namespace,$switch) $value
            }
            set ($namespace,switches) $switches
        }
        if {[info exists namespaces]} {
            composite::configure $($this,list) -list $namespaces
            bind $composite::($($this,list),listbox,path) <<ListboxSelect>> "moduleOperations::selection $this"
        } else {
            error {no loaded modules}
        }
    }

    proc unload {this} {
        if {[string length $($this,module)]==0} return
        dynamicallyUnloadModule $($this,module)
        if {[llength [modules::loaded]]==0} {
            delete $($this,dialog)
        } else {
            loaded $this
        }
    }

    proc help {this} {
        foreach {name index} [modules::decoded $($this,module)] {}
        moduleHelpWindow $name [modules::helpHTMLData $name]
    }

    proc updateScrollBar {widget beginning end} {
        $widget set $beginning $end
        if {($end-$beginning)<1} {
            grid $widget -row 0 -column 1 -sticky ns
        } else {
            grid forget $widget
        }
    }

    proc cleanOptions {this} {
        set table $($this,container)
        foreach cell [$table window names] {
            destroy $table.$cell
        }
    }

}

set readOnly [info exists arguments(-r)]
set global::static [info exists arguments(-S)]

set global::scroll [new scroll canvas .]
set global::canvas $composite::($global::scroll,scrolled,path)
$global::canvas configure -highlightthickness 0 -takefocus 0
trace variable global::canvasHeight w updateCanvasSize
trace variable global::canvasWidth w updateCanvasSize
updateCanvasSize
trace variable global::canvasBackground w updateCanvasBackground
updateCanvasBackground

set global::windowManager [new canvasWindowManager $global::canvas]

if {[info exists ::geometry]} {
    wm geometry . $::geometry
} elseif {[info exists initializer]} {
    foreach {width height} [record::sizes $initializer] {}
    composite::configure $global::scroll -width $width -height $height
} else {
    wm geometry . 450x300
}

image create photo applicationIcon -data [dataGraph::iconData]
if {[string equal $tcl_platform(platform) unix]} {
    wm iconwindow . [toplevel .icon]
    pack [label .icon.image -image applicationIcon]
}

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

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

updateTitle
createMenuWidget . $readOnly [llength $global::pollTimes]


set rcsId {$Id: tablesel.tcl,v 1.9 2001/12/29 00:32:39 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
        }
    }

}

set rcsId {$Id: datatab.tcl,v 2.34 2002/01/19 12:12:39 jfontain Exp $}


class dataTable {

    set (extreme,integer) -2147483648
    set (extreme,real) -1.7976931348623158e308
    set (list) {}
    set (scrollbarBorderWidth) [expr {$widget::option(scrollbar,borderwidth)==0?0:1}]
    set (scrollbarWidth) [expr {2*$widget::option(scrollbar,width)/3}]

    proc dataTable {this parentPath args} composite {
        [new scroll table $parentPath\
            -scrollbarwidth $(scrollbarWidth) -scrollbarelementborderwidth $(scrollbarBorderWidth)\
            -width $global::viewerWidth -height $global::viewerHeight\
        ] $args
    } {
        set path $composite::($composite::($this,base),scrolled,path)
        $path configure -font $font::(mediumNormal) -state disabled -colstretchmode last -variable dataTable::${this}data\
            -resizeborders col -cursor {} -highlightthickness 0 -takefocus 0 -ipadx 2
        $path tag configure sel -background {} -foreground black -borderwidth {2 1 2 1}
        bindtags $path [list $path [winfo toplevel $path] all]
        set ($this,tablePath) $path
        lappend (list) $this
        composite::complete $this

        if {$composite::($this,-resizablecolumns)} {
            $path configure -bordercursor sb_h_double_arrow
            bind $path <ButtonPress-1> "dataTable::buttonPress $this %x %y"
            bind $path <Button1-Motion> "if {\[info exists ::dataTable::($this,borderHit)\]} {%W border dragto %x %y}"
        } else {
            $path configure -bordercursor {}
        }
        set ($this,swap) 0
        if {[string length $composite::($this,-view)]>0} {
            catch {set ($this,swap) [set $composite::($this,-view)(swap)]}
        }
        $path tag configure lastcell -borderwidth 1
        $path tag configure lastcolumn -borderwidth {1 1 1 0}
        $path tag configure lastrow -background {} -borderwidth {1 0 1 1}
        if {$($this,swap)} {
            $path configure -cols 1 -titlecols 1 -colorigin -1
        } else {
            $path configure -rows 1 -titlerows 1 -roworigin -1
        }
        setupDataView $this
        set ($this,dataRows) {}
    }

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

        if {[string length $composite::($this,-data)]>0} {
            setTrace $this 0
        }
        catch {unset ${this}data}
        if {[info exists ($this,arrow)]} {
            eval delete $($this,arrow) $($this,tips)
        }
        if {[info exists ($this,drag)]} {
            delete $($this,drag)
        }
        if {[info exists ($this,selector)]} {
            delete $($this,selector)
        }
        ldelete (list) $this
    }

    proc options {this} {
        return [list\
            [list -columnwidths {} {}]\
            [list -data {} {}]\
            [list -draggable 0 0]\
            [list -leftcolumn 0 0]\
            [list -resizablecolumns 0 0]\
            [list -titlefont $font::(mediumBold) $font::(mediumBold)]\
            [list -toprow 0 0]\
            [list -view {} {}]\
        ]
    }

    proc set-columnwidths {this value} {
        if {$composite::($this,complete)} {
            updateColumnWidths $this
        }
    }

    proc set-titlefont {this value} {
        if {[string length $composite::($this,-data)]==0} return
        set path $($this,tablePath)
        for {set line 0} {$line<[llength $($this,dataColumns)]} {incr line} {
            $path.$line.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 $($this,tablePath)
        set ($this,drag) [new dragSite -path $path -validcommand "dataTable::validateDrag $this"]
        dragSite::provide $($this,drag) DATACELLS "dataTable::dragData $this"

        set ($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 set-leftcolumn {this value} {
        if {$composite::($this,complete)} {
            error {option -leftcolumn cannot be set dynamically}
        }
        set ($this,leftColumn) $value
    }

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

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

    proc buttonRelease {this x y} {
        if {[info exists ($this,borderHit)]} {
            unset ($this,borderHit)
        } else {
            if {$($this,swap)} {
                set number [expr {[$($this,tablePath) cget -cols]-1}]
            } else {
                set number [expr {[$($this,tablePath) cget -rows]-1}]
            }
            if {$number==0} return
            scan [$($this,tablePath) index @$x,$y] %d,%d row column
            if {($row<0)||($column<0)} return
            if {[info exists ($this,selector)]} {
                selector::select $($this,selector) $row,$column
            }
        }
    }

    proc lineSort {this dataColumn} {
        if {$dataColumn==$($this,dataSortColumn)} {
            if {[string equal $($this,sortOrder) increasing]} {
                set ($this,sortOrder) decreasing
            } else {
                set ($this,sortOrder) increasing
            }
        } else {
            set ($this,dataSortColumn) $dataColumn
            set ($this,sortOrder) increasing
        }
        if {[info exists ($this,selector)]} {
            selector::clear $($this,selector)
        }
        update $this
    }

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

        set path $($this,tablePath)
        set cursor [$path cget -cursor]
        $path configure -cursor watch
        ::update idletasks
        set lists {}
        set rows {}
        if {[catch {set dataSortColumn $($this,dataSortColumn)}]} {
            foreach name [array names data *,0] {
                scan $name %u dataRow
                lappend rows $dataRow
            }
            set rows [lsort -integer $rows]
        } else {
            set type $data($dataSortColumn,type)
            if {[regexp {^(integer|real)$} $type]} {
                set extreme $(extreme,$type)
                foreach name [array names data *,$dataSortColumn] {
                    scan $name %u dataRow
                    if {[string equal $data($dataRow,$dataSortColumn) ?]} {
                        lappend lists [list $dataRow $extreme]
                    } else {
                        lappend lists [list $dataRow $data($dataRow,$dataSortColumn)]
                    }
                }
                foreach pair [lsort -$($this,sortOrder) -$type -index 1 $lists] {
                    lappend rows [lindex $pair 0]
                }
            } else {
                foreach name [array names data *,$dataSortColumn] {
                    scan $name %u dataRow
                    lappend lists [list $dataRow $data($dataRow,$dataSortColumn)]
                }
                if {[string equal $type clock]} {
                    set list [lsort -$($this,sortOrder) -index 1 -command compareClocks $lists]
                } else {
                    set list [lsort -$($this,sortOrder) -$type -index 1 $lists]
                }
                foreach pair $list {
                    lappend rows [lindex $pair 0]
                }
            }
        }
        set ($this,dataRows) $rows
        catch {$path tag cell {} [$path tag cell lastcell]}
        if {$($this,swap)} {
            catch {$path tag col {} [$path tag col lastcolumn]}
            foreach {old new} [swap $this $rows] {}
        } else {
            catch {$path tag row {} [$path tag row lastrow]}
            foreach {old new} [copy $this $rows] {}
        }
        if {[info exists ($this,selector)]} {
            set changed 0
            if {[llength $new]>0} {
                selector::add $($this,selector) $new
                set changed 1
            }
            if {[llength $old]>0} {
                selector::remove $($this,selector) $old
                set changed 1
            }
            if {$changed} {
                selector::clear $($this,selector)
            }
        }
        if {[info exists ($this,leftColumn)]} {
            $path xview $($this,leftColumn)
            unset ($this,leftColumn)
        }
        if {[info exists ($this,topRow)]} {
            $path yview $($this,topRow)
            unset ($this,topRow)
        }
        if {!$composite::($this,-resizablecolumns)} {
            adjustTableColumns $path
        }
        drawTableLimits $this
        updateCellsColor $this
        $path configure -cursor $cursor
        ::update idletasks
    }

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

        set path $($this,tablePath)
        set row 0
        set rows {}
        foreach dataRow $dataRows {
            if {![info exists ${this}data($row,dataRow)]} {
                lappend rows $row
            }
            set ${this}data($row,dataRow) $dataRow
            set column 0
            set lines 1
            foreach dataColumn $($this,dataColumns) {
                set count [linesCount [set ${this}data($row,$column) $data($dataRow,$dataColumn)]]
                if {$count>$lines} {
                    set lines $count
                }
                incr column
            }
            $path height $row $lines
            incr row
        }
        $path configure -rows [expr {$row+1}]
        set newCells {}
        set columns [llength $($this,dataColumns)]
        if {[llength $rows]>0} {
            foreach new $rows {
                for {set column 0} {$column<$columns} {incr column} {
                    lappend newCells $new,$column
                }
            }
        }
        set oldCells {}
        set rows {}
        while {[info exists ${this}data($row,dataRow)]} {
            lappend rows $row
            incr row
        }
        if {[llength $rows]>0} {
            foreach old $rows {
                unset ${this}data($old,dataRow)
                for {set column 0} {$column<$columns} {incr column} {
                    lappend oldCells $old,$column
                    unset ${this}data($old,$column)
                }
            }
        }
        return [list $oldCells $newCells]
    }

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

        set numberOfRows [llength $($this,dataColumns)]
        for {set row 0} {$row<$numberOfRows} {incr row} {
            set lines($row) 1
        }
        set path $($this,tablePath)
        set column 0
        set columns {}
        foreach dataRow $dataRows {
            if {![info exists ${this}data($column,dataRow)]} {
                lappend columns $column
            }
            set ${this}data($column,dataRow) $dataRow
            set row 0
            foreach dataColumn $($this,dataColumns) {
                set count [linesCount [set ${this}data($row,$column) $data($dataRow,$dataColumn)]]
                if {$count>$lines($row)} {
                    set lines($row) $count
                }
                incr row
            }
            incr column
        }
        for {set row 0} {$row<$numberOfRows} {incr row} {
            $path height $row $lines($row)
        }
        $path configure -cols [expr {$column+1}]
        set newCells {}
        if {[llength $columns]>0} {
            foreach new $columns {
                for {set row 0} {$row<$numberOfRows} {incr row} {
                    lappend newCells $row,$new
                }
            }
        }
        set oldCells {}
        set columns {}
        while {[info exists ${this}data($column,dataRow)]} {
            lappend columns $column
            incr column
        }
        if {[llength $columns]>0} {
            foreach old $columns {
                unset ${this}data($old,dataRow)
                for {set row 0} {$row<$numberOfRows} {incr row} {
                    lappend oldCells $row,$old
                    unset ${this}data($row,$old)
                }
            }
        }
        return [list $oldCells $newCells]
    }

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

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

    proc validateDrag {this x y} {
        if {[info exists ($this,borderHit)]} {
            return 0
        }
        if {(!$($this,swap)&&([$($this,tablePath) cget -rows]<=1))||($($this,swap)&&([$($this,tablePath) cget -cols]<=1))} {
            return 1
        }
        return [expr {[lsearch -exact [selector::selected $($this,selector)] [$($this,tablePath) index @$x,$y]]>=0}]
    }

    proc setCellsState {this cells select} {
        set path $($this,tablePath)
        if {$select} {
            foreach cell $cells {
                $path selection set $cell
            }
        } else {
            foreach cell $cells {
                $path selection clear $cell
            }
        }
    }

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

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

    proc updateSortingArrow {this line} {
        set path $widget::($($this,arrow),path)
        set label $($this,tablePath).$line.label
        foreach event {<Enter> <Leave> <ButtonRelease-1>} {
            bind $path $event [bind $label $event]
        }
        array set direction {0,0 up 0,1 down 1,0 left 1,1 right}
        widget::configure $($this,arrow) -direction $direction($($this,swap),[string equal $($this,sortOrder) increasing])
        grid $path -in $($this,tablePath).$line -row 0 -column 1
    }

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

        set path $($this,tablePath)
        set font $composite::($this,-titlefont)
        set sortable [info exists ($this,dataSortColumn)]
        set arrowWidth 12
        set line 0
        if {$($this,swap)} {
            $path configure -rows [llength $($this,dataColumns)]
        } else {
            $path configure -cols [llength $($this,dataColumns)]
        }
        foreach dataColumn $($this,dataColumns) {
            set frame [frame $path.$line -cursor left_ptr]
            set label [label $path.$line.label -font $font -text $data($dataColumn,label) -cursor left_ptr -pady 0]
            grid columnconfigure $frame 0 -weight 1
            if {$sortable} {
                grid columnconfigure $frame 1 -minsize $arrowWidth
            }
            grid $label -row 0 -column 0 -sticky nsew
            if {$($this,swap)} {
                set cell $line,-1
            } else {
                set cell -1,$line
            }
            $path window configure $cell -window $frame -padx 2 -pady 1 -sticky nsew
            if {$sortable} {
                bind $frame <ButtonRelease-1> "dataTable::lineSort $this $dataColumn; dataTable::updateSortingArrow $this $line"
                bind $label <ButtonRelease-1> "dataTable::lineSort $this $dataColumn; dataTable::updateSortingArrow $this $line"
                bind $frame <Enter> "lifoLabel::push $global::messenger {click to toggle sorting order}"
                bind $frame <Leave> "lifoLabel::pop $global::messenger"
            }
            lappend ($this,tips) [new widgetTip -path $label -text $data($dataColumn,message)]
            incr line
        }
        updateColumnWidths $this
        if {$sortable} {
            set arrow [new arrowButton $path -state disabled -borderwidth 0 -highlightthickness 0 -width $arrowWidth]
            widget::configure $arrow -disabledforeground [widget::cget $arrow -foreground]
            set path $widget::($arrow,path)
            $path configure -cursor left_ptr
            bind $path <ButtonRelease-1> "dataTable::lineSort $this $dataColumn; dataTable::updateSortingArrow $this $line"
            lappend ($this,tips) [new widgetTip -path $widget::($arrow,path) -text {click to toggle sorting order}]
            set ($this,arrow) $arrow
        }
    }

    proc buttonPress {this x y} {
        foreach {row column} [$($this,tablePath) border mark $x $y] {}
        if {[info exists column]&&([string length $column]>0)&&($column<([$($this,tablePath) cget -cols]-1))} {
            set ($this,borderHit) {}
        }
    }

    proc setupDataView {this} {
        variable ${this}data

        if {[string length $composite::($this,-data)]==0} return
        if {[string length $composite::($this,-view)]>0} {
            upvar #0 $composite::($this,-view) data
        } else {
            upvar #0 $composite::($this,-data) data
        }
        catch {set columns $data(visibleColumns)}
        catch {set columns $data(indices)}
        if {![info exists columns]} {
            set columns {}
            foreach name [array names data *,label] {
                if {[scan $name %u column]>0} {
                    lappend columns $column
                }
            }
        }
        set ($this,dataColumns) [lsort -integer $columns]
        if {[info exists data(sort)]} {
            set ($this,dataSortColumn) [lindex $data(sort) 0]
            if {[lsearch -exact $columns $($this,dataSortColumn)]<0} {
                error "sort column $($this,dataSortColumn) is not visible"
            }
            set ($this,sortOrder) [lindex $data(sort) 1]
        }
        set line 0
        foreach dataColumn $($this,dataColumns) {
            set ${this}data($line,dataColumn) $dataColumn
            if {[info exists ($this,dataSortColumn)]&&($dataColumn==$($this,dataSortColumn))} {
                set sortLineIndex $line
            }
            incr line
        }
        catch {composite::configure $this -swap $data(swap)}
        createTitles $this
        drawTableLimits $this
        if {[info exists sortLineIndex]} {
            updateSortingArrow $this $sortLineIndex
        }
        setupLinesAnchoring $this
        setTrace $this 1
    }

    proc updateColumnWidths {this} {
        if {!$composite::($this,-resizablecolumns)} return
        set path $($this,tablePath)
        if {$($this,swap)} {
            set column -1
        } else {
            set column 0
        }
        foreach width $composite::($this,-columnwidths) {
            $path width $column $width
            if {[incr column]>=[$path cget -cols]} return
        }
    }

    proc initializationConfiguration {this} {
        set path $($this,tablePath)
        if {$($this,swap)} {
            set column -1
        } else {
            set column 0
        }
        for {} {$column<[$path cget -cols]} {incr column} {
            lappend widths [$path width $column]
        }

        if {$composite::($this,-resizablecolumns)} {
            set list [list -columnwidths $widths]
        } else {
            set list {}
        }
        set row [expr {round([lindex [$path yview] 0]*[$path cget -rows])}]
        if {$row!=0} {
            lappend list -toprow $row
        }
        set column [expr {round([lindex [$path xview] 0]*[$path cget -cols])}]
        if {$column!=0} {
            lappend list -leftcolumn $column
        }
        return $list
    }

    proc setTrace {this on} {
        if {$on} {
            set command variable
        } else {
            set command vdelete
        }
        trace $command $composite::($this,-data)(updates) w "dataTable::update $this"
    }

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

        set line -1
        set path $($this,tablePath)
        foreach dataColumn $($this,dataColumns) {
            incr line
            if {[catch {set anchor $data($dataColumn,anchor)}]} continue
            if {![regexp {^(center|left|right)$} $anchor]} {
                error "bad anchor value \"$anchor\": must be center, left or right"
            }
            if {[string equal $anchor center]} continue
            if {![$path tag exists $anchor]} {
                array set convert {left w right e}
                $path tag configure $anchor -anchor $convert($anchor)
            }
            if {$($this,swap)} {
                if {$line==[$path index end row]} {
                    $path tag configure lastrow -anchor $convert($anchor)
                } else {
                    $path tag row $anchor $line
                }
            } else {
                if {$line==[$path index end col]} {
                    $path tag configure lastcolumn -anchor $convert($anchor)
                } else {
                    $path tag col $anchor $line
                }
            }
        }
    }

    proc changeAllCellsColor {array row column color} {
        foreach table $(list) {
            if {[string equal $composite::($table,-data) $array]} {
                setCellColor $table $row $column $color
            }
        }
    }

    proc setCellColor {this dataRow dataColumn color} {
        variable ${this}color

        set row [lsearch -exact $($this,dataRows) $dataRow]
        if {$row<0} return
        set column [lsearch -exact $($this,dataColumns) $dataColumn]
        if {$column<0} return
        if {$($this,swap)} {
            set index $row
            set row $column
            set column $index
        }
        if {[string length $color]==0} {
            $($this,tablePath) tag cell {} $row,$column
            catch {unset ${this}color($dataRow,$dataColumn)}
        } else {
            $($this,tablePath) tag configure color$color -background $color
            $($this,tablePath) tag cell color$color $row,$column
            set ${this}color($dataRow,$dataColumn) $color
        }
    }

    proc updateCellsColor {this} {
        variable ${this}color

        set path $($this,tablePath)
        foreach tag [$path tag names color*] {
            $path tag delete $tag
        }
        foreach {cell color} [array get ${this}color] {
            scan $cell %u,%u dataRow dataColumn
            setCellColor $this $dataRow $dataColumn $color
        }
    }

    proc drawTableLimits {this} {
        set path $($this,tablePath)
        set row [$path index end row]
        set column [$path index end col]
        if {$($this,swap)} {
            $path tag row lastrow [$path index end row]
            if {$column<0} {                                                                                       # no data columns
                $path configure -borderwidth {1 1 1 0}
                $path window configure $row,-1 -borderwidth 1
            } else {
                $path configure -borderwidth {1 0 1 0}
                $path window configure $row,-1 -borderwidth {1 0 1 1}
                $path tag col lastcolumn $column
                $path tag cell lastcell $row,$column
            }
        } else {
            $path tag col lastcolumn [$path index end col]
            if {$row<0} {
                $path configure -borderwidth {1 0 1 1}
                $path window configure -1,$column -borderwidth 1
            } else {
                $path configure -borderwidth {1 0 1 0}
                $path window configure -1,$column -borderwidth {1 1 1 0}
                $path tag row lastrow $row
                $path tag cell lastcell $row,$column
            }
        }
    }

}

set rcsId {$Id: lastwish.tcl,v 2.5 2001/12/29 00:32:39 jfontain Exp $}

class lastWish {

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

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

}




set ::htmlLibraryCode {


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} {
    if {![winfo exists $win]} return
	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 yview 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 {[string equal [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 {[string length $val]==0} {
		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 {[string length $push]==0} {
		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 {[string length $form(submit_button)]==0} {
		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 [string compare [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 {[string length $value]>0} {
			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 {![string equal $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
	}
}

}
set htmlHelpContents {
<html><body>
<ul>
  <li><a href="#about">1. About this document</a>
  <li><a href="#introduction">2. Introduction</a>
  <li><a href="#required">3. Required software</a>
  <li><a href="#architecture">4. Architecture</a>
  <li><a href="#core">5. Core</a><ul>
    <li><a href="#userinterface">5.1. User interface</a><ul>
      <li><a href="#menus">5.1.1. Menus</a><ul>
        <li><a href="#menus.file">5.1.1.1. File</a><ul>
          <li><a href="#menus.file.open">5.1.1.1.1. Open</a>
          <li><a href="#menus.file.save">5.1.1.1.2. Save</a>
          <li><a href="#menus.file.saveas">5.1.1.1.3. Save As</a>
          <li><a href="#menus.file.modules">5.1.1.1.4. Modules</a><ul>
            <li><a href="#menus.file.modules.loaded">5.1.1.1.4.1. Loaded</a>
            <li><a href="#menus.file.modules.load">5.1.1.1.4.2. Load</a>
            <li><a href="#menus.file.modules.unload">5.1.1.1.4.3. Unload</a>
          </ul>
          <li><a href="#menus.file.print">5.1.1.1.5. Print</a>
          <li><a href="#menus.file.exit">5.1.1.1.6. Exit</a>
        </ul>
        <li><a href="#menus.edit">5.1.1.2. Edit</a><ul>
          <li><a href="#menus.edit.thresholds">5.1.1.2.1. Thresholds</a><ul>
            <li><a href="#menus.edit.thresholds.types">5.1.1.2.1.1. Types</a>
            <li><a href="#menus.edit.thresholds.color">5.1.1.2.1.2. Color</a>
            <li><a href="#menus.edit.thresholds.script">5.1.1.2.1.3. Script</a>
            <li><a href="#menus.edit.thresholds.notes">5.1.1.2.1.4. Notes</a>
          </ul>
          <li><a href="#menus.edit.configuration">5.1.1.2.2. Configuration</a>
          <li><a href="#menus.edit.new">5.1.1.2.3. New</a>
          <li><a href="#menus.edit.preferences">5.1.1.2.4. Preferences</a>
        </ul>
        <li><a href="#menus.view">5.1.1.3. View</a><ul>
          <li><a href="#menus.view.refresh">5.1.1.3.1. Refresh</a>
          <li><a href="#menus.view.polltime">5.1.1.3.2. Poll Time</a>
        </ul>
        <li><a href="#menus.help">5.1.1.4. Help</a><ul>
          <li><a href="#menus.help.global">5.1.1.4.1. Global</a>
          <li><a href="#menus.help.modules">5.1.1.4.2. Modules</a>
          <li><a href="#menus.help.sourceversions">5.1.1.4.3. Source Versions</a>
          <li><a href="#menus.help.about">5.1.1.4.4. About</a>
        </ul>
      </ul>
      <li><a href="#draganddrop">5.1.2. Drag and drop</a><ul>
        <li><a href="#dropsites">5.1.2.1. Drop sites</a>
        <li><a href="#dragsites">5.1.2.2. Drag sites</a>
      </ul>
    </ul>
    <li><a href="#commandline">5.2. Command line</a><ul>
      <li><a href="#mainarguments">5.2.1. Main arguments</a>
      <li><a href="#modulearguments">5.2.2. Module arguments</a>
    </ul>
    <li><a href="#core.configuration">5.3. Configuration</a><ul>
      <li><a href="#configuration.canvas">5.3.1. Canvas</a><ul>
        <li><a href="#configuration.canvas.size">5.3.1.1. Size</a>
        <li><a href="#configuration.canvas.colors">5.3.1.2. Colors</a>
      </ul>
      <li><a href="#configuration.viewers">5.3.2. Viewers</a><ul>
        <li><a href="#configuration.viewers.colors">5.3.2.1. Colors</a>
        <li><a href="#configuration.viewers.graphs">5.3.2.2. Graphs</a>
        <li><a href="#configuration.viewers.pies">5.3.2.3. Pies</a>
      </ul>
    </ul>
    <li><a href="#core.preferences">5.4. Preferences</a><ul>
      <li><a href="#preferences.canvas">5.4.1. Canvas</a><ul>
        <li><a href="#preferences.canvas.printing">5.4.1.1. Printing</a>
      </ul>
      <li><a href="#preferences.thresholds">5.5.1. Thresholds</a><ul>
        <li><a href="#preferences.thresholds.email">5.5.1.1. Email</a>
      </ul>
    </ul>
  </ul>
</ul>
<ul>
  <li><a href="#future">8. Future developments</a>
  <li><a href="#misc">9. Miscellaneous information</a>
</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 volume and distribution 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 kind of data. For example, in the case of processes running on a computer system, rows might be sorted according to their unique process identifier, with columns containing values such 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 <i>top</i> 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 visualize network traffic, connection matrices, ...

<p>In most cases, data comes from one or more 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, create views such as other tables, charts, ... best suited to the way data should be presented. Once optimized, the data viewers layout and configuration could be saved for later reuse as a dashboard. In effect, what is needed is a spreadsheet tailored to dynamic data processing.

<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 or while it is running, 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 package (at <a href="http://jfontain.free.fr/">http://jfontain.free.fr/</a>). The module function is to describe the data that it is also in charge of retrieving and formatting. Modules can be written in plain Tcl or use dynamically linked libraries written in the C language (modules are packages in the Tcl sense, so any language that can interface with Tcl is supported).

<p>Modules are loaded when moodss is started or dynamically at a later time. Several modules can be handled concurrently (starting with moodss version 3.0). This way, you may monitor data coming from any number of heterogeneous sources. Modules are specified in the command line or dynamically loaded, and can be unloaded at any time.

<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 (for which no polling is needed as module data may change on its own). Note that any number of asynchronous and regular (synchronous) modules can be simultaneously loaded.

<p>Versions 5.0 and up add a free text viewer, which can be used for comments, and which can also embed live data cells in text form.

<p>Versions 5.3 and up support viewer type mutation through viewer icon drag'n'drop, and viewer quick destruction by a drop into the eraser icon. A new menu for empty viewer creation was also added.

<p>Versions 6.0 and up support command line arguments per module, data table column anchoring in module configuration and automatic module discovery.

<p>Versions 6.1 and up support HTML formatted help data for modules.

<p>Versions 6.6 and up support automatic cross hairs with coordinates in message area for graph data viewers.

<p>Versions 6.7 and up support contextual help (through the main window message area) on all menu items.

<p>Versions 7.0 and up support per user (on UNIX systems) application wide preferences setting.

<p>Versions 7.99 and up support concurrent instances of the same module.

<p>Versions 8.1 and up support configuration settings per dashboard, with a user interface similar to the preferences interface.

<p>Versions 8.6 and up (in the 8 series) add a stacked graph viewer.

<p>Versions 9.0 and up are only compatible with Tcl/Tk versions 8.2 and above.

<p>Versions 9.4 and up add a stacked graph viewer.

<p>Versions 10.0 and up allow printing in postscript to printer or a file.

<p>Versions 10.1 and up allow printing previewing.

<p>Versions 11.0 and up are multilingual with incomplete French language support added.

<p>Versions 11.1 and up allow dynamically loading modules.

<p>Versions 11.3 and up allow dynamically unloading modules.

<p>Versions 11.7 and up allow swapping columns and rows in module data views.

<p>Versions 11.12 and up include a core trace module that allows displaying message from other loaded modules.

<p>Versions 12.0 and up include the ability to set thresholds on data cells.

<p>Versions 12.1 and up include the ability to send email alerts on thresholds.

<p>Versions 12.3 and up include the ability to change source data cells color on thresholds.

<p>Versions 13.0 and up allow modules to be written in the Perl language.

<p>Versions 14.0 and up allow modules to be written in the Python language.

<p>In version 15.0, the moomps (Modular Object Oriented Multi-Purpose Service) daemon was introduced (see <a href="moomps.htm">documentation</a>).

<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 activity and traffic load from a network 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 module structure 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 one table with a single row, with the most complicated requiring loading several multiple table modules.

<p>As moodss is written in Tcl and uses well supported extensions (Tktable and BLT), it will run on Tcl/Tk supported platforms: UNIX and Windows (I do not know if Tktable and BLT are available for the MacIntosh). Obviously, 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.

<h3><a name="required"></a>3. Required software</h3>

If you are using a Linux Redhat system (6.0 or above), then use the moodss rpm file (available at <a href="http://jfontain.free.fr/">http://jfontain.free.fr/</a>) for installation. It requires the tcl, tk, blt and tktable rpms also available at the same location (see INSTALL file for more information). You are then all set for using the included Linux modules or develop your own modules.

<p>For the current version (15.6), 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.3.1 or above (at <a href="http://tcl.sourceforge.net/">http://tcl.sourceforge.net/</a>)
<li>tkTable version 2.7 or above (at <a href="http://tktable.sourceforge.net/">http://tktable.sourceforge.net/</a>)<b>*</b>
<li>the latest BLT library version 2.4u or above (at <a href="ftp://tcltk.sourceforge.net/pub/tcltk/blt/">ftp://tcltk.sourceforge.net/pub/tcltk/blt/</a>)<b>*</b>
</ul>

Additionally, if you need emails to be sent as a result of threshold crossings:

<ul>
<li>tcllib version 1.0 or above (at <a href="http://tcllib.sourceforge.net/">http://tcllib.sourceforge.net/</a>)<b>*</b>
</ul>

<div align=right><b>*</b><i> many thanks to the authors for these great packages</i></div>

<p>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 will find the latest versions:
<ul>
<li>stooop version 4.1 or above
<li>switched version 2.2 or above (included in the stooop distribution)
<li>scwoop version 4.0 or above
<li>tkpiechart version 6.1 or above
</ul>

at <a href="http://jfontain.free.fr/">http://jfontain.free.fr/</a>.

<p>Finally, if you want to develop your own modules in a language other than Tcl, such as Perl or Python, you will need:

<ul>
<li>tclperl library
<li>tclpython or tclpython2 libraries
</ul>

also at <a href="http://jfontain.free.fr/">http://jfontain.free.fr/</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 loads one or more modules, whose names are passed as command line parameters, come from a save file or are dynamically loaded, and starts 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 (on a UNIX machine):

<pre>$ 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 any number of cells can be selected. Data viewers can be created by dragging and dropping cells into a graph, bar chart, pie chart, summary table, free text or thresholds sites. 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. Cells or rows can be removed from existing viewers, by simply selecting them and dropping them in the eraser iconic site (a pencil eraser).

<p>Any viewer can be mutated (its type changed) by dragging from a viewer icon and dropping into it. For example, create a stacked data bar viewer from several cells, then drag the 3D pie icon into it. Any viewer can also be destroyed in one shot by dropping the eraser icon into it.

<p>Any draggable data can be dropped in any valid drop site at any time. It is thus possible to drag several data cells from any table or any viewer into other ones, the thresholds interface, the eraser, ... 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, sizes, poll time, main window size, ...) can be saved in a file at any time, so that an identical dashboard can be relaunched at will.

<h3><a name="core"></a>5. Core</h3>

<h4><a name="userinterface"></a>5.1. User interface</h4>

Immediately after launch, module(s) is(are) loaded and initialized, with corresponding messages displayed in the message area, as follows:

<center><pre><img src="moodss5.gif" alt"moodss window view in load mode"></pre></center>

Soon after, tabular data is displayed in one or more tkTable widgets with the module identifier as title, automatic scroll bars, between the menu bar, the drop sites with graphical viewers, summary table, free text, thresholds and eraser icons and a message area, as one can see below:

<center><pre><img src="moodss1.gif" alt"moodss initial main window view"></pre></center>

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. Contextual help on all menu items is also activated as traversal occurs, either using the mouse or the keyboard, resulting in a short explicative string appearing in the message area and related to the active (highlighted) menu item. Further help is provided through widget tips (also known as balloons) when appropriate (on data table column headers, for example), and of course the Help menu.

<p>The window title shows the name of the loaded module(s) along with the poll time.

<p>When several modules of the same type are loaded (for example, CPU statistics on a group of servers), the initial data tables feature the module name followed by an instance number (<i>module&lt;N></i>), or the module identifier generated from the module code (<i>cpustats(host.domain.org)</i> for example). A lone module keeps his unmodified name as table titles.
<br>Any data displayed in a table can be sorted (provided that the related module allows it) 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 triangular 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 monitoring table cell data 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 <a href="#draganddrop">drag and drop</a> functionality.

<p>For all viewers, if a module identifier string is required (provided by the module, several instances of the same module, ...) for proper cell identification, that string will be placed first in the label. For example, data cells originating from the third instance of the random module would be labeled: "<i>random&lt;3>: data cell label</i>".

<p>Graphical viewers available at this time are BLT graph viewers (see images below), side-by-side bars charts, overlapped bars charts, stacked bars charts, 2D pie charts and 3D pie charts*. Graph viewers feature an automatic cross hair which follows the mouse pointer movements inside the plotting area. Corresponding coordinates are updated in real time in the main window message area.

<p>*<i>Note: if you know of any other nice viewers (like 3D graphs) that work with Tcl, please let me know so I can integrate them. Many thanks in advance...</i>

<center><table cols=2 width="100%">
<tr align=center valign=center>
<td><pre><img src="hgraph.gif" alt="graph viewer sample"></pre></td>
<td><pre><img src="hstackgr.gif" alt="stacked graph viewer sample"></pre></td>
</tr>
<tr align=center valign=center>
<td><pre><img src="hoverbar.gif" alt="overlap bar chart viewer sample"></pre></td>
<td><pre><img src="hsidebar.gif" alt="side bar chart viewer sample"></pre></td>
</tr>
<tr align=center valign=center>
<td><pre><img src="hstackbr.gif" alt="stacked bar chart viewer sample"></pre></td>
<td><pre><img src="h2dpie.gif" alt="2D pie chart viewer sample"></pre></td>
</tr>
<tr align=center valign=center>
<td><pre><img src="h3dpie.gif" alt="3D pie chart viewer sample"></pre></td>
</tr>
</table></center>

There are 2 textual viewers.

<p>The summary table displays for each row the cell label, the current, average, minimum and maximum values since the row was created. Data cells can be inserted one or several at a time through a simple drop. Rows can be deleted by selecting any cell in the row then dropping any number of them into the eraser drop site. Data cells with missing data (could be no longer available if coming from a vanished process, for example) display the ? character.

<p>The free text viewer is an editable Tk 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 eraser 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.

<center><table width="100%">
<tr align=center valign=center>
<td width="58%"><pre><img src="hsumtbl.gif" alt="summary table viewer sample"></pre></td>
<td width="42%"><pre><img src="hfreetxt.gif" alt="free text viewer sample"></pre></td>
</tr>
</table></center>

Here is a screen shot of loaded <i>ps</i> and <i>cpustats</i> modules with several graphical viewers:

<center><pre><img src="moodss3.gif" alt="moodss window with graph data viewers"></pre></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><pre><img src="moodss4.gif" alt"moodss window with free text data viewer"></pre></center>

Dropping cells into the thresholds drop site in the main window, or selecting the edit menu thresholds entry results in the following dialog box being displayed. While displayed, user interaction with other parts of the user interface remains possible, so that more cells can be dropped into the thresholds dialog box table itself.

<center><pre><img src="moodss8.gif" alt"thresholds user interface"></pre></center>

More information on <a href="#menus.edit.thresholds">thresholds</a>.

<h5><a name="menus"></a>5.1.1. Menus</h5>

<h6><a name="menus.file"></a>5.1.1.1. File</h6>

<h6><a name="menus.file.open"></a>5.1.1.1.1. Open</h6>

This menu entry allows the user to open an existing saved configuration file (also useful for editing moomps configuration files) to replace the currently loaded modules and viewers with those described in the file to open.

<p>As in the <a href="#menus.file.exit">exit</a> menu, if there are unsaved changes, the user is given the opportunity to save them to a file before opening the new file.

<p>Note that all existing modules will be unloaded, along with any viewers, prior to loading the configuration from the open file, thus acting as if the open file was directly and initially loaded when moodss was started.

<h6><a name="menus.file.save"></a>5.1.1.1.2. Save</h6>

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 <i>-f (--file)</i> 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>date and time
<li>application window size
<li>poll time
<li>modules
<li>tables positions and sizes
<li>viewers types, positions, sizes and specific data
</ul>

For moodss version 5.1 and above, the following information is also saved:

<ul>
<li>table viewers column widths
</ul>

For moodss version 5.2 and above, the following information is also saved:

<ul>
<li>viewers stacking order (for internal window manager)
</ul>

For moodss version 8.1 and above, the following information is also saved:

<ul>
<li>global configuration (such as canvas color, sizes, ...) (see <i>Edit</i> menu)
</ul>

When using this 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 <i>.moo</i> extension).

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

<h6><a name="menus.file.saveas"></a>5.1.1.1.3. Save As</h6>

This menu behaves as expected, with the user always having to choose a file name using the file selector dialog box (see <i>Save</i> menu above).
<br>This menu may be used at any time to change the current save file name.

<h6><a name="menus.file.modules"></a>5.1.1.1.4. Modules</h6>

<h6><a name="menus.file.modules.loaded"></a>5.1.1.1.4.1. Loaded</h6>

A module can be picked from a list of the currently loaded modules. Eventually, the module current options appear underneath.

<h6><a name="menus.file.modules.load"></a>5.1.1.1.4.2. Load</h6>

You can dynamically load a module by simply selecting its name from the available list discovered when the selection window opens. When the module is selected, its options appear underneath and any number of them can be filled.

<p>Once the new module, or new instance of an already loaded module, is loaded, the application behaves as if the module had been loaded from the start.

<h6><a name="menus.file.modules.unload"></a>5.1.1.1.4.3. Unload</h6>

The module to unload is picked from a list of the currently loaded modules. Once unloaded, the module data tables disappear, but the viewers containing cells pointing to the module data remain, simply showing that the data is now invalid.

<p><i>Note</i>: if a module is unloaded then loaded again, viewers that monitored the unloaded module data will not resume monitoring the newly loaded module data since internally Tcl traces on variables were removed.

<h6><a name="menus.file.print"></a>5.1.1.1.5. Print</h6>

You can print the canvas area in postscript to a printer or a file, which you may choose using the classical file browser. Please note that only the strictly visible area, without the scrollbars, will be printed.
<p>You can choose the printout orientation (portrait or landscape), palette (color, gray scale or monochrome) and the paper size.

<p>Due to widget and architecture limitations, the printout is pixel based. As a benefit, it is extremely WYSIWYG :-).
<br>Also, because of design limitations, printing is disabled on Windows platforms.

<p>The printout is sized according to the following rules:
<ul>
<li>empty space, around tables or data viewers, is not included (the area is cropped)
<li>a margin of 0.5 inch (12.7 millimeters) is used both horizontally and vertically on all sides
<li>size reduction occurs equally horizontally and vertically (aspect ratio is preserved) only when necessary so that all tables and data viewers are visible on the printout
</ul>

<p>When the print menu entry is selected, a dialog box appears, as can be seen in the screen shot below (which also shows the preview window):

<center><pre><img src="moodss7.gif" alt"print dialog box with preview window"></pre></center>

<br>You can choose to send the postscript data to a printer or to the screen for previewing.

<p>Depending on the print configuration (see <a href="#core.preferences">Preferences</a>), either a print command line entry or a printer selection list appears below the informational message. Hitting the OK button sends the data to the selected printer or through the specified command line.

<p>The preview functionality uses <em>gs</em> (also known as ghostscript), which must be installed (<i>note</i>: version 5.50 is required, as 5.10 is buggy). If gs cannot be found or executed, the preview button is grayed. If the gs version is below 5.20, the button is also grayed and a window tip explaining the cause is displayed when the mouse pointer is located above the button.

<p>When the gs utility is available and of the correct version, the preview button can be depressed, in which case the print dialog temporarily disappears (so that the application main window is not obscured), and reappears along with the preview window, once the printout view has been calculated.

<br>The preview window also features a zoom menu for resizing. If the user so desires, one or more printing parameters, such as page size, orientation, ... can be changed while the preview window remains visible. Hitting the preview button then results in both the print dialog box and the preview window to temporarily disappear while the new page look is calculated. After a short while, they both reappear with the preview updated accordingly, and having kept the same zoom ratio.

<p>Also note that due to the implementation of the graphical layer on UNIX systems, any window or object obscuring the canvas area will also be printed, but this is unlikely, as the moodss application window will be in front when the print menu item is selected.

<h6><a name="menus.file.exit"></a>5.1.1.1.6. Exit</h6>

Use this menu to gracefully quit the moodss application. You may also use the window manager to close the application.

<p>If there are unsaved changes (configuration, viewers created, tables or viewers moved, stacked, ...), the user is given the opportunity to save them to file (see <a href="#menus.file.save">File Save</a> menu). The file selector dialog box is used if no save file name is currently known by the application.

<h6><a name="menus.edit"></a>5.1.1.2. Edit</h6>

<h6><a name="menus.edit.thresholds"></a>5.1.1.2.1. Thresholds</h6>

Opens the thresholds dialog box.

<p>A list of threshold entries is displayed in a table with the following columns:

<ul>
<li><b>active</b>: clicking on the check button toggles the state of the entry between active and not. When active, the shell script is invoked when and if the threshold condition occurs. For example, if the threshold type is <i>up</i> and the data cell value goes above the threshold value.
<li><b>type</b>: clicking on the entry icon toggles the threshold type between <i>differ</i>, <i>down</i>, <i>equal</i>, <i>unknown</i> and <i>up</i>.  (see threshold types below).
<li><b>level</b>: importance level settable using a pop-up selector. When a cell has several thresholds active, it will take the color of the most important threshold. It is also included in the eventual email alert message and used by moomps to set the system logging importance level for the threshold log entry. Defaults to <i>notice</i>. Possible values are, in increasing importance order: <i>debug</i>, <i>info</i>, <i>notice</i>, <i>warning</i>, <i>error</i>, <i>critical</i>, <i>alert</i>, <i>emergency</i>.
<br>Changing the level may also automatically change the color to be displayed in source cell(s) (see below).
<li><b>color</b>: selects the color to be displayed in source cell(s) when the threshold condition occurs. Clicking on the menu button drops a menu window with predefined color buttons, the last of which, with 3 dots as a label, if selected, opens a custom color selection dialog box. The menu button color reflects the currently selected threshold color. The <b>?</b> entry stands for transparency, that is there will be no color change in the monitored cell displays when the threshold condition occurs. Note that this color is automatically updated when the importance level is changed (see above), provided the color was not previously set to a custom value by the user.
<li><b>value</b>: the threshold value, used as reference when comparing with the data cell current value. When changed, the threshold condition is checked as the user confirms when closing the dialog window.
<li><b>source</b>: initially, when the threshold entry is created, the data cell label, as it would be displayed in a data viewer. This column is editable so that the user may input a more meaningful description.
</ul>

When a row is selected in the table above, the corresponding <b>data cell current value</b> and <b>original label</b> are displayed next to an editable <b>list of email addresses</b>.
<br>To enter a new address, simply hit the &lt;Return&gt; of &lt;Enter&gt; key in any filled cell. An empty cell is then created at the bottom of the list. To delete an address, simply empty it using the usual &lt;Backspace&gt; or &lt;Delete&gt; editing keys.
<br>When a threshold event occurs, an alert message will be sent to each recipient (also see <a href="#preferences.thresholds.email">preferences</a>).
<br>You may also include a screen shot (in JPEG format) of the moodss window at the time the threshold occurred, by ticking the check button, next to the little computer monitor icon.
<br><i><b>Note</b>: the screen shot may turn out to be black, depending on whether the moodss window was visible when the threshold occurred, due to the X Window System implementation. More work needs to be done in that area to solve that problem.</i>

<p>When selecting another row in the thresholds table, or closing the dialog box using the OK button, the syntax of the displayed emails is checked and errors eventually reported in a message box. It is then recommended to test that emails actually get sent and to the right recipients, using the test functionality described below.
<p><i><b>Note</b>: the emails list is disabled if the tcllib smtp package, which is required to send emails, was not found (see the INSTALL file for more information).</i>

<p>Below, an editable text area can be used to enter a UNIX <b>shell script</b> invoked when the threshold is crossed <i>(incompatible with the Windows platform)</i>. See script section below for passing arguments to the script. The output of the script (if any and including errors) can be viewed in the <b>test trace area</b> underneath the script area. Errors are eventually visible in the trace module data table if displayed.

<p>Help is provided through widget tips on the table title cells, and a help button, which directly opens the main help window at the relevant section.

<p>Creating threshold entries is done through the drag'n'drop mechanism by dropping data cells into the thresholds drop icon or into the thresholds dialog box table itself (provided it is open, of course). Any number of thresholds can be set on the same data cell.

<p>Selecting a row is done by clicking on any cell of the row. The row is then highlighted.

Below the thresholds table, the following buttons, that act on the selected row, can be found:
<ul>
<li><b>Test</b>: simulates a threshold condition. The shell script is then invoked as if the real threshold was crossed, the cell value being artificially generated. Any output generated by the shell script is displayed in the test trace area. Displayed source cell(s) in the main application window remain unaffected color-wise.
<li><b>Delete</b>: removes the selected threshold entry (row). All related displayed source cells are reset to their original (transparent) color.
</ul>

<h6><a name="menus.edit.thresholds.types"></a>5.1.1.2.1.1. Types</h6>

The following threshold types are supported:
<ul>
<li><img src=differ.gif alt=differ>&nbsp;: threshold and cell value must differ.
<li><img src=down.gif alt=down>&nbsp;: cell value must be less than threshold.
<li><img src=equal.gif alt=equal>&nbsp;: threshold and cell value must be equal.
<li><img src=unknown.gif alt=unknown>&nbsp;: cell value must be unknown (invalid).
<li><img src=up.gif alt=up>&nbsp;: cell value must be more than threshold.
</ul>

<p>Depending on the source data cell type, specific internal comparison techniques are used.

<p>For the ASCII type, the current cell value can be lexicographically less than, equal to, or greater than the threshold value. Empty threshold values are allowed. The strings are compared in a case-insensitive manner.

<p>The dictionary type is handled as the ASCII type, with case ignored except as a tie-breaker and if there are embedded numbers, the numbers compare as  integers, not characters.

<p>For the clock type, the cell and threshold values are first converted to seconds, then compared.

<p>When the threshold type is <img src=unknown.gif alt=unknown>, the condition occurs when the data cell value cannot be determined, and only in such a case. It is the only type of threshold that can be triggered by the void nature of a data cell, as for the other threshold types, no action is ever taken in such an event.

<h6><a name="menus.edit.thresholds.color"></a>5.1.1.2.1.2. Color</h6>

If a non-transparent color has been selected (see previous section), whenever the threshold condition occurs, all displays of the monitored data cell change color (in data tables or in viewers), and return to their normal color when the threshold condition no longer exists.

<p>When several thresholds are placed on the same data cell with different colors, and they all trigger, the behavior is undefined at this time (but the most recent threshold is likely to prevail).

<h6><a name="menus.edit.thresholds.script"></a>5.1.1.2.1.3. Script</h6>

Whenever a threshold is triggered (the manner of which depends on the type), the corresponding script is passed to the UNIX shell interpreter (the <i>sh</i> UNIX command), after variable substitution.

<p>Substitution occurs prior to script invocation if the script contains any % characters. Each % and the character following it is replaced with information from the threshold occurrence. The replacement depends on the character following the %, as defined in the following list:
<ul>
<li><b>%%</b>: replaced by a single %.
<li><b>%c</b>: replaced by the original data cell string (as would be displayed in any data viewer).
<li><b>%s</b>: replaced by the contents of the source column from the thresholds table.
<li><b>%t</b>: the threshold value
<li><b>%T</b>: the threshold type (<i>differ</i>, <i>down</i>, <i>equal</i>, <i>unknown</i>, <i>up</i>, ...)
<li><b>%v</b>: the data cell value responsible for triggering the threshold
</ul>

<h6><a name="menus.edit.thresholds.notes"></a>5.1.1.2.1.4. Notes</h6>

When the dialog box is displayed, existing thresholds are sorted according to their importance level with the most important on top. If several thresholds of the same type and same importance level are set on the same cell, the highest (according to the cell data type) threshold is displayed first.
<br>When new thresholds are interactively added to the dialog box, they are displayed at the bottom of the thresholds table, but will be sorted as the others the next time the dialog box is opened.

<p>While the thresholds dialog box is visible, threshold conditions are not checked by the software, which means no cell color changes, no email alerts, ... can occur.

<p>Internally, threshold conditions are checked in reverse order compared to the displayed order, that is the most important thresholds last. As a consequence, color gradients on a cell are automatically achieved.
<br>For example, if you set the 3 following <i>up</i> thresholds of the same importance level (does not matter in this case, say <i>info</i>) on the same cell:

<ul>
<li>color: <i><font color="yellow">yellow</font></i>, value: <i>80</i>
<li>color: <i><font color="orange">orange</font></i>, value: <i>90</i>
<li>color: <i><font color="red">red</font></i>, value: <i>95</i>
</ul>

you will get a color gradient effect, as the cell value approaches 100, it will turn <i><font color="yellow">yellow</font></i>, <i><font color="orange">orange</font></i> then <i><font color="red">red</font></i>.

<p>You can also force color gradients on a cell by combining importance levels and colors.
<br>For example, if you set the 3 following <i>up</i> thresholds on the same cell:

<ul>
<li>level: <i>notice</i>, color: <i><font color="yellow">yellow</font></i>, value: <i>80</i>
<li>level: <i>warning</i>, color: <i><font color="orange">orange</font></i>, value: <i>90</i>
<li>level: <i>alert</i>, color: <i><font color="red">red</font></i>, value: <i>95</i>
</ul>

you will get an importance color gradient effect as the cell value approaches 100.

<p><i>There are still a lot of features to implement: please see the TODO file.</i>

<h6><a name="menus.edit.configuration"></a>5.1.1.2.2. Configuration</h6>

When selected, this menu launches the configuration dialog box, as described in <a href="#core.configuration">Configuration</a>.

<h6><a name="menus.edit.new"></a>5.1.1.2.3. New</h6>

Allows the creation of empty viewers of any type (graph chart, stacked graph chart, overlap bar chart, side bar chart, stacked bar chart, 2D pie chart, 3D pie chart, summary table or free text).
<br>This menu is only visible when not running in read-only mode (see <a href="#commandline">Command line</a>).

<h6><a name="menus.edit.preferences"></a>5.1.1.2.4. Preferences</h6>

When selected, this menu launches the preferences dialog box, as described in <a href="#core.preferences">Preferences</a>.

<h6><a name="menus.view"></a>5.1.1.3. View</h6>

<h6><a name="menus.view.refresh"></a>5.1.1.3.1. Refresh</h6>

Immediately refreshes display of all loaded asynchronous modules.

<h6><a name="menus.view.polltime"></a>5.1.1.3.2. Poll Time</h6>

The <i>View</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><pre><img src="moodss2.gif" alt"poll time dialog box"></pre></center>

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 warning message is displayed.

<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.
<br>This menu is only visible when not running in read-only mode (see <a href="#commandline">Command line</a>).

<h6><a name="menus.help"></a>5.1.1.4. Help</h6>

<h6><a name="menus.help.global"></a>5.1.1.4.1. Global</h6>

This menu launches an embedded HTML viewer with this very document minus the sections related to module development.

<h6><a name="menus.help.modules"></a>5.1.1.4.2. Modules</h6>

This menu features one sub menu per module, which when selected displays the module's help data.

<h6><a name="menus.help.sourceversions"></a>5.1.1.4.3. Source Versions</h6>

Displays all the source code file names with their versions, in a table with sortable columns (as in table viewers).

<h6><a name="menus.help.about"></a>5.1.1.4.4. About</h6>

Displays version, author, extension authors, license and basic information about moodss.

<h5><a name="draganddrop"></a>5.1.2 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 eraser.

<h6><a name="dropsites"></a>5.1.2.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>stacked graph viewer with one or more data filled curves created at once
<li>side by side bar chart with one or more data bars created at once
<li>stacked bar chart with one or more data bars created at once
<li>2D pie chart with one or more data slices created at once
<li>3D pie chart with one or more data slices created at once
<li>summary table with one or more data rows created at once
<li>free text with one or more labeled data cell windows created at once
<li>thresholds with one or more entries created at once
<li>object eraser with one or more data viewer elements deleted at once
</ul>

<p>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 eraser drop site (the pencil eraser) on the upper right side of the main window and releasing the first mouse button result in the corresponding viewer elements to be destroyed. When there are no remaining elements, the viewer itself (graph, bar chart, pie or summary table) can be destroyed by dropping it into the eraser site. The free text viewer can only be deleted this way when completely emptied of any text and data cell window.

<p>Any viewer can be deleted in one shot by dropping from the eraser icon into it.

<p>Any viewer also acts as a drop site for viewer type data, which allows viewer mutation by just dropping from the new viewer type icon into the existing viewer. It is much quicker than destroying the existing viewer and create a new one of the new type, while remembering which data cells were monitored by the viewer of the old type.
<br>When mutating, if some cells in the current viewer no longer exist (they may belong to a disappeared summary table), they are not made a part of the new viewer, and a warning message is flashed to the user in the message area.

<h6><a name="dragsites"></a>5.1.2.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 eraser.

<p>All viewer icons (below the menu bar) are drag sites for viewer type data, which allows quick viewer mutation (see mechanism description in <a href="#dropsites">Drop sites</a>).

<p>The eraser icon is also a drag site of the killing action type, which allows viewer destruction in one shot.

<h4><a name="commandline"></a>5.2. Command line</h4>

<h5><a name="mainarguments"></a>5.2.1. Main arguments</h5>

Launching moodss is very simple:

<pre>    $ moodss</pre>

or

<pre>    $ wish moodss</pre>

if the Tcl/Tk wish interpreter is not found in your PATH. You can then dynamically load modules from the File menu.

<p>You can also 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 can specify the same module more than once and with different arguments in the command line:

<pre>    $ wish moodss ps -r host.domain ps -r otherhost.domain</pre>

When several modules of the same type are passed as argument, the initial data tables feature the module name followed by a number as title. For example <i>"ps&lt;2>"</i>. If the module provides an identifier string, that text will be used instead, as in <i>"ps(host.domain)"</i>. Data cell labels include the module identifier or numbered module name as well, for proper identification.

<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. New modules data displays can be added at any latter time to existing dashboards by specifying modules on the command line after the -f (--file) switch / value pair.

<p>Command line options include:

<ul>
<li><b>--debug</b>: set verbose reporting when module errors occur
<li><b>-f</b> (or <b>--file</b>): specify a configuration file name
<li><b>-h</b> (or <b>--help</b>): display some help text and exit
<li><b>-geometry</b>: set the initial geometry of the main window (a la X window)
<li><b>-p</b> (or <b>--poll-time</b>): specify a poll time in seconds
<li><b>-r</b> (or <b>--read-only</b>): disable viewer creation, editing, ...
<li><b>-S</b> (or <b>--static</b>): disable internal window manager sizing and moving
<li><b>--show-modules</b>: discover valid moodss modules, show their directory location(s) and exit
<li><b>--version</b>: output version information and exit
</ul>

Moodss command line options must appear before any module name appears on the command line, so as not to interfere with the module options.

<p>In debug mode, when errors occur within the module namespace body or initialize procedure, the error message (either in text output when loading the module from the command line, or in a message window when dynamically loading the module) is followed by a Tcl stack trace of what was in progress when the error occurred (see the Tcl <i>error</i> manual page for further information).

<h5><a name="modulearguments"></a>5.2.2. Module arguments</h5>

Module themselves can take options (if programmed to do so, see <a href="#initialization">module initialization</a>), through command line arguments placed right after the module name and before the next module name, if any.

<p>For example, the following command:

<pre>    $ moodss -p 15 random --asynchronous arp --remote jdoe@foo.bar --numeric route --numeric</pre>

causes the <i>random</i> module to update asynchronously, the <i>arp</i> module to collect data from the <i>foo.bar</i> host under the <i>jdoe</i> login name and not attempt to lookup symbolic names for hosts, with the last module <i>route</i> doing the same.

<p>Note the setting the application poll time to 15 seconds does not interfere with the module options.

<p>The moodss core checks the validity of module options according to the information provided by the module programmer. Any invalid option / value combination for the module is detected, reported on the standard error channel before the application exits.

<p>Finally, it is always possible to determine the valid options for a module, using the following command:

<pre>    $ moodss module --help</pre>

<h4><a name="core.configuration"></a>5.3. Configuration</h4>

All configuration parameters can be set using the following interface:

<center><pre><img src="moodss6.gif" alt"configuration dialog box"></pre></center>

The Configuration dialog box allows the user to change global settings for the current view (also called a dashboard). This data is stored along when saving the configuration to a file (see <a href="#menus.file.save">Save</a> menu).

<p>Changing configuration choices do not affect the <a href="#core.preferences">Preferences</a> choices, which are used as initial values the first time the user modifies the configuration. Configuration settings have a higher priority than preferences settings, but are lost when not filed.

<p>Configuration entry is done through pages organized in a browsable hierarchical tree, always visible on the left side of the configuration dialog box (see picture above).

<p>After selection of the category from the tree on the left, a related dialog interface appears, which may or may not allow immediately applying new data values.
<br>Clicking on the OK button results in the current configuration data to be saved in memory. It will be stored in the save file when requested (see File <a href="#menus.file.save">Save</a> and <a href="#menus.file.saveas">Save As</a> menus).

<p>Specific help can always be accessed by clicking on the bottom <b>Help</b> button when in a configuration page.

<h5><a name="configuration.canvas"></a>5.3.1. Canvas</h5>

The canvas is the data viewers background area, and its configuration (size, color, ...) can be changed as described below.

<h5><a name="configuration.canvas.size"></a>5.3.1.1. Size</a></h5>

The canvas width and height can be changed so that all the different tables and viewers that the dashboard comprises can fit nicely within the viewing space.
<p>The default is the current screen size.
<p>The size is immediately updated when clicking on the <b>Apply</b> button.

<h5><a name="configuration.canvas.colors"></a>5.3.1.2. Colors</a></h5>

The canvas color can be changed for your viewing pleasure...
<p>The color is immediately updated when clicking on the <b>Apply</b> button.

<h5><a name="configuration.viewers"></a></a>5.3.2. Viewers</h5>

The viewers are used for viewing table data, and their configuration (colors, ...) can be changed as described below.

<h5><a name="configuration.viewers.colors"></a>5.3.2.1. Colors</a></h5>

These are the colors of viewer elements. For each viewer that needs different colors for displaying data cell elements (such as graphs, pie charts, ...), each new element uses the next color in the sequence (wraps around if necessary).

<p><i>Advice</i>: adjacent colors should be very different, colors should be visible on a black background.

<p><i>Note</i>: in a future version, creating, deleting and moving colors in the sequence will be possible.

<h5><a name="configuration.viewers.graphs"></a>5.3.2.2. Graphs</a></h5>

The number of samples (on the X axis) can be changed for data graph viewers. The specified value will not be used for existing graphs but for newly created ones.

<h5><a name="configuration.viewers.pies"></a>5.3.2.3. Pies</a></h5>

The labeler type for data pie viewers can be changed as follows:
<ul>
<li>current value labels can be displayed next to corresponding slices (<b>peripheral</b> style)
<li>or next to the corresponding text labels (<b>box</b> style)
</ul>

<p>The selected type will not be used for existing pies but for newly created ones.

<h4><a name="core.preferences"></a>5.4. Preferences</h4>

The preferences dialog box is used for application-wide settings.<br>
It is very similar to the <a href="#core.configuration">configuration</a> dialog box, except that it also includes canvas printing and email servers settings.

<br>It allows the user to change application wide settings, saved in a global file (known as an <i>rc</i> file to UNIX people), used for initialization when the application is started. Since this file is stored in the user home directory (on a UNIX system), it provides a way for a user to customize the look, behavior, ... of the moodss application in a permanent manner.

<p>Preferences choices, when applied (either by choosing Apply or OK) also affect <a href="#core.configuration">configuration</a> settings.

<p>On UNIX systems, preferences data is saved in each user home directory under the <i>rc</i> file named <i>.moodssrc</i>.<br>
On Windows, data is saved in <i>C:\.moodssrc</i> (by default, but depends on the <i>HOME</i> variable).

<p>After selection of the category from the tree on the left, a related dialog interface appears.
<br>Help is provided for each interface, which may or may not allow immediately applying new data values.
<br>Clicking on the <b>OK</b> button results in the preferences data to be written to the <i>rc</i> file.

<h5><a name="preferences.canvas"></a>5.4.1. Canvas</h5>

<h5><a name="preferences.canvas.printing"></a>5.4.1.1. Printing</a></h5>

The canvas area can be printed in the Postscript data format.<br>
The default behavior when printing can be set to either a printer or a file, but can always be overridden in the print dialog box launched when actually printing.<br>
Various parameters, such as orientation, palette and paper size can be set.

<p>The print command typically reads the Postscript data from its standard input and redirects it to the specified printer (for example, on UNIX, 'lpr -Pacme' will print the canvas area on the "acme" printer.
<br>By default, the command is set to 'lpr -P%P', which by including the <em>%P</em> generic printer name tag allows the user to pick the printer from a list (drawn from the /etc/printcap database) at printing time.

<p>When printing to a file, you may choose its default location and name with the file browser. Note that it can be overridden in the print dialog box launched when actually printing.

<h5><a name="preferences.thresholds"></a>5.5.1. Thresholds</h5>

<h5><a name="preferences.thresholds.email"></a>5.5.1.1. Email</h5>

When a threshold event occurs, an email alert message can be sent (see <a href="#menus.edit.thresholds">thresholds</a>).

<p>Proper identification is required so that the originator of the message (the <i>From</i> address field in an email message) is known. Use your own email address or another email address (such as <i>moodss@your.domain.com</i>) that you control.
<br>In any case, the <b>From address</b> field must contain a valid email address.
<br>Your user name is used by default.
<br>When closing the dialog box or moving to another section, the syntax of the email address is checked and errors eventually reported in a message box.

<p>Sending email requires at least one <b>Outgoing mail SMTP server</b>. Input the one that you use for sending your emails (check your browser or email software current configuration), or any other valid SMTP address (consult your system administrator in case of doubt).<br>

You may enter additional servers that will be used as backups of the main server in case it fails. Keep pressing the &lt;Enter&gt; key to append servers to the list. To remove a server from the list, simply empty its list cell using the usual editing keys.<br>
The local host (<i>127.0.0.1</i> address) is used by default as the main SMTP server.


<h3><a name="future"></a>8. 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>more data viewers
<li>table row and column selection in one click
</ul>

I welcome any suggestion for new features that you may need in your specific use of moodss.

<h3><a name="misc"></a>9. Miscellaneous information</h3>

For downloading Tcl software (such as stooop, scwoop, tkpiechart, ...), many Redhat rpm packages, visit my home page at <a href="http://jfontain.free.fr/">http://jfontain.free.fr/</a>.

<p>Send your comments, complaints, ... to <a href="mailto:jfontain@free.fr">jfontain@free.fr</a>.

</body>
</html>
}

set rcsId {$Id: htmlview.tcl,v 2.9 2001/12/29 00:32:39 jfontain Exp $}


set ::htmlLibraryAdditionalCode {

    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
    }

    unset HMevents(Enter)
    unset HMevents(Leave)
    unset HMevents(1)
    set HMevents(ButtonRelease-1) {-foreground darkblue}

    proc HMset_image {widget label source} {
        if {![catch {image create photo -file $source} image]} {
            bind $label <Destroy> "image delete $image"
            HMgot_image $label $image
        }
    }

}


proc HMlink_hit {path x y} {
    $::htmlViewer::interpreterFromPath($path) eval "HMlink_hit $path $x $y"
}


class htmlViewer {

    set (initialDirectory) [pwd]

    proc htmlViewer {this parentPath args} composite {[new scroll text $parentPath] $args} {
        variable interpreterFromPath

        set path $composite::($composite::($this,base),scrolled,path)

        set interpreter [interp create]
        $interpreter eval $::htmlLibraryCode
        $interpreter eval $::htmlLibraryAdditionalCode

        $interpreter alias $path $path
        foreach command {bind bindtags image pack update winfo} {
            $interpreter alias $command $command
        }
        foreach command {button frame label scrollbar text} {
            $interpreter alias $command ::htmlViewer::widget $command $interpreter
        }

        $interpreter eval "HMinit_win $path"
        $path tag configure mark -foreground black
        $path tag configure link -borderwidth 1 -foreground blue -underline 1
        $interpreter eval "set ::HM${path}(S_symbols) {oooooo\xd7\xb0>:\xb7}"

        set ($this,interpreter) $interpreter
        set ($this,textPath) $path
        set interpreterFromPath($path) $interpreter

        composite::complete $this
    }

    proc ~htmlViewer {this} {
        variable interpreterFromPath

        if {[string length $composite::($this,-directory)]>0} {
            cd $(initialDirectory)
        }
        $($this,interpreter) eval "HMset_state $($this,textPath) -stop 1"
        unset interpreterFromPath($($this,textPath))
        interp delete $($this,interpreter)
    }

    proc options {this} {
        return [list\
            [list -data {} {}]\
            [list -directory {} {}]\
            [list -file {} {}]\
            [list -linkto $this]\
        ]
    }

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

    proc set-data {this value} {
        if {[info exists ($this,loaded)]} {
            error {data can only be loaded once}
        }
        load $this $value
    }

    proc set-file {this value} {
        if {[info exists ($this,loaded)]} {
            error {data can only be loaded once}
        }
        set file [open $value]
        load $this [read $file]
        close $file
    }

    proc set-linkto {this viewer} {
        if {$viewer==$this} {
            $($this,interpreter) eval {
                proc HMlink_callback {widget reference} {
                    if {![string match #* $reference]} return
                    HMgoto $widget [string trimleft $reference #]
                }
            }
        } else {
            $($this,interpreter) alias HMlink_callback ::htmlViewer::linkCallbackRedirect $viewer
        }
    }

    proc load {this data} {
        set ($this,loaded) {}
        set path $($this,textPath)
        $path configure -cursor watch
        update idletasks
        $path configure -state normal
        catch {cd $composite::($this,-directory)}
        catch {$($this,interpreter) eval "HMparse_html {$data} {HMrender $path}"}
        cd $(initialDirectory)
        if {![winfo exists $path]} return
        $($this,interpreter) eval "HMset_state $path -stop 1"
        $path configure -state disabled
        $path configure -cursor {}
        update idletasks
    }

    proc widget {type interpreter args} {
        set path [eval ::$type $args]
        $interpreter alias $path $path
        return $path
    }

    proc linkCallbackRedirect {viewer widget reference} {
        $($viewer,interpreter) eval "HMlink_callback $($viewer,textPath) $reference"
    }


    proc goTo {this url} {
        catch {$($this,interpreter) eval "HMlink_callback $($this,textPath) $url"}
    }

}

set rcsId {$Id: html.tcl,v 1.34 2001/12/29 00:32:39 jfontain Exp $}


proc displayHelpWindow {topLevelName name title} {
    upvar $topLevelName toplevel

    set toplevel .grabber.help${name}
    if {[winfo exists $toplevel]} {
        wm deiconify $toplevel
        raise $toplevel
        return 0
    }
    toplevel $toplevel
    wm group $toplevel .
    wm title $toplevel $title
    frame $toplevel.bound
    return 1
}

proc generalHelpWindow {{url {}}} {
    static bottom

    if {[displayHelpWindow toplevel moodss {moodss: Global Help}]} {
        set panes [new panner $toplevel -panes 2]
        pack $widget::($panes,path) -fill both -expand 1

        set top [new htmlViewer $panner::($panes,frame1)]
        composite::configure $top base -height 100 -width 500
        pack $widget::($top,path) -fill both -expand 1
        set bottom [new htmlViewer $panner::($panes,frame2) -directory $::global::documentationDirectory]
        composite::configure $top -linkto $bottom
        composite::configure $bottom base -height 400
        pack $widget::($bottom,path) -fill both -expand 1
        bind $toplevel.bound <Destroy> "delete $bottom $top $panes"

        composite::configure $top -data $::htmlHelpContents
        if {![winfo exists $toplevel]} return
        composite::configure $bottom -data $::htmlHelpData
    }
    if {([string length $url]>0)&&[info exists bottom]} {
        htmlViewer::goTo $bottom $url
    }
}

proc moduleHelpWindow {name text} {
    if {![displayHelpWindow toplevel $name "moodss: $name Module Help"]} return
    set viewer [new htmlViewer $toplevel -directory $::packageDirectory($name)]
    pack $widget::($viewer,path) -fill both -expand 1
    bind $toplevel.bound <Destroy> "delete $viewer"
    composite::configure $viewer -data $text
}

proc createCellsViewer {class cells draggable static {pollTime {}}} {
    set viewer [new $class $global::canvas -draggable $draggable]
    if {[string length $pollTime]>0} {
        composite::configure $viewer -interval $pollTime
    }
    viewer::view $viewer $cells
    manageViewer $viewer 1 -static $static
    return $viewer
}

proc manageViewer {viewer destroyable args} {
    set path $widget::($viewer,path)
    canvasWindowManager::manage $global::windowManager $path
    eval canvasWindowManager::configure $global::windowManager $path $args
    if {$destroyable} {
        composite::configure $viewer -deletecommand "canvasWindowManager::unmanage $global::windowManager $path"
    }
}

proc save {{ask 0}} {
    if {$ask||([string length $global::saveFile]==0)} {
        set file [tk_getSaveFile\
            -title {moodss: Save} -initialdir $global::fileDirectory -defaultextension .moo -filetypes {{{moodss data} .moo}}\
            -initialfile $global::saveFile
        ]
        if {[string length $file]==0} return
        set global::saveFile $file
        set global::fileDirectory [file dirname $file]
        updateFileSaveMenuHelp $file
    }
    lifoLabel::flash $global::messenger "saving in $global::saveFile..."
    set record [new record -file $global::saveFile]
    set error [catch {record::write $record} message]
    if {$error} {
        tk_messageBox -title {moodss: Save} -type ok -icon error -message $message
    }
    delete $record
    if {!$error} record::snapshot
}

proc refresh {} {
    static updateEvent

    catch {after cancel $updateEvent}
    if {[llength $modules::(synchronous)]==0} return
    foreach instance $modules::(synchronous) {
        set namespace $modules::instance::($instance,namespace)
        ${namespace}::update
    }
    set updateEvent [after [expr {1000*$global::pollTime}] refresh]
}

proc changeAllCellsColor {array row column color} {
    dataTable::changeAllCellsColor $array $row $column $color
    viewer::changeAllCellsColor $array $row $column $color
}

proc inquireSaving {} {
    set message {There are unsaved configuration changes. Do you want them saved to file}
    if {[string length $::global::saveFile]>0} {
        append message ": $::global::saveFile"
    }
    append message ?
    array set answer {0 yes 1 no 2 cancel}
    return $answer([tk_dialog .saveorexit {moodss: Save} $message question 0 Yes No Cancel])
}

rename exit _exit
proc exit {{code 0}} {
    if {$code!=0} {
        _exit $code
    }
    if {![record::changed]} _exit
    switch [inquireSaving] {
        yes {
            save
            if {![record::changed]} _exit
        }
        no _exit
    }
}


set draggable [expr {!$readOnly}]


proc createSavedViewers {record} {
    foreach {class cells x y width height level switchedOptions} [record::viewersData $record] {
        if {[string equal $class ::thresholds]} {
            set viewer $thresholds::singleton
            eval switched::configure $viewer $switchedOptions
        } else {
            set viewer [eval new $class $global::canvas $switchedOptions -draggable $::draggable]
            foreach list [composite::configure $viewer] {
                if {[string equal [lindex $list 0] -interval]} {
                    composite::configure $viewer -interval $global::pollTime
                    break
                }
            }
            manageViewer $viewer 1 -static $global::static -setx $x -sety $y -setwidth $width -setheight $height -level $level
        }
        set viewerCells($viewer) $cells
    }
    foreach {viewer cells} [array get viewerCells] {
        viewer::view $viewer $cells
    }
}

proc dynamicallyLoadModules {arguments} {
    set instances $modules::(instances)
    modules::parse $arguments
    modules::initialize
    modules::setPollTimes
    foreach instance $modules::(instances) {
        if {[lsearch -exact $instances $instance]>=0} continue
        displayModule $instance $::draggable
    }
    updateTitle
    destroy $global::menu
    createMenuWidget . $::readOnly [llength $global::pollTimes]
    refresh
}

proc dynamicallyUnloadModule {namespace} {
    foreach instance $modules::(instances) {
        if {[string equal $modules::instance::($instance,namespace) $namespace]} break
    }
    if {[lindex $modules::instance::($instance,times) 0]>0} {
        ldelete modules::(synchronous) $instance
    }
    foreach table $dataTable::(list) {
        if {[string equal [modules::namespaceFromArray [composite::cget $table -data]] $namespace]} {
            canvasWindowManager::unmanage $global::windowManager $widget::($table,path)
            delete $table
        }
    }
    modules::instance::empty $instance
    modules::unload $instance
    modules::setPollTimes
    updateTitle
    destroy $global::menu
    createMenuWidget . $::readOnly [llength $global::pollTimes]
}

set modules::(synchronous) {}

proc displayModule {instance draggable} {
    static x 0.0
    static y 0.0

    if {[lindex $modules::instance::($instance,times) 0]>0} {
        lappend modules::(synchronous) $instance
    }
    if {[info exists modules::instance::($instance,views)]} {
        set viewMembers $modules::instance::($instance,views)
    } else {
        set viewMembers {{}}
    }
    set index 0
    set namespace $modules::instance::($instance,namespace)
    foreach members $viewMembers {
        set initialize [expr {[info exists ::initializer]&&([lsearch -exact $modules::(initialized) $namespace]>=0)}]
        if {$initialize} {
            set arguments [record::tableOptions $::initializer $namespace $index]
        } else {
            set arguments {}
        }
        if {![catch {set ${namespace}::data(resizableColumns)} resizable]} {
            lappend arguments -resizablecolumns $resizable
        }
        if {[llength $members]>0} {
            array set ::view $members
            set table [eval new dataTable $global::canvas -data ${namespace}::data -view ::view -draggable $draggable $arguments]
            unset ::view
        } else {
            set table [eval new dataTable $global::canvas -data ${namespace}::data -draggable $draggable $arguments]
        }
        if {[info exists modules::instance::($instance,identifier)]} {
            set title $modules::instance::($instance,identifier)
        } else {
            set title $namespace
        }
        if {$initialize} {
            set list [record::tableWindowManagerData $::initializer $namespace $index]
            if {[llength $list]>0} {
                foreach {x y width height level} $list {}
                manageViewer $table 0 -static $global::static -setx $x -sety $y -setwidth $width -setheight $height -level $level\
                    -title $title
            } else {
                manageViewer $table 0 -static $global::static -setx $x -sety $y -title $title
            }
        } else {
            manageViewer $table 0 -static $global::static -setx $x -sety $y -title $title
        }
        set x [expr {$x+$global::xWindowManagerInitialOffset}]
        set y [expr {$y+$global::yWindowManagerInitialOffset}]
        incr index
    }
}

foreach instance $modules::(instances) {
    displayModule $instance $draggable
}
if {[info exists initializer]} {
    createSavedViewers $initializer
}

refresh
update
record::snapshot

