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
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
|
# 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: record.tcl,v 2.68 2005/01/02 00:45:07 jfontain Exp $
class record {
proc record {this args} switched {$args} {
switched::complete $this
}
proc ~record {this} {
if {[info exists ($this,root)]} {
dom::destroy $($this,root) ;# cleanup XML data
}
}
proc options {this} {
return [list\
[list -file {} {}]\
]
}
proc set-file {this value} {}
if {$global::withGUI} { ;# used only for saving
# flag viewers requiring initialization configuration special treatment for options that actually are lists:
array set series {
::store,comments {} ::thresholds,addresses {} ::dataTable,columnwidths {} ::freeText,cellindices {}
::summaryTable,cellrows {} ::summaryTable,columns {} ::summaryTable,columnwidths {} ::data2DPieChart,cellcolors {}
::data3DPieChart,cellcolors {} ::dataGraph,cellcolors {} ::dataStackedGraph,cellcolors {} ::dataBarChart,cellcolors {}
::dataSideBarChart,cellcolors {} ::dataStackedBarChart,cellcolors {} ::dataOverlapBarChart,cellcolors {}
::formulas::table,cellindexes {} ::formulas::table,cells {} ::formulas::table,rows {}
}
# Note: this method is more appropriate than using special names or characters in configuration switches, since that would imply
# that the object would have to know that its configuration is to be saved in a special way. It is better to assume that the
# code responsible for saving data knows about the nature of the data to be saved.
# Note: all viewers options with switches ending with "text" are stored in text form so that embedded new lines are preserved
# Warning: options with name ending with "text" or "data" have a special treatment
proc write {this} { ;# save current configuration in XML form (synchronize code with currentConfiguration{})
variable series
if {[string length $switched::($this,-file)] == 0} {
error {-file option undefined}
}
set document [dom::create]
set root [dom::document createElement $document moodssConfiguration]
dom::document createTextNode [dom::document createElement $root version] $global::applicationVersion
set seconds [clock seconds]
dom::document createTextNode [dom::document createElement $root date] [clock format $seconds -format %D]
dom::document createTextNode [dom::document createElement $root time] [clock format $seconds -format %T]
set node [dom::document createElement $root configuration]
foreach name [configuration::variables 0] {
if {[string equal $name viewerColors]} continue ;# skip lists
dom::element setAttribute $node $name [set ::global::$name]
}
nodeFromList $node viewerColors $::global::viewerColors ;# list of colors
# main window coordinates are not saved as it would be bad manners to force initial window placement
# use main window size to ignore tool bar presence interference:
dom::document createTextNode [dom::document createElement $root width] [winfo width $widget::($global::scroll,path)]
dom::document createTextNode [dom::document createElement $root height] [winfo height $widget::($global::scroll,path)]
dom::document createTextNode [dom::document createElement $root pollTime] $global::pollTime
if {[info exists databaseInstances::singleton]} { ;# database history mode
set node [dom::document createElement $root databaseRange]
foreach {from to} [databaseInstances::cursorsRange] {}
dom::element setAttribute $node from $from
dom::element setAttribute $node to $to
set node [dom::document createElement $root databaseViewer]
set path $widget::($databaseInstances::singleton,path)
foreach {x y width height} [canvasWindowManager::getGeometry $global::windowManager $path] {}
foreach {xIcon yIcon} [canvasWindowManager::iconCoordinates $global::windowManager $path] {}
dom::element setAttribute $node x $x; dom::element setAttribute $node y $y
dom::element setAttribute $node width $width; dom::element setAttribute $node height $height
dom::element setAttribute $node xIcon $xIcon; dom::element setAttribute $node yIcon $yIcon
}
set modules [dom::document createElement $root modules]
foreach instance $modules::(instances) { ;# note: in modules list, modules are in creation order
if {[string equal $modules::instance::($instance,module) formulas]} {
continue ;# formulas modules are created by formulas tables viewers
}
set namespace $modules::instance::($instance,namespace)
set module [dom::document createElement $modules module]
dom::element setAttribute $module namespace $namespace
dom::document createTextNode [dom::document createElement $module arguments] $modules::instance::($instance,arguments)
set tables [dom::document createElement $module tables]
foreach table $dataTable::(list) { ;# note: in tables list, tables are in creation order
# filter other module tables
if {![string equal $namespace [namespace qualifiers [composite::cget $table -data]]]} continue
foreach {x y width height} [canvasWindowManager::getGeometry $global::windowManager $widget::($table,path)] {}
set level [canvasWindowManager::getStackLevel $global::windowManager $widget::($table,path)]
foreach {xIcon yIcon} [canvasWindowManager::iconCoordinates $global::windowManager $widget::($table,path)] {}
# note: icon coordinates are empty if table is not minimized
set node [dom::document createElement $tables table]
dom::element setAttribute $node x $x; dom::element setAttribute $node y $y
dom::element setAttribute $node width $width; dom::element setAttribute $node height $height
dom::element setAttribute $node level $level
dom::element setAttribute $node xIcon $xIcon; dom::element setAttribute $node yIcon $yIcon
set list [dataTable::initializationConfiguration $table]
if {[llength $list] > 0} {
set options [dom::document createElement $node configuration]
foreach {switch value} $list {
set switch [string trimleft $switch -] ;# remove heading dash (invalid name start) and restore it later
if {[info exists series(::dataTable,$switch)]} { ;# it is actually a list
nodeFromList $options $switch $value ;# so store as an encoded list
} else {
dom::element setAttribute $options $switch $value
}
}
}
}
}
set viewers [dom::document createElement $root viewers]
foreach viewer $viewer::(list) { ;# note: in viewers list, viewers are in creation order
if {![viewer::saved $viewer]} continue ;# viewer does not want to be saved
set node [dom::document createElement $viewers viewer]
set class [classof $viewer]
dom::element setAttribute $node class $class
if {[viewer::manageable $viewer]} { ;# some viewers, such as the thresholds viewer, handle their display themselves
foreach {x y width height} [canvasWindowManager::getGeometry $global::windowManager $widget::($viewer,path)] {}
set level [canvasWindowManager::getStackLevel $global::windowManager $widget::($viewer,path)]
dom::element setAttribute $node x $x; dom::element setAttribute $node y $y
dom::element setAttribute $node width $width; dom::element setAttribute $node height $height
dom::element setAttribute $node level $level
foreach {xIcon yIcon} [canvasWindowManager::iconCoordinates $global::windowManager $widget::($viewer,path)] {}
if {[string length $xIcon] > 0} { ;# iconfied viewer (such as formulas table)
dom::element setAttribute $node xIcon $xIcon; dom::element setAttribute $node yIcon $yIcon
}
}
nodeFromList $node cells [viewer::cells $viewer] ;# list of cells
set list [viewer::initializationConfiguration $viewer]
if {[llength $list] > 0} {
catch {unset configurationNode}
foreach {switch value} $list {
set switch [string trimleft $switch -] ;# remove heading dash (invalid name start) and restore it later
if {[string equal $switch configurations]} {
# some viewers, such as thresholds, need to save several arguments lists instead of just one, so they pass
# them as a list of lists under the -configurations switch, which is reserved for that particular usage
foreach sublist $value { ;# use one entry per list otherwise it looks ugly in a XML sense
# use configurations reserved word as a flag so the list of lists can be regenerated at read time:
set options [dom::document createElement $node configurations]
foreach {switch value} $sublist {
set switch [string trimleft $switch -] ;# remove heading dash and restore it later
if {[info exists series($class,$switch)]} { ;# it is actually a list
nodeFromList $options $switch $value ;# so store as an encoded list
} else { ;# handle text with embedded new lines and base 64 data
switch -glob [string tolower $switch] {
*text {dom::document createTextNode [dom::document createElement $options $switch] $value}
*data\
{dom::document createCDATASection [dom::document createElement $options $switch] $value}
default {dom::element setAttribute $options $switch $value}
}
}
}
}
} else {
if {![info exists configurationNode]} {
set configurationNode [dom::document createElement $node configuration]
}
set options $configurationNode
if {[info exists series($class,$switch)]} { ;# it is actually a list
nodeFromList $options $switch $value ;# so store as an encoded list
} else { ;# handle text with embedded new lines and base 64 data
switch -glob [string tolower $switch] {
*text {dom::document createTextNode [dom::document createElement $options $switch] $value}
*data {dom::document createCDATASection [dom::document createElement $options $switch] $value}
default {dom::element setAttribute $options $switch $value}
}
}
}
}
}
}
set images [dom::document createElement $root images]
foreach {file format data} [images::values] {
set node [dom::document createElement $images image]
dom::element setAttribute $node file $file
dom::element setAttribute $node format $format
dom::document createCDATASection $node \n$data\n ;# save in a separate block
}
set file [open $switched::($this,-file) w+] ;# create or overwrite
dom::document configure $document -encoding [fconfigure $file -encoding] ;# use fine automatic Tcl encoding
set data [serialize $document]
dom::destroy $root ;# cleanup
puts $file $data
close $file
}
}
proc read {this} {
if {[string length $switched::($this,-file)] == 0} {
error {-file option undefined}
}
if {[catch {set file [open $switched::($this,-file)]} message]} {
puts stderr $message
exit 1
}
set line [gets $file] ;# retrieve first line
seek $file 0 ;# rewind
if {[catch {set ($this,root) [dom::parse [::read $file]]} message]} {
puts stderr "file $switched::($this,-file) is not a valid moodss configuration file:\n$message"
exit 1
}
close $file
# moodss before 19.0 saved namespace of the first instance of a module without its number suffix (<0>)
set ($this,convertNamespaces) [expr {[package vcompare [version $this] 19.0] < 0}]
}
proc modules {this} {
set list {}
foreach node [dom::selectNode $($this,root) /moodssConfiguration/modules/module] { ;# modules were saved in creation order
set namespace [dom::element getAttribute $node namespace]
if {$($this,convertNamespaces)} {
foreach {name index} [modules::decoded $namespace] {}
if {[string length $index] == 0} {append namespace <0>} ;# non indexed namespace
}
lappend list $namespace
}
return $list
}
proc modulesWithArguments {this {validateCommand {}}} { ;# validate command allows filtering out some modules, such as instance
set list {}
foreach node [dom::selectNode $($this,root) /moodssConfiguration/modules/module] {
# not evaluated because namespace may contain interpreted characters, such as ;, $, ...:
set namespace [dom::element getAttribute $node namespace]
if {([string length $validateCommand] > 0) && ![uplevel #0 $validateCommand $namespace]} continue
lappend list $namespace
eval lappend list [dom::node stringValue [dom::selectNode $node arguments]]
}
return $list ;# format: module [-option [value] -option ...] module [-option ...]
}
proc pollTime {this} {
return [dom::node stringValue [dom::selectNode $($this,root) /moodssConfiguration/pollTime]]
}
proc sizes {this} {
return [list\
[dom::node stringValue [dom::selectNode $($this,root) /moodssConfiguration/width]]\
[dom::node stringValue [dom::selectNode $($this,root) /moodssConfiguration/height]]\
]
}
# Note: all viewers options with switches ending with "text" were stored in text form so that embedded new lines are preserved,
# so apply corresponding special processing.
# Warning: options with name ending with "text" or "data" have a special treatment
proc viewersData {this} {
set list {}
foreach viewerNode [dom::selectNode $($this,root) /moodssConfiguration/viewers/viewer] {
set class [dom::element getAttribute $viewerNode class]
if {$($this,convertNamespaces)} {
set cells [convertedCells [listFromNode $viewerNode cells]]
} else {
set cells [listFromNode $viewerNode cells]
}
# note: coordinates, sizes and level may be empty (for thresholds viewer for example)
lappend list $class $cells [dom::element getAttribute $viewerNode x] [dom::element getAttribute $viewerNode y]\
[dom::element getAttribute $viewerNode width] [dom::element getAttribute $viewerNode height]\
[dom::element getAttribute $viewerNode level] [dom::element getAttribute $viewerNode xIcon]\
[dom::element getAttribute $viewerNode yIcon] ;# note: icon attributes values returned empty if they do not exist
set options {} ;# in case configuration(s) is(are) empty
set node [dom::selectNode $viewerNode configuration]
if {[string length $node] > 0} { ;# simple viewer configuration
foreach {name value} [array get [dom::node cget $node -attributes]] {
if {$($this,convertNamespaces)} { ;# single cell type option for data graphs, bars and pies
switch $name totalcell - ymaximumcell {set value [converted $value]}
}
lappend options -$name $value ;# heading dashes were stripped at save time
}
foreach node [dom::selectNode $node *] { ;# if there are children, they are list or text type options
set name [dom::node cget $node -nodeName] ;# handle text with embedded new lines or base 64 data
switch -glob [string tolower $name] {
*text - *data {lappend options -$name [dom::node stringValue $node]}
default {lappend options -$name [listFromNode $node]}
}
}
}
set nodes [dom::selectNode $viewerNode configurations]
if {[llength $nodes] > 0} { ;# viewer (such as thresholds) with multiple configuration lists
set lists {}
foreach node $nodes {
set append {}
foreach {name value} [array get [dom::node cget $node -attributes]] {
lappend append -$name $value ;# heading dashes were stripped at save time
}
foreach node [dom::selectNode $node *] { ;# if there are children, they are list options
set name [dom::node cget $node -nodeName] ;# text with embedded new lines or base 64 data
switch -glob [string tolower $name] {
*text - *data {lappend append -$name [dom::node stringValue $node]}
default {
if {\
$($this,convertNamespaces) &&\
[string equal $class ::formulas::table] && [string equal $name cells]\
} {
lappend append -$name [convertedCells [listFromNode $node]]
} else {
lappend append -$name [listFromNode $node]
}
}
}
}
lappend lists $append
}
lappend options -configurations $lists
} ;# else there may not be any switched configuration data
lappend list $options
}
return $list
}
proc tableNode {this namespace creationIndex} { ;# index is module data table creation index, from 0
if {$($this,convertNamespaces) && [string match *<0> $namespace]} {
# remove trailing namespace index for reading recorded data of the first instance of a module, saved without index
regsub {<0>$} $namespace {} namespace
}
set node [dom::selectNode $($this,root) /moodssConfiguration/modules/module\[@namespace=\"$namespace\"\]]
if {[string length $node] == 0} {error {internal error: please report to author}}
# note: table entry may not exist if new views were added to module after the file was saved
return [lindex [dom::selectNode $node tables/table] $creationIndex] ;# tables are saved in creation order
}
proc tableWindowManagerData {this namespace creationIndex} { ;# index is module data table creation index, starting with 0
if {[string length [set node [tableNode $this $namespace $creationIndex]]] == 0} {
return {}
}
array set data [array get [dom::node cget $node -attributes]]
return [list $data(x) $data(y) $data(width) $data(height) $data(level) $data(xIcon) $data(yIcon)]
}
proc tableOptions {this namespace creationIndex} { ;# index is module data table creation index, starting with 0
if {[string length [set node [tableNode $this $namespace $creationIndex]]] == 0} {
return {}
}
set options {}
set node [dom::selectNode $node configuration]
if {[string length $node] > 0} { ;# some switched configuration data was saved
foreach {name value} [array get [dom::node cget $node -attributes]] {
lappend options -$name $value ;# heading dashes were stripped at save time
}
foreach node [dom::selectNode $node *] { ;# if there are children, they are list options
lappend options -[dom::node cget $node -nodeName] [listFromNode $node]
}
}
return $options
}
proc configurationData {this} { ;# return a global name / value list
set node [dom::selectNode $($this,root) /moodssConfiguration/configuration]
set list [array get [dom::node cget $node -attributes]]
lappend list viewerColors [listFromNode $node viewerColors]
return $list
}
proc version {this} { ;# return the version of the application that generated the save file
return [dom::node stringValue [dom::selectNode $($this,root) /moodssConfiguration/version]]
}
proc databaseRange {this} { ;# return a list of 2 integers: from and to in seconds
set node [dom::selectNode $($this,root) /moodssConfiguration/databaseRange]
if {[string length $node] == 0} {return {}} ;# that must be a real-time type dashboard
array set data [array get [dom::node cget $node -attributes]]
return [list $data(from) $data(to)]
}
proc databaseViewerWindowManagerData {this} {
set node [dom::selectNode $($this,root) /moodssConfiguration/databaseViewer]
if {[string length $node] == 0} {return {}} ;# that must be a real-time type dashboard
array set data [array get [dom::node cget $node -attributes]]
return [list $data(x) $data(y) $data(width) $data(height) $data(xIcon) $data(yIcon)]
}
proc converted {cell} { ;# convert cell with non indexed namespace (moodss before 19.0) to cell with namespace indexed at 0
if {[string length $cell] == 0} {return {}}
viewer::parse $cell array row column ignore
set namespace [namespace qualifiers $array]
foreach {name index} [modules::decoded $namespace] {}
if {[string length $index] == 0} { ;# non indexed namespace
set cell $namespace<0>::[namespace tail $array]($row,$column)
}
return $cell
}
proc convertedCells {list} {
set cells {}
foreach cell $list {lappend cells [converted $cell]}
return $cells
}
if {$global::withGUI} { ;# used only for saving
proc imagesData {this} { ;# note: used from moodss 18.2 on
set list {}
foreach node [dom::selectNode $($this,root) /moodssConfiguration/images/image] {
lappend list [dom::element getAttribute $node file] [string trim [dom::node stringValue $node]] ;# remove formatting
dom::destroy $node ;# free potentially big memory
}
return $list
}
# Warning: options with name ending with "data" have a special treatment
proc currentConfiguration {} { ;# current configuration in a high performance data storage (synchronize code with write{})
set root [new container]
# ignore version, data and time which always change between snapshots
container::bind $root [set container [new container configuration]]
foreach name [configuration::variables 0] {
container::set $container $name [set ::global::$name]
}
container::set $root width [winfo width $widget::($global::scroll,path)]
container::set $root height [winfo height $widget::($global::scroll,path)]
container::set $root pollTime $global::pollTime
if {[info exists databaseInstances::singleton]} { ;# database history mode
container::bind $root [set container [new container databaseRange]]
foreach {from to} [databaseInstances::cursorsRange] {}
container::set $container from $from
container::set $container to $to
container::bind $root [set container [new container databaseViewer]]
set path $widget::($databaseInstances::singleton,path)
foreach {x y width height} [canvasWindowManager::getGeometry $global::windowManager $path] {}
foreach {xIcon yIcon} [canvasWindowManager::iconCoordinates $global::windowManager $path] {}
container::set $container x $x; container::set $container y $y
container::set $container width $width; container::set $container height $height
container::set $container xIcon $xIcon; container::set $container yIcon $yIcon
}
container::bind $root [set modules [new container modules]]
foreach instance $modules::(instances) { ;# note: in modules list, modules are in creation order
set namespace $modules::instance::($instance,namespace)
container::bind $modules [set module [new container module]]
container::set $module namespace $namespace
container::set $module arguments $modules::instance::($instance,arguments)
container::bind $module [set tables [new container tables]]
foreach table $dataTable::(list) { ;# note: in tables list, tables are in creation order
# filter other module tables
if {![string equal $namespace [namespace qualifiers [composite::cget $table -data]]]} continue
foreach {x y width height} [canvasWindowManager::getGeometry $global::windowManager $widget::($table,path)] {}
set level [canvasWindowManager::getStackLevel $global::windowManager $widget::($table,path)]
foreach {xIcon yIcon} [canvasWindowManager::iconCoordinates $global::windowManager $widget::($table,path)] {}
# note: icon coordinates are empty if table is not minimized
container::bind $tables [set container [new container table]]
container::set $container x $x; container::set $container y $y
container::set $container width $width; container::set $container height $height
container::set $container level $level
container::set $container xIcon $xIcon; container::set $container yIcon $yIcon
set list [dataTable::initializationConfiguration $table]
if {[llength $list] > 0} {
container::bind $container [set options [new container configuration]]
foreach {switch value} $list {
container::set $options $switch $value
}
}
}
}
container::bind $root [set viewers [new container viewers]]
foreach viewer $viewer::(list) { ;# note: in viewers list, viewers are in creation order
if {![viewer::saved $viewer]} continue ;# viewer does not want to be saved
container::bind $viewers [set container [new container viewer]]
container::set $container class [classof $viewer]
if {[viewer::manageable $viewer]} { ;# some viewers, such as the thresholds viewer, handle their display themselves
foreach {x y width height} [canvasWindowManager::getGeometry $global::windowManager $widget::($viewer,path)] {}
set level [canvasWindowManager::getStackLevel $global::windowManager $widget::($viewer,path)]
container::set $container x $x; container::set $container y $y
container::set $container width $width; container::set $container height $height
container::set $container level $level
foreach {xIcon yIcon} [canvasWindowManager::iconCoordinates $global::windowManager $widget::($viewer,path)] {}
if {[string length $xIcon] > 0} { ;# iconfied viewer (such as formulas table)
container::set $container xIcon $xIcon; container::set $container yIcon $yIcon
}
}
container::set $container cells [viewer::cells $viewer]
set list [viewer::initializationConfiguration $viewer]
if {[llength $list] > 0} {
container::bind $container [set options [new container configuration]]
foreach {switch value} $list {
if {[string match -nocase *data $switch]} continue ;# skip base 64 data
if {[string equal $switch -configurations]} {
foreach list $value {
container::bind $options [set configurations [new container configurations]]
foreach {switch value} $list {
container::set $configurations $switch $value
}
}
} else {
container::set $options $switch $value
}
}
}
}
container::bind $root [set images [new container images]]
foreach file [images::names] { ;# ignore image data
container::bind $images [set container [new container image]]
container::set $container file $file
}
return $root
}
proc snapshot {} { ;# remember current configuration
if {[info exists (data)]} {delete $(data)}
set (data) [currentConfiguration]
}
proc changed {} { ;# see if configuration has changed since last snapshot
if {[info exists (data)]} {
set container [currentConfiguration]
set equal [container::equal $(data) [currentConfiguration]]
delete $container
return [expr {!$equal}]
} else { ;# snapshot was not yet taken, assume there was no change (can happen when user closes window right after start)
return 0
}
}
}
}
|
