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 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358
|
# 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: valuetab.tcl,v 1.40 2005/01/02 00:45:07 jfontain Exp $
class currentValueTable {
if {$global::withGUI} {
proc currentValueTable {this parentPath realTime args} composite {[new frame $parentPath] $args} viewTable {} viewer {} {
composite::complete $this
constructor $this $realTime
}
} else { ;# remove Tk dependant code since this class can be used by monitoring daemon in a Tcl environment
proc currentValueTable {this args} switched {$args} viewTable {} viewer {} {
switched::complete $this
constructor $this
}
}
proc constructor {this {realTime {}}} {
set dataName ::currentValueTable::$(nextDataIndex)data ;# generate unique name based on index (available after completion)
incr (nextDataIndex)
catch {unset $dataName}
array set $dataName [list\
updates 0\
0,label [mc data] 0,type ascii 0,message [mc {data cell description}]\
1,label [mc current] 1,type real 1,message [mc {current value}]\
indexColumns 0\
sort {0 increasing}\
]
if {$global::withGUI} {
if {!$realTime} { ;# database mode
array set $dataName [list\
0,label [mc instant] 0,type clock 0,message [mc {record date and time (empty to show start of truncation)}]\
]
resetValueColumn $this $dataName
set ($this,archived) {} ;# database mode flag
composite::configure $this -draggable 0 ;# disallow dragging cells since that is pointless in history mode
}
viewTable::createTable $this $dataName "currentValueTable::dragData $this"
updateMessage $this
} else {
viewTable::setDataName $this $dataName
}
}
proc ~currentValueTable {this} {
if {$global::withGUI} {
variable ${this}cellRange ;# for history mode
foreach {name wish} [array get {} $this,rowLastWish,*] { ;# delete remaining last wishes, one for each row
delete $wish ;# which in turn deletes row
}
catch {unset ${this}cellRange}
if {[info exists ($this,cell)]} { ;# in history mode, trace was registered just once for instance module
viewer::parse $($this,cell) array ignore ignore ignore
viewer::unregisterTrace $this $array
}
if {[string length $composite::($this,-deletecommand)] > 0} {
uplevel #0 $composite::($this,-deletecommand) ;# always invoke command at global level
}
} else {
if {[string length $switched::($this,-deletecommand)] > 0} {
uplevel #0 $switched::($this,-deletecommand)
}
}
}
if {$global::withGUI} {
proc iconData {} {
return {
R0lGODdhJAAkAOMAAPj8+Hh4eHh8eAAAANjc2ICEgIiQiJCYkKCkoKisqLi8uMDEwMjQyNDY0ODk4Ojs6CwAAAAAJAAkAAAE/hDIKQO99s5cNeUaiH3eVgIi
aaJB675wLLtCnXblje+ejp6g22BILBIFxuQA16ohCdBoVAAgVK/WbHXoFA2kYIF2jAUMqEKwlEpun3+as3NOr9PfmWbtq4ayy25yAl59fm2AZmgefH1/h1l4
i3aTlJEsToxqjoiQglQUmWGPZZYXoWucgKWghQRiqVqWekiUtXeepq2bj6sTp1OjsYpxurBYlkm2ykhGd8XBW3QF09O/hsZWZ9QFBt3d1q7Y0d4GB+bm4K/Q
Z+cHCO/vSvLzXPAICfj4B8vL+QkKAAMKHEiwoMEFCBMqXMiwoUMGECNKnEixosUGGDNq3Mixo0cHEiBDihxJsqTJByhTqlzJsqXLCAA7
}
}
}
proc options {this} {
# data index must be forced so that initialization always occur
if {$global::withGUI} {
set font $font::(mediumBold)
} else {
set font {}
}
return [list\
[list -cellrows {} {}]\
[list -dataindex {}]\
[list -deletecommand {} {}]\
[list -draggable 0 0]\
[list -interval 0 0]\
]
}
proc set-cellrows {this value} { ;# restore cell to row mapping from a save file
if {$global::withGUI} {
set complete $composite::($this,complete)
} else {
set complete $switched::($this,complete)
}
if {$complete} {
error {option -cellrows cannot be set dynamically}
}
viewTable::setCellRows $this $value
}
set (nextDataIndex) 0 ;# used when data array index is not specified as an option when creating table
proc reset {} { ;# reset generated counter (invoker must insure that there are no viewers left)
set (nextDataIndex) 0
}
# data array name index must be specifiable so that data viewers depending on values table data array name (through their
# monitored cells) do not fail accessing that data (required when generating viewers from save file)
proc set-dataindex {this value} { ;# always invoked at construction time
if {$global::withGUI} {
set complete $composite::($this,complete)
} else {
set complete $switched::($this,complete)
}
if {$complete} {
error {option -dataindex cannot be set dynamically}
}
if {[string length $value] > 0} { ;# specified, else use internally generated next available index
if {$value < $(nextDataIndex)} {
error "specified data index ($value) is lower than internal values table index"
}
set (nextDataIndex) $value
}
}
proc set-deletecommand {this value} {}
proc set-draggable {this value} {
if {$global::withGUI} {
set noChange [expr {$composite::($this,complete) && ![info exists ($this,archived)]}] ;# allow changes in history mode
} else {
set noChange $switched::($this,complete)
}
if {$noChange} {
error {option -draggable cannot be set dynamically}
}
}
proc set-interval {this value} {} ;# only so that history mode can be detected
proc supportedTypes {this} {
return $global::dataTypes
}
proc monitorCell {this array row column} {
if {$global::withGUI} {
variable ${this}cellRange
}
set cell ${array}($row,$column)
if {[string length [viewTable::row $this $cell]] > 0} return ;# already displayed, abort
if {$global::withGUI} {
if {[info exists ($this,archived)] && ![string equal [lindex [modules::decoded $array] 0] instance]} {
lifoLabel::flash $global::messenger $viewTable::(monitorInstanceCellsMessage)
return ;# in history mode, ignore any cell not from an instance module
}
}
foreach {label incomplete} [viewer::label $array $row $column] {}
set dataName $viewTable::($this,dataName)
if {[info exists ($this,archived)]} {
resetValueColumn $this $dataName
set ${dataName}(1,label) $label ;# use data cell name as column header
foreach {ignore type message ignore} [databaseInstances::entryData $cell] {}
catch { ;# handle database errors
set ${dataName}(1,type) $type
set ${dataName}(1,message) $message
}
clearData $this
viewTable::createTable $this $dataName "currentValueTable::dragData $this" ;# refresh display by recreating table
updateMessage $this 1
set ${this}cellRange($cell,start) 0
set ${this}cellRange($cell,end) 0
if {![info exists ($this,cell)]} { ;# register trace just once for instance module
viewer::registerTrace $this $array
}
set ($this,cell) $cell
return
}
set row [viewTable::register $this $cell $array]
set ${dataName}($row,0) $label
set current ?
catch {set current [set $cell]} ;# cell may not exist
set ${dataName}($row,1) $current
if {$global::withGUI} {
# setup action when a row is deleted through a cell drop in eraser site
set ($this,rowLastWish,$row) [new lastWish "currentValueTable::deleteRow $this $cell"]
}
if {$incomplete} { ;# label cannot be determined yet
set ($this,relabel,$row) {}
}
incr ${dataName}(updates) ;# let data table update itself (so colors can be set on cells, for example)
if {$global::withGUI} {
updateMessage $this
}
}
proc update {this array} {
if {[info exists ($this,archived)]} {
if {[info exists ($this,cell)]} { ;# note: cell may have come from a summary or formula table (see monitorCell{})
processHistory $this $($this,cell)
}
} else {
set dataName $viewTable::($this,dataName)
set updated 0
foreach {cell row} [viewTable::cellsAndRows $this] {
if {[string first $array $cell] != 0} continue ;# no need to update if cell does not belong to updated array
if {[catch {set current [set $cell]}] || [string equal $current ?]} { ;# cell does not exist or is void
set ${dataName}($row,1) ? ;# do not touch other columns as their content remains valid
} else { ;# data is valid
set ${dataName}($row,1) $current
}
if {[info exists ($this,relabel,$row)] && [info exists $cell]} { ;# if label is not yet defined, update it
viewer::parse $cell ignore cellRow cellColumn type
foreach [list ${dataName}($row,0) incomplete] [viewer::label $array $cellRow $cellColumn] {}
if {!$incomplete} {
unset ($this,relabel,$row) ;# label now completely defined
}
}
set updated 1
}
if {$updated} {incr ${dataName}(updates)} ;# let data table update itself
}
}
proc cells {this} {
set list {}
if {[info exists ($this,archived)]} { ;# just one cell
catch {set list $($this,cell)}
} else { ;# cells in creation order (increasing row) so that restoring from save file works properly
set list [viewTable::cells $this]
}
return $list
}
if {$global::withGUI} {
proc clearData {this} {
array unset $viewTable::($this,dataName) {[0-9]*,[0-9]*}
}
proc processHistory {this cell} {
variable ${this}cellRange
set dataName $viewTable::($this,dataName)
foreach {start end} [databaseInstances::range $cell] {} ;# database cell range in seconds (limited by cursors)
if {[string length $start] == 0} { ;# no history data
clearData $this
set ${this}cellRange($cell,start) 0
set ${this}cellRange($cell,end) 0
incr ${dataName}(updates) ;# let data table update itself
return
}
if {([set ${this}cellRange($cell,start)] == $start) && ([set ${this}cellRange($cell,end)] == $end)} {
return ;# no range change: avoid potentially lengthy database query
}
if {[viewer::numericType [set ${dataName}(1,type)]]} {set void ?} else {set void {}}
clearData $this
set row 0
set list [databaseInstances::history $cell]
if {[llength $list] > (2 * $global::currentValueTableRows)} { ;# too many rows to display
array set $dataName [list $row,0 {} $row,1 $void] ;# prepend an empty row as an indication that data is truncated
incr row
}
set start 0
# limit number of rows while keeping most recent data, empty if database error
foreach {stamp value} [lrange $list end-[expr {2 * $global::currentValueTableRows} - 1] end] {
if {$start == 0} {set start $stamp}
if {[string length $value] == 0} { ;# void value (instead of ? since data comes from a database)
set value $void
}
array set $dataName [list $row,0 $stamp $row,1 $value]
incr row
}
if {[info exists stamp]} { ;# remember whole data (even including voids) time limits
set ${this}cellRange($cell,start) $start
set ${this}cellRange($cell,end) $stamp
} ;# else a database error occured
incr ${dataName}(updates) ;# let data table update itself
}
proc dragData {this format} {
switch $format {
OBJECTS {
set lastWishes {}
foreach row [viewTable::selectedRows $this OBJECTS] {
lappend lastWishes $($this,rowLastWish,$row)
}
if {[llength $lastWishes] == 0} {
return $this ;# self destruct if no rows remain
} else {
return $lastWishes
}
}
DATACELLS {
return [viewTable::dragCells $this]
}
}
}
proc deleteRow {this cell} { ;# last wish object is deleted after completion of this procedure
set dataName $viewTable::($this,dataName)
set row [viewTable::deleteRow $this $cell]
unset ${dataName}($row,0) ${dataName}($row,1) ($this,rowLastWish,$row)
viewTable::update $this
updateMessage $this
}
proc initializationConfiguration {this} {
return [viewTable::initializationConfiguration $this]
}
proc monitored {this cell} {
return [viewTable::monitored $this $cell]
}
proc setCellColor {this source color} {
viewTable::setCellColor $this $source $color
}
proc updateMessage {this {forceEmpty 0}} {
if {[viewTable::numberOfRows $this] || $forceEmpty} {
centerMessage $widget::($this,path) {}
} else {
centerMessage $widget::($this,path)\
[mc "values table:\ndrop data cell(s)"] $viewer::(background) $global::viewerMessageColor
}
}
proc resetValueColumn {this dataName} {
array set $dataName [list 1,label ? 1,type dictionary 1,message [mc {archived data name}]]
}
proc updateLabels {this} {
if {[info exists ($this,archived)]} { ;# database history mode
viewer::parse $($this,cell) array row column ignore
set dataName $viewTable::($this,dataName)
set ${dataName}(1,label) [lindex [viewer::label $array $row $column] 0]
viewTable::updateTitleLabels $this
} else {
viewTable::updateLabels $this
}
}
}
}
|