1
# ------------------------------------------------------------------------------
3
# This file is part of Unifix BWidget Toolkit
4
# $Id: dragsite.tcl,v 1.1 2004/03/04 00:47:28 airadier Exp $
5
# ------------------------------------------------------------------------------
10
# - DragSite::_begin_drag
11
# - DragSite::_init_drag
12
# - DragSite::_end_drag
13
# - DragSite::_update_operation
14
# ----------------------------------------------------------------------------
16
namespace eval DragSite {
17
Widget::define DragSite dragsite -classonly
19
Widget::declare DragSite [list \
20
[list -dragevent Enum 1 0 [list 1 2 3]] \
21
[list -draginitcmd String "" 0] \
22
[list -dragendcmd String "" 0] \
25
variable _topw ".drag"
31
bind BwDrag1 <ButtonPress-1> {DragSite::_begin_drag press %W %s %X %Y}
32
bind BwDrag1 <B1-Motion> {DragSite::_begin_drag motion %W %s %X %Y}
33
bind BwDrag2 <ButtonPress-2> {DragSite::_begin_drag press %W %s %X %Y}
34
bind BwDrag2 <B2-Motion> {DragSite::_begin_drag motion %W %s %X %Y}
35
bind BwDrag3 <ButtonPress-3> {DragSite::_begin_drag press %W %s %X %Y}
36
bind BwDrag3 <B3-Motion> {DragSite::_begin_drag motion %W %s %X %Y}
42
# ----------------------------------------------------------------------------
43
# Command DragSite::include
44
# ----------------------------------------------------------------------------
45
proc DragSite::include { class type event } {
46
set dragoptions [list \
47
[list -dragenabled Boolean 0 0] \
48
[list -draginitcmd String "" 0] \
49
[list -dragendcmd String "" 0] \
50
[list -dragtype String $type 0] \
51
[list -dragevent Enum $event 0 [list 1 2 3]] \
53
Widget::declare $class $dragoptions
57
# ----------------------------------------------------------------------------
58
# Command DragSite::setdrag
59
# Widget interface to register
60
# ----------------------------------------------------------------------------
61
proc DragSite::setdrag { path subpath initcmd endcmd {force 0}} {
62
set cen [Widget::hasChanged $path -dragenabled en]
63
set cdragevt [Widget::hasChanged $path -dragevent dragevt]
65
if { $force || $cen || $cdragevt } {
67
-draginitcmd $initcmd \
77
# ----------------------------------------------------------------------------
78
# Command DragSite::register
79
# ----------------------------------------------------------------------------
80
proc DragSite::register { path args } {
81
upvar \#0 DragSite::$path drag
83
if { [info exists drag] } {
84
bind $path $drag(evt) {}
87
Widget::init DragSite .drag$path $args
88
set event [Widget::getMegawidgetOption .drag$path -dragevent]
89
set initcmd [Widget::getMegawidgetOption .drag$path -draginitcmd]
90
set endcmd [Widget::getMegawidgetOption .drag$path -dragendcmd]
91
set tags [bindtags $path]
92
set idx [lsearch $tags "BwDrag*"]
93
Widget::destroy .drag$path
94
if { $initcmd != "" } {
96
bindtags $path [lreplace $tags $idx $idx BwDrag$event]
98
bindtags $path [concat $tags BwDrag$event]
100
set drag(initcmd) $initcmd
101
set drag(endcmd) $endcmd
103
} elseif { $idx != -1 } {
104
bindtags $path [lreplace $tags $idx $idx]
109
# ----------------------------------------------------------------------------
110
# Command DragSite::_begin_drag
111
# ----------------------------------------------------------------------------
112
proc DragSite::_begin_drag { event source state X Y } {
124
if { ![info exists _state] } {
125
# This is just extra protection. There seem to be
126
# rare cases where the motion comes before the press.
129
if { [string equal $_state "press"] } {
130
if { abs($_x0-$X) > 3 || abs($_y0-$Y) > 3 } {
132
_init_drag $source $state $X $Y
140
# ----------------------------------------------------------------------------
141
# Command DragSite::_init_drag
142
# ----------------------------------------------------------------------------
143
proc DragSite::_init_drag { source state X Y } {
145
upvar \#0 DragSite::$source drag
150
wm overrideredirect $_topw 1
152
set info [uplevel \#0 $drag(initcmd) [list $source $X $Y .drag]]
154
set type [lindex $info 0]
155
set ops [lindex $info 1]
156
set data [lindex $info 2]
158
if { [winfo children $_topw] == "" } {
159
if { [string equal $type "BITMAP"] || [string equal $type "IMAGE"] } {
160
label $_topw.l -image [Bitmap::get dragicon] -relief flat -bd 0
162
label $_topw.l -image [Bitmap::get dragfile] -relief flat -bd 0
166
wm geometry $_topw +[expr {$X+1}]+[expr {$Y+1}]
168
if {[catch {tkwait visibility $_topw}]} {
171
BWidget::grab set $_topw
172
BWidget::focus set $_topw
174
bindtags $_topw [list $_topw DragTop]
175
DropSite::_init_drag $_topw $drag(evt) $source $state $X $Y $type $ops $data
182
# ----------------------------------------------------------------------------
183
# Command DragSite::_end_drag
184
# ----------------------------------------------------------------------------
185
proc DragSite::_end_drag { source target op type data result } {
187
upvar \#0 DragSite::$source drag
189
BWidget::grab release $_topw
190
BWidget::focus release $_topw
192
if { $drag(endcmd) != "" } {
193
uplevel \#0 $drag(endcmd) [list $source $target $op $type $data $result]
added
removed
plugins/BWidget-1.7.0/dragsite.tcl
