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
|
# copyright (C) 1997-98 Jean-Luc Fontaine (mailto:jfontain@mygale.org)
# this program is free software: please read the COPYRIGHT file enclosed in this package or use the Help Copyright menu
set rcsId {$Id: drop.tcl,v 1.11 1998/10/09 19:35:44 jfontain Exp $}
class dropSite {
set dropSite::(list) {} ;# initialize list of objects
proc dropSite {this args} switched {$args} {
lappend dropSite::(list) $this ;# manage a list of drop sites for drop regions
switched::complete $this
}
proc ~dropSite {this} {
set index [lsearch -exact $dropSite::(list) $this] ;# remove self from list
set dropSite::(list) [lreplace $dropSite::(list) $index $index]
catch {delete $dropSite::($this,bindings)} ;# eventually remove bindings
}
proc options {this} {
# accept all data formats by default
return [list\
[list -command {} {}]\
[list -formats {{}} {{}}]\
[list -path {} {}]\
]
}
proc set-command {this value} {} ;# nothing to do as data is stored at the switched level
proc set-formats {this value} {}
proc set-path {this value} { ;# target widget path
if {$switched::($this,complete)} {
error {option -path cannot be set dynamically}
}
if {![winfo exists $value]} {
error "invalid widget: \"$value\""
}
set dropSite::($this,bindings) [new bindings $value end] ;# do not interfere with existing bindings
set dropSite::($this,visible) 1 ;# monitor visibility
bindings::set $dropSite::($this,bindings) <Visibility>\
"set dropSite::($this,visible) \[string compare %s VisibilityFullyObscured\]"
}
proc dropped {this} {
if {[string length $switched::($this,-command)]>0} {
uplevel #0 $switched::($this,-command) ;# always invoke command at global level as tk buttons do
# the user command can retrieve data in the dragSite format indexed data array, for the available formats (dragSite
# data array names). it is guaranteed that at least 1 drop site format is supported by the drag site
}
}
proc regions {formats} { ;# return a list of drop sites with compatible data formats
# update was invoked here to make sure visibility and coordinates are correct, but it interferences with events in drag code
set regions {}
foreach site $dropSite::(list) {
if {[catch {winfo viewable $switched::($site,-path)} viewable]} continue ;# check if viewable, path may also be empty
# check that drop site is at least partly visible and not iconified
if {!$viewable||!$dropSite::($site,visible)} continue
foreach format $switched::($site,-formats) {
if {[lsearch -exact $formats $format]>=0} {
set path $switched::($site,-path)
set x [winfo rootx $path]; set y [winfo rooty $path]
lappend regions [list $site $x $y [expr {$x+[winfo width $path]}] [expr {$y+[winfo height $path]}]]
break ;# drop site will accept at least one of the data formats from the drag site
}
}
}
return $regions
}
}
|
