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
|
# 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: canvaswm.tcl,v 2.66 2005/02/19 21:16:23 jfontain Exp $
class canvasWindowManager {
proc canvasWindowManager {this canvas} {
# used for icons (minimized objects) in the canvas window manager context, also used by canvas viewers
set ($this,drag) [new dragSite -path $canvas -validcommand "canvasWindowManager::validateDrag $this" -grab 0]
set ($this,canvas) $canvas
}
proc ~canvasWindowManager {this} {
variable ${this}data
variable ${this}handleIcon
variable ${this}handleCoordinates
variable ${this}handleIconCoordinates
foreach {handle icon} [array get ${this}handleIcon] {
delete $icon
}
foreach {name handle} [array get ${this}data handle,*] {
delete $handle
}
catch {unset ${this}data}
catch {unset ${this}handleIcon}; catch {unset ${this}handleCoordinates}; catch {unset ${this}handleIconCoordinates}
delete $($this,drag)
}
proc manage {this path viewer} { ;# viewer, table or database cell histories container
variable ${this}data
set handle [new handles $($this,canvas) $this -path $path]
set ${this}data(handle,$path) $handle
set ${this}data(viewerHandle,$viewer) $handle ;# a viewer can have one handle only
}
proc unmanage {this path} {
variable ${this}data
variable ${this}handleIcon
variable ${this}handleCoordinates
variable ${this}handleIconCoordinates
set handle [set ${this}data(handle,$path)]
if {[info exists ${this}handleIcon($handle)]} { ;# minimized
delete [set ${this}handleIcon($handle)] ;# delete icon
unset ${this}handleIcon($handle)
catch {unset ${this}handleIconCoordinates($handle)}
}
catch {unset ${this}handleCoordinates($handle)}
foreach {name value} [array get ${this}data viewerHandle,*] {
if {$value == $handle} {array unset ${this}data $name; break}
}
delete $handle
unset ${this}data(handle,$path) ${this}data(relativeStackingLevel,$path)
}
proc configure {this path args} {
variable ${this}data
set handle [set ${this}data(handle,$path)]
array set value $args
if {![catch {string length $value(-level)} length] && ($length > 0)} {
# find out which managed widget to stack right below, if any. if none is found, widget defaults to top stack level
set names [array names ${this}data relativeStackingLevel,*]
if {[llength $names] > 0} { ;# there are other managed widgets
foreach name $names { ;# build path from level mapping
set pathFrom([set ${this}data($name)]) [lindex [split $name ,] end]
}
foreach level [lsort -integer [array names pathFrom]] {
if {$level > $value(-level)} {
handles::stackLower $handle [set ${this}data(handle,$pathFrom($level))]
break ;# found the handles for widget right above
}
}
}
set ${this}data(relativeStackingLevel,$path) $value(-level)
}
catch {set xIcon $value(-iconx); set yIcon $value(-icony)}
catch {unset value(-level)} ;# handles do not handle the level option
catch {unset value(-iconx) value(-icony)} ;# nor the icon coordinates
if {![catch {set object $value(-dragobject)}]} {
composite::configure $handle -dragobject $object
unset value(-dragobject)
}
eval composite::configure $handle [array get value]
::update idletasks ;# so that handles return correct geometry even when immediately minimized right below
if {[info exists xIcon] && ([string length $xIcon] > 0)} { ;# icon coordinates are defined so minimize
minimize $this $handle [composite::cget $handle -title] $xIcon $yIcon $value(-static)
}
}
proc getGeometry {this path} { ;# return x, y, width and height as a list
variable ${this}data
variable ${this}handleIcon
variable ${this}handleCoordinates
set handle [set ${this}data(handle,$path)]
set geometry [handles::getGeometry $handle]
if {[info exists ${this}handleIcon($handle)]} { ;# minimized
# return coordinates before minimization:
return [eval lreplace [list $geometry] 0 1 [set ${this}handleCoordinates($handle)]]
} else {
return $geometry
}
}
proc getStackLevel {this path} { ;# return relative stacking level
variable ${this}data
return [set ${this}data(relativeStackingLevel,$path)]
}
proc iconCoordinates {this path} {
variable ${this}data
variable ${this}handleIcon
set handle [set ${this}data(handle,$path)]
if {[catch {set icon [set ${this}handleIcon($handle)]}]} { ;# not minimized
return [list {} {}] ;# list of 2 empty coordinates
} else {
return [icon::coordinates $icon]
}
}
proc relativeStackingLevels {this} { ;# return paths relative levels sorted in increasing order
variable ${this}data
set list {}
foreach {name value} [array get ${this}data relativeStackingLevel,*] {
lappend list $value
}
return [lsort -integer $list]
}
proc stacked {this path raised} { ;# parameter is a boolean: either raised to top or lowered to bottom
variable ${this}data
set levels [relativeStackingLevels $this]
if {[llength $levels] == 0} { ;# first widget to be positionned
set ${this}data(relativeStackingLevel,$path) 0
} elseif {$raised} {
set ${this}data(relativeStackingLevel,$path) [expr {[lindex $levels end] + 1}] ;# place right above maximum level
} else {
set ${this}data(relativeStackingLevel,$path) [expr {[lindex $levels 0] - 1}] ;# place right below minimum level
}
}
proc raisedOnTop {this path} {
variable ${this}data
return [expr {[set ${this}data(relativeStackingLevel,$path)] >= [lindex [relativeStackingLevels $this] end]}]
}
proc raise {this next} { ;# next is a boolean: false means previous
variable ${this}data
variable ${this}handleIcon
set canvas $($this,canvas)
set bounds [bounds $canvas] ;# for current page
set handles {}
foreach {name handle} [array get ${this}data handle,*] {
if {[info exists ${this}handleIcon($handle)]} continue ;# ignore minimized handles
if {![intersect [$canvas bbox $handles::($handle,item)] $bounds]} continue ;# ignore handles in other pages
set path($handle) [scan $name handle,%s]
lappend handles $handle
}
set length [llength $handles]
if {$length < 2} {
raiseOther $this $next ;# try icons and other objects
return ;# there can be no next or previous handle
}
set handles [lsort -integer $handles] ;# sort in order of creation
set maximum $global::32BitIntegerMinimum
set index 0
foreach handle $handles {
set level [set ${this}data(relativeStackingLevel,$path($handle))]
if {$level > $maximum} {
set maximum $level
set top $index
}
incr index
}
if {$next} {
if {[incr top] >= $length} { ;# circle around to beginning
if {[raiseOther $this 1]} return ;# except if there were other objects to show
set top 0
}
} else {
if {[incr top -1] < 0} { ;# circle around back to end
if {[raiseOther $this 0]} return ;# except if there were other objects to show
set top end
}
}
handles::stack [lindex $handles $top] raise
}
proc raiseOther {this next} {
variable ${this}data
variable ${this}handleIcon
set canvas $($this,canvas)
set bounds [bounds $canvas] ;# for current page
set handles {}
foreach {name handle} [array get ${this}data handle,*] {
if {[catch {set tag icon([set ${this}handleIcon($handle)])}]} continue ;# not minimized
if {![intersect [$canvas bbox $tag] $bounds]} continue ;# ignore objects in other pages
lappend handles $handle
}
set tags {}
foreach handle [lsort -integer $handles] { ;# sort in order of creation
lappend tags icon([set ${this}handleIcon($handle)])
}
foreach viewer $canvas::viewer::(list) { ;# now look at canvas viewers
set tag $canvas::viewer::($viewer,tag)
if {![intersect [$canvas bbox $tag] $bounds]} continue ;# ignore viewers in other pages
lappend tags $tag
}
if {[llength $tags] == 0} {return 0} ;# nothing to highlight
if {[info exists ($this,raiseOtherEvent)]} { ;# an icon is being highlighted
set command [lindex [after info $($this,raiseOtherEvent)] 0]
after cancel $($this,raiseOtherEvent) ;# cancel current event
uplevel #0 $command ;# but still execute its script
set index [lsearch -exact $tags $($this,raiseOtherTag)]
if {$index < 0} { ;# object may have disappeared (unlikely)
if {$next} {set index 0} else {set index end}
} elseif {$next} {
if {[incr index] >= [llength $tags]} {unset index} ;# no next object to highlight
} else {
if {[incr index -1] < 0} {unset index} ;# no next object to highlight
}
} else { ;# start at extreme object
if {$next} {set index 0} else {set index end}
}
if {![info exists index]} { ;# no next object to highlight
unset ($this,raiseOtherTag)
return 0
}
set ($this,raiseOtherTag) [lindex $tags $index]
foreach {left top right bottom} [$canvas bbox $($this,raiseOtherTag)] {}
set highlighter [new highlighter]
highlighter::show $highlighter\
[expr {[winfo rootx $canvas] + $left}] [expr {[winfo rooty $canvas] + $top}]\
[expr {$right - $left}] [expr {$bottom - $top}]
set ($this,raiseOtherEvent) [after 1000 "delete $highlighter; unset canvasWindowManager::($this,raiseOtherEvent)"]
return 1
}
proc minimize {this handle title {xIcon {}} {yIcon {}} {static 0}} {
variable ${this}handleIcon
variable ${this}handleCoordinates
variable ${this}handleIconCoordinates
foreach {x y} [handles::getGeometry $handle] break ;# retrieve current coordinates
set ${this}handleCoordinates($handle) [list $x $y] ;# remember them
handles::moveTo $handle $global::32BitIntegerMinimum $global::32BitIntegerMinimum ;# make window invisible to the user
set icon [new icon $($this,canvas) $title -command "canvasWindowManager::deIconify $this $handle"]
if {$static} {switched::configure $icon -state disabled} else {switched::configure $icon -state normal}
if {[string length $xIcon] > 0} {
icon::coordinates $icon $xIcon $yIcon ;# pre-defined coordinates
set ${this}handleIconCoordinates($handle) [list $xIcon $yIcon] ;# remember them for next minimization
} elseif {[info exists ${this}handleIconCoordinates($handle)]} { ;# if available,
eval icon::coordinates $icon [set ${this}handleIconCoordinates($handle)] ;# use previous icon coordinates
} else {
stowIcon $this $icon
}
switched::configure $icon -color [composite::cget $handle -titlebackground]
set ${this}handleIcon($handle) $icon
}
proc deIconify {this handle} {
variable ${this}handleIcon
variable ${this}handleCoordinates
variable ${this}handleIconCoordinates
set icon [set ${this}handleIcon($handle)]
if {$icon::($icon,moved)} { ;# icon was moved by user
set ${this}handleIconCoordinates($handle) [icon::coordinates $icon] ;# remember its coordinates for next minimization
}
delete $icon
eval handles::moveTo $handle [set ${this}handleCoordinates($handle)] ;# place back in original position
handles::stack $handle raise ;# but on top of the others so that it can be easily found
unset ${this}handleIcon($handle) ${this}handleCoordinates($handle)
}
proc stowIcon {this identifier} { ;# place icon at the bottom left of the canvas current page where there is room
set canvas $($this,canvas)
set padding $global::iconPadding
::update idletasks ;# needed to get canvas correct size
set bounds [bounds $canvas] ;# for current page
foreach {region(left) region(top) region(right) region(bottom)} $bounds {}
foreach item [$canvas find all] {
set index 0
foreach tag [$canvas gettags $item] {
if {[scan $tag icon(%u) index] > 0} break ;# found an icon
}
if {($index == 0) || ($index == $identifier)} continue ;# ignore items other than icons and new icon
if {![intersect [$canvas bbox icon($index)] $bounds]} continue ;# ignore icons in other pages
set found($index) {} ;# eliminate duplicates (an icon may be composed of several elements with the same tag)
}
set coordinates {}
foreach index [array names found] {
lappend coordinates [$canvas bbox icon($index)]
}
set coordinates [lsort -integer -index 0 $coordinates] ;# order by abscissa
foreach {left top right bottom} [$canvas bbox icon($identifier)] {} ;# all icons have the same height
set height [expr {$bottom - $top + (2 * $padding)}] ;# icons are initially placed in slices with a reasonable padding value
set width [expr {$right - $left + (2 * $padding)}]
set maximum $region(bottom)
while {[set minimum [expr {$maximum - $height}]] >= 0} { ;# look for room in slices starting from the bottom
set spaces {} ;# build a list a empty segments in the slice
set x $region(left) ;# the right side of the last occupied area
foreach list $coordinates {
foreach {left top right bottom} $list {}
if {($top > $maximum) || ($bottom < $minimum)} continue ;# icon area does not intersect the slice
if {$left > $x} { ;# an empty space exists
lappend spaces $x $left
}
set x $right
}
if {$x < $region(right)} {
lappend spaces $x $region(right) ;# space remaining on the right slice of the slice
}
# find out whether there is a wide enough empty area in the slice to contain the new icon:
foreach {left right} $spaces {
if {($right - $left) > $width} {
set position(x) $left
set position(y) $minimum
break ;# a wide enough space was found
}
}
if {[info exists position]} break ;# a valid space was found
set maximum $minimum ;# look in the next slice up
}
# if no large enough empty area was found (unlikely), place the icon at the bottom left corner, maybe on top of other ones:
if {![info exists position]} {
set position(x) [expr {$region(left)}]
set position(y) [expr {$region(bottom) - $height}]
}
# place top left corner of icon at calculated coordinates
foreach {x y} [icon::coordinates $identifier] {}
foreach {left top right bottom} [$canvas bbox icon($identifier)] {}
icon::coordinates $identifier [expr {$position(x) + ($x - $left)}] [expr {$position(y) + ($y - $top)}]
}
# return the page where the viewer or table lies or nothing if failure, such as the object not being managed
proc viewerPage {this object} { ;# identifier
variable ${this}data
variable ${this}handleIcon
if {[catch {set handle [set ${this}data(viewerHandle,$object)]}]} {
return {} ;# object is not managed
}
set tag $handles::($handle,item)
catch {set tag icon([set ${this}handleIcon($handle)])} ;# handle may be minimized
return [pages::tagOrItemPage $tag]
}
proc handles {this} { ;# returns a list of the existing handles
variable ${this}data
set list {}
foreach {name handle} [array get ${this}data handle,*] {
lappend list $handle
}
return $list
}
# list of rectangles (borders of managed windows) from the same page, including visible canvas rectangle
proc rectangles {this exclude} { ;# handle to exclude
variable ${this}handleIcon
set canvas $($this,canvas)
set page [pages::tagOrItemPage $handles::($exclude,item)]
set list {}
foreach handle [handles $this] {
if {($handle == $exclude) || [info exists ${this}handleIcon($handle)]} continue ;# minimized
set item $handles::($handle,item)
if {![string equal [pages::tagOrItemPage $item] $page]} continue ;# page may be empty if there are no pages
foreach {x y} [coordinates $canvas $item] {}
lappend list [list $x $y [winfo width $widget::($handle,path)] [winfo height $widget::($handle,path)]]
}
return $list
}
proc coordinates {canvas itemOrTag} { ;# return coordinates in pixels as integers
set values {}
foreach value [$canvas coords $itemOrTag] {
lappend values [expr {round($value)}]
}
return $values
}
proc validateDrag {this x y} {
variable ${this}handleIcon
set drag $($this,drag)
set canvas $($this,canvas)
# reset all formats as they are dynamically defined in order to handle different canvas object types
foreach format [dragSite::provide $drag] {dragSite::provide $drag $format {}}
foreach tag [$canvas gettags current] {
if {[set icon [icon::fromTag $tag]] > 0} { ;# a minimized object was selected
set handle 0
foreach {name value} [array get ${this}handleIcon] {
if {$value == $icon} {set handle $name; break}
}
if {$handle == 0} {error {could not find a handle for selected icon}}
dragSite::provide $drag MINIMIZED "dragEcho [list [list $this $handle $icon]]" ;# allow dropping in another page
return 1
}
}
return [canvas::viewer::validateDrag $canvas $x $y] ;# see if a canvas viewer is being dragged
}
proc dragData {this format} { ;# note: minimized window manager objects are handled directly
return [canvas::viewer::dragData $($this,canvas) $format]
}
proc moveIconToPage {list x y} { ;# list of manager, handle and icon
foreach {manager handle icon} $list {}
variable ${manager}handleCoordinates
set ${manager}handleCoordinates($handle) [list $x $y] ;# so that it deiconifies in the same page
icon::coordinates $icon $x $y
}
proc moveHandlesToPage {handles x y} {
set manager $global::windowManager
variable ${manager}handleCoordinates
variable ${manager}handleIconCoordinates
set ${manager}handleCoordinates($handles) [list $x $y]
catch {unset ${manager}handleIconCoordinates($handles)} ;# previous icon coordinates are no longer valid
handles::moveTo $handles $x $y
}
proc moveAll {this xMaximum} {
variable ${this}handleIcon
foreach handle [handles $this] {
if {![catch {set icon [set ${this}handleIcon($handle)]}]} { ;# minimized
foreach {x y} [icon::coordinates $icon] {}
if {$x >= $xMaximum} {
moveIconToPage [list $this $handle $icon] [expr {round($x) % $xMaximum}] $y
}
} else {
foreach {x y} [canvasWindowManager::handles::getGeometry $handle] break
if {$x >= $xMaximum} {
moveHandlesToPage $handle [expr {round($x) % $xMaximum}] $y
}
}
}
}
proc color {this path value} { ;# color the window manager part in some way
variable ${this}data
variable ${this}handleIcon
set handle [set ${this}data(handle,$path)]
composite::configure $handle -titlebackground $value
if {![catch {set icon [set ${this}handleIcon($handle)]}]} { ;# minimized
switched::configure $icon -color $value
}
}
}
|
