File: valuetab.tcl

package info (click to toggle)
moomps 4.6-2
  • links: PTS
  • area: main
  • in suites: sarge
  • size: 2,444 kB
  • ctags: 2,307
  • sloc: tcl: 34,882; sh: 167; makefile: 91
file content (358 lines) | stat: -rw-r--r-- 16,442 bytes parent folder | download | duplicates (2)
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
        }
    }

}

}