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
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
|
# 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
# various procedures mostly used in moodss.tcl
# $Id: procs.tcl,v 1.95 2005/02/19 21:10:34 jfontain Exp $
set dialogBoxErrorIcon [image create photo -data {
R0lGODlhIAAgAOfJAIkAAIoAAIsAAIwAAI4AAI8AAJAAAJEAAJIAAJQAAJUAAJYAAJcAAJMCApgAAJkAAJoAAJsAAJwAAJMEBJ0AAJ4AAJ8AAKAAAKEAAKMA
AJcGBqUAAKYAAKcAAKgAAKkAAKoAAKsAAKwAAJ8GBq0AAK4AAK8AALEAAKEHB7IAAKkEBLMAAJwKCrQAALUAALYAALcAALgAALkAALUCAroAAKELC7sAALwA
AL0AAL4AAL8AAMAAAMEAAKoKCsIAAMMAAMQAAMUAAMYAAMgAAMkAAMoAAMsAAMwAALwHB80AAM4AANAAALcLC9UAANgAANoAANwAAN4AAN8AALcSEs0JCeIA
AK0XF64XF68XF9AJCeYAALEXF+4AAN0JCfIAAMoSEvQAAPcAANcODuoGBvoAAPkBAf4AAP0BAf8CAvkICP8HB+4VFfkREf8QEMcpKfUWFv8SEvEZGfQYGM0p
Kc4pKfUZGesfH9YpKfkaGv8dHfUiIvkiIu8oKP8iIvgmJvomJuouLvcpKf8oKPcvL/gwMPowMPE2NvQ2Nv8zM/80NPM6Ov81Ne0/P/M+Pu5DQ+pFRexFRf8/
P/9FRf9KSv9RUftTU/dWVvpVVftVVf9WVvdcXP9nZ/hra/9sbPVxcfZ0dPl0dP5ycvxzc/9ycvl7e/95ef+Kiv6QkP+amvqfn/yfn/2fn/6fn/+fn/6goP+g
oPykpP+jo/+np/ysrP+rq/+trfyvr/+xsf+4uP+8vP++vv6/v//Bwf/Fxf/Hx//Kyv/MzP3Nzf7Nzf/Ozv/U1P/b2//c3P/h4f/r6///////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////yH5BAEKAP8ALAAAAAAgACAAAAj+AP8JHEiwoMGD
CBEKCfLDxw4dOGwknCiQyJCFQpQkOWJEB40YMFxQNFhkyBEodjSRWkmKE6AmOFqkGCnQSBEjUizZQsazJ89goMS4MEGCos0lfGAZW8q06VJhjmiIAJGwSBEn
jXYB28q1q1dPQT50QFhkiaJcaH+hXcs2l1q0n1xwOEjEyBpXtGgBS3Ysr1+/x5IB88voQ4aCFqWIQoWKV7LHxRhLRlXscTJejE9lwXCBoEk9pky9svyYWOjQ
xEgnexX6EogKBIVEqVSq9l7Sw2oPUw0sFKZBcoZIGLhwzKbjx3up9uVL9axAXqJ7qRLhgUAgQt5k2s5dl2rVqaT+i7fgQOAPJXskqV8vCdf3x+HFSy+xQCCP
I3gQ6d+v/9b3+PJFR0ICAu1gBBt9JKhggrX8F6B0IiAgUA5FpNHGhRi2Ict7yaQCxocgfhjCAQLdoEMZaKSo4mgcJqNKGDDGGAYDBghkgwxcnKGjjq6otsoq
PpIhpJBaFEDAQDE8YcaSZrCiWitLtqIaK0yaIcSRA72QgxpcLqJaLFxyGYtqi4QpwQAEtbBCF3C02YllsrQpJxwbPtaJnFQMIEBBJ8xQRx6AjpIMLYAWWigt
yYxSaBwNBHBQCUj8IciklExq6aWCVDqpHyg4epAIIXxRSCKklmrqqYkQMkUAACT0gQdOTBwSyay01lqrITWwShEHG6hwxyTABisssHNMoCtNnPVAByTccfeI
GywM4ClNAllAQQQQjLAFFldYoYGR0lJ70AMMKJAAAgcYKe66NAUEADs=
}]
proc printUsage {exitCode} {
puts stderr [format [mc {Usage: %s [OPTION]... [MODULE] [OPTION]... [MODULE]...}] $::argv0]
puts stderr [mc { --debug module errors verbose reporting}]
puts stderr [mc { -f, --file dashboard file name}]
puts stderr [mc { -h, --help display this help and exit}]
puts stderr [mc { -p, --poll-time poll time in seconds}]
puts stderr [mc { -r, --read-only disable viewer creation, editing, ...}]
puts stderr [mc { -S, --static disable internal window manager sizing and moving}]
puts stderr [mc { --show-modules try to find available moodss modules}]
puts stderr [mc { --version output version information and exit}]
exit $exitCode
}
proc printVersion {} {
puts [format [mc {moodss (Modular Object Oriented Dynamic SpreadSheet) version %s}] $global::applicationVersion]
}
proc loadFromFile {name} { ;# eventually unload all existing modules and load from a save file
clearModulesAndViewers
set global::saveFile $name
set global::fileDirectory [file dirname $name]
set initializer [new record -file $name]
record::read $initializer
configuration::load [record::configurationData $initializer] ;# set global values from save file
modules::parse [record::modulesWithArguments $initializer] ;# recursive
set modules::(initialized) [record::modules $initializer]
return $initializer
}
proc clearModulesAndViewers {} {
foreach viewer $viewer::(list) { ;# delete all existing viewers except thresholds viewer
set class [classof $viewer]
switch $class {
::store - ::store::dialog - ::thresholdLabel - ::thresholds {
${class}::reset $viewer ;# make sure to remove now obsolete existing entries
}
default {
delete $viewer ;# note: in formulas table case, that also unloads the corresponding formulas module
}
}
}
if {[info exists databaseInstances::singleton]} {
delete $databaseInstances::singleton
}
foreach instance [modules::instancesWithout formulas] {
dynamicallyUnloadModule $modules::instance::($instance,namespace)
}
if {[llength [modules::instancesWithout]] > 0} {
error {internal moodss error: please report to author with error trace}
}
}
proc clear {} { ;# return true if user went ahead and cleared main window or return false in case of change in mind
static busy 0
if {$busy} return ;# protection against overlapping invocations from fast clicking, as a lot of updates occur within
if {[needsSaving]} { ;# see if there are changes that the user may want to be saved before reloading
switch [inquireSaving] {
yes {
save
if {[needsSaving]} {return 0} ;# data was not saved: assume the user wants to abort reloading
}
cancel {return 0}
}
}
set busy 1
if {[info exists ::initializer]} {
delete $::initializer
unset ::initializer
}
clearModulesAndViewers
databaseConnection 0 ;# disconnect from database
set global::saveFile {}
updateFileSaveHelp {} ;# to reflect save file disappearance
updateTitle
updateMenuWidget
updateToolBar
updateDragAndDropZone
configuration::load [preferences::read] ;# reinitialize from rc file
record::snapshot ;# take a snapshot of new configuration os that user is not asked to save wnen trying to open a new file next
set busy 0
return 1
}
proc reload {} { ;# restart by loading modules from a save file
if {[needsSaving]} { ;# there are changes that the user may want to be saved before reloading
switch [inquireSaving] {
yes {
save
if {[needsSaving]} return ;# data was not saved: assume the user wants to abort reloading
}
cancel return
}
}
set file [tk_getOpenFile\
-title [mc {moodss: Open}] -initialdir $global::fileDirectory -defaultextension .moo\
-filetypes [list [list [mc {moodss dashboard}] .moo]]\
]
if {[string length $file] == 0} return ;# user canceled loading
databaseConnection 0 ;# disconnect from database
set global::fileDirectory [file dirname $file]
if {[info exists ::initializer]} {
delete $::initializer
unset ::initializer
}
updateCanvasImage {}; set global::canvasImageFile {} ;# possibly clear existing background
set ::initializer [loadFromFile $file]
$global::canvas configure -background $global::canvasBackground
wm geometry . {}
foreach {width height} [record::sizes $::initializer] {} ;# used stored geometry
composite::configure $global::scroll -width $width -height $height
updateCanvasImage $global::canvasImageFile 1
modules::initialize 0 initializationErrorMessageBox
modules::setPollTimes [record::pollTime $::initializer]
foreach instance [modules::instancesWithout formulas] {
displayModule $instance $::draggable
}
summaryTable::reset; currentValueTable::reset; formulas::table::reset ;# so that data names are generated as when first started
createSavedImages $::initializer ;# note: existing images, if any, were deleted at the same time as their associated viewers
createSavedViewers $::initializer
if {[pages::current] == 0} { ;# no pages
manageScrolledCanvas 1
} else {
pages::manageScrolledCanvas 1
}
updateTitle
updateMenuWidget
updateToolBar
updateDragAndDropZone
updateFileSaveHelp $file ;# since current save file has changed
updateCanvasImagesPosition
refresh ;# make sure data is immediately displayed
update ;# required so that table and viewer windows sizes are correct for snapshot
record::snapshot ;# take a snap shot of new configuration so any future changes are detected as meaningful
}
proc createNewCellsViewer {class cells draggable static {pollTime {}}} {
switch $class {
::canvas::iconic {
if {[string length [set name [canvas::iconic::chooseFile]]] == 0} return ;# canceled
foreach {left top right bottom} [$global::canvas cget -scrollregion] {}
# place new icon at the top left corner of the current page
set viewer [new $class $global::canvas -draggable $draggable -static $static -file $name -x $left -y $top]
canvas::viewer::flash $viewer ;# in case it is hidden by other graphical objects
}
::currentValueTable { ;# needs to know mode (real time or database) at construction time
set viewer [new currentValueTable $global::canvas $global::pollTime -draggable $draggable -interval $pollTime]
}
::dataGraph - ::dataStackedGraph - ::dataSideBarChart - ::dataStackedBarChart - ::dataOverlapBarChart {
if {[string length $pollTime] == 0} {
set viewer [new $class $global::canvas -labelsposition $global::graphLabelsPosition -draggable $draggable]
} else {
set viewer [new $class $global::canvas\
-labelsposition $global::graphLabelsPosition -draggable $draggable -interval $pollTime\
]
}
}
default {
if {[string length $pollTime] == 0} {
set viewer [new $class $global::canvas -draggable $draggable]
} else {
set viewer [new $class $global::canvas -draggable $draggable -interval $pollTime]
}
}
}
if {[viewer::view $viewer $cells]} {
if {[viewer::manageable $viewer]} {
manageViewer $viewer 1 -static $static -dragobject $viewer
}
return $viewer
} else { ;# do not create new viewer if cells cannot be viewed
delete $viewer
return 0
}
}
proc createNewFormulasViewer {object category draggable static} {
set viewer [new formulas::table $global::canvas -draggable $draggable -object $object -category $category]
manageViewer $viewer 1 -static $static -dragobject $viewer -title [formulas::table::title $viewer]
return $viewer
}
proc manageViewer {viewer destroyable args} { ;# viewer or table, arguments are window manager configuration switched options
set path $widget::($viewer,path)
canvasWindowManager::manage $global::windowManager $path $viewer
eval canvasWindowManager::configure $global::windowManager $path $args
if {$destroyable} {
composite::configure $viewer -deletecommand "canvasWindowManager::unmanage $global::windowManager $path"
}
}
proc save {{ask 0}} { ;# save current configuration in user defined file or currently defined storage file
if {$ask || ([string length $global::saveFile] == 0)} {
set file [tk_getSaveFile\
-title [mc {moodss: Save}] -initialdir $global::fileDirectory -defaultextension .moo\
-filetypes [list [list [mc {moodss dashboard}] .moo]] -initialfile $global::saveFile\
]
if {[string length $file] == 0} return ;# user canceled saving
set global::saveFile $file
set global::fileDirectory [file dirname $file]
updateFileSaveHelp $file
}
lifoLabel::push $global::messenger [format [mc {saving in %s...}] $global::saveFile]
update idletasks ;# make sure message is visible
set record [new record -file $global::saveFile]
set error [catch {record::write $record} message]
lifoLabel::pop $global::messenger
if {$error} {
tk_messageBox -title [mc {moodss: Save}] -type ok -icon error -message $message
}
delete $record
if {!$error} record::snapshot ;# remember current configuration
}
proc refresh {} {
static updateEvent
catch {after cancel $updateEvent} ;# eventually cancel current event
if {[llength $modules::(synchronous)] == 0} return ;# nothing to do
foreach instance $modules::(synchronous) {
set namespace $modules::instance::($instance,namespace)
${namespace}::update ;# ask module to update its dynamic data
}
foreach viewer $viewer::(list) { ;# update formulas tables
if {[string equal [classof $viewer] ::formulas::table]} {
formulas::table::update $viewer ;# direct update bypassing viewer layer
}
}
if {$global::pollTime > 0} { ;# any synchronous modules loaded
set updateEvent [after [expr {1000 * $global::pollTime}] refresh] ;# convert to milliseconds
}
}
# invoked by thresholds code when a threshold condition occurs (color and level are empty for resetting)
proc cellThresholdCondition {array row column color level summary} { ;# summary is a short description of the threshold condition
dataTable::cellThresholdCondition $array $row $column
viewer::cellThresholdCondition $array $row $column $color $level $summary
}
proc inquireSaving {} {
if {[string length $::global::saveFile] > 0} { ;# there is a save file
set message [format [mc {There are unsaved configuration changes. Do you want them saved to file: %s?}] $::global::saveFile]
} else {
set message [mc {There are unsaved configuration changes. Do you want them saved to file?}]
}
array set answer {0 yes 1 no 2 cancel}
return $answer([tk_dialog .saveorexit [mc {moodss: Save}] $message question 0 [mc Yes] [mc No] [mc Cancel]])
}
proc needsSaving {} { ;# no need to save if there are no loaded modules
return [expr {[record::changed] && ([llength [modules::instancesWithout formulas]] > 0)}]
}
proc manageToolBar {{save 1}} { ;# whether to save state in preferences
set bar [updateToolBar]
if {$global::showToolBar} {
grid $bar -row 0 -column 0 -sticky we
} else {
grid forget $bar
}
if {$save} {
preferences::update
}
}
proc createSavedImages {record} {
foreach {file data} [record::imagesData $record] {
images::load $file {} $data
}
}
proc createSavedViewers {record} { ;# strictly viewers, not tables
if {[llength [set range [record::databaseRange $record]]] > 0} { ;# saved in database history mode
monitorDatabaseInstances $range ;# display loaded instance modules viewer
}
set data [record::viewersData $record]
foreach {class cells x y width height level xIcon yIcon switchedOptions} $data {
# process formulas table viewers first since they create namespaces and thus data that other viewers may display
if {![string equal $class ::formulas::table]} continue
set viewer [eval new ::formulas::table $global::canvas $switchedOptions -draggable $::draggable]
manageViewer $viewer 1 -static $global::static -setx $x -sety $y -setwidth $width -setheight $height -level $level\
-dragobject $viewer -iconx $xIcon -icony $yIcon -title [formulas::table::title $viewer] ;# always manageable
set viewerCells($viewer) $cells ;# gather cells
}
foreach {class cells x y width height level xIcon yIcon switchedOptions} $data { ;# process remaining viewers
switch $class {
::formulas::table continue
::store - ::thresholds {
set viewer [set ${class}::singleton] ;# store and thresholds viewers are special cases and are not displayed
eval switched::configure $viewer $switchedOptions
}
::thresholdLabel {
set viewer [set ${class}::singleton] ;# threshold label viewer is a special case and is not displayed
eval composite::configure $viewer $switchedOptions
}
::currentValueTable { ;# needs to know mode (real time or database) at construction time
set viewer [eval new currentValueTable\
$global::canvas $global::pollTime $switchedOptions -interval $global::pollTime -draggable $::draggable\
]
manageViewer $viewer 1 -static $global::static -setx $x -sety $y -setwidth $width -setheight $height\
-level $level -dragobject $viewer
}
::canvas::iconic {
set viewer [eval new $class $global::canvas $switchedOptions -draggable $::draggable -static $global::static]
}
::page {
set viewer [eval new $class $global::canvas $switchedOptions -draggable $::draggable]
set background {}
foreach {switch value} $switchedOptions {
if {[string equal $switch -background]} {
set background $value
break
}
}
if {[string length $background] == 0} { ;# pre-18.4 dashboard file
composite::configure $viewer -background $global::canvasBackground ;# use default background
}
}
default {
set viewer [eval new $class $global::canvas $switchedOptions -draggable $::draggable]
foreach list [composite::configure $viewer] {
if {[string equal [lindex $list 0] -interval]} { ;# viewer supports interval option
composite::configure $viewer -interval $global::pollTime ;# so use current interval
break ;# done
}
}
if {[viewer::manageable $viewer]} {
manageViewer $viewer 1 -static $global::static -setx $x -sety $y -setwidth $width -setheight $height\
-level $level -dragobject $viewer
}
}
}
set viewerCells($viewer) $cells ;# gather cells
}
# monitor cells now that all viewers exist (for example, summary tables have their own data and thus need be created before
# other viewers can reference them)
foreach {viewer cells} [array get viewerCells] {
viewer::view $viewer $cells
}
}
# must be invoked only when the application is running, that is after all the save file and command line modules have been loaded
proc dynamicallyLoadModules {arguments} { ;# arguments list format is: module [-option [value] -option ...] module [-option ...]
set instances [modules::instancesWithout formulas]
modules::parse $arguments
modules::initialize ;# initializes only modules that have not yet been initialized
modules::setPollTimes ;# recalculate valid poll times but do not change current value
set first 1
foreach instance [modules::instancesWithout formulas] {
if {[lsearch -exact $instances $instance] >= 0} continue
# new module or instance:
if {$first} { ;# reset next module table coordinates so that successively loaded modules do not go off screen
displayModule $instance $::draggable 1
set first 0
} else {
displayModule $instance $::draggable
}
}
updateTitle
updateMenuWidget
updateToolBar
refresh ;# make sure data is immediately displayed
}
proc dynamicallyUnloadModule {namespace} {
foreach instance [modules::instancesWithout formulas] {
if {[string equal $modules::instance::($instance,namespace) $namespace]} break ;# found
}
if {[lindex $modules::instance::($instance,times) 0] >= 0} { ;# then if module is synchronous
ldelete modules::(synchronous) $instance ;# remove it from list
}
foreach table $dataTable::(list) { ;# delete related tables
if {[string equal [modules::namespaceFromArray [composite::cget $table -data]] $namespace]} {
canvasWindowManager::unmanage $global::windowManager $widget::($table,path)
delete $table
}
}
modules::instance::empty $instance ;# empty module data so that related viewers can show empty cells
modules::unload $instance
modules::setPollTimes ;# recalculate valid poll times but do not change current value
updateTitle
updateMenuWidget
updateToolBar
}
proc residentTraceModule {display} { ;# initialize and eventually display resident trace module
if {![winfo exists .trace]} {
toplevel .trace
wm withdraw .trace
wm group .trace . ;# for proper window manager (windowmaker for example) behavior
wm title .trace [mc {moodss: Trace}]
set namespace $modules::instance::($modules::(trace),namespace)
set table [new dataTable .trace -data ${namespace}::data]
dataTable::update $table ;# force refreshing of the display so data appears immediately
# handle closing via window manager:
wm protocol .trace WM_DELETE_WINDOW "wm withdraw .trace; set global::showTrace 0"
pack $widget::($table,path) -fill both -expand 1
}
if {$display} {
wm deiconify .trace
} else {
wm withdraw .trace
}
after idle {focus .} ;# keep the focus on the main window
}
proc displayModule {instance draggable {resetOrigin 0}} {
static x
static y
if {![info exists x] || $resetOrigin} {
foreach {x y dummy dummy} [$global::canvas cget -scrollregion] {} ;# next module table coordinates
}
if {[lindex $modules::instance::($instance,times) 0] >= 0} { ;# if module is synchronous
### should be done in modules code ###
lappend modules::(synchronous) $instance
}
if {[info exists modules::instance::($instance,views)]} { ;# check whether several views are defined
set viewMembers $modules::instance::($instance,views) ;# create and manage a table for each view
} else {
set viewMembers {{}} ;# there is a single table (the default view)
}
set index 0
set namespace $modules::instance::($instance,namespace)
foreach members $viewMembers {
set initialize [expr {[info exists ::initializer] && ([lsearch -exact $modules::(initialized) $namespace] >= 0)}]
if {$initialize} {
set arguments [record::tableOptions $::initializer $namespace $index] ;# extra stored arguments for table
} else {
set arguments {}
}
if {![catch {set ${namespace}::data(resizableColumns)} resizable]} {
lappend arguments -resizablecolumns $resizable
}
if {[llength $members] > 0} { ;# it is a view
array set ::view$instance $members
set table\
[eval new dataTable $global::canvas -data ${namespace}::data -view ::view$instance -draggable $draggable $arguments]
unset ::view$instance
} else { ;# use single default data view
set table [eval new dataTable $global::canvas -data ${namespace}::data -draggable $draggable $arguments]
}
if {[info exists modules::instance::($instance,identifier)]} { ;# set a title for data table
set title $modules::instance::($instance,identifier) ;# favor identifier if it exists
} else { ;# simply use module name
set title $namespace
}
regsub {<0>$} $title {} title ;# remove trailing namespace index for first instance of a module
if {$initialize} { ;# setup initialized modules tables
# use stored window manager initialization data for table if it exists:
set list [record::tableWindowManagerData $::initializer $namespace $index]
if {[llength $list] > 0} {
foreach {x y width height level xIcon yIcon} $list {}
manageViewer $table 0 -static $global::static -setx $x -sety $y -setwidth $width -setheight $height\
-level $level -title $title -iconx $xIcon -icony $yIcon
} else {
manageViewer $table 0 -static $global::static -setx $x -sety $y -title $title
}
} else {
manageViewer $table 0 -static $global::static -setx $x -sety $y -title $title
}
set x [expr {$x + $global::xWindowManagerInitialOffset}] ;# offset tables to achieve a nicer layout
set y [expr {$y + $global::yWindowManagerInitialOffset}]
incr index ;# next view for initializer
}
}
proc initializationErrorMessageBox {namespace message} { ;# namespace of the module
set top [new toplevel .]
set path $widget::($top,path)
wm transient $path .
regsub {<0>$} $namespace {} namespace ;# remove trailing namespace index for first instance of a module
wm title $path [format [mc {moodss: Error initializing module "%s"}] $namespace]
wm group $path . ;# for proper window manager (windowmaker for example) behavior
wm protocol $path WM_DELETE_WINDOW "delete $top" ;# self cleanup
set text [message $path.message -text $message -font $font::(mediumNormal) -justify left -width 640]
grid rowconfigure $path 0 -weight 1
grid columnconfigure $path 1 -weight 1
grid [label $path.icon -image $::dialogBoxErrorIcon] -row 0 -column 0 -sticky nw -padx 2 -pady 2
grid $text -row 0 -column 1 -sticky nw
grid [frame $path.separator -relief sunken -borderwidth 1 -height 2] -row 1 -column 0 -columnspan 100 -stick we -pady 2
grid [button $path.close -text [mc Close] -command "destroy $path"] -row 2 -column 0 -columnspan 100 -padx 2 -pady 2
}
proc databaseConnection {connect} { ;# boolean: or disconnect, procedure is idempotent
if {$connect} {
if {$global::database != 0} return ;# already connected
lifoLabel::push $global::messenger [mc {connecting to database...}]
} else {
if {$global::database == 0} return ;# already disconnected
lifoLabel::push $global::messenger [mc {disconnecting from database...}]
}
busy 1 .
if {$connect} {
set database [eval new database $global::databaseOptions]
if {[string length $database::($database,error)] > 0} { ;# there was a problem probably due to misconfiguration
tk_messageBox -title [mc {moodss: Database error}] -type ok -icon error -message $database::($database,error)
delete $database
} else {
if {$database::($database,created)} {
modules::trace {} moodss(database) [mc {created tables in moodss database}]
}
set global::database $database
}
} else {
delete $global::database ;# disconnect
set global::database 0
}
busy 0 .
lifoLabel::pop $global::messenger
}
proc loadFromDatabase {draggable static} { ;# get ready to load data cell histories from database
if {![info exists databaseInstances::singleton]} { ;# not in database mode already
if {![clear]} return ;# eventually unload all modules unless user aborted
databaseConnection 1 ;# connect to database
if {$global::database == 0} return ;# database connection failed
}
database::displayAndSelectInstances ;# show dialog box with modules instances, data cells histories, ... in database
createInstancesViewer $draggable $static
updateMenuWidget
updateToolBar
updateDragAndDropZone
# monitor selected instance if any and eventually delete empty instances viewer when closed:
switched::configure $database::(dialog) -command "databaseInstances::monitor $databaseInstances::singleton"\
-deletecommand {after idle {databaseInstances::deleteEmpty}} ;# note: avoid loop in mutual destruction with instances viewer
}
proc createInstancesViewer {draggable static} {
if {[info exists databaseInstances::singleton]} return
set instances [new databaseInstances $global::canvas -draggable $draggable] ;# create database instances singleton
set path $widget::($instances,path)
canvasWindowManager::manage $global::windowManager $path $instances
set title [mc {database module instances}]
if {[info exists ::initializer] && ([llength [set list [record::databaseViewerWindowManagerData $::initializer]]] > 0)} {
foreach {x y width height xIcon yIcon} $list {} ;# recorded window manager configuration
canvasWindowManager::configure $global::windowManager $path\
-setx $x -sety $y -setwidth $width -setheight $height -iconx $xIcon -icony $yIcon\
-static $static -title $title -level $global::32BitIntegerMinimum ;# always stack below all other windows
} else {
canvasWindowManager::configure $global::windowManager $path\
-static $static -title $title -level $global::32BitIntegerMinimum ;# always stack below all other windows
}
# clear on self deletion to avoid recursion in clear{}, delayed to avoid loop in mutual destruction with instances dialog box
composite::configure $instances -selfdeletecommand {after idle clear}\
-deletecommand "canvasWindowManager::unmanage $global::windowManager $path; database::removeInstances"
}
proc databaseRecording {start} { ;# boolean: start or stop
if {$start} {
databaseConnection 1 ;# connect to database
if {$global::database == 0} return ;# database connection failed
refresh ;# attempt data storage from store class so that eventual errors can be detected immediately
} else {
databaseConnection 0 ;# disconnect from database
}
updateMenuWidget
updateToolBar
}
proc monitorDatabaseInstances {presetRange} { ;# used when loading a database history configuration
databaseConnection 1 ;# connect to database
if {$global::database == 0} {exit 1} ;# database connection failure is a fatal error
createInstancesViewer [expr {!$global::readOnly}] $global::static
foreach instance [modules::instancesWithout formulas] { ;# display all instance modules in instances viewer
foreach {name index} [modules::decoded $modules::instance::($instance,namespace)] {} ;# index is database instance number
if {![string equal $name instance]} {error "not an instance module in history mode: $name"}
array set option $modules::instance::($instance,arguments)
databaseInstances::monitor $databaseInstances::singleton [list $index $name $option(-identifier) $option(-arguments)] 0
}
eval databaseInstances::setCursors $databaseInstances::singleton $presetRange
}
proc updateCanvasImage {file {initialize 0}} { ;# note: does not update canvas image global variables
# use full file path, as current directory may change during the lifetime of the application or dashboard
if {[package vcompare $::tcl_version 8.4] < 0} {
if {[string length $file] > 0} {set file [file join [pwd] $file]}
} else {
set file [file normalize $file]
}
if {[string equal $file $global::canvasImageFile] && !$initialize} return ;# no change
if {([string length $global::canvasImageFile] > 0) && !$initialize} {
images::release $global::canvasImageFile
}
if {[string length $file] == 0} {
if {[info exists global::canvasImageItem]} {
$global::canvas delete $global::canvasImageItem; unset global::canvasImageItem
}
} else {
images::load $file $file {}
set image [images::use $file]
if {[info exists global::canvasImageItem]} {
$global::canvas itemconfigure $global::canvasImageItem -image $image
} else {
set global::canvasImageItem [$global::canvas create image 0 0 -image $image]
}
$global::canvas lower $global::canvasImageItem ;# background image should be below anything else
}
}
proc updateCanvasImagePosition {item position {offset 0}} {
set canvas $global::canvas
foreach {left top right bottom} [bounds $canvas] {} ;# top is always 0
switch $position {
nw {
$canvas itemconfigure $item -anchor nw
$canvas coords $item $offset 0
}
default { ;# center
$canvas itemconfigure $item -anchor center
$canvas coords $item [expr {$offset + (($right - $left) / 2.0)}] [expr {$bottom / 2.0}]
}
}
}
proc updateCanvasImagesPosition {} {
if {[info exists global::canvasImageItem]} {
updateCanvasImagePosition $global::canvasImageItem $global::canvasImagePosition
}
pages::updateImagesPositions
}
proc traceDialog {title message {exit 0}} { ;# with text area so that message cutting and pasting is possible by the user
set dialog [new dialogBox . -title $title -buttons x -default x -x [winfo pointerx .] -y [winfo pointery .]]
if {$exit} {composite::configure $dialog -labels [list x [mc Exit]]}
set frame [frame $widget::($dialog,path).frame]
set scroll [new scroll text $frame -height 100]
composite::configure $dialog -deletecommand "delete $scroll; set ::traceDialogDone {}"
set text $composite::($scroll,scrolled,path)
$text insert end $message
$text configure -font $font::(mediumNormal) -wrap word -state disabled
pack $widget::($scroll,path) -fill both -expand 1
dialogBox::display $dialog $frame
vwait ::traceDialogDone
}
proc manageScrolledCanvas {show} {
set path $widget::($global::scroll,path)
if {$show} {
if {[llength [grid info $path]] == 0} {
grid $path -row 2 -column 0 -sticky nsew
}
} else {
grid forget $path
}
}
proc createNewPage {} {
updateCanvasImage {}; set global::canvasImageFile {} ;# possibly clear existing background
set pages [expr {[pages::current] != 0}]
if {!$pages} {manageScrolledCanvas 0} ;# first page
set page [new page . -background $global::canvasBackground -draggable [expr {!$global::readOnly}]]
if {!$pages} {pages::manageScrolledCanvas 1}
pages::edit $page
}
proc formulasDialog {{formulasTable 0} {selectedFormula 0}} {
if {[info exists global::formulasDialog]} {
formulas::dialog::raise $global::formulasDialog ;# make it visible
} else {
set command "formulasDialogValidated $formulasTable"
set deletion {unset global::formulasDialog}
if {$formulasTable == 0} {
set list {}
set global::formulasDialog [new formulas::dialog -command $command -deletecommand $deletion]
} else {
composite::configure $formulasTable -state disabled ;# so that user cannot modify table while it is being edited
append deletion "; composite::configure $formulasTable -state normal"
set list [formulas::table::formulas $formulasTable]
set global::formulasDialog [new formulas::dialog\
-command $command -deletecommand $deletion -formulas $list\
-object [composite::cget $formulasTable -object] -category [composite::cget $formulasTable -category] -initial 0\
]
}
if {([llength $list] > 0) && ($selectedFormula > 0)} {
formulas::dialog::select $global::formulasDialog $selectedFormula
}
}
}
proc formulasDialogValidated {table object category formulas} {
if {$table == 0} { ;# create a new table
formulas::table::manage [createNewFormulasViewer $object $category 1 $global::static] $formulas
} else { ;# update existing table
if {[formulas::table::manage $table $formulas 1]} { ;# the name of at least 1 existing formula was changed
foreach viewer $viewer::(list) {
viewer::updateLabels $viewer ;# update labels in case one pointed to one of the formulas data cells
}
}
}
}
proc raiseExistingFormulasDialog {} {
if {[info exists global::formulasDialog]} {
formulas::dialog::raise $global::formulasDialog
}
}
proc displayModuleState {namespace value} {
# use grayish colors: yellow for busy, red for error and green for idle
switch $value {
busy {set color #C0C0C0}
error {set color #D0A0A0}
idle {set color #A0D0A0}
default error
}
foreach table $dataTable::(list) { ;# find all data tables for the specified module instance
if {[string equal [modules::namespaceFromArray [composite::cget $table -data]] $namespace]} {
canvasWindowManager::color $global::windowManager $widget::($table,path) $color
}
}
}
|
