# copyright (C) 1997-2001 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

set rcsId {$Id: threshold.tcl,v 1.34 2001/01/27 16:19:15 jfontain Exp $}


class thresholds {

    variable help
    set help(active) "whether the threshold\ncondition is ckeched"
    set help(threshold) {}                                                                                          ;# hidden column
    set help(type) "threshold type\n(click for next type)"
    set help(color) "color showing threshold\ncondition occured\n(click to edit)"
    set help(source) {monitored data cell}
    set help(value) {threshold value}
    set help(emails) "comma separated list of\nemail adresses, recipients\nof threshold alert messages"
    set help(script) "system script invoked when the\nthreshold condition occurs"
    variable noMail [expr {[lsearch -exact [package names] smtp]<0}]
    set (default,button,background) $widget::option(button,background)

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

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

    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} {                                     ;# list of lists of switch/value pairs from save file
        set ($this,initializeIndex) 0                                        
    }

    proc edit {} {
        variable singleton
        variable thresholds

        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]
        grid [createTable $this $frame] -sticky nsew -row 0 -column 0 -columnspan 100
        grid rowconfigure $frame 0 -weight 1
        grid columnconfigure $frame 0 -weight 1
        set ($this,testButton) [button $frame.test -text Test -command "thresholds::test $this" -state disabled]
        grid $($this,testButton) -row 1 -column 2
        grid columnconfigure $frame 3 -weight 1
        set ($this,deleteButton) [button $frame.delete -text Delete -command "thresholds::delete $this" -state disabled]
        grid $($this,deleteButton) -row 1 -column 4
        grid columnconfigure $frame 5 -weight 1
        # implement single mode selection:
        set ($this,selector) [new objectSelector -selectcommand "thresholds::setRowsState $this"]
        bind $($this,tablePath) <ButtonRelease-1> "+ thresholds::select $this \[%W index @0,%y row\]"
        dialogBox::display $dialog $frame
        set ($this,dialog) $dialog
        foreach threshold [lsort -integer $thresholds] {                                  ;# display thresholds in order of creation
            display $this $threshold
        }
        adjustTableColumns $($this,tablePath)                                          ;# in case there was no thresholds to display
    }

    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} {                                                                             ;# to initialize from save file
            set threshold\
                [eval new threshold $cell [lindex $switched::($this,-configurations) $($this,initializeIndex)]]
            if {[incr ($this,initializeIndex)]==$length} {                                       ;# done initializing from save file
                switched::configure $this -configurations {}
                unset ($this,initializeIndex)
            }
        } else {
            set threshold [new threshold $cell]
            # initialize threshold label with cell label
            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) {}                                           ;# so threshold can be deleted upon user cancellation
            display $this $threshold
        }
    }

    proc display {this threshold} {
        variable data
        variable noMail

        set path $($this,tablePath)
        set row [expr {[$path cget -rows]-1}]                                                               ;# account for title row
        $path configure -rows [expr {$row+2}]                       ;# required so that embedded windows are displayed in their rows
        set background [$path cget -background]
        set font [$path cget -font]

        set data($row,1) $threshold             ;# row/threshold mapping kept in a hidden column so that it is updated properly when
        $path spans $row,0 0,1                                                                       ;# deleting rows from the table

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

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

        set data($row,3) [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,3 -window $button -padx 4 -pady 4 -relief sunken -borderwidth 1 -sticky nsew

        set data($row,4) [switched::cget $threshold -label]
        $path height $row [linesCount $data($row,4)]                                                ;# row height is number of lines

        set data($row,5) [switched::cget $threshold -value]

        set data($row,6) [join [switched::cget $threshold -addresses] ,]
        if {$noMail} {                                                                             ;# disable email addresses column
            $path tag cell disabled $row,6
        }

        set data($row,7) [switched::cget $threshold -script]

        adjustTableColumns $path
    }

    proc update {this array args} {
        variable thresholds

        if {[info exists ($this,dialog)]} return                                        ;# do nothing if thresholds are being edited
        foreach threshold $thresholds {
            threshold::check $threshold $array
        }
    }

    proc createDialog {this} {                                           ;# do not grab events to allow dropping in thresholds table
        set dialog [new dialogBox .\
            -buttons hoc -default o -title [mc {moodss: Thresholds}] -die 1 -grab release\
            -x [winfo pointerx .] -y [winfo pointery .] -helpcommand {generalHelpWindow #menus.edit.thresholds}\
            -command "thresholds::done $this 0" -deletecommand "thresholds::done $this 1"\
        ]
        wm geometry $widget::($dialog,path) 500x300                                     ;# so that script column is reasonably large
        set ($this,helpTip) [linkedHelpWidgetTip $composite::($dialog,help,path)]
        return $dialog
    }

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

        set scroll [new scroll table $parentPath]
        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
        if {$noMail} {                                                                             ;# disable email addresses column
            $path tag configure disabled -state disabled -foreground $widget::option(button,disabledforeground)
            $path tag cell disabled -1,6
        }
        # table titles:
        array set data {-1,0 active -1,1 threshold -1,2 type -1,3 color -1,4 source -1,5 value -1,6 emails -1,7 script}
        foreach {cell title} [array get data -1,*] {
            set label [label $path.$cell -font $font::(mediumBold) -text $title]
            $path window configure $cell -window $label -padx 2 -pady 2 -sticky nsew
            lappend ($this,tips) [new widgetTip -path $label -text $help($title)]
        }
        $path configure -cols 8
        $path spans -1,0 0,1                                                                           ;# threshold column is hidden
        # keep data in a full array so that empty cells are kept when deleting rows with the table delete command
        configureWritableTable $path
        $path tag configure active -background {} -relief sunken
        $path tag configure sel -background {} -borderwidth 2
        $path tag configure left -anchor w
        $path tag col left 6 7                                        ;# email addresses and script columns are anchored to the left
        $path configure -cols [llength [array names data -1,*]]                  ;# set number of column according to title row data
        $path tag configure title -borderwidth 1 -relief sunken -foreground black -background {} -font $font::(mediumBold)
        set ($this,tablePath) $path
        return $widget::($scroll,path)
    }

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

        if {$destroy} {                                                                             ;# dialog box is being destroyed
            # this procedure goes once only through here if user canceled
            eval ::delete $($this,helpTip) $($this,selector) $($this,tips)
            unset ($this,dialog) ($this,tablePath) ($this,helpTip) ($this,selector) ($this,tips)
            unset data
            foreach threshold $thresholds {                                                                 ;# delete new thresholds
                if {[info exists (held,$threshold)]} {
                    ldelete thresholds $threshold
                    ::delete $threshold
                }
            }
            if {[info exists deleted]} {
                set thresholds [concat $thresholds $deleted]                                               ;# user canceled deletion
                unset deleted
            }
        } else {                          ;# user confirmed update (then this procedure is invoked again as dialog box is destroyed)
            foreach {name threshold} [array get data {[0-9]*,1}] {
                scan $name %u row
                switched::configure $threshold -active $data($row,0) -type $data($row,2) -color $data($row,3) -label $data($row,4)\
                    -value $data($row,5) -addresses [split $data($row,6) ,] -script $data($row,7)
            }
            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
            }
        }
        # if user confirmed update, then the held thresholds will not be deleted when this procedure is invoked for destruction
        array unset {} held,*
    }

    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 {}
            foreach configuration [switched::configure $threshold] {
                foreach {option default value} $configuration {}
                lappend list $option $value
            }
            lappend arguments $list
        }
        return [list -configurations $arguments]
    }

    proc test {this} {
        variable data

        set row $($this,selected)
        set threshold $data($row,1)
        catch {$($this,tablePath) activate active}                           ;# make sure data array content is in sync with display
        set temporary [new threshold $threshold::($threshold,cell)\
            -active $data($row,0) -type $data($row,2) -color $data($row,3) -label $data($row,4) -value $data($row,5)\
            -addresses [split $data($row,6) ,] -script $data($row,7)\
        ]
        threshold::test $temporary
        ::delete $temporary
    }

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

        set path $($this,tablePath)
        set row $($this,selected)
        deselect $this $row
        set threshold $data($row,1)
        $path delete rows $row
        ldelete thresholds $threshold                                                                    ;# remove from current list
        lappend deleted $threshold                                                    ;# but save in case user cancels the operation
        array unset data [llength $thresholds],\[0-9\]*    ;# delete now empty last row data (all others have been moved up 1 notch)
        $path activate -1,0                                                                           ;# make sure no cell is active
    }

    proc setRowsState {this rows select} {
        set path $($this,tablePath)
        set right [expr {[$path cget -cols]-1}]
        if {$select} {
            foreach row $rows {
                $path selection set $row,0 $row,$right
                ### should be handled by selection tag, but compensate for what I think is a tktable bug:
                $path window configure $row,0 -borderwidth 2
                $path window configure $row,2 -borderwidth 2
                $path window configure $row,3 -borderwidth 2
            }
        } else {
            foreach row $rows {
                $path selection clear $row,0 $row,$right
                $path window configure $row,0 -borderwidth 1
                $path window configure $row,2 -borderwidth 1
                $path window configure $row,3 -borderwidth 1
            }
        }
    }

    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
        
        foreach {name value} [array get data {[0-9]*,1}] {
            if {$value==$threshold} {
                scan $name %u row
                return $row
            }
        }
        error "row not found for threshold $threshold"
    }

    proc select {this row} {
        if {$row<0} return                                                                        ;# prevent selection on title line
        set ($this,selected) $row
        selector::select $($this,selector) $row
        $($this,testButton) configure -state normal
        $($this,deleteButton) configure -state normal
    }

    proc deselect {this row} {
        if {$row<0} return                                                                      ;# prevent deselection on title line
        unset ($this,selected)
        selector::deselect $($this,selector) $row
        $($this,testButton) configure -state disabled
        $($this,deleteButton) configure -state disabled
    }

    proc chooseColor {this button row value} {
        variable data

        switch $value {
            {} {
                set color $data($row,3)
                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                                                ;# 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,3) $color
    }

    proc createColorsMenuButton {this parentPath threshold} {
        variable data

        set button $parentPath.$threshold,color
        set row [row $this $threshold]
        set initialColor $data($row,3)
        menubutton $button -relief raised -borderwidth 1 -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 {#FFFF80 #FFC000 #FF8080 #80FF80 #80FFFF #00C0FF white ? {}} {
            # 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 {   } -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

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

    proc setCellColor {this array row column color} {}                                               ;# obviously nothing to do here

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

        set color {}
        foreach threshold $thresholds {               ;# check all thresholds since there can be several thresholds on the same cell
            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]\
            } {                                        ;# wait till threshold is somewhat initialized and ignore inactive thresholds
                set color $threshold::($threshold,cellColor)
            }
        }
        return $color                                                                  ;# the most recent threshold has the priority
    }

}

set ::thresholds::singleton [new thresholds]


class thresholds {

    class threshold {

        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 (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,active) 0                                                    ;# whether threshold condition is currently true
            switched::complete $this
        }

        proc ~threshold {this} {
            if {$($this,active)&&$($this,colored)} {                                                         ;# if cells are colored
                changeAllCellsColor $($this,array) $($this,row) $($this,column) {}                            ;# reset related cells
            }
        }

        proc options {this} {                                                                          ;# force color initialization
            return [list\
                [list -active 0 0]\
                [list -addresses {} {}]\
                [list -color {}]\
                [list -label {} {}]\
                [list -script {} {}]\
                [list -type up up]\
                [list -value {} {}]\
            ]
        }

        proc set-active {this value} {
            if {$value} {
                check $this $($this,array)                                                                      ;# check immediately
            } elseif {$($this,active)} {                                                                           ;# going inactive
                if {$($this,colored)} {                                                                      ;# if cells are colored
                    changeAllCellsColor $($this,array) $($this,row) $($this,column) {}                        ;# reset related cells
                    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                       ;# update related cells
                set ($this,cellColor) $value
            }                                                                                     ;# else cells color is transparent
        }

        proc set-label {this value} {}

        proc set-script {this value} {}

        proc set-type {this value} {                                                                                  ;# type change
            check $this $($this,array)                                                                                    ;# recheck
        }

        proc set-value {this value} {                                                                      ;# threshold value change
            check $this $($this,array)                                                                                    ;# recheck
        }

        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                            ;# check that cell belongs to updated array
            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
            if {[info exists value]&&![string equal $value ?]} {                                                         ;# not void
                if {[compare $this $threshold $value]} {
                    act $this $threshold $value
                    set condition 1
                }
            } else {                                                                                           ;# unknown cell value
                if {[string equal $switched::($this,-type) unknown]} {                                               ;# special case
                    act $this {} ?
                    set condition 1
                }                                                                                                 ;# else do nothing
            }
            if {$($this,colored)&&($condition!=$($this,active))} {                        ;# changeable cells color and state change
                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) {}                                      ;# reset
                    set ($this,cellColor) {}
                }
            }
            set ($this,active) $condition
        }

        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
            }
            set threshold [string trim $switched::($this,-value)]
            if {[string length $threshold]==0} {                                                              ;# no meaningful value
                # use an arbitrary value (except for ascii and dictionary which can be empty)
                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
            }
            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}]}
                    }
                }
            }
        }

        proc replacePercents {this threshold value text} {
            regsub -all %% $text \001 text                                                           ;# first handle quoted percents
            set label [viewer::label $($this,array) $($this,row) $($this,column)]
            regsub -all %c $text $label text                                                                  ;# cell original label
            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 {[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} {
            if {[string length $switched::($this,-script)]>0} {
                if {[catch {exec sh -c [replacePercents $this $threshold $value $switched::($this,-script)]} message]} {
                    puts stderr "$switched::($this,-label): $message"
                    modules::trace thresholds thresholds "$switched::($this,-label): $message"
                }
            }
            if {!$thresholds::noMail&&[llength $switched::($this,-addresses)]>0} {
                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 {moodss threshold alert}]
                if {[catch {eval smtp::sendmessage $token $headers} error]} {
                    set message "SMTP error: $error"
                    puts stderr $message
                    modules::trace thresholds thresholds $message
                } else {
                    foreach list $error {
                        foreach {address code message} $list {
                            set message "$switched::($this,-label): on \"$address\", SMTP $code error: $message"
                            puts stderr $message
                            modules::trace thresholds thresholds $message
                        }
                    }
                }
                mime::finalize $token -subordinates all
            }
        }

    }

}