# copyright (C) 1997-2005 Jean-Luc Fontaine (mailto:jfontain@free.fr)
# this program is free software: please read the COPYRIGHT file enclosed in this package or use the Help Copyright menu

# $Id: threshold.tcl,v 1.193 2005/02/20 19:05:39 jfontain Exp $


class thresholds {

    variable levelColor
    array set levelColor {emergency red alert red critical red error red warning orange notice yellow info white debug blue}
    set (levels) {emergency alert critical error warning notice info debug}                ;# ordered: emergency = 0, alert = 1, ...
    set (colors) {red orange yellow white green cyan blue ? {}}
    variable help                                                                                          ;# help for column titles
    variable translated                                                                                    ;# internationalized text

if {$global::withGUI} {

    set (default,button,background) $widget::option(button,background)
    variable cameraIcon [image create photo -data {
        R0lGODlhEgAQAMYAAAAAAB0dHWpqatfX1+Xl5eLi4tLS0t3d3SIiIszMzM3NzdDQ0NXV1dzc3OTk5OHh4bGxsQEBAbKyslVVVTY2NmdnZ8fHxxQUFIODgwgI
        CAQEBAwMDAoKCmxsbMnJydvb2+Pj47S0tBEREU5OTkVFRSoqKgMDA3BwcNPT097e3r6+vnx8fCQkJHp6eiEhIbe3t5GRkX19fUNDQyYmJgcHBx8fH3Nzc2Zm
        Zm1tbZubm4eHh39/f0dHRygoKAICAg4ODrCwsHFxcY2NjRgYGHZ2dicnJ6urqzU1NWVlZSsrKxAQEJOTkzAwMERERC0tLWBgYKCgoLW1tV5eXoWFhcrKyo+P
        j8HBwaenp1tbW0ZGRv//////////////////////////////////////////////////////////////////////////////////////////////////////
        /////////////////////////////////////////////////yH5BAEKAH8ALAAAAAASABAAAAfDgH8Ag4N/hoeIhgECAwQFhACJiAAGBwSXmIMIkgAJCgsM
        DQUOlw8QgxGHnQkJEhMUFRYFmASDF4KsGBkaGxccHR4fIJgGgwkhIhQjJCUXJicJKCkEKissnS0uLzAxMjM0NawJFjY31wk4NTk6Ozw9Pj/iQEHmnUJDAjtE
        RUMcFOJG6J1LQOIIkiRKfIhYAlAgoQQTZCRh0sSIuAQBzRki5OQJlCgeLmZkkQiSlClUWI2UtJFQFStXsDiZwXLSoCw9DAUCADs=
    }]

    variable mailIcon [image create photo -data {
        R0lGODlhCgAKAMIAAPgA+MDAwHh8ePj8+AAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAKAAoAAAMiCLoc/k8EMWqdJAxiQ84V52kgRkibI03siXbCScw0zdxAAgA7
    }]
    variable customMailIcon [image create photo -data {
        R0lGODlhCgAKAMIAAL+/YHt7Pvz7fgAAAP///////////////yH5BAEAAAQALAAAAAAKAAoAAAMiSLoM/i+AIGqdA4hhQc4V52kgNkibI03siXbBOcw0zdxEAgA7
    }]
    variable gearIcon [image create photo -data {
        R0lGODlhCgAKAKEAAPgA+MDAwHh8eAAAACH5BAEAAAAALAAAAAAKAAoAAAIhhBFyFoGaWJthnDZGRDjrKgiVF1pctnFiWBmCFWULIB8FADs=
    }]

}                                                                  ;# else avoid Tk commands when running under tclsh in daemon mode

    proc thresholds {this args} switched {$args} viewer {} {                     ;# a special kind of viewer, active but not visible
        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 $global::dataTypes
    }

    proc set-configurations {this value} {}                                    ;# list of lists of switch/value pairs from save file

if {$global::withGUI} {

    proc edit {} {
        variable singleton
        variable thresholds
        variable cameraIcon
        variable number

        set this $singleton
        if {[info exists ($this,dialog)]} {                                                                                ;# exists
            raise $widget::($($this,dialog),path)                                                                 ;# make it visible
            return
        }
        set dialog [createDialog $this]
        set frame [frame $widget::($dialog,path).frame]

        set table [createTable $this $frame]                                                                        ;# table section
        grid $widget::($table,path) -row 0 -column 0 -sticky nsew

        set details [frame $frame.details]                                                               ;# start of details section
        set ($this,initial) 0                                                                     ;# reset flag before any selection
        set ($this,initialButton) [checkbutton $details.initial\
            -font $font::(mediumBold) -text [mc {Initial condition}] -variable thresholds::($this,initial) -state disabled\
        ]
        lappend ($this,objects) [new widgetTip\
            -path $($this,initialButton) -text [mc {no action (even if condition is met) when application is started}]\
        ]
        grid $($this,initialButton) -row 0 -column 0 -columnspan 2 -sticky w -padx 5
        set ($this,emailsLabel) [label $details.emailsLabel -font $font::(mediumBold) -text [mc Emails:] -state disabled]
        grid $($this,emailsLabel) -row 0 -column 2 -sticky e
        set ($this,emails) [new listEntry $details -state disabled]
        grid $widget::($($this,emails),path) -row 0 -column 3 -rowspan 3 -sticky nsew
        set ($this,cellLabel) [label $details.cellLabel -font $font::(mediumBold) -text [mc {Original cell:}] -state disabled]
        grid $($this,cellLabel) -row 1 -column 0 -sticky w
        set ($this,cell) [label $details.cell -font $font::(mediumNormal) -relief sunken -width 20]
        grid $($this,cell) -row 1 -column 1 -columnspan 2 -sticky we -padx 5
        set ($this,currentLabel) [label $details.currentLabel -font $font::(mediumBold) -text [mc {Current value:}] -state disabled]
        grid $($this,currentLabel) -row 2 -column 0 -sticky w
        set ($this,current) [label $details.current -font $font::(mediumNormal) -relief sunken -width 20]
        grid $($this,current) -row 2 -column 1 -columnspan 2 -sticky we -padx 5
        # allow dragging from current cell:
        set ($this,drag) [new dragSite -path $($this,current) -validcommand "thresholds::validateDrag $this"]
        dragSite::provide $($this,drag) DATACELLS "thresholds::dragData $this"
        grid columnconfigure $details 1 -weight 1
        grid columnconfigure $details 3 -weight 2
        grid $details -row 1 -column 0 -sticky ew                                                          ;# end of details section

        set arrowSize [font metrics $font::(mediumBold) -ascent]

        set mailFrame [frame $frame.mailFrame]                                               ;# start of custom mail message section
        set ($this,mailLabel) [label $mailFrame.label -font $font::(mediumBold) -text [mc {Mail message}] -state disabled]
        grid $($this,mailLabel) -row 0 -column 0 -sticky w
        set arrow [new arrowButton $mailFrame -width $arrowSize -height $arrowSize]
        lappend ($this,objects) $arrow
        grid $widget::($arrow,path) -row 0 -column 1 -sticky w
        set ($this,default) 1                                                                     ;# reset flag before any selection
        set ($this,defaultButton) [checkbutton $mailFrame.default -command "thresholds::updateMailSection $this"\
            -font $font::(mediumBold) -text [mc Default] -variable thresholds::($this,default) -state disabled\
        ]
        lappend ($this,objects) [new widgetTip -path $($this,defaultButton)\
            -text [mc {use default subject and body for email message, as defined in preferences}]\
        ]
        grid $($this,defaultButton) -row 0 -column 2 -sticky e
        set partsFrame [frame $mailFrame.parts]
        set ($this,subjectLabel) [label $partsFrame.subjectLabel -font $font::(mediumBold) -text [mc Subject:] -state disabled]
        grid $($this,subjectLabel) -row 0 -column 0 -sticky w
        set ($this,subjectEntry) [entry $partsFrame.subjectEntry -font $font::(fixedNormal) -state disabled]
        grid $($this,subjectEntry) -row 0 -column 1 -sticky ew
        set ($this,bodyLabel) [label $partsFrame.bodyLabel -font $font::(mediumBold) -text [mc Body:] -state disabled]
        grid $($this,bodyLabel) -row 1 -column 0 -sticky nw
        set ($this,body) [new scroll text $partsFrame -height 80]                                   ;# start of message body section
        set ($this,bodyText) $composite::($($this,body),scrolled,path)
        $($this,bodyText) configure -state disabled -background white -font $font::(fixedNormal)
        setupTextBindings $($this,bodyText)
        grid $widget::($($this,body),path) -row 1 -column 1 -rowspan 2 -sticky nsew                   ;# end of message body section
        set ($this,emailShot) 0                                                                   ;# reset flag before any selection
        set ($this,shot) [checkbutton $partsFrame.shot -image $cameraIcon -variable thresholds::($this,emailShot) -state disabled]
        lappend ($this,objects) [new widgetTip -path $($this,shot) -text [mc {attach screen shot to email message}]]
        grid $($this,shot) -row 2 -column 0
        composite::configure $arrow -command "thresholds::toggleGrid $arrow $partsFrame -row 1 -column 0 -columnspan 3 -sticky nsew"
        grid columnconfigure $partsFrame 1 -weight 1
        grid columnconfigure $mailFrame 1 -weight 1
        grid $mailFrame -row 2 -column 0 -sticky nsew                                          ;# end of custom mail message section

        set scriptFrame [frame $frame.scriptFrame]                                                        ;# start of script section
        set ($this,scriptLabel) [label $scriptFrame.label -font $font::(mediumBold) -text [mc Script] -state disabled]
        grid $($this,scriptLabel) -row 0 -column 0 -sticky w
        set arrow [new arrowButton $scriptFrame -width $arrowSize -height $arrowSize]
        lappend ($this,objects) $arrow
        grid $widget::($arrow,path) -row 0 -column 1 -sticky w
        set panes [new panner $scriptFrame -panes 2]
        set ($this,script) [new scroll text $panner::($panes,frame1) -height 80]                     ;# start of script text section
        set ($this,scriptText) $composite::($($this,script),scrolled,path)
        $($this,scriptText) configure -state disabled -background white -font $font::(fixedNormal)
        setupTextBindings $($this,scriptText)
        pack $widget::($($this,script),path) -fill both -expand 1                                      ;# end of script text section
        set ($this,testLabel) [label $panner::($panes,frame2).testLabel\
            -font $font::(mediumBold) -text [mc {Test trace:}] -state disabled\
        ]                                                                                                   ;# start of test section
        pack $($this,testLabel) -anchor nw
        set ($this,test) [new scroll text $panner::($panes,frame2) -height 120]
        set text $composite::($($this,test),scrolled,path)
        $text configure -state disabled -font $font::(fixedNormal)
        # resize separators when window is resized:
        bind $text <Configure>\
            {foreach window [%W window names] {$window configure -width [expr {%w - $global::separatorCut}]}}
        set ($this,testText) $text
        pack $widget::($($this,test),path) -fill both -expand 1                                               ;# end of test section
        composite::configure $arrow\
            -command "thresholds::toggleGrid $arrow $widget::($panes,path) -row 1 -column 0 -columnspan 2 -sticky nsew"
        grid rowconfigure $scriptFrame 1 -weight 1
        grid columnconfigure $scriptFrame 1 -weight 1
        set ($this,panes) $panes
        grid $scriptFrame -row 3 -column 0 -sticky nsew                                                     ;# end of script section

        grid rowconfigure $frame 0 -weight 1
        grid columnconfigure $frame 0 -weight 1

        foreach {string underline} [underlineAmpersand [mc &Test]] {}
        composite::configure $dialog test -text $string -underline $underline -command "thresholds::test $this" -state disabled
        set button $composite::($dialog,test,path)              ;# configure test and delete buttons at the bottom of the dialog box
        lappend ($this,objects) [new widgetTip -path $button -text [mc {test email and script}]]
        set ($this,testButton) $button
        foreach {string underline} [underlineAmpersand [mc &Delete]] {}
        composite::configure $dialog delete -text $string -underline $underline -command "thresholds::delete $this" -state disabled
        set button $composite::($dialog,delete,path)
        lappend ($this,objects) [new widgetTip -path $button -text [mc {delete selected entry}]]
        set ($this,deleteButton) $button

        dialogBox::display $dialog $frame
        set ($this,table) $table
        set ($this,dialog) $dialog
        # display thresholds with the most important ones on top:
        foreach threshold [lsort -command threshold::comparison -decreasing $thresholds] {
            display $this $threshold
        }
        selectTable::refreshBorders $table                                                    ;# needed if there are multi-line rows
        selectTable::adjustTableColumns $table                                         ;# in case there was no thresholds to display
    }

}

    proc monitorCell {this array row column} {
        variable thresholds

        # make sure thresholds viewer is updated last to properly detect summary tables thresholds, for example:
        viewer::registerTrace $this $array 1
        set cell ${array}($row,$column)
        if {[llength $switched::($this,-configurations)] > 0} {                                      ;# to initialize from save file
            set index 0
            foreach configuration $switched::($this,-configurations) {
                catch {unset option}; array set option $configuration
                if {![info exists option(-cell)]} break                                                                ;# old format
                if {[string equal $option(-cell) $cell]} {                                                  ;# new format, from 19.1
                    # since cells and their configurations are recorded in the same order, skip configurations of void cells, which
                    # can happen when their module has not been loaded due to some initialization problem
                    unset option(-cell)                                                    ;# threshold does not have such an option
                    break                                                                  ;# found configuration for monitored cell
                }
                incr index
            }
            set threshold [eval new threshold $cell [array get option]]
            # eat processed configurations as there can be several thresholds (configurations) on the same cell, otherwise, in the
            # 19.1 format, the same configuration (the first found) would always be returned for a specific cell:
            switched::configure $this -configurations [lrange $switched::($this,-configurations) [incr index] end]
        } else {
            set threshold [new threshold $cell]
            switched::configure $threshold -label $threshold::($threshold,cellLabel)   ;# initialize threshold label with cell label
        }
        lappend thresholds $threshold
        if {[info exists ($this,dialog)]} {
            set (held,$threshold) {}                                           ;# so threshold can be deleted upon user cancellation
            display $this $threshold
            selectTable::refreshBorders $($this,table)
            selectTable::adjustTableColumns $($this,table)
        }
        set ($this,lastMonitored) $threshold
    }

if {$global::withGUI} {

    proc display {this threshold} {
        variable data
        variable number
        variable translated

        set table $($this,table)
        set path $selectTable::($table,tablePath)
        set row [selectTable::rows $table]
        selectTable::rows $table [expr {$row + 1}]                                  ;# required so that embedded windows are visible
        set background [composite::cget $table -background]
        # row/threshold mapping kept in a hidden column so that it is updated properly when deleting rows from the table
        set data($row,$number(threshold)) $threshold
        selectTable::spans $table $row,$number(active) 0,$(hiddenColumns)
        set data($row,$number(active)) [switched::cget $threshold -active]
        set button $path.$threshold,active
        # do not take the focus since it would be too complicated to manage for windows embedded in the table
        checkbutton $button\
            -activebackground $background -highlightthickness 0 -variable thresholds::data($row,$number(active)) -takefocus 0
        bind $button <ButtonRelease-1> "thresholds::select $this $threshold"
        selectTable::windowConfigure $table $row,$number(active) -window $button -padx 1 -pady 1 -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 $threshold
        "
        selectTable::windowConfigure $table $row,$number(type) -window $label -relief sunken -padx 1 -pady 1
        set data($row,$number(once)) [switched::cget $threshold -actonce]
        set button $path.$threshold,once
        # do not take the focus since it would be too complicated to manage for windows embedded in the table
        checkbutton $button\
            -activebackground $background -highlightthickness 0 -variable thresholds::data($row,$number(once)) -takefocus 0
        bind $button <ButtonRelease-1> "thresholds::select $this $threshold"
        selectTable::windowConfigure $table $row,$number(once) -window $button -padx 1 -pady 1 -sticky nsew
        if {![info exists translated(levels)]} {
            foreach level $(levels) {lappend translated(levels) [mc $level]}
        }
        set data($row,$number(level)) [switched::cget $threshold -level]
        set index [lsearch -exact $(levels) $data($row,$number(level))]; if {$index < 0} {set index 0}
        set menu [new optionMenu $path\
            -font $font::(tinyNormal) -choices $translated(levels) -text [lindex $translated(levels) $index] -takefocus 0\
            -popupcommand "thresholds::select $this $threshold"\
        ]
        composite::configure $menu base -highlightthickness 0
        selectTable::windowConfigure $table $row,$number(level) -window $widget::($menu,path) -padx 1 -pady 1 -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 $threshold"
        selectTable::windowConfigure $table $row,$number(color) -window $button -padx 1 -pady 1 -sticky nsew
        # eventually update color as level is changed:
        composite::configure $menu -command "thresholds::updateLevel $this $threshold $button"
        set frame [frame $path.$threshold,actions]                                                 ;# contains eventual image labels
        selectTable::windowConfigure $table $row,$number(actions) -window $frame -padx 1 -pady 1
        set cell $row,$number(value)
        set data($cell) [switched::cget $threshold -value]
        set entry $path.$threshold,value
        entry $entry -font $font::(mediumNormal) -textvariable thresholds::data($cell) -borderwidth 0 -highlightthickness 0\
            -width 10                         ;# wide enough for largest 32 bit integers, but limited in display width for text data
        bind $entry <FocusIn> "thresholds::select $this $threshold"
        selectTable::windowConfigure $table $cell -window $entry -padx 1 -pady 1 -sticky nsew
        set cell $row,$number(source)
        regsub -all {\n} [switched::cget $threshold -label] { } data($cell)      ;# replace all new lines, which entry cannot handle
        set entry $path.$threshold,source
        entry $entry -font $font::(mediumNormal) -textvariable thresholds::data($cell) -borderwidth 0 -highlightthickness 0 -width 1
        bind $entry <FocusIn> "thresholds::select $this $threshold"
        selectTable::windowConfigure $table $cell -window $entry -padx 1 -pady 1 -sticky nsew
        set data($row,$number(addresses)) [switched::cget $threshold -addresses]
        set data($row,$number(subject)) [set subject [switched::cget $threshold -subject]]
        set data($row,$number(body)) [set body [switched::cget $threshold -bodytext]]
        set data($row,$number(default)) [expr {([string length $subject] == 0) && ([string length $body] == 0)}]
        set data($row,$number(script)) [switched::cget $threshold -scripttext]
        # at this point, cell may no longer exist or module may have been unloaded, which implies that the cell array is gone
        set data($row,$number(label)) $threshold::($threshold,cellLabel)
        set data($row,$number(initial)) [switched::cget $threshold -initial]
        set data($row,$number(emailShot)) [switched::cget $threshold -emailshot]
        updateActions $this $row                                                                  ;# eventually display action icons
        if {[string equal $::tcl_platform(platform) windows]} ::update           ;# so that level menu appears with the proper width
    }

}

    proc update {this array} {
        variable thresholds

        if {[info exists ($this,dialog)]} {
            if {[info exists ($this,selected)]} {                                               ;# a threshold is currently selected
                updateCurrentValue $this $($this,selected)
            }
        } else {                                                             ;# check thresholds only when they are not being edited
            foreach threshold $thresholds {
                # thresholds must be sorted with the most important checked last so that their colors prevail
                threshold::check $threshold $array
            }
        }
    }

if {$global::withGUI} {

    proc updateCurrentValue {this row} {
        variable data
        variable number                                                                                        ;# data column number

        set threshold $data($row,$number(threshold))
        set value ?
        catch {set value [set $threshold::($threshold,cell)]}                                            ;# cell may no longer exist
        $($this,current) configure -text $value
    }

    proc createDialog {this} {                                           ;# do not grab events to allow dropping in thresholds table
        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" -otherbuttons {test delete}\
        ]
        set ($this,helpTip) [linkedHelpWidgetTip $composite::($dialog,help,path)]
        if {![info exists geometry]} {set geometry 600x550}                     ;# use last geometry which the user may have changed
        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                                                                                        ;# data column number

        if {![info exists help]} {
            set help(active) [mc {whether the threshold condition is checked}]
            set help(type) [mc {threshold type (click for next type)}]
            set help(once) [mc {whether actions are taken only once when threshold condition is maintained over time (reset when condition disappears)}]
            set help(level) [mc {importance level (used by moomps for system logging and included in email alert)}]
            set help(color) [mc {color showing threshold condition occurred (click to edit)}]
            set help(actions) [mc {actions (email, script) taken when threshold condition occurs}]
            set help(value) [mc {threshold value}]
            set help(source) [mc {data description (can be edited)}]
        }
        # keep data in a full array so that empty cells are kept when deleting rows with the table delete command
        set table [new selectTable $parentPath\
            -selectcommand "thresholds::selected $this" -followfocus 0 -variable thresholds::data -titlerows 1 -roworigin -1\
        ]
        set path $selectTable::($table,tablePath)
        set column 0
        foreach title {
            active threshold addresses script label initial default subject body emailShot
            type once level color actions value source
        } {
            set data(-1,$column) $title                                                                              ;# table titles
            set number($title) $column
            incr column
        }
        composite::configure $table -columns [llength [array names data -1,*]]  ;# set number of columns according to title row data
        foreach {cell title} [array get data -1,*] {
            if {![info exists help($title)]} continue                                                               ;# hidden column
            set label [label $path.$cell -font $font::(mediumBold) -text [mc $title]]
            selectTable::windowConfigure $table $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}]
        selectTable::spans $table -1,$number(active) 0,$(hiddenColumns)
        # allow direct drop:
        set ($this,drop) [new dropSite -path $path -formats DATACELLS -command "viewer::view $this \$dragSite::data(DATACELLS)"]
        return $table
    }

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

        if {$destroy} {                                          ;# dialog box is being destroyed: last invocation of this procedure
            # this procedure goes once only through here if user canceled
            eval ::delete $($this,helpTip) $($this,objects) $($this,emails) $($this,body) $($this,script) $($this,test)\
                $($this,panes) $($this,table) $($this,drop) $($this,drag)
            unset ($this,dialog) ($this,helpTip) ($this,objects) ($this,emails) ($this,cell) ($this,current) ($this,body)\
                ($this,bodyText) ($this,script) ($this,scriptText) ($this,test) ($this,testText) ($this,panes) ($this,table)\
                ($this,drop) ($this,drag)
            catch {unset ($this,selected)}
            unset data
            foreach threshold $thresholds {                                                 ;# delete new thresholds on cancellation
                if {[info exists (held,$threshold)]} {
                    viewer::unregisterTrace $this $threshold::($threshold,array)
                    ldelete thresholds $threshold
                    ::delete $threshold
                }
            }
            if {[info exists deleted]} {                                               ;# restore deleted thresholds on cancellation
                foreach threshold $deleted {
                    if {[info exists (held,$threshold)]} continue                             ;# new threshold already handled above
                    lappend thresholds $threshold
                }
                unset deleted
            }
            array unset {} held,*
            # IMPORTANT: reorder thresholds so that the most important are last (see update{}):
            set thresholds [lsort -command threshold::comparison $thresholds]
            pages::monitorActiveCells                                   ;# the very last action is to refresh pages monitored cells,
            thresholdLabel::monitorActiveCells                                                ;# as well as global thresholds viewer
        } else {                          ;# user confirmed update (then this procedure is invoked again as dialog box is destroyed)
            if {[info exists ($this,selected)]} {
                set row $($this,selected)
                set data($row,$number(addresses)) [listEntry::get $($this,emails)]
                if {[string length [set errors [checkEmails $this $row]]] > 0} {
                    tk_messageBox -parent $widget::($($this,dialog),path)\
                        -title [mc {moodss: Email error}] -type ok -icon error -message $errors
                    return                                                                      ;# stay on row if any invalid emails
                }
            }
            foreach {name threshold} [array get data "\[0-9\]*,$number(threshold)"] {
                scan $name %u row
                if {[info exists ($this,selected)] && ($row == $($this,selected))} {     ;# eventually directly store displayed data
                    set data($row,$number(addresses)) [listEntry::get $($this,emails)]
                    if {[set data($row,$number(default)) $($this,default)]} {
                        set data($row,$number(subject)) {}
                        set data($row,$number(body)) {}
                    } else {
                        set data($row,$number(subject)) [string trim [$($this,subjectEntry) get]]
                        set data($row,$number(body)) [string trim [$($this,bodyText) get 1.0 end]]
                    }
                    set data($row,$number(script)) [string trim [$($this,scriptText) get 1.0 end]]
                    set data($row,$number(initial)) $($this,initial)
                    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)) -emailshot $data($row,$number(emailShot))\
                    -label $data($row,$number(source)) -addresses $data($row,$number(addresses)) -actonce $data($row,$number(once))\
                    -subject $data($row,$number(subject)) -bodytext $data($row,$number(body)) -value $data($row,$number(value))\
                    -initial $data($row,$number(initial)) -scripttext $data($row,$number(script))
            }
            if {[info exists deleted]} {
                foreach threshold $deleted {                                                                   ;# confirmed deletion
                    viewer::unregisterTrace $this $threshold::($threshold,array)           ;# trace may no longer be needed on array
                    ::delete $threshold
                }
                unset deleted
            }
            array unset {} held,*   ;# so that run-time created thresholds are not deleted at following invocation of this procedure
            ::delete $($this,dialog)
        }
    }

    proc updateMailSection {this} {
        variable data
        variable number

        set entry $($this,subjectEntry)
        set text $($this,bodyText)
        if {$($this,default)} {
            $($this,subjectLabel) configure -state disabled
            $entry configure -state normal; $entry delete 0 end; $entry configure -state disabled
            $($this,bodyLabel) configure -state disabled
            $text configure -state normal; $text delete 1.0 end; $text configure -state disabled
        } else {
            $($this,subjectLabel) configure -state normal
            $entry configure -state normal
            $entry delete 0 end
            $($this,bodyLabel) configure -state normal
            $text configure -state normal
            $text delete 1.0 end
            if {[info exists ($this,selected)]} {                                               ;# a threshold is currently selected
                set row $($this,selected)
                $entry insert 0 $data($row,$number(subject))
                $text insert 1.0 $data($row,$number(body))                                           ;# display current message body
            }
        }
    }

    proc toggleGrid {arrow path args} {
        if {[llength [grid info $path]] == 0} {
            composite::configure $arrow -direction right
            eval grid $path $args
        } else {
            composite::configure $arrow -direction down
            grid forget $path
        }
    }

}

    proc cells {this} {
        variable thresholds

        set cells {}
        foreach threshold $thresholds {                    ;# must be in the same order as in initialization configuration procedure
            lappend cells $threshold::($threshold,cell)
        }
        return $cells                                                                                      ;# may contain duplicates
    }

    proc initializationConfiguration {this} {
        variable thresholds

        set arguments {}
        foreach threshold $thresholds {                                           ;# must be in the same order as in cells procedure
            set list [list -cell $threshold::($threshold,cell)]                                      ;# from 19.1: see monitorCell{}
            foreach configuration [switched::configure $threshold] {
                foreach {option default value} $configuration {}
                if {[string equal $option -script]} continue                                     ;# obsolete starting at moodss 17.0
                lappend list $option $value
            }
            lappend arguments $list
        }
        return [list -configurations $arguments]                             ;# note: always return configurations in the same order
    }

    proc manageable {this} {return 0}                                       ;# thresholds are displayed in a self managed dialog box

if {$global::withGUI} {

    proc monitored {this cell} {
        variable thresholds

        foreach threshold $thresholds {
            if {[string equal $threshold::($threshold,cell) $cell]} {
                return 1
            }
        }
        return 0
    }

    proc test {this} {
        variable data
        variable number

        set emails [listEntry::get $($this,emails)]                                                   ;# first check email addresses
        if {[string length [set errors [checkEmailAddresses $emails]]] > 0} {
            tk_messageBox -parent $widget::($($this,dialog),path)\
                -title [mc {moodss: Email error}] -type ok -icon error -message $errors
            return
        }
        set row $($this,selected)
        set threshold $data($row,$number(threshold))
        if {$($this,default)} {
            set subject {}
            set body {}
        } else {
            set subject [string trim [$($this,subjectEntry) get]]
            set body [string trim [$($this,bodyText) get 1.0 end]]
        }
        set script [string trim [$($this,scriptText) get 1.0 end]]
        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 -scripttext $script -emailshot $($this,emailShot) -initial 0 -actonce 0 -test 1\
            -subject $subject -bodytext $body\
        ]                                                        ;# prevent acting once only since that would disturb repeated tests
        set output [threshold::test $temporary]
        if {[string length $script] > 0} {                                             ;# show test output only if there is a script
            set text $($this,testText)
            $text configure -state normal
            $text insert end \n$output\n
            # use a unique name for separator:
            $text window create end -window [frame $text.$temporary\
                -relief sunken -borderwidth 1 -height 2 -width [expr {[winfo width $text] - $global::separatorCut}]\
            ]
            $text see end
            $text configure -state disabled
        }
        ::delete $temporary
    }

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

        set table $($this,table)
        set path $selectTable::($table,tablePath)
        set row $($this,selected)
        deselect $this $row
        set threshold $data($row,$number(threshold))
        selectTable::delete $table $row
        ldelete thresholds $threshold                                                                    ;# remove from current list
        lappend deleted $threshold                                                    ;# but save in case user cancels the operation
        for {} {$row < [llength $thresholds]} {incr row} {                                               ;# restore entries variable
            set threshold $data($row,$number(threshold))
            $path.$threshold,active configure -variable thresholds::data($row,$number(active))
            $path.$threshold,once configure -variable thresholds::data($row,$number(once))
            $path.$threshold,value configure -textvariable thresholds::data($row,$number(value))
            $path.$threshold,source configure -textvariable thresholds::data($row,$number(source))
        }
        array unset data [llength $thresholds],\[0-9\]*    ;# delete now empty last row data (all others have been moved up 1 notch)
        selectTable::clear $table
        selectTable::refreshBorders $table                                                    ;# needed if there are multi-line rows
        selectTable::adjustTableColumns $table
    }

    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 threshold} {                                                             ;# select row for specified threshold
        return [selectTable::select $($this,table) [row $this $threshold]]
    }

    proc selected {this row} {     ;# note: select table implementation insures that row differs from previously selected row if any
        variable data
        variable number

        set topPath $widget::($($this,dialog),path)
        catch {set selection [selection get]}
        if {[info exists ($this,selected)]} {                                                    ;# store last selected row contents
            set selected $($this,selected)
            set data($selected,$number(addresses)) [listEntry::get $($this,emails)]
            if {[set data($selected,$number(default)) $($this,default)]} {
                set data($selected,$number(subject)) {}
                set data($selected,$number(body)) {}
            } else {
                set data($selected,$number(subject)) [string trim [$($this,subjectEntry) get]]
                set data($selected,$number(body)) [string trim [$($this,bodyText) get 1.0 end]]
            }
            set data($selected,$number(script)) [string trim [$($this,scriptText) get 1.0 end]]
            set data($selected,$number(initial)) $($this,initial)
            set data($selected,$number(emailShot)) $($this,emailShot)
            updateActions $this $selected
        }
        if {[info exists selected] && ([string length [set errors [checkEmails $this $selected]]] > 0)} {
            focus $widget::($($this,emails),path)
            tk_messageBox -parent $topPath -title [mc {moodss: Email error}] -type ok -icon error -message $errors
            return 0                                                                            ;# stay on row if any invalid emails
        }
        set ($this,selected) $row
        set button $($this,testButton)
        $button configure -state normal
        bind $topPath <Alt-KeyPress-t> "$button configure -relief sunken"          ;# make sure that only this button sees the event
        bind $topPath <Alt-KeyRelease-t> "$button configure -relief raised; $button invoke"
        set button $($this,deleteButton)
        $button configure -state normal
        bind $topPath <Alt-KeyPress-d> "$button configure -relief sunken"          ;# make sure that only this button sees the event
        bind $topPath <Alt-KeyRelease-d> "$button configure -relief raised; $button invoke"
        $($this,emailsLabel) configure -state normal
        composite::configure $($this,emails) -state normal
        $($this,initialButton) configure -state normal
        if {[string equal $::tcl_platform(platform) unix]} {                                           ;# not implemented in windows
            $($this,shot) configure -state normal
        }
        listEntry::set $($this,emails) $data($row,$number(addresses))
        $($this,cellLabel) configure -state normal
        $($this,cell) configure -text $data($row,$number(label))
        $($this,currentLabel) configure -state normal
        $($this,mailLabel) configure -state normal
        $($this,defaultButton) configure -state normal
        set ($this,default) $data($row,$number(default))
        updateMailSection $this
        $($this,scriptLabel) configure -state normal
        $($this,scriptText) configure -state normal
        $($this,scriptText) delete 1.0 end                                                             ;# display current row script
        $($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                                                                         ;# clear test trace
        $($this,testText) configure -state disabled
        set ($this,initial) $data($row,$number(initial))
        set ($this,emailShot) $data($row,$number(emailShot))
        updateCurrentValue $this $row
        if {[info exists selection]} {            ;# transport selection from one entry to another (useful for copying scripts text)
            clipboard clear
            clipboard append $selection
        }
        return 1
    }

    proc deselect {this row} {
        set topPath $widget::($($this,dialog),path)
        unset ($this,selected)
        composite::configure $($this,emails) -state disabled
        listEntry::set $($this,emails) {}
        $($this,cellLabel) configure -state disabled
        $($this,currentLabel) configure -state disabled
        $($this,emailsLabel) configure -state disabled
        $($this,mailLabel) configure -state disabled
        set ($this,default) 1
        $($this,defaultButton) configure -state disabled
        updateMailSection $this
        $($this,scriptLabel) configure -state disabled
        $($this,scriptText) delete 1.0 end
        $($this,scriptText) configure -state disabled
        $($this,testLabel) configure -state disabled
        $($this,testText) configure -state normal; $($this,testText) delete 1.0 end; $($this,testText) configure -state disabled
        $($this,testButton) configure -state disabled
        bind $topPath <Alt-KeyPress-t> {}; bind $topPath <Alt-KeyRelease-t> {}
        $($this,deleteButton) configure -state disabled
        bind $topPath <Alt-KeyPress-d> {}; bind $topPath <Alt-KeyRelease-d> {}
        $($this,cell) configure -text {}
        $($this,current) configure -text {}
        set ($this,initial) 0
        $($this,initialButton) configure -state disabled
        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 [mc {Choose color}] -parent $widget::($($this,dialog),path)]
                if {[string length $color] == 0} return                                              ;# user cancellation: no change
                $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::(mediumNormal)
        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
        set spaces {   }
        if {[string equal $::tcl_platform(platform) windows]} {
            set spaces {      }                     ;### Tk bug: use 6 spaces for windows because otherwise labels look too thin ###
        }
        foreach color $(colors) {
            # empty color means custom color, ? color means no color, this button color being set dynamically
            switch $color {
                {} {
                    $menu add command -label ...
                }
                ? {
                    $menu add command -label { ?}
                }
                default {
                    $menu add command -label $spaces -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                              ;# set custom button color
    }

    proc updateLevel {this threshold colorsMenu value} {                                             ;# value is possibly translated
        variable data
        variable number
        variable levelColor
        variable translated

        set index [lsearch -exact $translated(levels) $value]; if {$index < 0} {set index 0}
        set value [lindex $(levels) $index]
        set row [row $this $threshold]
        if {[string equal $levelColor($data($row,$number(level))) $data($row,$number(color))]} {
            # current level and current color match: set color corresponding to new level
            chooseColor $this $colorsMenu $row $levelColor($value)
        }
        set data($row,$number(level)) $value                                                             ;# finally update new level
    }

    proc updateActions {this row} {                                         ;# update action column with icons for the specified row
        variable data
        variable number
        variable mailIcon
        variable customMailIcon
        variable gearIcon

        set threshold $data($row,$number(threshold))
        set path $selectTable::($($this,table),tablePath)
        set frame $path.$threshold,actions
        foreach label [winfo children $frame] {destroy $label}                                                     ;# clean up first
        if {[llength $data($row,$number(addresses))] > 0} {                                             ;# there are mail recipients
            if {$data($row,$number(default))} {
                pack [label $frame.mail -image $mailIcon] -side left
            } else {
                pack [label $frame.mail -image $customMailIcon] -side left            ;# give a hint that mail message is customized
            }
        }
        if {[string length $data($row,$number(script))] > 0} {                                                ;# script is not empty
            pack [label $frame.gear -image $gearIcon]
        }
    }

}

if {$global::withGUI} {

    proc cellData {array row column} {                            ;# can be invoked at any time (on new cell in viewer, for example)
        variable thresholds

        set list {}
        foreach threshold $thresholds {               ;# check all thresholds since there can be several thresholds on the same cell
            if {\
                ![switched::cget $threshold -active] || ![string equal $threshold::($threshold,array) $array] ||\
                ![string equal $threshold::($threshold,row) $row] || ![string equal $threshold::($threshold,column) $column]\
            } continue                                                                                 ;# ignore inactive thresholds
            lappend list $switched::($threshold,-color) $switched::($threshold,-level)
            if {$threshold::($threshold,condition)} {
                lappend list [threshold::summary $threshold]
            } else {
                lappend list {}
            }
        }
        return $list
    }

    proc activeCells {} {
        variable thresholds

        foreach threshold $thresholds {
            if {[switched::cget $threshold -active]} {
                set active($threshold::($threshold,cell)) {}                                                  ;# disallow duplicates
            }
        }
        return [array names active]
    }

    proc validateDrag {this x y} {
        return [info exists ($this,selected)]                                             ;# obviously there must be a selected cell
    }

    proc dragData {this format} {                                                                    ;# format can only be DATACELLS
        variable data
        variable number

        set threshold $data($($this,selected),$number(threshold))
        return $threshold::($threshold,cell)
    }

}

    proc reset {this} {                                                       ;# return to original state when singleton was created
        variable thresholds

if {$global::withGUI} {
        if {[info exists ($this,dialog)]} {                                                               ;# dialog box is displayed
            ::delete $($this,dialog)                                                                          ;# as if user canceled
        }
}
        foreach threshold $thresholds {
            viewer::unregisterTrace $this $threshold::($threshold,array)                   ;# trace may no longer be needed on array
            ldelete thresholds $threshold
            ::delete $threshold
        }
    }

    proc checkEmails {this row} {
        variable data
        variable number

        return [checkEmailAddresses $data($row,$number(addresses))]
    }

    proc checkEmailAddresses {list} {
        set errors {}
        foreach address $list {
            set message [emailAddressError $address]
            if {[string length $message] == 0} continue
            append errors "$address: $message\n"
        }
        return $errors
    }

    proc active {options} {                          ;# public procedure: returns the number of active thresholds emails and scripts
        array set value $options
        if {![info exists value(-configurations)]} {
            return [list 0 0]                                                                                       ;# no thresholds
        }
        set emails 0; set scripts 0
        foreach options $value(-configurations) {                                              ;# list of switch, value, switch, ...
            set list [threshold::active $options]
            incr emails [lindex $list 0]
            incr scripts [lindex $list end]
        }
        return [list $emails $scripts]
    }

    proc create {this array row column args} {      ;# public procedure usable from modules via interpreter alias (see module class)
        viewer::view $this ${array}($row,$column)                                                          ;# create a new threshold
        eval switched::configure $($this,lastMonitored) $args                                              ;# with specified options
        pages::monitorActiveCells                                                                  ;# refresh pages monitored cells,
        thresholdLabel::monitorActiveCells                                                    ;# as well as global thresholds viewer
    }

    proc current {this array} {                     ;# public procedure usable from modules via interpreter alias (see module class)
        variable thresholds

        set list {}
        foreach threshold $thresholds {
            if {[string equal $threshold::($threshold,array) $array]} {
                lappend list $threshold
            }
        }
        return $list                                                    ;# list of thesholds on any cell of the specified data array
    }


}

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=\
        ]

}                                                                  ;# else avoid Tk commands when running under tclsh in daemon mode

        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,condition) 0                                                 ;# whether threshold condition is currently true
            # remember source cell label in case its module is unloaded, in which case it would be impossible to reconstruct:
            set ($this,cellLabel) [lindex [viewer::label $($this,array) $($this,row) $($this,column) 1] 0]
            set ($this,checked) 0
            switched::complete $this
        }

        proc ~threshold {this} {
            if {$($this,condition)} {
                cellThresholdCondition $($this,array) $($this,row) $($this,column)\
                    $switched::($this,-color) $switched::($this,-level) {}                                    ;# reset related cells
            }
        }

        proc options {this} {                                                                          ;# force color initialization
            return [list\
                [list -active 0 0]\
                [list -actonce 0 0]\
                [list -addresses {} {}]\
                [list -bodytext {} {}]\
                [list -color white]\
                [list -emailshot 0 0]\
                [list -initial 0 0]\
                [list -label {} {}]\
                [list -level info info]\
                [list -script {} {}]\
                [list -scripttext {} {}]\
                [list -subject {} {}]\
                [list -type up up]\
                [list -test 0 0]\
                [list -value {} {}]\
            ]
        }

        proc set-active {this value} {
            if {!$switched::($this,complete)} return                              ;# no need to do anything before object completion
            if {$value} {
                check $this $($this,array)                                                                      ;# check immediately
            } elseif {$($this,condition)} {                                                                        ;# going inactive
                cellThresholdCondition $($this,array) $($this,row) $($this,column)\
                    $switched::($this,-color) $switched::($this,-level) {}                                    ;# reset related cells
                set ($this,condition) 0
            }
        }

        proc set-actonce {this value} {}

        proc set-addresses {this value} {}

        proc set-color {this value} {
            if {$switched::($this,complete) && $($this,condition)} {                                         ;# update related cells
                cellThresholdCondition $($this,array) $($this,row) $($this,column) $value $switched::($this,-level) [summary $this]
            }
        }

        proc set-emailshot {this value} {}

        proc set-initial {this value} {}

        proc set-label {this value} {}

        proc set-level {this value} {
            if {[lsearch -exact $thresholds::(levels) $value] < 0} {
                error {invalid level value}
            }
            if {$switched::($this,complete) && $($this,condition)} {                                         ;# update related cells
                cellThresholdCondition $($this,array) $($this,row) $($this,column) $switched::($this,-color) $value [summary $this]
            }
        }

        proc set-scripttext {this value} {}      ;# used instead of -script since text termination insures that it is properly saved
        # obsolete starting at moodss 17.0: use -scripttext instead
        proc set-script {this value} {switched::configure $this -scripttext $value}

        proc set-test {this value} {}

        proc set-type {this value} {                                                                                  ;# type change
            if {$switched::($this,complete)} {                                    ;# no need to do anything before object completion
                check $this $($this,array)                                                                                ;# recheck
            }
        }

        proc set-value {this value} {                                                                      ;# threshold value change
            if {$switched::($this,complete)} {                                    ;# no need to do anything before object completion
                check $this $($this,array)                                                                                ;# recheck
            }
        }

        proc set-subject {this value} {}                                                                    ;# email message subject
        proc set-bodytext {this value} {}                                                     ;# and body (defaults used when empty)

        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} {
            # do nothing if test threshold, since it is artificially activated, and check that cell belongs to updated array
            if {$switched::($this,-test) || ![string equal $array $($this,array)]} return
            # update label in case cell has disappeared or on the contrary appeared, as in the case of an asynchronous module:
            set ($this,cellLabel) [lindex [viewer::label $array $($this,row) $($this,column) 1] 0]
            # abort if threshold is not active and wait until data is actually updated from its module and thus valid
            if {!$switched::($this,-active) || ([set ${array}(updates)] < 1)} return
            set threshold [string trim $switched::($this,-value)]
            catch {set value [set $($this,cell)]}                                    ;# may no longer exist or may not be filled yet
            set condition 0
            set act\
                [expr {(!$switched::($this,-actonce) || !$($this,condition)) && (!$switched::($this,-initial) || $($this,checked))}]
            if {![info exists value] || ([string equal $value ?] && $($this,numeric))} {                                ;# void cell
                if {[string equal $switched::($this,-type) unknown]} {               ;# special case of unknown threshold occurrence
                    if {$act} {act $this {} ?}
                    set condition 1
                }
            } else {                                                                                           ;# existing cell data
                if {![string equal $switched::($this,-type) unknown] && [compare $this $threshold $value]} {     ;# normal threshold
                    if {$act} {act $this $threshold $value}
                    set condition 1
                }
            }
            if {$condition} {
                set ($this,seconds) [clock seconds]
                set ($this,condition) 1                                                        ;# summary needs up-to-date condition
                # delay displayed data update so that data tables, for example, are updated, due to the implementation of the Tcl
                # trace command which invokes latest traces commands first, resulting in the viewers (created after the data tables)
                # being updated first:
                cellThresholdCondition $($this,array) $($this,row) $($this,column)\
                    $switched::($this,-color) $switched::($this,-level) [summary $this]
if {$global::withGUI} {
                if {$global::traceThresholds && $act} {
                    if {![info exists value]} {if {$($this,numeric)} {set value ?} else {set value {}}}
                    modules::trace {} moodss(thresholds) [replacePercents $this $threshold $value $global::logMessage]
                }
}
            } elseif {$($this,condition)} {                                                             ;# condition changed to none
                unset ($this,seconds)
                set ($this,condition) 0
                cellThresholdCondition $($this,array) $($this,row) $($this,column)\
                    $switched::($this,-color) $switched::($this,-level) {}                                                  ;# reset
            }
            incr ($this,checked)
        }

if {$global::withGUI} {

        proc test {this} {                        ;# at this point threshold value validity must have been checked according to type
            if {[string equal $switched::($this,-type) unknown]} {
                act $this {} ?
                return $($this,output)
            }
            set threshold [string trim $switched::($this,-value)]
            # if invalid threshold value (includes void), use arbitrary value (except for ascii and dictionary which can be empty):
            switch $($this,cellType) {
                clock {
                    if {[catch {clock scan $threshold}]} {set threshold [clock format [clock seconds]]}
                }
                integer {
                    if {![string is integer -strict $threshold]} {set threshold 10}
                }
                real {
                    if {![string is double -strict $threshold]} {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)                                                                  ;# return eventual script output
        }

}

        proc replacePercents {this threshold value text} {
            regsub -all %% $text \001 text                                                           ;# first handle quoted percents
            regsub -all %A $text $global::applicationName text                                                   ;# application name
            regsub -all %c $text $($this,cellLabel) text                                                      ;# cell original label
            regsub -all %l $text $switched::($this,-level) text                                                  ;# importance level
            regsub -all %s $text $switched::($this,-label) text                                                            ;# source
            regsub -all %t $text $threshold text                                                                  ;# threshold value
            regsub -all %T $text $switched::($this,-type) text                                                     ;# threshold type
            regsub -all %v $text $value text                                                                           ;# cell value
            regsub -all \001 $text % text                                                                 ;# restore quoted percents
            return $text
        }

        proc compare {this threshold value} {                                                     ;# at this point, data cell exists
            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 {[catch {set threshold [clock scan $threshold -base 0]}] || [catch {set value [clock scan $value -base 0]}]} {
                return 0                                  ;# ignore data in invalid format since there is no guarantee at this point
            }
            switch $type {
                differ {return [expr {$value != $threshold}]}
                down {return [expr {$value < $threshold}]}
                equal {return [expr {$value == $threshold}]}
                up {return [expr {$value > $threshold}]}
            }
        }

        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 is double -strict $threshold] || ![string is double -strict $value]} {                  ;# check if numeric
                return [compare-dictionary $type $threshold $value]                          ;# fall back in case of invalid numbers
            }
            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,-scripttext)] > 0} {
                set script [replacePercents $this $threshold $value $switched::($this,-scripttext)]
                # save command output on both standard or error outputs, or error message:
                if {[string equal $::tcl_platform(platform) unix]} {
                    if {![info exists ::env(SHELL)]} {set ::env(SHELL) sh}
                    set error [catch {exec 2>@ stdout $::env(SHELL) -c $script} ($this,output)]
                } else {                                                                                                  ;# windows
                    if {![info exists ::env(COMSPEC)]} {set ::env(COMSPEC) cmd}                ;# use evolved interpreter by default
                    # use eval since windows interpreter does not seem to support whole scripts passed as parameter but rather
                    # commands with arguments. also the standard error channel does not seem to exist:
                    set error [catch {eval exec [list $::env(COMSPEC)] /c $script} ($this,output)]
                }
                if {$error} {
                    set message "$switched::($this,-label): $($this,output)"
                    if {$global::withGUI} {
                        modules::trace {} moodss(thresholds) $message
                    } else {
                        writeLog $message error
                    }
                }
            }
            if {!$global::withGUI} {                           ;# in daemon mode, send message to system log with user defined level
                writeLog "($switched::($this,-level)) [replacePercents $this $threshold $value $global::logMessage]"\
                    $switched::($this,-level)
            }
            if {[llength $switched::($this,-addresses)] > 0} {
                if {[llength $global::smtpServers] == 0} {
                    set message {no SMTP servers defined}
                    if {$global::withGUI} {
                        modules::trace {} moodss(thresholds) [mc $message]
                    } else {
                        writeLog $message error
                    }
                } else {
                    set noDefault [string length $switched::($this,-subject)]
                    if {!$noDefault && ([string length $switched::($this,-bodytext)] == 0)} {
                        set body [replacePercents $this $threshold $value $global::mailBody]                          ;# use default
                    } else {
                        set body [replacePercents $this $threshold $value $switched::($this,-bodytext)]  ;# use user defined message
                    }
                    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 $body]\
                            [mime::initialize -canonical image/gif -file $shot]\
                        ]]
                    } else {
                        set token [mime::initialize -canonical text/plain -string $body]
                    }
                    lappend headers -servers [list $global::smtpServers]
                    lappend headers -header [list From $global::fromAddress]
                    foreach address $switched::($this,-addresses) {
                        lappend headers -header [list To $address]
                    }
                    if {$noDefault} {
                        set subject $switched::($this,-subject)                                          ;# use user defined subject
                    } else {                                                                          ;# never leave a subject empty
                        set subject $global::mailSubject                                                              ;# use default
                    }
                    lappend headers -header [list Subject [replacePercents $this $threshold $value $subject]]
                    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 {} moodss(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 {} moodss(thresholds) $message
                                } else {
                                    writeLog $message error
                                }
                            }
                        }
                    }
                    mime::finalize $token -subordinates all
                    if {[info exists shot]} {
                        file delete $shot
                    }
                }
            }
        }

        proc initializeLevelsMapping {} {
            variable level

            if {![info exists level]} {                                     ;# associate a threshold level name with a numeric level
                set index 0
                foreach name $thresholds::(levels) {
                    set level($name) $index
                    incr index
                }
            }
        }

if {$global::withGUI} {

        proc compareLevels {level1 level2} {                   ;# levels in string form, suitable for use with lsort -command option
            variable level

            initializeLevelsMapping
            return [expr {$level($level2) - $level($level1)}]                                            ;# lesser is more important
        }

}

        # compare 2 thresholds, returns:
        #   0   if both thresholds are of equal importance
        #   -1  if first threshold is less important than the second
        #   1   if first threshold is more important than the second
        proc comparison {threshold1 threshold2} {
            variable level

            initializeLevelsMapping
            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)]\
                } {                                                                  ;# thresholds of the same type on the same cell
                    set value1 [string trim $switched::($threshold1,-value)]
                    set value2 [string trim $switched::($threshold2,-value)]
                    if {[compare $threshold1 $value2 $value1]} {
                        return 1                                  ;# first threshold value is "more" than the second threshold value
                    } elseif {[compare $threshold1 $value1 $value2]} {
                        return -1                                 ;# first threshold value is "less" than the second threshold value
                    }
                }
                return 0
            } elseif {$level1 < $level2} {
                return 1
            } else {
                return -1
            }
        }

        proc summary {this} {                                                        ;# short enough to be displayed in a widget tip
            if {$($this,condition)} {
                set threshold [string trim $switched::($this,-value)]
                set value ?
                catch {set value [set $($this,cell)]}                                ;# may no longer exist or may not be filled yet
                return\
            "[clock format $($this,seconds) -format {%d %b %Y %T}]: [replacePercents $this $threshold $value $global::logMessage]"
            } else {
                return {}
            }
        }

        proc active {options} {                       ;# returns the number of active emails and scripts in list of switched options
            array set value $options
            if {$value(-active)} {
                return [list [llength $value(-addresses)] [expr {[llength $value(-scripttext)] > 0}]]
            } else {
                return [list 0 0]
            }
        }

    }

}