ultimatevocalremovergui/tkinterdnd2/tkdnd/win64/tkdnd_utils.tcl
2020-11-09 21:58:55 +01:00

253 lines
9.9 KiB
Tcl
Vendored

#
# tkdnd_utils.tcl --
#
# This file implements some utility procedures that are used by the TkDND
# package.
#
# This software is copyrighted by:
# George Petasis, National Centre for Scientific Research "Demokritos",
# Aghia Paraskevi, Athens, Greece.
# e-mail: petasis@iit.demokritos.gr
#
# The following terms apply to all files associated
# with the software unless explicitly disclaimed in individual files.
#
# The authors hereby grant permission to use, copy, modify, distribute,
# and license this software and its documentation for any purpose, provided
# that existing copyright notices are retained in all copies and that this
# notice is included verbatim in any distributions. No written agreement,
# license, or royalty fee is required for any of the authorized uses.
# Modifications to this software may be copyrighted by their authors
# and need not follow the licensing terms described here, provided that
# the new terms are clearly indicated on the first page of each file where
# they apply.
#
# IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
# FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
# ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
# DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
#
# THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE
# IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
# NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
# MODIFICATIONS.
#
package require tkdnd
namespace eval ::tkdnd {
namespace eval utils {
};# namespace ::tkdnd::utils
namespace eval text {
variable _drag_tag tkdnd::drag::selection::tag
variable _state {}
variable _drag_source_widget {}
variable _drop_target_widget {}
variable _now_dragging 0
};# namespace ::tkdnd::text
};# namespace ::tkdnd
bind TkDND_Drag_Text1 <ButtonPress-1> {tkdnd::text::_begin_drag clear 1 %W %s %X %Y %x %y}
bind TkDND_Drag_Text1 <B1-Motion> {tkdnd::text::_begin_drag motion 1 %W %s %X %Y %x %y}
bind TkDND_Drag_Text1 <B1-Leave> {tkdnd::text::_TextAutoScan %W %x %y}
bind TkDND_Drag_Text1 <ButtonRelease-1> {tkdnd::text::_begin_drag reset 1 %W %s %X %Y %x %y}
bind TkDND_Drag_Text2 <ButtonPress-2> {tkdnd::text::_begin_drag clear 2 %W %s %X %Y %x %y}
bind TkDND_Drag_Text2 <B2-Motion> {tkdnd::text::_begin_drag motion 2 %W %s %X %Y %x %y}
bind TkDND_Drag_Text2 <ButtonRelease-2> {tkdnd::text::_begin_drag reset 2 %W %s %X %Y %x %y}
bind TkDND_Drag_Text3 <ButtonPress-3> {tkdnd::text::_begin_drag clear 3 %W %s %X %Y %x %y}
bind TkDND_Drag_Text3 <B3-Motion> {tkdnd::text::_begin_drag motion 3 %W %s %X %Y %x %y}
bind TkDND_Drag_Text3 <ButtonRelease-3> {tkdnd::text::_begin_drag reset 3 %W %s %X %Y %x %y}
# ----------------------------------------------------------------------------
# Command tkdnd::text::drag_source
# ----------------------------------------------------------------------------
proc ::tkdnd::text::drag_source { mode path { types DND_Text } { event 1 } { tagprefix TkDND_Drag_Text } { tag sel } } {
switch -exact -- $mode {
register {
$path tag bind $tag <ButtonPress-${event}> \
"tkdnd::text::_begin_drag press ${event} %W %s %X %Y %x %y"
## Set a binding to the widget, to put selection as data...
bind $path <<DragInitCmd>> "::tkdnd::text::DragInitCmd $path {%t} $tag"
## Set a binding to the widget, to remove selection if action is move...
bind $path <<DragEndCmd>> "::tkdnd::text::DragEndCmd $path %A $tag"
}
unregister {
$path tag bind $tag <ButtonPress-${event}> {}
bind $path <<DragInitCmd>> {}
bind $path <<DragEndCmd>> {}
}
}
::tkdnd::drag_source $mode $path $types $event $tagprefix
};# ::tkdnd::text::drag_source
# ----------------------------------------------------------------------------
# Command tkdnd::text::drop_target
# ----------------------------------------------------------------------------
proc ::tkdnd::text::drop_target { mode path { types DND_Text } } {
switch -exact -- $mode {
register {
bind $path <<DropPosition>> "::tkdnd::text::DropPosition $path %X %Y %A %a %m"
bind $path <<Drop>> "::tkdnd::text::Drop $path %D %X %Y %A %a %m"
}
unregister {
bind $path <<DropEnter>> {}
bind $path <<DropPosition>> {}
bind $path <<DropLeave>> {}
bind $path <<Drop>> {}
}
}
::tkdnd::drop_target $mode $path $types
};# ::tkdnd::text::drop_target
# ----------------------------------------------------------------------------
# Command tkdnd::text::DragInitCmd
# ----------------------------------------------------------------------------
proc ::tkdnd::text::DragInitCmd { path { types DND_Text } { tag sel } { actions { copy move } } } {
## Save the selection indices...
variable _drag_source_widget
variable _drop_target_widget
set _drag_source_widget $path
set _drop_target_widget {}
_save_selection $path $tag
list $actions $types [$path get $tag.first $tag.last]
};# ::tkdnd::text::DragInitCmd
# ----------------------------------------------------------------------------
# Command tkdnd::text::DragEndCmd
# ----------------------------------------------------------------------------
proc ::tkdnd::text::DragEndCmd { path action { tag sel } } {
variable _drag_source_widget
variable _drop_target_widget
set _drag_source_widget {}
set _drop_target_widget {}
_restore_selection $path $tag
switch -exact -- $action {
move {
## Delete the original selected text...
variable _selection_first
variable _selection_last
$path delete $_selection_first $_selection_last
}
}
};# ::tkdnd::text::DragEndCmd
# ----------------------------------------------------------------------------
# Command tkdnd::text::DropPosition
# ----------------------------------------------------------------------------
proc ::tkdnd::text::DropPosition { path X Y action actions keys} {
variable _drag_source_widget
variable _drop_target_widget
set _drop_target_widget $path
## This check is primitive, a more accurate one is needed!
if {$path eq $_drag_source_widget} {
## This is a drag within the same widget! Set action to move...
if {"move" in $actions} {set action move}
}
incr X -[winfo rootx $path]
incr Y -[winfo rooty $path]
$path mark set insert @$X,$Y; update
return $action
};# ::tkdnd::text::DropPosition
# ----------------------------------------------------------------------------
# Command tkdnd::text::Drop
# ----------------------------------------------------------------------------
proc ::tkdnd::text::Drop { path data X Y action actions keys } {
incr X -[winfo rootx $path]
incr Y -[winfo rooty $path]
$path mark set insert @$X,$Y
$path insert [$path index insert] $data
return $action
};# ::tkdnd::text::Drop
# ----------------------------------------------------------------------------
# Command tkdnd::text::_save_selection
# ----------------------------------------------------------------------------
proc ::tkdnd::text::_save_selection { path tag} {
variable _drag_tag
variable _selection_first
variable _selection_last
variable _selection_tag $tag
set _selection_first [$path index $tag.first]
set _selection_last [$path index $tag.last]
$path tag add $_drag_tag $_selection_first $_selection_last
$path tag configure $_drag_tag \
-background [$path tag cget $tag -background] \
-foreground [$path tag cget $tag -foreground]
};# tkdnd::text::_save_selection
# ----------------------------------------------------------------------------
# Command tkdnd::text::_restore_selection
# ----------------------------------------------------------------------------
proc ::tkdnd::text::_restore_selection { path tag} {
variable _drag_tag
variable _selection_first
variable _selection_last
$path tag delete $_drag_tag
$path tag remove $tag 0.0 end
#$path tag add $tag $_selection_first $_selection_last
};# tkdnd::text::_restore_selection
# ----------------------------------------------------------------------------
# Command tkdnd::text::_begin_drag
# ----------------------------------------------------------------------------
proc ::tkdnd::text::_begin_drag { event button source state X Y x y } {
variable _drop_target_widget
variable _state
# puts "::tkdnd::text::_begin_drag $event $button $source $state $X $Y $x $y"
switch -exact -- $event {
clear {
switch -exact -- $_state {
press {
## Do not execute other bindings, as they will erase selection...
return -code break
}
}
set _state clear
}
motion {
variable _now_dragging
if {$_now_dragging} {return -code break}
if { [string equal $_state "press"] } {
variable _x0; variable _y0
if { abs($_x0-$X) > ${::tkdnd::_dx} || abs($_y0-$Y) > ${::tkdnd::_dy} } {
set _state "done"
set _drop_target_widget {}
set _now_dragging 1
set code [catch {
::tkdnd::_init_drag $button $source $state $X $Y $x $y
} info options]
set _drop_target_widget {}
set _now_dragging 0
if {$code != 0} {
## Something strange occurred...
return -options $options $info
}
}
return -code break
}
set _state clear
}
press {
variable _x0; variable _y0
set _x0 $X
set _y0 $Y
set _state "press"
}
reset {
set _state {}
}
}
if {$source eq $_drop_target_widget} {return -code break}
return -code continue
};# tkdnd::text::_begin_drag
proc tkdnd::text::_TextAutoScan {w x y} {
variable _now_dragging
if {$_now_dragging} {return -code break}
return -code continue
};# tkdnd::text::_TextAutoScan