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
|
# 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: pages.tcl,v 1.71 2005/01/02 00:45:07 jfontain Exp $
# Display the unique global canvas in notebook pages, each displaying a disjoint area of the canvas (via the scroll region canvas
# option).
# Displayed objects (tables, viewers, ...) have no knowledge of which page they reside in, except perhaps by looking at their
# coordinates (but that would be cheating and would require knowing the page class implementation).
# In effect, pages are totally disconnected from displayed objects and that is a good thing.
class page {
# use composite as base class instead of switched for compatibility with other viewers:
proc page {this parentPath args} composite {[new frame $parentPath] $args} viewer {} { ;# base widget frame remains invisible
set book [pages::book] ;# a single book is used
set first [expr {[llength [$book pages]] == 0}]
set ($this,page) [$book insert end $this -raisecmd "page::raised $this"]
set ($this,book) $book
set ($this,canvas) $pages::(canvas) ;# only notebook canvas is useful to a page
set ($this,drop) [new dropSite\
-path $book -regioncommand "page::dropRegion $this" -formats [list HANDLES CANVASVIEWER MINIMIZED]\
-command "pages::transfer $this"\
]
composite::complete $this
composite::configure $this -deletecommand "pages::deleted $this"
if {$first} { ;# the first page must be raised otherwise canvas is hidden when page is created dynamically (notebook bug?)
$book raise $this
pages::monitorActiveCells ;# only for first page since others will be empty
}
}
proc ~page {this} {
variable index
variable ${this}monitored
if {[info exists ($this,image)]} {
images::release $($this,imageFile)
$global::canvas delete $($this,image)
}
unset index($this)
catch {unset ${this}monitored}
delete $($this,drop)
if {[info exists ($this,thresholds)]} {delete $($this,thresholds)}
if {[info exists ($this,sequencer)]} {delete $($this,sequencer)}
if {[info exists ($this,tip)]} {delete $($this,tip)}
$($this,book) delete $this
if {[string length $composite::($this,-deletecommand)] > 0} {
uplevel #0 $composite::($this,-deletecommand) ;# always invoke command at global level
}
}
proc options {this} { ;# force initialization of index and label. -raised option is only used internally and thus not public.
return [list\
[list -background $widget::option(canvas,background) $widget::option(canvas,background)]\
[list -deletecommand {} {}]\
[list -draggable 0 0]\
[list -imagefile {} {}]\
[list -imageposition nw]\
[list -index {}]\
[list -label {}]\
[list -raised 0 0]\
]
}
proc set-background {this value} {
if {[string equal [$($this,book) raise] $this]} { ;# note: raised page may be empty if none is selected
$global::canvas configure -background $value
}
}
proc set-deletecommand {this value} {}
proc set-draggable {this value} {}
proc set-imagefile {this value} {
set canvas $global::canvas
if {[info exists ($this,image)]} {
images::release $($this,imageFile)
}
if {[string length $value] == 0} {
if {[info exists ($this,image)]} {
$canvas delete $($this,image)
unset ($this,image) ($this,imageFile)
}
return
}
# use full file path as key, as current directory may change during the lifetime of the application or the dashboard
if {[package vcompare $::tcl_version 8.4] < 0} {
if {[string length $value] > 0} {set value [file join [pwd] $value]}
} else {
set value [file normalize $value] ;# note: image file validity must have been checked before
}
set ($this,imageFile) $value
images::load $value $value {} ;# load into images repository
set image [images::use $value]
if {[info exists ($this,image)]} {
$canvas itemconfigure $($this,image) -image $image
} else {
set ($this,image) [$canvas create image 0 0 -image $image]
}
$canvas lower $($this,image) ;# background image should be below anything else
updateImagePosition $this
}
proc set-imageposition {this value} {
updateImagePosition $this
}
proc set-index {this value} {
variable index
if {$composite::($this,complete)} {
error {option -index cannot be set dynamically}
}
if {[string length $value] == 0} { ;# find a free index for the page
foreach {page value} [array get index] {set taken($value) {}}
set value 0; while {[info exists taken($value)]} {incr value}
} ;# else forced value from a save file
set index($this) $value
set ($this,left) [expr {$value * $global::pagesWidth}] ;# left coordinate of the page
updateImagePosition $this
}
proc set-label {this value} {
$($this,book) itemconfigure $this -text $value
}
# important: private procedure, used internally to store state, to use only when creating pages from a save file
proc set-raised {this value} {}
proc raised {this} {
if {![info exists global::scroll]} return
set x [lindex [$global::canvas xview] 0] ;# for some reason, the horizontal view is changed by the operations below
pages::updateScrollRegion $global::canvas $($this,left)
pack $widget::($global::scroll,path) -in $($this,page) -fill both -expand 1 ;# display scrolled canvas in this page
::update idletasks ;# needed to avoid weird behaviors, such as ghost tables from 1st page displayed on 2nd page in dashboard
$global::canvas xview moveto $x ;# keep the same horizontal view
$global::canvas configure -background $composite::($this,-background)
}
proc editLabel {this} {
set book $($this,book)
foreach {x top right bottom} [$($this,canvas) bbox $this:text] {}
set y [expr {($top + $bottom) / 2}]
set entry [entry .pageLabel\
-borderwidth 0 -highlightthickness 0 -width 0 -font [$book cget -font]\
-validate key -validatecommand "$book itemconfigure $this -text %P; list 1"\
] ;# use text as tab label as it is edited for better feedback
lifoLabel::push $global::messenger [mc {enter page tab label (Return to valid, Escape to abort)}]
# when Return or Enter is pressed, use new text as label, else if Escape is pressed, abort:
foreach key {<KP_Enter> <Return>} {
bind $entry $key "composite::configure $this -label \[%W get\]; destroy %W; lifoLabel::pop $global::messenger"
}
bind $entry <Escape>\
"page::set-label $this [list $composite::($this,-label)]; destroy %W; lifoLabel::pop $global::messenger"
$entry insert 0 $composite::($this,-label)
$entry selection range 0 end ;# initially select all characters, which is a common behavior
place $entry -in $($this,canvas) -anchor w -x $x -y $y ;# place entry over existing text
focus $entry
::update idletasks ;# so entry is visible and grab works
grab $entry
}
proc dropRegion {this} {
foreach {left top right bottom} [$($this,canvas) bbox $this:text] {} ;# tab text area (from BWidget notebook source code)
set X [winfo rootx $($this,canvas)]; set Y [winfo rooty $($this,canvas)]
return [list [incr left $X] [incr top $Y] [incr right $X] [incr bottom $Y]] ;# absolute region
}
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)}
if {[info exists ($this,tip)]} {switched::configure $($this,tip) -text {}}
$($this,book) itemconfigure $this -background {} ;# resets tab background
}
proc update {this array} {} ;# nothing to do, only threshold conditions are waited upon
proc cells {this} { ;# note: always return cells in the same order
variable ${this}monitored
return [lsort -dictionary [array names ${this}monitored]]
}
proc initializationConfiguration {this} {
variable index
return [list\
-background $composite::($this,-background) -index $index($this) -label $composite::($this,-label)\
-raised [string equal [$($this,book) raise] $this]\
-imagefile $composite::($this,-imagefile) -imageposition $composite::($this,-imageposition)\
]
}
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} {
$($this,book) itemconfigure $this -background {} ;# restore default tab background
} elseif {[llength $colors] == 1} {
$($this,book) itemconfigure $this -background [lindex $colors 0] ;# colors tab background
} else { ;# display the different colors in sequence
set ($this,sequencer) [new sequencer 1000 %c $colors "$($this,book) itemconfigure $this -background %c"]
sequencer::start $($this,sequencer)
}
if {[llength $summaries] == 0} {
if {[info exists ($this,tip)]} {switched::configure $($this,tip) -text {}}
} else {
if {![info exists ($this,tip)]} {
set ($this,tip) [new widgetTip -path $($this,canvas) -itemortag p:$this]
}
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} ;# pages manage their display themselves
proc monitored {this cell} {
variable ${this}monitored
return [info exists ${this}monitored($cell)]
}
proc updateImagePosition {this} {
if {![info exists ($this,image)] || ![info exists ($this,left)]} return ;# -index may not be defined yet
updateCanvasImagePosition $($this,image) $composite::($this,-imageposition) $($this,left)
}
}
class pages {
proc pages {this} error ;# object less class
proc manageScrolledCanvas {show} {
if {$show} {
if {[llength [grid info $(book)]] == 0} {
grid $(book) -row 2 -column 0 -sticky nsew
raise $widget::($global::scroll,path) $(book) ;# so that scrolled canvas is visible
}
foreach page [$(book) pages] { ;# raise the page that is supposed to be raised so that restoring from save file works
if {[composite::cget $page -raised]} {
$(book) raise $page
break ;# only a single page can be raised
}
}
} else {
grid forget $(book)
}
}
proc deleted {page} { ;# page was just deleted
if {[llength [$(book) pages]] == 0} { ;# no more pages
::delete $(drag)
manageScrolledCanvas 0
destroy $(book) ;# destroy book
unset (book) (canvas) (drag)
# all objects must be eventually moved to the sole main page, otherwise they could become invisible:
canvasWindowManager::moveAll $global::windowManager $global::pagesWidth
canvas::viewer::moveAll $global::pagesWidth
updateScrollRegion $global::canvas 0 ;# force left border as there are no pages left
$global::canvas configure -background $global::canvasBackground ;# restore original background
::manageScrolledCanvas 1 ;# show canvas in environment without pages
} else {
$(book) raise [$(book) pages 0] ;# always raise the first page by default
}
}
proc closestPageTopLeftCorner {x} { ;# from an abscissa
return [list [expr {round(double($x) / $global::pagesWidth) * $global::pagesWidth}] 0]
}
proc dragData {format} { ;# return page to be deleted to the eraser, format is always OBJECT
set page [$(book) raise] ;# active page or nothing if no page is selected
if {[string length $page] == 0} {return {}}
# deleting the last remaining page is always allowed:
if {([llength [$(book) pages]] <= 1) || [currentPageEmpty $global::canvas $page]} {
return $page
} else { ;# warn the user that there must not be any table or viewer in the page for the page to be allowed to be deleted
lifoLabel::flash $global::messenger [mc {a page must be empty to be deleted}]
bell
return {}
}
}
proc validateDrag {x y} {
foreach page [$(book) pages] { ;# mouse pointer must lie in a tab
if {![composite::cget $page -draggable]} continue
foreach {left top right bottom} [$(canvas) bbox p:$page] {}
if {($x > $left) && ($x < $right) && ($y > $top) && ($y < $bottom)} {return 1} ;# in a tab
}
return 0 ;# outside a page tab
}
proc labelsSide {value} { ;# must be top or bottom
if {![info exists (book)]} return
$(book) configure -side $value
}
proc transfer {targetPage} { ;# a viewer was dropped into that page tab, so move viewer to the upper left corner of that page
if {[info exists dragSite::data(CANVASVIEWER)]} { ;# canvas viewer
composite::configure $dragSite::data(CANVASVIEWER) -x $page::($targetPage,left) -y 0
} elseif {[info exists dragSite::data(MINIMIZED)]} { ;# window manager minimized object
canvasWindowManager::moveIconToPage $dragSite::data(MINIMIZED) $page::($targetPage,left) 0
} else { ;# handles (managed viewer)
canvasWindowManager::moveHandlesToPage $dragSite::data(HANDLES) $page::($targetPage,left) 0
}
monitorActiveCells ;# refresh pages monitored cells
}
proc book {} { ;# return book, create it if it does not exist
if {![info exists (book)]} {
set (book) [NoteBook .book\
-background $viewer::(background) -borderwidth 1 -internalborderwidth 0 -font $font::(mediumNormal)\
-side $global::pagesTabPosition\
]
$(book) bindtabs <Double-ButtonPress-1> page::editLabel
$(book) bindtabs <ButtonPress-3> page::editLabel
set (canvas) $(book).c ;# from the BWidget notebook source code
set (drag) [::new dragSite -path $(canvas) -validcommand pages::validateDrag] ;# for pages deletion by drop in eraser
dragSite::provide $(drag) OBJECTS pages::dragData
}
return $(book)
}
proc edit {page} {
$(book) see $page
::update idletasks ;# make sure tab label is in place before attempting to edit it
after idle "page::editLabel $page"
}
proc tagOrItemPage {value} { ;# return the page containing a canvas item or tag, or nothing if failure
if {![info exists (book)]} {return {}}
foreach {left top right bottom} [$global::canvas bbox $value] {}
foreach page [$(book) pages] {
set x [expr {$right - $page::($page,left)}]
if {($x >= 0) && ($x < $global::pagesWidth)} { ;# right side must be in page area but not in next page
return $page
}
}
return {}
}
proc cellsWithActiveThreshold {pageCellsName} { ;# fill array with page as key and list of cells as value
upvar 1 $pageCellsName pageCells
foreach cell [thresholds::activeCells] {
foreach viewer [viewer::monitoring $cell] { ;# viewer or table
set page [canvasWindowManager::viewerPage $::global::windowManager $viewer]
if {[string length $page] == 0} { ;# try canvas viewers
set page [canvas::viewer::page $viewer]
}
if {[string length $page] == 0} continue ;# if an unmanaged viewer for example
set ${page}($cell) {}
}
foreach table [dataTable::monitoring $cell] {
set page [canvasWindowManager::viewerPage $::global::windowManager $table]
if {[string length $page] == 0} continue
set ${page}($cell) {} ;# suppress duplicates (viewers derived from table or including tables)
}
}
foreach page [info locals] {
if {![string is integer -strict $page]} continue ;# a page is an object identifier
set pageCells($page) [array names $page]
}
}
# Since a page is a viewer, it is notified when a cell threshold condition occurs (color, level change, ...).
# The following procedure is idempotent, and is invoked in the following cases:
# - thresholds updated in their dialog box
# - module unloaded
# - table or viewer moved between pages
# - viewer deleted
# - first page created
# When a module is loaded, its tables cells do not have thresholds set yet.
# When a viewer is created, it contains no cells or cells located in the same page, thus already accounted for.
# When a page is created, it is empty of any table or viewer (except for the first page).
proc monitorActiveCells {} {
if {![info exists (book)]} return
foreach page [$(book) pages] {
page::forgetAllMonitoredCells $page ;# completely refresh all pages
}
cellsWithActiveThreshold data
foreach {page cells} [array get data] {
viewer::view $page $cells
}
}
# make sure no tables, viewers, icons, ... become unreachable when canvas is resized
proc updateScrollRegion {canvas {pageLeft {}}} { ;# current page left border is optional
if {[string length $pageLeft] == 0} {
set pageLeft [lindex [$canvas cget -scrollregion] 0]
}
if {[info exists (book)]} {
foreach page [$(book) pages] {
lappend lefts $page::($page,left)
}
} else {
set lefts 0 ;# no pages, canvas left side is at 0 abscissa
}
set width 0; set height 0
foreach from $lefts {
set to [expr {$from + ($global::pagesWidth / 2)}] ;# avoid pages intersections by dividing huge page width
set items [list]
foreach item [$canvas find all] {
if {[llength [set list [$canvas bbox $item]]] == 0} continue ;# skip void items
foreach {left top right bottom} $list {}
if {($right >= $from) && ($left <= $to)} { ;# item intersects in page
lappend items $item
}
}
if {[llength $items] == 0} continue ;# nothing in current page
foreach {left top right bottom} [eval $canvas bbox $items] {}
set width [maximum $width [expr {$right - $from}]]
set height [maximum $height $bottom]
}
if {($global::canvasWidth > 0) && ($global::canvasHeight > 0)} { ;# user defined fixed size
set width [maximum $width $global::canvasWidth] ;# never allow unreachable objects
set height [maximum $height $global::canvasHeight]
}
$canvas configure -scrollregion [list $pageLeft 0 [expr {$pageLeft + $width}] $height]
}
proc currentPageEmpty {canvas page} {
set from [lindex [$canvas cget -scrollregion] 0]
set to [expr {$from + ($global::pagesWidth / 2)}] ;# avoid pages intersections by dividing huge page width
foreach item [$canvas find all] {
if {[llength [set list [$canvas bbox $item]]] == 0} continue ;# skip void items
foreach {left top right bottom} $list {}
if {[info exists page::($page,image)] && ($item == $page::($page,image))} continue ;# ignore background image in page
if {($right >= $from) && ($left <= $to)} { ;# item intersects in page
return 0
}
}
return 1
}
proc data {} {
set list {}
if {[info exists (book)]} {
foreach page [$(book) pages] {
lappend list $page [composite::cget $page -label] [string equal [$(book) raise] $page]
}
}
return $list
}
proc updateImagesPositions {} {
if {![info exists (book)]} return
foreach page [$(book) pages] {page::updateImagePosition $page}
}
proc current {} { ;# returns current page or 0 if there are no pages
if {[info exists (book)]} {
return [$(book) raise]
} else {
return 0
}
}
}
|
