1# ------------------------------------------------------------------------------ 2# dragsite.tcl 3# This file is part of Unifix BWidget Toolkit 4# $Id: dragsite.tcl,v 1.6 2001/06/11 23:58:40 hobbs Exp $ 5# ------------------------------------------------------------------------------ 6# Index of commands: 7# - DragSite::include 8# - DragSite::setdrag 9# - DragSite::register 10# - DragSite::_begin_drag 11# - DragSite::_init_drag 12# - DragSite::_end_drag 13# - DragSite::_update_operation 14# ------------------------------------------------------------------------------ 15 16namespace eval DragSite { 17 Widget::declare DragSite [list \ 18 [list -dragevent Enum 1 0 [list 1 2 3]] \ 19 [list -draginitcmd String "" 0] \ 20 [list -dragendcmd String "" 0] \ 21 ] 22 23 variable _topw ".drag" 24 variable _tabops 25 variable _state 26 variable _x0 27 variable _y0 28 29 bind BwDrag1 <ButtonPress-1> {DragSite::_begin_drag press %W %s %X %Y} 30 bind BwDrag1 <B1-Motion> {DragSite::_begin_drag motion %W %s %X %Y} 31 bind BwDrag2 <ButtonPress-2> {DragSite::_begin_drag press %W %s %X %Y} 32 bind BwDrag2 <B2-Motion> {DragSite::_begin_drag motion %W %s %X %Y} 33 bind BwDrag3 <ButtonPress-3> {DragSite::_begin_drag press %W %s %X %Y} 34 bind BwDrag3 <B3-Motion> {DragSite::_begin_drag motion %W %s %X %Y} 35 36 proc use {} {} 37} 38 39 40# ------------------------------------------------------------------------------ 41# Command DragSite::include 42# ------------------------------------------------------------------------------ 43proc DragSite::include { class type event } { 44 set dragoptions [list \ 45 [list -dragenabled Boolean 0 0] \ 46 [list -draginitcmd String "" 0] \ 47 [list -dragendcmd String "" 0] \ 48 [list -dragtype String $type 0] \ 49 [list -dragevent Enum $event 0 [list 1 2 3]] \ 50 ] 51 Widget::declare $class $dragoptions 52} 53 54 55# ------------------------------------------------------------------------------ 56# Command DragSite::setdrag 57# Widget interface to register 58# ------------------------------------------------------------------------------ 59proc DragSite::setdrag { path subpath initcmd endcmd {force 0}} { 60 set cen [Widget::hasChanged $path -dragenabled en] 61 set cdragevt [Widget::hasChanged $path -dragevent dragevt] 62 if { $en } { 63 if { $force || $cen || $cdragevt } { 64 register $subpath \ 65 -draginitcmd $initcmd \ 66 -dragendcmd $endcmd \ 67 -dragevent $dragevt 68 } 69 } else { 70 register $subpath 71 } 72} 73 74 75# ------------------------------------------------------------------------------ 76# Command DragSite::register 77# ------------------------------------------------------------------------------ 78proc DragSite::register { path args } { 79 upvar \#0 DragSite::$path drag 80 81 if { [info exists drag] } { 82 bind $path $drag(evt) {} 83 unset drag 84 } 85 Widget::init DragSite .drag$path $args 86 set event [Widget::getMegawidgetOption .drag$path -dragevent] 87 set initcmd [Widget::getMegawidgetOption .drag$path -draginitcmd] 88 set endcmd [Widget::getMegawidgetOption .drag$path -dragendcmd] 89 set tags [bindtags $path] 90 set idx [lsearch $tags "BwDrag*"] 91 Widget::destroy .drag$path 92 if { $initcmd != "" } { 93 if { $idx != -1 } { 94 bindtags $path [lreplace $tags $idx $idx BwDrag$event] 95 } else { 96 bindtags $path [concat $tags BwDrag$event] 97 } 98 set drag(initcmd) $initcmd 99 set drag(endcmd) $endcmd 100 set drag(evt) $event 101 } elseif { $idx != -1 } { 102 bindtags $path [lreplace $tags $idx $idx] 103 } 104} 105 106 107# ------------------------------------------------------------------------------ 108# Command DragSite::_begin_drag 109# ------------------------------------------------------------------------------ 110proc DragSite::_begin_drag { event source state X Y } { 111 variable _x0 112 variable _y0 113 variable _state 114 115 switch -- $event { 116 press { 117 set _x0 $X 118 set _y0 $Y 119 set _state "press" 120 } 121 motion { 122 if { ![info exists _state] } { 123 # This is just extra protection. There seem to be 124 # rare cases where the motion comes before the press. 125 return 126 } 127 if { ![string compare $_state "press"] } { 128 if { abs($_x0-$X) > 3 || abs($_y0-$Y) > 3 } { 129 set _state "done" 130 _init_drag $source $state $X $Y 131 } 132 } 133 } 134 } 135} 136 137 138# ------------------------------------------------------------------------------ 139# Command DragSite::_init_drag 140# ------------------------------------------------------------------------------ 141proc DragSite::_init_drag { source state X Y } { 142 variable _topw 143 upvar \#0 DragSite::$source drag 144 145 destroy $_topw 146 toplevel $_topw 147 wm withdraw $_topw 148 wm overrideredirect $_topw 1 149 150 set info [uplevel \#0 $drag(initcmd) [list $source $X $Y .drag]] 151 if { $info != "" } { 152 set type [lindex $info 0] 153 set ops [lindex $info 1] 154 set data [lindex $info 2] 155 156 if { [winfo children $_topw] == "" } { 157 if { ![string compare $type "BITMAP"] || ![string compare $type "IMAGE"] } { 158 label $_topw.l -image [Bitmap::get dragicon] -relief flat -bd 0 159 } else { 160 label $_topw.l -image [Bitmap::get dragfile] -relief flat -bd 0 161 } 162 pack $_topw.l 163 } 164 wm geometry $_topw +[expr {$X+1}]+[expr {$Y+1}] 165 wm deiconify $_topw 166 if {[catch {tkwait visibility $_topw}]} { 167 return 168 } 169 BWidget::grab set $_topw 170 BWidget::focus set $_topw 171 172 bindtags $_topw [list $_topw DragTop] 173 DropSite::_init_drag $_topw $drag(evt) $source $state $X $Y $type $ops $data 174 } else { 175 destroy $_topw 176 } 177} 178 179 180# ------------------------------------------------------------------------------ 181# Command DragSite::_end_drag 182# ------------------------------------------------------------------------------ 183proc DragSite::_end_drag { source target op type data result } { 184 variable _topw 185 upvar \#0 DragSite::$source drag 186 187 BWidget::grab release $_topw 188 BWidget::focus release $_topw 189 destroy $_topw 190 if { $drag(endcmd) != "" } { 191 uplevel \#0 $drag(endcmd) [list $source $target $op $type $data $result] 192 } 193} 194 195 196