I am uploading the old code to start updating it and keep track of the changes.

This commit is contained in:
Victor Santiago
2017-11-30 21:25:25 -06:00
parent 49dea2850b
commit 7287407014
13 changed files with 2687 additions and 0 deletions

0
modules/__init__.py Normal file
View File

View File

@@ -0,0 +1,6 @@
#
# Tcl package index file
#
package ifneeded tkdnd 2.6 \
"source \{$dir/tkdnd.tcl\} ; \
tkdnd::initialise \{$dir\} tkdnd26.dll tkdnd"

418
modules/tkdnd2.6/tkdnd.tcl Normal file
View File

@@ -0,0 +1,418 @@
#
# tkdnd.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 Tk
namespace eval tkdnd {
variable _topw ".drag"
variable _tabops
variable _state
variable _x0
variable _y0
variable _platform_namespace
variable _drop_file_temp_dir
variable _auto_update 1
variable _windowingsystem
bind TkDND_Drag1 <ButtonPress-1> {tkdnd::_begin_drag press 1 %W %s %X %Y}
bind TkDND_Drag1 <B1-Motion> {tkdnd::_begin_drag motion 1 %W %s %X %Y}
bind TkDND_Drag2 <ButtonPress-2> {tkdnd::_begin_drag press 2 %W %s %X %Y}
bind TkDND_Drag2 <B2-Motion> {tkdnd::_begin_drag motion 2 %W %s %X %Y}
bind TkDND_Drag3 <ButtonPress-3> {tkdnd::_begin_drag press 3 %W %s %X %Y}
bind TkDND_Drag3 <B3-Motion> {tkdnd::_begin_drag motion 3 %W %s %X %Y}
# ----------------------------------------------------------------------------
# Command tkdnd::initialise: Initialise the TkDND package.
# ----------------------------------------------------------------------------
proc initialise { dir PKG_LIB_FILE PACKAGE_NAME} {
variable _platform_namespace
variable _drop_file_temp_dir
variable _windowingsystem
global env
switch [tk windowingsystem] {
x11 {
set _windowingsystem x11
}
win32 -
windows {
set _windowingsystem windows
}
aqua {
set _windowingsystem aqua
}
default {
error "unknown Tk windowing system"
}
}
## Get User's home directory: We try to locate the proper path from a set of
## environmental variables...
foreach var {HOME HOMEPATH USERPROFILE ALLUSERSPROFILE APPDATA} {
if {[info exists env($var)]} {
if {[file isdirectory $env($var)]} {
set UserHomeDir $env($var)
break
}
}
}
## Should use [tk windowingsystem] instead of tcl platform array:
## OS X returns "unix," but that's not useful because it has its own
## windowing system, aqua
## Under windows we have to also combine HOMEDRIVE & HOMEPATH...
if {![info exists UserHomeDir] &&
[string equal $_windowingsystem windows] &&
[info exists env(HOMEDRIVE)] && [info exists env(HOMEPATH)]} {
if {[file isdirectory $env(HOMEDRIVE)$env(HOMEPATH)]} {
set UserHomeDir $env(HOMEDRIVE)$env(HOMEPATH)
}
}
## Have we located the needed path?
if {![info exists UserHomeDir]} {
set UserHomeDir [pwd]
}
set UserHomeDir [file normalize $UserHomeDir]
## Try to locate a temporary directory...
foreach var {TKDND_TEMP_DIR TEMP TMP} {
if {[info exists env($var)]} {
if {[file isdirectory $env($var)] && [file writable $env($var)]} {
set _drop_file_temp_dir $env($var)
break
}
}
}
if {![info exists _drop_file_temp_dir]} {
foreach _dir [list "$UserHomeDir/Local Settings/Temp" \
"$UserHomeDir/AppData/Local/Temp" \
/tmp \
C:/WINDOWS/Temp C:/Temp C:/tmp \
D:/WINDOWS/Temp D:/Temp D:/tmp] {
if {[file isdirectory $_dir] && [file writable $_dir]} {
set _drop_file_temp_dir $_dir
break
}
}
}
if {![info exists _drop_file_temp_dir]} {
set _drop_file_temp_dir $UserHomeDir
}
set _drop_file_temp_dir [file native $_drop_file_temp_dir]
switch $_windowingsystem {
x11 {
source $dir/tkdnd_unix.tcl
set _platform_namespace xdnd
}
win32 -
windows {
source $dir/tkdnd_windows.tcl
set _platform_namespace olednd
}
aqua {
source $dir/tkdnd_unix.tcl
source $dir/tkdnd_macosx.tcl
set _platform_namespace macdnd
}
default {
error "unknown Tk windowing system"
}
}
load $dir/$PKG_LIB_FILE $PACKAGE_NAME
source $dir/tkdnd_compat.tcl
};# initialise
proc GetDropFileTempDirectory { } {
variable _drop_file_temp_dir
return $_drop_file_temp_dir
}
proc SetDropFileTempDirectory { dir } {
variable _drop_file_temp_dir
set _drop_file_temp_dir $dir
}
};# namespace tkdnd
# ----------------------------------------------------------------------------
# Command tkdnd::drag_source
# ----------------------------------------------------------------------------
proc tkdnd::drag_source { mode path { types {} } { event 1 } } {
set tags [bindtags $path]
set idx [lsearch $tags "TkDND_Drag*"]
switch -- $mode {
register {
if { $idx != -1 } {
bindtags $path [lreplace $tags $idx $idx TkDND_Drag$event]
} else {
bindtags $path [concat $tags TkDND_Drag$event]
}
set types [platform_specific_types $types]
set old_types [bind $path <<DragSourceTypes>>]
foreach type $types {
if {[lsearch $old_types $type] < 0} {lappend old_types $type}
}
bind $path <<DragSourceTypes>> $old_types
}
unregister {
if { $idx != -1 } {
bindtags $path [lreplace $tags $idx $idx]
}
}
}
};# tkdnd::drag_source
# ----------------------------------------------------------------------------
# Command tkdnd::drop_target
# ----------------------------------------------------------------------------
proc tkdnd::drop_target { mode path { types {} } } {
variable _windowingsystem
set types [platform_specific_types $types]
switch -- $mode {
register {
switch $_windowingsystem {
x11 {
_register_types $path [winfo toplevel $path] $types
}
win32 -
windows {
_RegisterDragDrop $path
bind <Destroy> $path {+ tkdnd::_RevokeDragDrop %W}
}
aqua {
macdnd::registerdragwidget [winfo toplevel $path] $types
}
default {
error "unknown Tk windowing system"
}
}
set old_types [bind $path <<DropTargetTypes>>]
set new_types {}
foreach type $types {
if {[lsearch -exact $old_types $type] < 0} {lappend new_types $type}
}
if {[llength $new_types]} {
bind $path <<DropTargetTypes>> [concat $old_types $new_types]
}
}
unregister {
switch $_windowingsystem {
x11 {
}
win32 -
windows {
_RevokeDragDrop $path
}
aqua {
error todo
}
default {
error "unknown Tk windowing system"
}
}
bind $path <<DropTargetTypes>> {}
}
}
};# tkdnd::drop_target
# ----------------------------------------------------------------------------
# Command tkdnd::_begin_drag
# ----------------------------------------------------------------------------
proc tkdnd::_begin_drag { event button source state X Y } {
variable _x0
variable _y0
variable _state
switch -- $event {
press {
set _x0 $X
set _y0 $Y
set _state "press"
}
motion {
if { ![info exists _state] } {
# This is just extra protection. There seem to be
# rare cases where the motion comes before the press.
return
}
if { [string equal $_state "press"] } {
if { abs($_x0-$X) > 3 || abs($_y0-$Y) > 3 } {
set _state "done"
_init_drag $button $source $state $X $Y
}
}
}
}
};# tkdnd::_begin_drag
# ----------------------------------------------------------------------------
# Command tkdnd::_init_drag
# ----------------------------------------------------------------------------
proc tkdnd::_init_drag { button source state rootX rootY } {
# Call the <<DragInitCmd>> binding.
set cmd [bind $source <<DragInitCmd>>]
if {[string length $cmd]} {
set cmd [string map [list %W $source %X $rootX %Y $rootY \
%S $state %e <<DragInitCmd>> %A \{\} \
%t [bind $source <<DragSourceTypes>>]] $cmd]
set info [uplevel \#0 $cmd]
if { $info != "" } {
variable _windowingsystem
foreach { actions types data } $info { break }
set types [platform_specific_types $types]
set action refuse_drop
switch $_windowingsystem {
x11 {
set action [xdnd::_dodragdrop $source $actions $types $data $button]
}
win32 -
windows {
set action [_DoDragDrop $source $actions $types $data $button]
}
aqua {
set action [macdnd::dodragdrop $source $actions $types $data]
}
default {
error "unknown Tk windowing system"
}
}
## Call _end_drag to notify the widget of the result of the drag
## operation...
_end_drag $button $source {} $action {} $data {} $state $rootX $rootY
}
}
};# tkdnd::_init_drag
# ----------------------------------------------------------------------------
# Command tkdnd::_end_drag
# ----------------------------------------------------------------------------
proc tkdnd::_end_drag { button source target action type data result
state rootX rootY } {
set rootX 0
set rootY 0
# Call the <<DragEndCmd>> binding.
set cmd [bind $source <<DragEndCmd>>]
if {[string length $cmd]} {
set cmd [string map [list %W $source %X $rootX %Y $rootY \
%S $state %e <<DragEndCmd>> %A \{$action\}] $cmd]
set info [uplevel \#0 $cmd]
if { $info != "" } {
variable _windowingsystem
foreach { actions types data } $info { break }
set types [platform_specific_types $types]
switch $_windowingsystem {
x11 {
error "dragging from Tk widgets not yet supported"
}
win32 -
windows {
set action [_DoDragDrop $source $actions $types $data $button]
}
aqua {
macdnd::dodragdrop $source $actions $types $data
}
default {
error "unknown Tk windowing system"
}
}
## Call _end_drag to notify the widget of the result of the drag
## operation...
_end_drag $button $source {} $action {} $data {} $state $rootX $rootY
}
}
};# tkdnd::_end_drag
# ----------------------------------------------------------------------------
# Command tkdnd::platform_specific_types
# ----------------------------------------------------------------------------
proc tkdnd::platform_specific_types { types } {
variable _platform_namespace
return [${_platform_namespace}::_platform_specific_types $types]
}; # tkdnd::platform_specific_types
# ----------------------------------------------------------------------------
# Command tkdnd::platform_independent_types
# ----------------------------------------------------------------------------
proc tkdnd::platform_independent_types { types } {
variable _platform_namespace
return [${_platform_namespace}::_platform_independent_types $types]
}; # tkdnd::platform_independent_types
# ----------------------------------------------------------------------------
# Command tkdnd::platform_specific_type
# ----------------------------------------------------------------------------
proc tkdnd::platform_specific_type { type } {
variable _platform_namespace
return [${_platform_namespace}::_platform_specific_type $type]
}; # tkdnd::platform_specific_type
# ----------------------------------------------------------------------------
# Command tkdnd::platform_independent_type
# ----------------------------------------------------------------------------
proc tkdnd::platform_independent_type { type } {
variable _platform_namespace
return [${_platform_namespace}::_platform_independent_type $type]
}; # tkdnd::platform_independent_type
# ----------------------------------------------------------------------------
# Command tkdnd::bytes_to_string
# ----------------------------------------------------------------------------
proc tkdnd::bytes_to_string { bytes } {
set string {}
foreach byte $bytes {
append string [binary format c $byte]
}
return $string
};# tkdnd::bytes_to_string
# ----------------------------------------------------------------------------
# Command tkdnd::urn_unquote
# ----------------------------------------------------------------------------
proc tkdnd::urn_unquote {url} {
set result ""
set start 0
while {[regexp -start $start -indices {%[0-9a-fA-F]{2}} $url match]} {
foreach {first last} $match break
append result [string range $url $start [expr {$first - 1}]]
append result [format %c 0x[string range $url [incr first] $last]]
set start [incr last]
}
append result [string range $url $start end]
return $result
};# tkdnd::urn_unquote

View File

@@ -0,0 +1,159 @@
#
# tkdnd_compat.tcl --
#
# This file implements some utility procedures, to support older versions
# of 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.
#
namespace eval compat {
};# namespace compat
# ----------------------------------------------------------------------------
# Command ::dnd
# ----------------------------------------------------------------------------
proc ::dnd {method window args} {
switch $method {
bindtarget {
switch [llength $args] {
0 {return [tkdnd::compat::bindtarget0 $window]}
1 {return [tkdnd::compat::bindtarget1 $window [lindex $args 0]]}
2 {return [tkdnd::compat::bindtarget2 $window [lindex $args 0] \
[lindex $args 1]]}
3 {return [tkdnd::compat::bindtarget3 $window [lindex $args 0] \
[lindex $args 1] [lindex $args 2]]}
4 {return [tkdnd::compat::bindtarget4 $window [lindex $args 0] \
[lindex $args 1] [lindex $args 2] [lindex $args 3]]}
}
}
cleartarget {
return [tkdnd::compat::cleartarget $window]
}
bindsource {
switch [llength $args] {
0 {return [tkdnd::compat::bindsource0 $window]}
1 {return [tkdnd::compat::bindsource1 $window [lindex $args 0]]}
2 {return [tkdnd::compat::bindsource2 $window [lindex $args 0] \
[lindex $args 1]]}
3 {return [tkdnd::compat::bindsource3 $window [lindex $args 0] \
[lindex $args 1] [lindex $args 2]]}
}
}
clearsource {
return [tkdnd::compat::clearsource $window]
}
drag {
return [tkdnd::_init_drag $window "press" 0 0]
}
}
error "invalid number of arguments!"
};# ::dnd
# ----------------------------------------------------------------------------
# Command compat::bindtarget
# ----------------------------------------------------------------------------
proc compat::bindtarget0 {window} {
return [bind $window <<DropTargetTypes>>]
};# compat::bindtarget0
proc compat::bindtarget1 {window type} {
return [bindtarget2 $window $type <Drop>]
};# compat::bindtarget1
proc compat::bindtarget2 {window type event} {
switch $event {
<DragEnter> {return [bind $window <<DropEnter>>]}
<Drag> {return [bind $window <<DropPosition>>]}
<DragLeave> {return [bind $window <<DropLeave>>]}
<Drop> {return [bind $window <<Drop>>]}
}
};# compat::bindtarget2
proc compat::bindtarget3 {window type event script} {
set type [normalise_type $type]
::tkdnd::drop_target register $window [list $type]
switch $event {
<DragEnter> {return [bind $window <<DropEnter>> $script]}
<Drag> {return [bind $window <<DropPosition>> $script]}
<DragLeave> {return [bind $window <<DropLeave>> $script]}
<Drop> {return [bind $window <<Drop>> $script]}
}
};# compat::bindtarget3
proc compat::bindtarget4 {window type event script priority} {
return [bindtarget3 $window $type $event $script]
};# compat::bindtarget4
proc compat::normalise_type { type } {
switch $type {
text/plain -
{text/plain;charset=UTF-8} -
Text {return DND_Text}
text/uri-list -
Files {return DND_Files}
default {return $type}
}
};# compat::normalise_type
# ----------------------------------------------------------------------------
# Command compat::bindsource
# ----------------------------------------------------------------------------
proc compat::bindsource0 {window} {
return [bind $window <<DropTargetTypes>>]
};# compat::bindsource0
proc compat::bindsource1 {window type} {
return [bindsource2 $window $type <Drop>]
};# compat::bindsource1
proc compat::bindsource2 {window type script} {
::tkdnd::drag_source register $window $type 2
bind $window <<DragInitCmd>> "list {copy} %t \[$script\]"
};# compat::bindsource2
proc compat::bindsource3 {window type script priority} {
return [bindsource2 $window $type $script]
};# compat::bindsource3
# ----------------------------------------------------------------------------
# Command compat::cleartarget
# ----------------------------------------------------------------------------
proc compat::cleartarget {window} {
};# compat::cleartarget
# ----------------------------------------------------------------------------
# Command compat::clearsource
# ----------------------------------------------------------------------------
proc compat::clearsource {window} {
};# compat::clearsource

View File

@@ -0,0 +1,170 @@
#
# tkdnd_macosx.tcl --
#
# This file implements some utility procedures that are used by the TkDND
# package.
# This software is copyrighted by:
# Georgios Petasis, Athens, Greece.
# e-mail: petasisg@yahoo.gr, petasis@iit.demokritos.gr
#
# Mac portions (c) 2009 Kevin Walzer/WordTech Communications LLC,
# kw@codebykevin.com
#
#
# 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.
#
#basic API for Mac Drag and Drop
#two data types supported: strings and file paths
#two commands at C level: ::tkdnd::macdnd::registerdragwidget, ::tkdnd::macdnd::unregisterdragwidget
#data retrieval mechanism: text or file paths are copied from drag clipboard to system clipboard and retrieved via [clipboard get]; array of file paths is converted to single tab-separated string, can be split into Tcl list
if {[tk windowingsystem] eq "aqua" && "AppKit" ni [winfo server .]} {
error {TkAqua Cocoa required}
}
namespace eval macdnd {
variable _dropped_data
};# namespace macdnd
# ----------------------------------------------------------------------------
# Command macdnd::_HandleEnter
# ----------------------------------------------------------------------------
proc macdnd::_HandleEnter { path drag_source typelist } {
return [::tkdnd::xdnd::_HandleXdndEnter $path $drag_source $typelist]
};# macdnd::_HandleEnter
# ----------------------------------------------------------------------------
# Command macdnd::_HandlePosition
# ----------------------------------------------------------------------------
proc macdnd::_HandlePosition { drop_target rootX rootY } {
return [::tkdnd::xdnd::_HandleXdndPosition $drop_target $rootX $rootY]
};# macdnd::_HandlePosition
# ----------------------------------------------------------------------------
# Command macdnd::_HandleLeave
# ----------------------------------------------------------------------------
proc macdnd::_HandleLeave { args } {
return [::tkdnd::xdnd::_HandleXdndLeave]
};# macdnd::_HandleLeave
# ----------------------------------------------------------------------------
# Command macdnd::_HandleDrop
# ----------------------------------------------------------------------------
proc macdnd::_HandleDrop { drop_target data args } {
variable _dropped_data
set _dropped_data $data
return [::tkdnd::xdnd::_HandleXdndDrop 0]
};# macdnd::_HandleDrop
# ----------------------------------------------------------------------------
# Command macdnd::_GetDroppedData
# ----------------------------------------------------------------------------
proc macdnd::_GetDroppedData { time } {
variable _dropped_data
return $_dropped_data
};# macdnd::_GetDroppedData
proc xdnd::_GetDroppedData { time } {
return [::tkdnd::macdnd::_GetDroppedData $time]
};# xdnd::_GetDroppedData
# ----------------------------------------------------------------------------
# Command macdnd::_GetDragSource
# ----------------------------------------------------------------------------
proc macdnd::_GetDragSource { } {
return [::tkdnd::xdnd::_GetDragSource]
};# macdnd::_GetDragSource
# ----------------------------------------------------------------------------
# Command macdnd::_GetDropTarget
# ----------------------------------------------------------------------------
proc macdnd::_GetDropTarget { } {
return [::tkdnd::xdnd::_GetDropTarget]
};# macdnd::_GetDropTarget
# ----------------------------------------------------------------------------
# Command macdnd::_supported_types
# ----------------------------------------------------------------------------
proc macdnd::_supported_types { types } {
return [::tkdnd::xdnd::_supported_types $types]
}; # macdnd::_supported_types
# ----------------------------------------------------------------------------
# Command macdnd::_platform_specific_types
# ----------------------------------------------------------------------------
proc macdnd::_platform_specific_types { types } {
return [::tkdnd::xdnd::_platform_specific_types $types]
}; # macdnd::_platform_specific_types
# ----------------------------------------------------------------------------
# Command macdnd::_normalise_data
# ----------------------------------------------------------------------------
proc macdnd::_normalise_data { type data } {
return [::tkdnd::xdnd::_normalise_data $type $data]
}; # macdnd::_normalise_data
# ----------------------------------------------------------------------------
# Command macdnd::_platform_specific_type
# ----------------------------------------------------------------------------
proc macdnd::_platform_specific_type { type } {
switch $type {
DND_Text {return [list NSStringPboardType]}
DND_Files {return [list NSFilenamesPboardType]}
default {return [list $type]}
}
}; # macdnd::_platform_specific_type
proc xdnd::_platform_specific_type { type } {
return [::tkdnd::macdnd::_platform_specific_type $type]
}; # xdnd::_platform_specific_type
# ----------------------------------------------------------------------------
# Command macdnd::_platform_independent_type
# ----------------------------------------------------------------------------
proc macdnd::_platform_independent_type { type } {
switch $type {
NSStringPboardType {return DND_Text}
NSFilenamesPboardType {return DND_Files}
default {return [list $type]}
}
}; # macdnd::_platform_independent_type
proc xdnd::_platform_independent_type { type } {
return [::tkdnd::macdnd::_platform_independent_type $type]
}; # xdnd::_platform_independent_type
# ----------------------------------------------------------------------------
# Command macdnd::_supported_type
# ----------------------------------------------------------------------------
proc macdnd::_supported_type { type } {
return 1
}; # macdnd::_supported_type
proc xdnd::_supported_type { type } {
return [::tkdnd::macdnd::_supported_type $type]
}; # xdnd::_supported_type

File diff suppressed because it is too large Load Diff

View File

@@ -0,0 +1,360 @@
#
# tkdnd_windows.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.
#
namespace eval olednd {
variable _types {}
variable _typelist {}
variable _codelist {}
variable _actionlist {}
variable _pressedkeys {}
variable _action {}
variable _common_drag_source_types {}
variable _common_drop_target_types {}
variable _unhandled_types {}
};# namespace olednd
# ----------------------------------------------------------------------------
# Command olednd::_HandleDragEnter
# ----------------------------------------------------------------------------
proc olednd::_HandleDragEnter { drop_target typelist actionlist pressedkeys
rootX rootY codelist } {
variable _typelist; set _typelist $typelist
variable _codelist; set _codelist $codelist
variable _actionlist; set _actionlist $actionlist
variable _pressedkeys; set _pressedkeys $pressedkeys
variable _action; set _action {}
variable _common_drag_source_types; set _common_drag_source_types {}
variable _common_drop_target_types; set _common_drop_target_types {}
# puts "olednd::_HandleDragEnter: drop_target=$drop_target,\
# typelist=$typelist, actionlist=$actionlist,\
# pressedkeys=$pressedkeys, rootX=$rootX, rootY=$rootY"
focus $drop_target
## Does the new drop target support any of our new types?
variable _types; set _types [bind $drop_target <<DropTargetTypes>>]
if {[llength $_types]} {
## Examine the drop target types, to find at least one match with the drag
## source types...
set supported_types [_supported_types $_typelist]
foreach type $_types {
foreach matched [lsearch -glob -all -inline $supported_types $type] {
## Drop target supports this type.
lappend common_drag_source_types $matched
lappend common_drop_target_types $type
}
}
}
set _action refuse_drop
if {[info exists common_drag_source_types]} {
set _action copy
set _common_drag_source_types $common_drag_source_types
set _common_drop_target_types $common_drop_target_types
## Drop target supports at least one type. Send a <<DropEnter>>.
set cmd [bind $drop_target <<DropEnter>>]
if {[string length $cmd]} {
set cmd [string map [list %W $drop_target %X $rootX %Y $rootY \
%CST \{$_common_drag_source_types\} \
%CTT \{$_common_drop_target_types\} \
%ST \{$_typelist\} %TT \{$_types\} \
%A $_action %a \{$_actionlist\} \
%b \{$_pressedkeys\} %m \{$_pressedkeys\} \
%D \{\} %e <<DropEnter>> \
%L \{$_typelist\} %% % \
%t \{$_typelist\} %T \{[lindex $_common_drag_source_types 0]\} \
%c \{$_codelist\} %C \{[lindex $_codelist 0]\} \
] $cmd]
set _action [uplevel \#0 $cmd]
}
}
if {$::tkdnd::_auto_update} {update}
# Return values: copy, move, link, ask, private, refuse_drop, default
return $_action
};# olednd::_HandleDragEnter
# ----------------------------------------------------------------------------
# Command olednd::_HandleDragOver
# ----------------------------------------------------------------------------
proc olednd::_HandleDragOver { drop_target pressedkeys rootX rootY } {
variable _types
variable _typelist
variable _codelist
variable _actionlist
variable _pressedkeys
variable _action
variable _common_drag_source_types
variable _common_drop_target_types
# puts "olednd::_HandleDragOver: drop_target=$drop_target,\
# pressedkeys=$pressedkeys, rootX=$rootX, rootY=$rootY"
if {![llength $_common_drag_source_types]} {return refuse_drop}
set _pressedkeys $pressedkeys
set cmd [bind $drop_target <<DropPosition>>]
if {[string length $cmd]} {
set cmd [string map [list %W $drop_target %X $rootX %Y $rootY \
%CST \{$_common_drag_source_types\} \
%CTT \{$_common_drop_target_types\} \
%ST \{$_typelist\} %TT \{$_types\} \
%A $_action %a \{$_actionlist\} \
%b \{$_pressedkeys\} %m \{$_pressedkeys\} \
%D \{\} %e <<DropPosition>> \
%L \{$_typelist\} %% % \
%t \{$_typelist\} %T \{[lindex $_common_drag_source_types 0]\} \
%c \{$_codelist\} %C \{[lindex $_codelist 0]\} \
] $cmd]
set _action [uplevel \#0 $cmd]
}
if {$::tkdnd::_auto_update} {update}
# Return values: copy, move, link, ask, private, refuse_drop, default
return $_action
};# olednd::_HandleDragOver
# ----------------------------------------------------------------------------
# Command olednd::_HandleDragLeave
# ----------------------------------------------------------------------------
proc olednd::_HandleDragLeave { drop_target } {
variable _types
variable _typelist
variable _codelist
variable _actionlist
variable _pressedkeys
variable _action
variable _common_drag_source_types
variable _common_drop_target_types
if {![llength $_common_drag_source_types]} {return}
foreach var {_types _typelist _actionlist _pressedkeys _action
_common_drag_source_types _common_drop_target_types} {
set $var {}
}
set cmd [bind $drop_target <<DropLeave>>]
if {[string length $cmd]} {
set cmd [string map [list %W $drop_target %X 0 %Y 0 \
%CST \{$_common_drag_source_types\} \
%CTT \{$_common_drop_target_types\} \
%ST \{$_typelist\} %TT \{$_types\} \
%A \{$_action\} %a \{$_actionlist\} \
%b \{$_pressedkeys\} %m \{$_pressedkeys\} \
%D \{\} %e <<DropLeave>> \
%L \{$_typelist\} %% % \
%t \{$_typelist\} %T \{[lindex $_common_drag_source_types 0]\} \
%u \{$_codelist\} %C \{[lindex $_codelist 0]\} \
] $cmd]
set _action [uplevel \#0 $cmd]
}
if {$::tkdnd::_auto_update} {update}
};# olednd::_HandleDragLeave
# ----------------------------------------------------------------------------
# Command olednd::_HandleXdndDrop
# ----------------------------------------------------------------------------
proc olednd::_HandleDrop { drop_target pressedkeys rootX rootY _type data } {
variable _types
variable _typelist
variable _codelist
variable _actionlist
variable _pressedkeys
variable _action
variable _common_drag_source_types
variable _common_drop_target_types
set data [_normalise_data $_type $data]
# puts "olednd::_HandleDrop: drop_target=$drop_target,\
# pressedkeys=$pressedkeys, rootX=$rootX, rootY=$rootY,\
# data=\"$data\""
if {![llength $_common_drag_source_types]} {return refuse_drop}
set _pressedkeys $pressedkeys
## Try to select the most specific <<Drop>> event.
foreach type [concat $_common_drag_source_types $_common_drop_target_types] {
set type [_platform_independent_type $type]
set cmd [bind $drop_target <<Drop:$type>>]
if {[string length $cmd]} {
set cmd [string map [list %W $drop_target %X $rootX %Y $rootY \
%CST \{$_common_drag_source_types\} \
%CTT \{$_common_drop_target_types\} \
%ST \{$_typelist\} %TT \{$_types\} \
%A $_action %a \{$_actionlist\} \
%b \{$_pressedkeys\} %m \{$_pressedkeys\} \
%D [list $data] %e <<Drop:$type>> \
%L \{$_typelist\} %% % \
%t \{$_typelist\} %T \{[lindex $_common_drag_source_types 0]\} \
%c \{$_codelist\} %C \{[lindex $_codelist 0]\} \
] $cmd]
return [uplevel \#0 $cmd]
}
}
set cmd [bind $drop_target <<Drop>>]
if {[string length $cmd]} {
set cmd [string map [list %W $drop_target %X $rootX %Y $rootY \
%CST \{$_common_drag_source_types\} \
%CTT \{$_common_drop_target_types\} \
%ST \{$_typelist\} %TT \{$_types\} \
%A $_action %a \{$_actionlist\} \
%b \{$_pressedkeys\} %m \{$_pressedkeys\} \
%D [list $data] %e <<Drop>> \
%L \{$_typelist\} %% % \
%t \{$_typelist\} %T \{[lindex $_common_drag_source_types 0]\} \
%c \{$_codelist\} %C \{[lindex $_codelist 0]\} \
] $cmd]
set _action [uplevel \#0 $cmd]
}
if {$::tkdnd::_auto_update} {update}
# Return values: copy, move, link, ask, private, refuse_drop
return $_action
};# olednd::_HandleXdndDrop
# ----------------------------------------------------------------------------
# Command olednd::_GetDropTypes
# ----------------------------------------------------------------------------
proc olednd::_GetDropTypes { drop_target } {
variable _common_drag_source_types
return $_common_drag_source_types
};# olednd::_GetDropTypes
# ----------------------------------------------------------------------------
# Command olednd::_GetDroppedData
# ----------------------------------------------------------------------------
proc olednd::_GetDroppedData { } {
variable _drop_target
return [selection get -displayof $_drop_target \
-selection XdndSelection -type STRING]
};# olednd::_GetDroppedData
# ----------------------------------------------------------------------------
# Command olednd::_GetDragSource
# ----------------------------------------------------------------------------
proc olednd::_GetDragSource { } {
variable _drag_source
return $_drag_source
};# olednd::_GetDragSource
# ----------------------------------------------------------------------------
# Command olednd::_GetDropTarget
# ----------------------------------------------------------------------------
proc olednd::_GetDropTarget { } {
variable _drop_target
return [winfo id $_drop_target]
};# olednd::_GetDropTarget
# ----------------------------------------------------------------------------
# Command olednd::_supported_types
# ----------------------------------------------------------------------------
proc olednd::_supported_types { types } {
set new_types {}
foreach type $types {
if {[_supported_type $type]} {lappend new_types $type}
}
return $new_types
}; # olednd::_supported_types
# ----------------------------------------------------------------------------
# Command olednd::_platform_specific_types
# ----------------------------------------------------------------------------
proc olednd::_platform_specific_types { types } {
set new_types {}
foreach type $types {
set new_types [concat $new_types [_platform_specific_type $type]]
}
return $new_types
}; # olednd::_platform_specific_types
# ----------------------------------------------------------------------------
# Command olednd::_platform_independent_types
# ----------------------------------------------------------------------------
proc olednd::_platform_independent_types { types } {
set new_types {}
foreach type $types {
set new_types [concat $new_types [_platform_independent_type $type]]
}
return $new_types
}; # olednd::_platform_independent_types
# ----------------------------------------------------------------------------
# Command olednd::_normalise_data
# ----------------------------------------------------------------------------
proc olednd::_normalise_data { type data } {
switch $type {
CF_HDROP {return $data}
DND_Text {return [list CF_UNICODETEXT CF_TEXT]}
DND_Files {return [list CF_HDROP]}
default {return $data}
}
}; # olednd::_normalise_data
# ----------------------------------------------------------------------------
# Command olednd::_platform_specific_type
# ----------------------------------------------------------------------------
proc olednd::_platform_specific_type { type } {
switch $type {
DND_Text {return [list CF_UNICODETEXT CF_TEXT]}
DND_Files {return [list CF_HDROP]}
default {
# variable _unhandled_types
# if {[lsearch -exact $_unhandled_types $type] == -1} {
# lappend _unhandled_types $type
# }
return [list $type]}
}
}; # olednd::_platform_specific_type
# ----------------------------------------------------------------------------
# Command olednd::_platform_independent_type
# ----------------------------------------------------------------------------
proc olednd::_platform_independent_type { type } {
switch $type {
CF_UNICODETEXT - CF_TEXT {return DND_Text}
CF_HDROP {return DND_Files}
default {return [list $type]}
}
}; # olednd::_platform_independent_type
# ----------------------------------------------------------------------------
# Command olednd::_supported_type
# ----------------------------------------------------------------------------
proc olednd::_supported_type { type } {
# return 1;
switch $type {
CF_UNICODETEXT - CF_TEXT -
FileGroupDescriptor - FileGroupDescriptorW -
CF_HDROP {return 1}
}
# Is the type in our known, but unhandled types?
variable _unhandled_types
if {[lsearch -exact $_unhandled_types $type] != -1} {return 1}
return 0
}; # olednd::_supported_type

View File

@@ -0,0 +1,97 @@
import os
import Tkinter
def _load_tkdnd(master):
tkdndlib = os.environ.get('TKDND_LIBRARY')
if tkdndlib:
master.tk.eval('global auto_path; lappend auto_path {%s}' % tkdndlib)
master.tk.eval('package require tkdnd')
master._tkdnd_loaded = True
class TkDND(object):
def __init__(self, master):
if not getattr(master, '_tkdnd_loaded', False):
_load_tkdnd(master)
self.master = master
self.tk = master.tk
# Available pre-defined values for the 'dndtype' parameter:
# text/plain
# text/plain;charset=UTF-8
# text/uri-list
def bindtarget(self, window, callback, dndtype, event='<Drop>', priority=50):
cmd = self._prepare_tkdnd_func(callback)
return self.tk.call('dnd', 'bindtarget', window, dndtype, event,
cmd, priority)
def bindtarget_query(self, window, dndtype=None, event='<Drop>'):
return self.tk.call('dnd', 'bindtarget', window, dndtype, event)
def cleartarget(self, window):
self.tk.call('dnd', 'cleartarget', window)
def bindsource(self, window, callback, dndtype, priority=50):
cmd = self._prepare_tkdnd_func(callback)
self.tk.call('dnd', 'bindsource', window, dndtype, cmd, priority)
def bindsource_query(self, window, dndtype=None):
return self.tk.call('dnd', 'bindsource', window, dndtype)
def clearsource(self, window):
self.tk.call('dnd', 'clearsource', window)
def drag(self, window, actions=None, descriptions=None,
cursorwin=None, callback=None):
cmd = None
if cursorwin is not None:
if callback is not None:
cmd = self._prepare_tkdnd_func(callback)
self.tk.call('dnd', 'drag', window, actions, descriptions,
cursorwin, cmd)
_subst_format = ('%A', '%a', '%b', '%D', '%d', '%m', '%T',
'%W', '%X', '%Y', '%x', '%y')
_subst_format_str = " ".join(_subst_format)
def _prepare_tkdnd_func(self, callback):
funcid = self.master.register(callback, self._dndsubstitute)
cmd = ('%s %s' % (funcid, self._subst_format_str))
return cmd
def _dndsubstitute(self, *args):
if len(args) != len(self._subst_format):
return args
def try_int(x):
x = str(x)
try:
return int(x)
except ValueError:
return x
A, a, b, D, d, m, T, W, X, Y, x, y = args
event = Tkinter.Event()
event.action = A # Current action of the drag and drop operation.
event.action_list = a # Action list supported by the drag source.
event.mouse_button = b # Mouse button pressed during the drag and drop.
event.data = D # The data that has been dropped.
event.descr = d # The list of descriptions.
event.modifier = m # The list of modifier keyboard keys pressed.
event.dndtype = T
event.widget = self.master.nametowidget(W)
event.x_root = X # Mouse pointer x coord, relative to the root win.
event.y_root = Y
event.x = x # Mouse pointer x coord, relative to the widget.
event.y = y
event.action_list = str(event.action_list).split()
for name in ('mouse_button', 'x', 'y', 'x_root', 'y_root'):
setattr(event, name, try_int(getattr(event, name)))
return (event, )