1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
|
# 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: threshman.tcl,v 1.9 2005/01/02 00:45:07 jfontain Exp $
# a cell thresholds manager for the page and message viewer
class thresholdsManager {
set (number) 0 ;# unique: the higher the most recent entry
proc thresholdsManager {this} {}
proc ~thresholdsManager {this} {
variable ${this}number
variable ${this}text
catch {unset ${this}number ${this}text}
}
proc condition {this cell color level text} { ;# a threshold condition occured
variable ${this}number
variable ${this}text
if {[string length $color] == 0} {set color $viewer::(background)} ;# use viewer background in absence of color
foreach {red green blue} [winfo rgb . $color] {}
set color #[format %04X $red][format %04X $green][format %04X $blue] ;# use a unique format
set key [list $cell $color $level] ;# a cell may have several thresholds set on it
if {[string length $text] == 0} { ;# threshold is being reset
catch {unset ${this}number($key) ${this}text($key)}
} else { ;# new or update threshold condition
set ${this}number($key) [incr (number)]
set ${this}text($key) $text
}
}
# return the colors and texts, most important and most recent first, in the form of 2 lists without duplicates
proc colorsAndTexts {this} {
variable ${this}number
variable ${this}text
set texts {}
set list {}
foreach {key number} [array get ${this}number] {
foreach {cell color level} $key {}
lappend list [list $level $key $color $number]
}
# sort by importance level, most important first, and only keep maximum importance:
foreach list [lsort -command thresholds::threshold::compareLevels -index 0 -decreasing $list] {
foreach {level key color number} $list {}
if {![info exists minimum]} {set minimum $level}
if {[thresholds::threshold::compareLevels $level $minimum] < 0} break ;# only keep maximum level thresholds
set colorNumber($color) $number ;# suppress duplicates
set textNumber([set ${this}text($key)]) $number
}
set list {}
foreach {color number} [array get colorNumber] {lappend list [list $color $number]}
set colors {}
foreach list [lsort -decreasing -integer -index end $list] {lappend colors [lindex $list 0]} ;# most recent first
set list {}
foreach {text number} [array get textNumber] {lappend list [list $text $number]}
set texts {}
foreach list [lsort -decreasing -integer -index end $list] {lappend texts [lindex $list 0]} ;# most recent first
return [list $colors $texts]
}
}
|
