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
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
|
# 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: threshlbl.tcl,v 1.12 2005/01/02 00:45:07 jfontain Exp $
class thresholdLabel {
proc thresholdLabel {this parentPath args} composite {
[new label $parentPath -background $viewer::(background) -font $font::(mediumBold)] $args
} viewer {} {
variable singleton
if {[info exists singleton]} {
error {only 1 threshold label object can exist}
}
set singleton $this
set ($this,tip) [new widgetTip -path $widget::($this,path)]
composite::complete $this
}
proc ~thresholdLabel {this} {
error {not implemented}
}
proc options {this} {
return [list\
[list -borderwidth $widget::option(button,borderwidth)]\
[list -draggable 0 0]\
[list -text {} {}]\
]
}
proc set-borderwidth {this value} {$widget::($this,path) configure -borderwidth $value}
proc set-text {this value} {$widget::($this,path) configure -text $value}
proc set-draggable {this value} {} ;# unused
proc supportedTypes {this} { ;# same as thresholds
return [thresholds::supportedTypes 0]
}
proc monitorCell {this array row column} {
variable ${this}monitored
set cell ${array}($row,$column)
set ${this}monitored($cell) {}
}
proc forgetAllMonitoredCells {this} {
variable ${this}monitored
catch {unset ${this}monitored}
if {[info exists ($this,thresholds)]} {delete $($this,thresholds); unset ($this,thresholds)}
if {[info exists ($this,sequencer)]} {delete $($this,sequencer); unset ($this,sequencer)}
$widget::($this,path) configure -background $viewer::(background)
switched::configure $($this,tip) -text {}
}
proc update {this array} {} ;# nothing to do, only threshold conditions are waited upon
proc cells {this} { ;# sort cells so that they are always in the same order to prevent wrongful configuration change detection
variable ${this}monitored
return [lsort -dictionary [array names ${this}monitored]]
}
proc thresholdCondition {this array row column color level summary} {
variable ${this}monitored
set cell ${array}($row,$column)
if {![info exists ${this}monitored($cell)]} return
if {![info exists ($this,thresholds)]} { ;# create manager only when needed
set ($this,thresholds) [new thresholdsManager]
}
thresholdsManager::condition $($this,thresholds) $cell $color $level $summary
foreach {colors summaries} [thresholdsManager::colorsAndTexts $($this,thresholds)] {}
if {[info exists ($this,sequencer)]} {delete $($this,sequencer); unset ($this,sequencer)}
if {[llength $colors] == 0} {
$widget::($this,path) configure -background $viewer::(background)
} elseif {[llength $colors] == 1} {
$widget::($this,path) configure -background [lindex $colors 0]
} else { ;# display the different colors in sequence
set ($this,sequencer) [new sequencer 1000 %c $colors "$widget::($this,path) configure -background %c"]
sequencer::start $($this,sequencer)
}
if {[llength $summaries] == 0} {
switched::configure $($this,tip) -text {}
} else {
set text {}
set number 0
foreach summary $summaries {
if {$number < 3} { ;# display a maximum of 3 messages
if {$number > 0} {append text \n}
append text $summary
}
incr number
}
if {$number > 3} {append text \n...} ;# give a visual clue that there are more messages
switched::configure $($this,tip) -text $text
}
}
proc manageable {this} {return 0} ;# displayed by itself
proc monitored {this cell} {
variable ${this}monitored
return [info exists ${this}monitored($cell)]
}
proc monitorActiveCells {} {
variable singleton
forgetAllMonitoredCells $singleton ;# refresh completely
viewer::view $singleton [thresholds::activeCells]
}
proc reset {this} {
forgetAllMonitoredCells $this
}
}
|
