Attempt at fixing issue #19

tkinterdnd2/TkinterDnD.py

@@ -0,0 +1,292 @@
+'''Python wrapper for the tkdnd tk extension.
+
+The tkdnd extension provides an interface to native, platform specific
+drag and drop mechanisms. Under Unix the drag & drop protocol in use is
+the XDND protocol version 5 (also used by the Qt toolkit, and the KDE and
+GNOME desktops). Under Windows, the OLE2 drag & drop interfaces are used.
+Under Macintosh, the Cocoa drag and drop interfaces are used.
+
+Once the TkinterDnD2 package is installed, it is safe to do:
+
+from TkinterDnD2 import *
+
+This will add the classes TkinterDnD.Tk and TkinterDnD.TixTk to the global
+namespace, plus the following constants:
+PRIVATE, NONE, ASK, COPY, MOVE, LINK, REFUSE_DROP,
+DND_TEXT, DND_FILES, DND_ALL, CF_UNICODETEXT, CF_TEXT, CF_HDROP,
+FileGroupDescriptor, FileGroupDescriptorW
+
+Drag and drop for the application can then be enabled by using one of the
+classes TkinterDnD.Tk() or (in case the tix extension shall be used)
+TkinterDnD.TixTk() as application main window instead of a regular
+tkinter.Tk() window. This will add the drag-and-drop specific methods to the
+Tk window and all its descendants.
+'''
+
+try:
+    import Tkinter as tkinter
+    import Tix as tix
+except ImportError:
+    import tkinter
+    from tkinter import tix
+
+TkdndVersion = None
+
+def _require(tkroot):
+    '''Internal function.'''
+    global TkdndVersion
+    try:
+        import os.path
+        import platform
+
+        if platform.system()=="Darwin":
+            tkdnd_platform_rep = "osx64"
+        elif platform.system()=="Linux":
+            tkdnd_platform_rep = "linux64"
+        elif platform.system()=="Windows":
+            tkdnd_platform_rep = "win64"
+        else:
+            raise RuntimeError('Plaform not supported.')
+        
+        module_path = os.path.join(os.path.dirname(__file__), 'tkdnd', tkdnd_platform_rep)
+        tkroot.tk.call('lappend', 'auto_path', module_path)
+        TkdndVersion = tkroot.tk.call('package', 'require', 'tkdnd')
+    except tkinter.TclError:
+        raise RuntimeError('Unable to load tkdnd library.')
+    return TkdndVersion
+
+class DnDEvent:
+    """Internal class.
+    Container for the properties of a drag-and-drop event, similar to a
+    normal tkinter.Event.
+    An instance of the DnDEvent class has the following attributes:
+        action (string)
+        actions (tuple)
+        button (int)
+        code (string)
+        codes (tuple)
+        commonsourcetypes (tuple)
+        commontargettypes (tuple)
+        data (string)
+        name (string)
+        types (tuple)
+        modifiers (tuple)
+        supportedsourcetypes (tuple)
+        sourcetypes (tuple)
+        type (string)
+        supportedtargettypes (tuple)
+        widget (widget instance)
+        x_root (int)
+        y_root (int)
+    Depending on the type of DnD event however, not all attributes may be set.
+    """
+    pass
+
+class DnDWrapper:
+    '''Internal class.'''
+    # some of the percent substitutions need to be enclosed in braces
+    # so we can use splitlist() to convert them into tuples
+    _subst_format_dnd = ('%A', '%a', '%b', '%C', '%c', '{%CST}',
+                         '{%CTT}', '%D', '%e', '{%L}', '{%m}', '{%ST}',
+                         '%T', '{%t}', '{%TT}', '%W', '%X', '%Y')
+    _subst_format_str_dnd = " ".join(_subst_format_dnd)
+    tkinter.BaseWidget._subst_format_dnd = _subst_format_dnd
+    tkinter.BaseWidget._subst_format_str_dnd = _subst_format_str_dnd
+
+    def _substitute_dnd(self, *args):
+        """Internal function."""
+        if len(args) != len(self._subst_format_dnd):
+            return args
+        def getint_event(s):
+            try:
+                return int(s)
+            except ValueError:
+                return s
+        def splitlist_event(s):
+            try:
+                return self.tk.splitlist(s)
+            except ValueError:
+                return s
+        # valid percent substitutions for DnD event types
+        # (tested with tkdnd-2.8 on debian jessie):
+        # <<DragInitCmd>> : %W, %X, %Y %e, %t
+        # <<DragEndCmd>> : %A, %W, %e
+        # <<DropEnter>> : all except : %D (always empty)
+        # <<DropLeave>> : all except %D (always empty)
+        # <<DropPosition>> :all except %D (always empty)
+        # <<Drop>> : all
+        A, a, b, C, c, CST, CTT, D, e, L, m, ST, T, t, TT, W, X, Y = args
+        ev = DnDEvent()
+        ev.action = A
+        ev.actions = splitlist_event(a)
+        ev.button = getint_event(b)
+        ev.code = C
+        ev.codes = splitlist_event(c)
+        ev.commonsourcetypes = splitlist_event(CST)
+        ev.commontargettypes = splitlist_event(CTT)
+        ev.data = D
+        ev.name = e
+        ev.types = splitlist_event(L)
+        ev.modifiers = splitlist_event(m)
+        ev.supportedsourcetypes = splitlist_event(ST)
+        ev.sourcetypes = splitlist_event(t)
+        ev.type = T
+        ev.supportedtargettypes = splitlist_event(TT)
+        try:
+            ev.widget = self.nametowidget(W)
+        except KeyError:
+            ev.widget = W
+        ev.x_root = getint_event(X)
+        ev.y_root = getint_event(Y)
+        return (ev,)
+    tkinter.BaseWidget._substitute_dnd = _substitute_dnd
+
+    def _dnd_bind(self, what, sequence, func, add, needcleanup=True):
+        """Internal function."""
+        if isinstance(func, str):
+            self.tk.call(what + (sequence, func))
+        elif func:
+            funcid = self._register(func, self._substitute_dnd, needcleanup)
+            # FIXME: why doesn't the "return 'break'" mechanism work here??
+            #cmd = ('%sif {"[%s %s]" == "break"} break\n' % (add and '+' or '',
+            #                              funcid, self._subst_format_str_dnd))
+            cmd = '%s%s %s' %(add and '+' or '', funcid,
+                                    self._subst_format_str_dnd)
+            self.tk.call(what + (sequence, cmd))
+            return funcid
+        elif sequence:
+            return self.tk.call(what + (sequence,))
+        else:
+            return self.tk.splitlist(self.tk.call(what))
+    tkinter.BaseWidget._dnd_bind = _dnd_bind
+
+    def dnd_bind(self, sequence=None, func=None, add=None):
+        '''Bind to this widget at drag and drop event SEQUENCE a call
+        to function FUNC.
+        SEQUENCE may be one of the following:
+        <<DropEnter>>, <<DropPosition>>, <<DropLeave>>, <<Drop>>,
+        <<Drop:type>>, <<DragInitCmd>>, <<DragEndCmd>> .
+        The callbacks for the <Drop*>> events, with the exception of
+        <<DropLeave>>, should always return an action (i.e. one of COPY,
+        MOVE, LINK, ASK or PRIVATE).
+        The callback for the <<DragInitCmd>> event must return a tuple
+        containing three elements: the drop action(s) supported by the
+        drag source, the format type(s) that the data can be dropped as and
+        finally the data that shall be dropped. Each of these three elements
+        may be a tuple of strings or a single string.'''
+        return self._dnd_bind(('bind', self._w), sequence, func, add)
+    tkinter.BaseWidget.dnd_bind = dnd_bind
+
+    def drag_source_register(self, button=None, *dndtypes):
+        '''This command will register SELF as a drag source.
+        A drag source is a widget than can start a drag action. This command
+        can be executed multiple times on a widget.
+        When SELF is registered as a drag source, optional DNDTYPES can be
+        provided. These DNDTYPES will be provided during a drag action, and
+        it can contain platform independent or platform specific types.
+        Platform independent are DND_Text for dropping text portions and
+        DND_Files for dropping a list of files (which can contain one or
+        multiple files) on SELF. However, these types are
+        indicative/informative. SELF can initiate a drag action with even a
+        different type list. Finally, button is the mouse button that will be
+        used for starting the drag action. It can have any of the values 1
+        (left mouse button), 2 (middle mouse button - wheel) and 3
+        (right mouse button). If button is not specified, it defaults to 1.'''
+        # hack to fix a design bug from the first version
+        if button is None:
+            button = 1
+        else:
+            try:
+                button = int(button)
+            except ValueError:
+                # no button defined, button is actually
+                # something like DND_TEXT
+                dndtypes = (button,) + dndtypes
+                button = 1
+        self.tk.call(
+                'tkdnd::drag_source', 'register', self._w, dndtypes, button)
+    tkinter.BaseWidget.drag_source_register = drag_source_register
+
+    def drag_source_unregister(self):
+        '''This command will stop SELF from being a drag source. Thus, window
+        will stop receiving events related to drag operations. It is an error
+        to use this command for a window that has not been registered as a
+        drag source with drag_source_register().'''
+        self.tk.call('tkdnd::drag_source', 'unregister', self._w)
+    tkinter.BaseWidget.drag_source_unregister = drag_source_unregister
+
+    def drop_target_register(self, *dndtypes):
+        '''This command will register SELF as a drop target. A drop target is
+        a widget than can accept a drop action. This command can be executed
+        multiple times on a widget. When SELF is registered as a drop target,
+        optional DNDTYPES can be provided. These types list can contain one or
+        more types that SELF will accept during a drop action, and it can
+        contain platform independent or platform specific types. Platform
+        independent are DND_Text for dropping text portions and DND_Files for
+        dropping a list of files (which can contain one or multiple files) on
+        SELF.'''
+        self.tk.call('tkdnd::drop_target', 'register', self._w, dndtypes)
+    tkinter.BaseWidget.drop_target_register = drop_target_register
+
+    def drop_target_unregister(self):
+        '''This command will stop SELF from being a drop target. Thus, SELF
+        will stop receiving events related to drop operations. It is an error
+        to use this command for a window that has not been registered as a
+        drop target with drop_target_register().'''
+        self.tk.call('tkdnd::drop_target', 'unregister', self._w)
+    tkinter.BaseWidget.drop_target_unregister = drop_target_unregister
+
+    def platform_independent_types(self, *dndtypes):
+        '''This command will accept a list of types that can contain platform
+        independnent or platform specific types. A new list will be returned,
+        where each platform specific type in DNDTYPES will be substituted by
+        one or more platform independent types. Thus, the returned list may
+        have more elements than DNDTYPES.'''
+        return self.tk.split(self.tk.call(
+                            'tkdnd::platform_independent_types', dndtypes))
+    tkinter.BaseWidget.platform_independent_types = platform_independent_types
+
+    def platform_specific_types(self, *dndtypes):
+        '''This command will accept a list of types that can contain platform
+        independnent or platform specific types. A new list will be returned,
+        where each platform independent type in DNDTYPES will be substituted
+        by one or more platform specific types. Thus, the returned list may
+        have more elements than DNDTYPES.'''
+        return self.tk.split(self.tk.call(
+                            'tkdnd::platform_specific_types', dndtypes))
+    tkinter.BaseWidget.platform_specific_types = platform_specific_types
+
+    def get_dropfile_tempdir(self):
+        '''This command will return the temporary directory used by TkDND for
+        storing temporary files. When the package is loaded, this temporary
+        directory will be initialised to a proper directory according to the
+        operating system. This default initial value can be changed to be the
+        value of the following environmental variables:
+        TKDND_TEMP_DIR, TEMP, TMP.'''
+        return self.tk.call('tkdnd::GetDropFileTempDirectory')
+    tkinter.BaseWidget.get_dropfile_tempdir = get_dropfile_tempdir
+
+    def set_dropfile_tempdir(self, tempdir):
+        '''This command will change the temporary directory used by TkDND for
+        storing temporary files to TEMPDIR.'''
+        self.tk.call('tkdnd::SetDropFileTempDirectory', tempdir)
+    tkinter.BaseWidget.set_dropfile_tempdir = set_dropfile_tempdir
+
+#######################################################################
+####      The main window classes that enable Drag & Drop for      ####
+####      themselves and all their descendant widgets:             ####
+#######################################################################
+
+class Tk(tkinter.Tk, DnDWrapper):
+    '''Creates a new instance of a tkinter.Tk() window; all methods of the
+    DnDWrapper class apply to this window and all its descendants.'''
+    def __init__(self, *args, **kw):
+        tkinter.Tk.__init__(self, *args, **kw)
+        self.TkdndVersion = _require(self)
+
+class TixTk(tix.Tk, DnDWrapper):
+    '''Creates a new instance of a tix.Tk() window; all methods of the
+    DnDWrapper class apply to this window and all its descendants.'''
+    def __init__(self, *args, **kw):
+        tix.Tk.__init__(self, *args, **kw)
+        self.TkdndVersion = _require(self)

tkinterdnd2/__init__.py

@@ -0,0 +1,25 @@
+# dnd actions
+PRIVATE = 'private'
+NONE = 'none'
+ASK = 'ask'
+COPY = 'copy'
+MOVE = 'move'
+LINK = 'link'
+REFUSE_DROP = 'refuse_drop'
+
+# dnd types
+DND_TEXT = 'DND_Text'
+DND_FILES = 'DND_Files'
+DND_ALL = '*'
+CF_UNICODETEXT = 'CF_UNICODETEXT'
+CF_TEXT = 'CF_TEXT'
+CF_HDROP = 'CF_HDROP'
+
+FileGroupDescriptor = 'FileGroupDescriptor - FileContents'# ??
+FileGroupDescriptorW = 'FileGroupDescriptorW - FileContents'# ??
+
+from . import TkinterDnD
+from .TkinterDnD import Tk
+from .TkinterDnD import TixTk
+
+

tkinterdnd2/tkdnd/linux64/pkgIndex.tcl

@@ -0,0 +1,10 @@
+#
+# Tcl package index file
+#
+package ifneeded tkdnd 2.9.2 \
+  "source \{$dir/tkdnd.tcl\} ; \
+   tkdnd::initialise \{$dir\} libtkdnd2.9.2.so tkdnd"
+
+package ifneeded tkdnd::utils 2.9.2 \
+  "source \{$dir/tkdnd_utils.tcl\} ; \
+   package provide tkdnd::utils 2.9.2"

tkinterdnd2/tkdnd/linux64/tkdnd.tcl

@@ -0,0 +1,469 @@
+#
+# 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 _dx 3 ;# The difference in pixels before a drag is initiated.
+  variable _dy 3 ;# The difference in pixels before a drag is initiated.
+
+  variable _windowingsystem
+
+  bind TkDND_Drag1 <ButtonPress-1> {tkdnd::_begin_drag press  1 %W %s %X %Y %x %y}
+  bind TkDND_Drag1 <B1-Motion>     {tkdnd::_begin_drag motion 1 %W %s %X %Y %x %y}
+  bind TkDND_Drag2 <ButtonPress-2> {tkdnd::_begin_drag press  2 %W %s %X %Y %x %y}
+  bind TkDND_Drag2 <B2-Motion>     {tkdnd::_begin_drag motion 2 %W %s %X %Y %x %y}
+  bind TkDND_Drag3 <ButtonPress-3> {tkdnd::_begin_drag press  3 %W %s %X %Y %x %y}
+  bind TkDND_Drag3 <B3-Motion>     {tkdnd::_begin_drag motion 3 %W %s %X %Y %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]
+
+    source $dir/tkdnd_generic.tcl
+    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_macosx.tcl
+        set _platform_namespace macdnd
+      }
+      default {
+        error "unknown Tk windowing system"
+      }
+    }
+    load $dir/$PKG_LIB_FILE $PACKAGE_NAME
+    source $dir/tkdnd_compat.tcl
+    ${_platform_namespace}::initialise
+  };# 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 }
+                                      { tagprefix TkDND_Drag } } {
+  set tags [bindtags $path]
+  set idx  [lsearch $tags ${tagprefix}$event]
+  switch -- $mode {
+    register {
+      if { $idx != -1 } {
+        ## No need to do anything!
+        # bindtags $path [lreplace $tags $idx $idx ${tagprefix}$event]
+      } else {
+        bindtags $path [linsert $tags 1 ${tagprefix}$event]
+      }
+      _drag_source_update_types $path $types
+    }
+    unregister {
+      if { $idx != -1 } {
+        bindtags $path [lreplace $tags $idx $idx]
+      }
+    }
+  }
+};# tkdnd::drag_source
+
+proc ::tkdnd::_drag_source_update_types { path types } {
+  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
+};# ::tkdnd::_drag_source_update_types
+
+# ----------------------------------------------------------------------------
+#  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 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"] } {
+        variable _dx
+        variable _dy
+        if { abs($_x0-$X) > ${_dx} || abs($_y0-$Y) > ${_dy} } {
+          set _state "done"
+          _init_drag $button $source $state $X $Y $x $y
+        }
+      }
+    }
+  }
+};# tkdnd::_begin_drag
+
+# ----------------------------------------------------------------------------
+#  Command tkdnd::_init_drag
+# ----------------------------------------------------------------------------
+proc ::tkdnd::_init_drag { button source state rootX rootY X Y } {
+  # Call the <<DragInitCmd>> binding.
+  set cmd [bind $source <<DragInitCmd>>]
+  # puts "CMD: $cmd"
+  if {[string length $cmd]} {
+    set cmd [string map [list %W $source %X $rootX %Y $rootY %x $X %y $Y \
+                              %S $state  %e <<DragInitCmd>> %A \{\} %% % \
+                              %t [bind $source <<DragSourceTypes>>]] $cmd]
+    set code [catch {uplevel \#0 $cmd} info options]
+    # puts "CODE: $code ---- $info"
+    switch -exact -- $code {
+      0 {}
+      3 - 4 {
+        # FRINK: nocheck
+        return
+      }
+      default {
+        return -options $options $info
+      }
+    }
+
+    set len [llength $info]
+    if {$len == 3} {
+      foreach { actions types _data } $info { break }
+      set types [platform_specific_types $types]
+      set data [list]
+      foreach type $types {
+        lappend data $_data
+      }
+      unset _data
+    } elseif {$len == 2} {
+      foreach { actions _data } $info { break }
+      set data [list]; set types [list]
+      foreach {t d} $_data {
+        foreach t [platform_specific_types $t] {
+          lappend types $t; lappend data $d
+        }
+      }
+      unset _data t d
+    } else {
+      if {$len == 1 && [string equal [lindex $actions 0] "refuse_drop"]} {
+        return
+      }
+      error "not enough items in the result of the <<DragInitCmd>>\
+             event binding. Either 2 or 3 items are expected. The command
+             executed was: \"$cmd\"\nResult was: \"$info\""
+    }
+    set action refuse_drop
+    variable _windowingsystem
+    # puts "Source:   \"$source\""
+    # puts "Types:    \"[join $types {", "}]\""
+    # puts "Actions:  \"[join $actions {", "}]\""
+    # puts "Button:   \"$button\""
+    # puts "Data:     \"[string range $data 0 100]\""
+    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 $button]
+      }
+      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 $X $Y
+  }
+};# tkdnd::_init_drag
+
+# ----------------------------------------------------------------------------
+#  Command tkdnd::_end_drag
+# ----------------------------------------------------------------------------
+proc ::tkdnd::_end_drag { button source target action type data result
+                          state rootX rootY X Y } {
+  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 %x $X %y $Y %% % \
+                              %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
+  ${_platform_namespace}::platform_specific_types $types
+}; # tkdnd::platform_specific_types
+
+# ----------------------------------------------------------------------------
+#  Command tkdnd::platform_independent_types
+# ----------------------------------------------------------------------------
+proc ::tkdnd::platform_independent_types { types } {
+  variable _platform_namespace
+  ${_platform_namespace}::platform_independent_types $types
+}; # tkdnd::platform_independent_types
+
+# ----------------------------------------------------------------------------
+#  Command tkdnd::platform_specific_type
+# ----------------------------------------------------------------------------
+proc ::tkdnd::platform_specific_type { type } {
+  variable _platform_namespace
+  ${_platform_namespace}::platform_specific_type $type
+}; # tkdnd::platform_specific_type
+
+# ----------------------------------------------------------------------------
+#  Command tkdnd::platform_independent_type
+# ----------------------------------------------------------------------------
+proc ::tkdnd::platform_independent_type { type } {
+  variable _platform_namespace
+  ${_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 [encoding convertfrom utf-8 $result]
+};# tkdnd::urn_unquote

tkinterdnd2/tkdnd/linux64/tkdnd_compat.tcl

@@ -0,0 +1,160 @@
+#
+# 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 1 $window "press" 0 0 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} {
+  set type [normalise_type $type]
+  ::tkdnd::drag_source register $window $type
+  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

tkinterdnd2/tkdnd/linux64/tkdnd_generic.tcl

@@ -0,0 +1,520 @@
+#
+# tkdnd_generic.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 generic {
+  variable _types {}
+  variable _typelist {}
+  variable _codelist {}
+  variable _actionlist {}
+  variable _pressedkeys {}
+  variable _action {}
+  variable _common_drag_source_types {}
+  variable _common_drop_target_types {}
+  variable _drag_source {}
+  variable _drop_target {}
+
+  variable _last_mouse_root_x 0
+  variable _last_mouse_root_y 0
+
+  variable _tkdnd2platform
+  variable _platform2tkdnd
+
+  proc debug {msg} {
+    puts $msg
+  };# debug
+
+  proc initialise { } {
+  };# initialise
+
+  proc initialise_platform_to_tkdnd_types { types } {
+    variable _platform2tkdnd
+    variable _tkdnd2platform
+    set _platform2tkdnd [dict create {*}$types]
+    set _tkdnd2platform [dict create]
+    foreach type [dict keys $_platform2tkdnd] {
+      dict lappend _tkdnd2platform [dict get $_platform2tkdnd $type] $type
+    }
+  };# initialise_platform_to_tkdnd_types
+
+  proc initialise_tkdnd_to_platform_types { types } {
+    variable _tkdnd2platform
+    set _tkdnd2platform [dict create {*}$types]
+  };# initialise_tkdnd_to_platform_types
+
+};# namespace generic
+
+# ----------------------------------------------------------------------------
+#  Command generic::HandleEnter
+# ----------------------------------------------------------------------------
+proc generic::HandleEnter { drop_target drag_source typelist codelist
+                            actionlist pressedkeys } {
+  variable _typelist;                 set _typelist    $typelist
+  variable _pressedkeys;              set _pressedkeys $pressedkeys
+  variable _action;                   set _action      refuse_drop
+  variable _common_drag_source_types; set _common_drag_source_types {}
+  variable _common_drop_target_types; set _common_drop_target_types {}
+  variable _actionlist
+  variable _drag_source;              set _drag_source $drag_source
+  variable _drop_target;              set _drop_target {}
+  variable _actionlist;               set _actionlist  $actionlist
+  variable _codelist                  set _codelist    $codelist
+
+  variable _last_mouse_root_x;        set _last_mouse_root_x 0
+  variable _last_mouse_root_y;        set _last_mouse_root_y 0
+  # debug "\n==============================================================="
+  # debug "generic::HandleEnter: drop_target=$drop_target,\
+  #        drag_source=$drag_source,\
+  #        typelist=$typelist"
+  # debug "generic::HandleEnter: ACTION: default"
+  return default
+};# generic::HandleEnter
+
+# ----------------------------------------------------------------------------
+#  Command generic::HandlePosition
+# ----------------------------------------------------------------------------
+proc generic::HandlePosition { drop_target drag_source pressedkeys
+                               rootX rootY { time 0 } } {
+  variable _types
+  variable _typelist
+  variable _codelist
+  variable _actionlist
+  variable _pressedkeys
+  variable _action
+  variable _common_drag_source_types
+  variable _common_drop_target_types
+  variable _drag_source
+  variable _drop_target
+
+  variable _last_mouse_root_x;        set _last_mouse_root_x $rootX
+  variable _last_mouse_root_y;        set _last_mouse_root_y $rootY
+
+  # debug "generic::HandlePosition: drop_target=$drop_target,\
+  #            _drop_target=$_drop_target, rootX=$rootX, rootY=$rootY"
+
+  if {![info exists _drag_source] && ![string length $_drag_source]} {
+    # debug "generic::HandlePosition: no or empty _drag_source:\
+    #               return refuse_drop"
+    return refuse_drop
+  }
+
+  if {$drag_source ne "" && $drag_source ne $_drag_source} {
+    debug "generic position event from unexpected source: $_drag_source\
+           != $drag_source"
+    return refuse_drop
+  }
+
+  set _pressedkeys $pressedkeys
+
+  ## Does the new drop target support any of our new types?
+  # foreach {common_drag_source_types common_drop_target_types} \
+  #         [GetWindowCommonTypes $drop_target $_typelist] {break}
+  foreach {drop_target common_drag_source_types common_drop_target_types} \
+          [FindWindowWithCommonTypes $drop_target $_typelist] {break}
+  set data [GetDroppedData $time]
+
+  # debug "\t($_drop_target) -> ($drop_target)"
+  if {$drop_target != $_drop_target} {
+    if {[string length $_drop_target]} {
+      ## Call the <<DropLeave>> event.
+      # debug "\t<<DropLeave>> on $_drop_target"
+      set cmd [bind $_drop_target <<DropLeave>>]
+      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\} \
+          %CPT \{[lindex [platform_independent_type [lindex $_common_drag_source_types 0]] 0]\} \
+          %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]\} \
+          %c   \{$_codelist\}    %C  \{[lindex $_codelist 0]\} \
+          ] $cmd]
+        uplevel \#0 $cmd
+      }
+    }
+    set _drop_target $drop_target
+    set _action      refuse_drop
+
+    if {[llength $common_drag_source_types]} {
+      set _action [lindex $_actionlist 0]
+      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>>.
+      # puts "<<DropEnter>> -> $drop_target"
+      set cmd [bind $drop_target <<DropEnter>>]
+      if {[string length $cmd]} {
+        focus $drop_target
+        set cmd [string map [list %W $drop_target %X $rootX %Y $rootY \
+          %CST \{$_common_drag_source_types\} \
+          %CTT \{$_common_drop_target_types\} \
+          %CPT \{[lindex [platform_independent_type [lindex $_common_drag_source_types 0]] 0]\} \
+          %ST  \{$_typelist\}    %TT \{$_types\} \
+          %A   $_action          %a  \{$_actionlist\} \
+          %b   \{$_pressedkeys\} %m  \{$_pressedkeys\} \
+          %D   [list $data]      %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]
+        switch -exact -- $_action {
+          copy - move - link - ask - private - refuse_drop - default {}
+          default {set _action copy}
+        }
+      }
+    }
+  }
+
+  set _drop_target {}
+  if {[llength $common_drag_source_types]} {
+    set _common_drag_source_types $common_drag_source_types
+    set _common_drop_target_types $common_drop_target_types
+    set _drop_target $drop_target
+    ## Drop target supports at least one type. Send a <<DropPosition>>.
+    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\} \
+        %CPT \{[lindex [platform_independent_type [lindex $_common_drag_source_types 0]] 0]\} \
+        %ST  \{$_typelist\}    %TT \{$_types\} \
+        %A   $_action          %a  \{$_actionlist\} \
+        %b   \{$_pressedkeys\} %m  \{$_pressedkeys\} \
+        %D   [list $data]      %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]
+    }
+  }
+  # Return values: copy, move, link, ask, private, refuse_drop, default
+  # debug "generic::HandlePosition: ACTION: $_action"
+  switch -exact -- $_action {
+    copy - move - link - ask - private - refuse_drop - default {}
+    default {set _action copy}
+  }
+  return $_action
+};# generic::HandlePosition
+
+# ----------------------------------------------------------------------------
+#  Command generic::HandleLeave
+# ----------------------------------------------------------------------------
+proc generic::HandleLeave { } {
+  variable _types
+  variable _typelist
+  variable _codelist
+  variable _actionlist
+  variable _pressedkeys
+  variable _action
+  variable _common_drag_source_types
+  variable _common_drop_target_types
+  variable _drag_source
+  variable _drop_target
+  variable _last_mouse_root_x
+  variable _last_mouse_root_y
+  if {![info exists _drop_target]} {set _drop_target {}}
+  # debug "generic::HandleLeave: _drop_target=$_drop_target"
+  if {[info exists _drop_target] && [string length $_drop_target]} {
+    set cmd [bind $_drop_target <<DropLeave>>]
+    if {[string length $cmd]} {
+      set cmd [string map [list %W $_drop_target \
+        %X $_last_mouse_root_x %Y $_last_mouse_root_y \
+        %CST \{$_common_drag_source_types\} \
+        %CTT \{$_common_drop_target_types\} \
+        %CPT \{[lindex [platform_independent_type [lindex $_common_drag_source_types 0]] 0]\} \
+        %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]\} \
+        %c   \{$_codelist\}    %C  \{[lindex $_codelist 0]\} \
+        ] $cmd]
+      set _action [uplevel \#0 $cmd]
+    }
+  }
+  foreach var {_types _typelist _actionlist _pressedkeys _action
+               _common_drag_source_types _common_drop_target_types
+               _drag_source _drop_target} {
+    set $var {}
+  }
+};# generic::HandleLeave
+
+# ----------------------------------------------------------------------------
+#  Command generic::HandleDrop
+# ----------------------------------------------------------------------------
+proc generic::HandleDrop {drop_target drag_source pressedkeys rootX rootY time } {
+  variable _types
+  variable _typelist
+  variable _codelist
+  variable _actionlist
+  variable _pressedkeys
+  variable _action
+  variable _common_drag_source_types
+  variable _common_drop_target_types
+  variable _drag_source
+  variable _drop_target
+  variable _last_mouse_root_x
+  variable _last_mouse_root_y
+  variable _last_mouse_root_x;        set _last_mouse_root_x $rootX
+  variable _last_mouse_root_y;        set _last_mouse_root_y $rootY
+
+  set _pressedkeys $pressedkeys
+
+  # puts "generic::HandleDrop: $time"
+
+  if {![info exists _drag_source] && ![string length $_drag_source]} {
+    return refuse_drop
+  }
+  if {![info exists _drop_target] && ![string length $_drop_target]} {
+    return refuse_drop
+  }
+  if {![llength $_common_drag_source_types]} {return refuse_drop}
+  ## Get the dropped data.
+  set data [GetDroppedData $time]
+  ## 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\} \
+        %CPT \{[lindex [platform_independent_type [lindex $_common_drag_source_types 0]] 0]\} \
+        %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]
+      set _action [uplevel \#0 $cmd]
+      # Return values: copy, move, link, ask, private, refuse_drop
+      switch -exact -- $_action {
+        copy - move - link - ask - private - refuse_drop - default {}
+        default {set _action copy}
+      }
+      return $_action
+    }
+  }
+  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\} \
+      %CPT \{[lindex [platform_independent_type [lindex $_common_drag_source_types 0]] 0]\} \
+      %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]
+  }
+  # Return values: copy, move, link, ask, private, refuse_drop
+  switch -exact -- $_action {
+    copy - move - link - ask - private - refuse_drop - default {}
+    default {set _action copy}
+  }
+  return $_action
+};# generic::HandleDrop
+
+# ----------------------------------------------------------------------------
+#  Command generic::GetWindowCommonTypes
+# ----------------------------------------------------------------------------
+proc generic::GetWindowCommonTypes { win typelist } {
+  set types [bind $win <<DropTargetTypes>>]
+  # debug ">> Accepted types: $win $_types"
+  set common_drag_source_types {}
+  set common_drop_target_types {}
+  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
+      }
+    }
+  }
+  list $common_drag_source_types $common_drop_target_types
+};# generic::GetWindowCommonTypes
+
+# ----------------------------------------------------------------------------
+#  Command generic::FindWindowWithCommonTypes
+# ----------------------------------------------------------------------------
+proc generic::FindWindowWithCommonTypes { win typelist } {
+  set toplevel [winfo toplevel $win]
+  while {![string equal $win $toplevel]} {
+    foreach {common_drag_source_types common_drop_target_types} \
+            [GetWindowCommonTypes $win $typelist] {break}
+    if {[llength $common_drag_source_types]} {
+      return [list $win $common_drag_source_types $common_drop_target_types]
+    }
+    set win [winfo parent $win]
+  }
+  ## We have reached the toplevel, which may be also a target (SF Bug #30)
+  foreach {common_drag_source_types common_drop_target_types} \
+          [GetWindowCommonTypes $win $typelist] {break}
+  if {[llength $common_drag_source_types]} {
+    return [list $win $common_drag_source_types $common_drop_target_types]
+  }
+  return { {} {} {} }
+};# generic::FindWindowWithCommonTypes
+
+# ----------------------------------------------------------------------------
+#  Command generic::GetDroppedData
+# ----------------------------------------------------------------------------
+proc generic::GetDroppedData { time } {
+  variable _dropped_data
+  return  $_dropped_data
+};# generic::GetDroppedData
+
+# ----------------------------------------------------------------------------
+#  Command generic::SetDroppedData
+# ----------------------------------------------------------------------------
+proc generic::SetDroppedData { data } {
+  variable _dropped_data
+  set _dropped_data $data
+};# generic::SetDroppedData
+
+# ----------------------------------------------------------------------------
+#  Command generic::GetDragSource
+# ----------------------------------------------------------------------------
+proc generic::GetDragSource { } {
+  variable _drag_source
+  return  $_drag_source
+};# generic::GetDragSource
+
+# ----------------------------------------------------------------------------
+#  Command generic::GetDropTarget
+# ----------------------------------------------------------------------------
+proc generic::GetDropTarget { } {
+  variable _drop_target
+  return $_drop_target
+};# generic::GetDropTarget
+
+# ----------------------------------------------------------------------------
+#  Command generic::GetDragSourceCommonTypes
+# ----------------------------------------------------------------------------
+proc generic::GetDragSourceCommonTypes { } {
+  variable _common_drag_source_types
+  return  $_common_drag_source_types
+};# generic::GetDragSourceCommonTypes
+
+# ----------------------------------------------------------------------------
+#  Command generic::GetDropTargetCommonTypes
+# ----------------------------------------------------------------------------
+proc generic::GetDropTargetCommonTypes { } {
+  variable _common_drag_source_types
+  return  $_common_drag_source_types
+};# generic::GetDropTargetCommonTypes
+
+# ----------------------------------------------------------------------------
+#  Command generic::platform_specific_types
+# ----------------------------------------------------------------------------
+proc generic::platform_specific_types { types } {
+  set new_types {}
+  foreach type $types {
+    set new_types [concat $new_types [platform_specific_type $type]]
+  }
+  return $new_types
+}; # generic::platform_specific_types
+
+# ----------------------------------------------------------------------------
+#  Command generic::platform_specific_type
+# ----------------------------------------------------------------------------
+proc generic::platform_specific_type { type } {
+  variable _tkdnd2platform
+  if {[dict exists $_tkdnd2platform $type]} {
+    return [dict get $_tkdnd2platform $type]
+  }
+  list $type
+}; # generic::platform_specific_type
+
+# ----------------------------------------------------------------------------
+#  Command tkdnd::platform_independent_types
+# ----------------------------------------------------------------------------
+proc ::tkdnd::platform_independent_types { types } {
+  set new_types {}
+  foreach type $types {
+    set new_types [concat $new_types [platform_independent_type $type]]
+  }
+  return $new_types
+}; # tkdnd::platform_independent_types
+
+# ----------------------------------------------------------------------------
+#  Command generic::platform_independent_type
+# ----------------------------------------------------------------------------
+proc generic::platform_independent_type { type } {
+  variable _platform2tkdnd
+  if {[dict exists $_platform2tkdnd $type]} {
+    return [dict get $_platform2tkdnd $type]
+  }
+  return $type
+}; # generic::platform_independent_type
+
+# ----------------------------------------------------------------------------
+#  Command generic::supported_types
+# ----------------------------------------------------------------------------
+proc generic::supported_types { types } {
+  set new_types {}
+  foreach type $types {
+    if {[supported_type $type]} {lappend new_types $type}
+  }
+  return $new_types
+}; # generic::supported_types
+
+# ----------------------------------------------------------------------------
+#  Command generic::supported_type
+# ----------------------------------------------------------------------------
+proc generic::supported_type { type } {
+  variable _platform2tkdnd
+  if {[dict exists $_platform2tkdnd $type]} {
+    return 1
+  }
+  return 0
+}; # generic::supported_type

tkinterdnd2/tkdnd/linux64/tkdnd_macosx.tcl

@@ -0,0 +1,144 @@
+#
+# 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 {
+
+  proc initialise { } {
+     ## Mapping from platform types to TkDND types...
+    ::tkdnd::generic::initialise_platform_to_tkdnd_types [list \
+       NSPasteboardTypeString  DND_Text  \
+       NSFilenamesPboardType   DND_Files \
+       NSPasteboardTypeHTML    DND_HTML  \
+    ]
+  };# initialise
+
+};# namespace macdnd
+
+# ----------------------------------------------------------------------------
+#  Command macdnd::HandleEnter
+# ----------------------------------------------------------------------------
+proc macdnd::HandleEnter { path drag_source typelist { data {} } } {
+  variable _pressedkeys
+  variable _actionlist
+  set _pressedkeys 1
+  set _actionlist  { copy move link ask private }
+  ::tkdnd::generic::SetDroppedData $data
+  ::tkdnd::generic::HandleEnter $path $drag_source $typelist $typelist \
+           $_actionlist $_pressedkeys
+};# macdnd::HandleEnter
+
+# ----------------------------------------------------------------------------
+#  Command macdnd::HandlePosition
+# ----------------------------------------------------------------------------
+proc macdnd::HandlePosition { drop_target rootX rootY {drag_source {}} } {
+  variable _pressedkeys
+  variable _last_mouse_root_x; set _last_mouse_root_x $rootX
+  variable _last_mouse_root_y; set _last_mouse_root_y $rootY
+  ::tkdnd::generic::HandlePosition $drop_target $drag_source \
+                                   $_pressedkeys $rootX $rootY
+};# macdnd::HandlePosition
+
+# ----------------------------------------------------------------------------
+#  Command macdnd::HandleLeave
+# ----------------------------------------------------------------------------
+proc macdnd::HandleLeave { args } {
+  ::tkdnd::generic::HandleLeave
+};# macdnd::HandleLeave
+
+# ----------------------------------------------------------------------------
+#  Command macdnd::HandleDrop
+# ----------------------------------------------------------------------------
+proc macdnd::HandleDrop { drop_target data args } {
+  variable _pressedkeys
+  variable _last_mouse_root_x
+  variable _last_mouse_root_y
+  ## Get the dropped data...
+  ::tkdnd::generic::SetDroppedData $data
+  ::tkdnd::generic::HandleDrop {} {} $_pressedkeys \
+                               $_last_mouse_root_x $_last_mouse_root_y 0
+};# macdnd::HandleDrop
+
+# ----------------------------------------------------------------------------
+#  Command macdnd::GetDragSourceCommonTypes
+# ----------------------------------------------------------------------------
+proc macdnd::GetDragSourceCommonTypes { } {
+  ::tkdnd::generic::GetDragSourceCommonTypes
+};# macdnd::GetDragSourceCommonTypes
+
+# ----------------------------------------------------------------------------
+#  Command macdnd::platform_specific_types
+# ----------------------------------------------------------------------------
+proc macdnd::platform_specific_types { types } {
+  ::tkdnd::generic::platform_specific_types $types
+}; # macdnd::platform_specific_types
+
+# ----------------------------------------------------------------------------
+#  Command macdnd::platform_specific_type
+# ----------------------------------------------------------------------------
+proc macdnd::platform_specific_type { type } {
+  ::tkdnd::generic::platform_specific_type $type
+}; # macdnd::platform_specific_type
+
+# ----------------------------------------------------------------------------
+#  Command tkdnd::platform_independent_types
+# ----------------------------------------------------------------------------
+proc ::tkdnd::platform_independent_types { types } {
+  ::tkdnd::generic::platform_independent_types $types
+}; # tkdnd::platform_independent_types
+
+# ----------------------------------------------------------------------------
+#  Command macdnd::platform_independent_type
+# ----------------------------------------------------------------------------
+proc macdnd::platform_independent_type { type } {
+  ::tkdnd::generic::platform_independent_type $type
+}; # macdnd::platform_independent_type

tkinterdnd2/tkdnd/linux64/tkdnd_unix.tcl

@@ -0,0 +1,810 @@
+#
+# tkdnd_unix.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 xdnd {
+  variable _dragging 0
+
+  proc initialise { } {
+    ## Mapping from platform types to TkDND types...
+    ::tkdnd::generic::initialise_platform_to_tkdnd_types [list \
+       text/plain\;charset=utf-8     DND_Text  \
+       UTF8_STRING                   DND_Text  \
+       text/plain                    DND_Text  \
+       STRING                        DND_Text  \
+       TEXT                          DND_Text  \
+       COMPOUND_TEXT                 DND_Text  \
+       text/uri-list                 DND_Files \
+       text/html\;charset=utf-8      DND_HTML  \
+       text/html                     DND_HTML  \
+       application/x-color           DND_Color \
+    ]
+  };# initialise
+
+};# namespace xdnd
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::HandleXdndEnter
+# ----------------------------------------------------------------------------
+proc xdnd::HandleXdndEnter { path drag_source typelist time { data {} } } {
+  variable _pressedkeys
+  variable _actionlist
+  variable _typelist
+  set _pressedkeys 1
+  set _actionlist  { copy move link ask private }
+  set _typelist    $typelist
+  # puts "xdnd::HandleXdndEnter: $time"
+  ::tkdnd::generic::SetDroppedData $data
+  ::tkdnd::generic::HandleEnter $path $drag_source $typelist $typelist \
+           $_actionlist $_pressedkeys
+};# xdnd::HandleXdndEnter
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::HandleXdndPosition
+# ----------------------------------------------------------------------------
+proc xdnd::HandleXdndPosition { drop_target rootX rootY time {drag_source {}} } {
+  variable _pressedkeys
+  variable _typelist
+  variable _last_mouse_root_x; set _last_mouse_root_x $rootX
+  variable _last_mouse_root_y; set _last_mouse_root_y $rootY
+  # puts "xdnd::HandleXdndPosition: $time"
+  ## Get the dropped data...
+  catch {
+    ::tkdnd::generic::SetDroppedData [GetPositionData $drop_target $_typelist $time]
+  }
+  ::tkdnd::generic::HandlePosition $drop_target $drag_source \
+                                   $_pressedkeys $rootX $rootY
+};# xdnd::HandleXdndPosition
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::HandleXdndLeave
+# ----------------------------------------------------------------------------
+proc xdnd::HandleXdndLeave { } {
+  ::tkdnd::generic::HandleLeave
+};# xdnd::HandleXdndLeave
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::_HandleXdndDrop
+# ----------------------------------------------------------------------------
+proc xdnd::HandleXdndDrop { time } {
+  variable _pressedkeys
+  variable _last_mouse_root_x
+  variable _last_mouse_root_y
+  ## Get the dropped data...
+  ::tkdnd::generic::SetDroppedData [GetDroppedData \
+    [::tkdnd::generic::GetDragSource] [::tkdnd::generic::GetDropTarget] \
+    [::tkdnd::generic::GetDragSourceCommonTypes] $time]
+  ::tkdnd::generic::HandleDrop {} {} $_pressedkeys \
+                               $_last_mouse_root_x $_last_mouse_root_y $time
+};# xdnd::HandleXdndDrop
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::GetPositionData
+# ----------------------------------------------------------------------------
+proc xdnd::GetPositionData { drop_target typelist time } {
+  foreach {drop_target common_drag_source_types common_drop_target_types} \
+    [::tkdnd::generic::FindWindowWithCommonTypes $drop_target $typelist] {break}
+  GetDroppedData [::tkdnd::generic::GetDragSource] $drop_target \
+    $common_drag_source_types $time
+};# xdnd::GetPositionData
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::GetDroppedData
+# ----------------------------------------------------------------------------
+proc xdnd::GetDroppedData { _drag_source _drop_target _common_drag_source_types time } {
+  if {![llength $_common_drag_source_types]} {
+    error "no common data types between the drag source and drop target widgets"
+  }
+  ## Is drag source in this application?
+  if {[catch {winfo pathname -displayof $_drop_target $_drag_source} p]} {
+    set _use_tk_selection 0
+  } else {
+    set _use_tk_selection 1
+  }
+  foreach type $_common_drag_source_types {
+    # puts "TYPE: $type ($_drop_target)"
+    # _get_selection $_drop_target $time $type
+    if {$_use_tk_selection} {
+      if {![catch {
+        selection get -displayof $_drop_target -selection XdndSelection \
+                      -type $type
+                                              } result options]} {
+        return [normalise_data $type $result]
+      }
+    } else {
+      # puts "_selection_get -displayof $_drop_target -selection XdndSelection \
+      #                 -type $type -time $time"
+      #after 100 [list focus -force $_drop_target]
+      #after 50 [list raise [winfo toplevel $_drop_target]]
+      if {![catch {
+        _selection_get -displayof $_drop_target -selection XdndSelection \
+                      -type $type -time $time
+                                              } result options]} {
+        return [normalise_data $type $result]
+      }
+    }
+  }
+  return -options $options $result
+};# xdnd::GetDroppedData
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::platform_specific_types
+# ----------------------------------------------------------------------------
+proc xdnd::platform_specific_types { types } {
+  ::tkdnd::generic::platform_specific_types $types
+}; # xdnd::platform_specific_types
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::platform_specific_type
+# ----------------------------------------------------------------------------
+proc xdnd::platform_specific_type { type } {
+  ::tkdnd::generic::platform_specific_type $type
+}; # xdnd::platform_specific_type
+
+# ----------------------------------------------------------------------------
+#  Command tkdnd::platform_independent_types
+# ----------------------------------------------------------------------------
+proc ::tkdnd::platform_independent_types { types } {
+  ::tkdnd::generic::platform_independent_types $types
+}; # tkdnd::platform_independent_types
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::platform_independent_type
+# ----------------------------------------------------------------------------
+proc xdnd::platform_independent_type { type } {
+  ::tkdnd::generic::platform_independent_type $type
+}; # xdnd::platform_independent_type
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::_normalise_data
+# ----------------------------------------------------------------------------
+proc xdnd::normalise_data { type data } {
+  # Tk knows how to interpret the following types:
+  #    STRING, TEXT, COMPOUND_TEXT
+  #    UTF8_STRING
+  # Else, it returns a list of 8 or 32 bit numbers...
+  switch -glob $type {
+    STRING - UTF8_STRING - TEXT - COMPOUND_TEXT {return $data}
+    text/html {
+      if {[catch {
+            encoding convertfrom unicode $data
+           } string]} {
+        set string $data
+      }
+      return [string map {\r\n \n} $string]
+    }
+    text/html\;charset=utf-8  -
+    text/plain\;charset=utf-8 -
+    text/plain {
+      if {[catch {
+            encoding convertfrom utf-8 [tkdnd::bytes_to_string $data]
+           } string]} {
+        set string $data
+      }
+      return [string map {\r\n \n} $string]
+    }
+    text/uri-list* {
+      if {[catch {
+            encoding convertfrom utf-8 [tkdnd::bytes_to_string $data]
+          } string]} {
+        set string $data
+      }
+      ## Get rid of \r\n
+      set string [string trim [string map {\r\n \n} $string]]
+      set files {}
+      foreach quoted_file [split $string] {
+        set file [tkdnd::urn_unquote $quoted_file]
+        switch -glob $file {
+          \#*       {}
+          file://*  {lappend files [string range $file 7 end]}
+          ftp://*   -
+          https://* -
+          http://*  {lappend files $quoted_file}
+          default   {lappend files $file}
+        }
+      }
+      return $files
+    }
+    application/x-color {
+      return $data
+    }
+    text/x-moz-url -
+    application/q-iconlist -
+    default    {return $data}
+  }
+}; # xdnd::normalise_data
+
+#############################################################################
+##
+##  XDND drag implementation
+##
+#############################################################################
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::_selection_ownership_lost
+# ----------------------------------------------------------------------------
+proc xdnd::_selection_ownership_lost {} {
+  variable _dragging
+  set _dragging 0
+};# _selection_ownership_lost
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::_dodragdrop
+# ----------------------------------------------------------------------------
+proc xdnd::_dodragdrop { source actions types data button } {
+  variable _dragging
+
+  # puts "xdnd::_dodragdrop: source: $source, actions: $actions, types: $types,\
+  #       data: \"$data\", button: $button"
+  if {$_dragging} {
+    ## We are in the middle of another drag operation...
+    error "another drag operation in progress"
+  }
+
+  variable _dodragdrop_drag_source                $source
+  variable _dodragdrop_drop_target                0
+  variable _dodragdrop_drop_target_proxy          0
+  variable _dodragdrop_actions                    $actions
+  variable _dodragdrop_action_descriptions        $actions
+  variable _dodragdrop_actions_len                [llength $actions]
+  variable _dodragdrop_types                      $types
+  variable _dodragdrop_types_len                  [llength $types]
+  variable _dodragdrop_data                       $data
+  variable _dodragdrop_transfer_data              {}
+  variable _dodragdrop_button                     $button
+  variable _dodragdrop_time                       0
+  variable _dodragdrop_default_action             refuse_drop
+  variable _dodragdrop_waiting_status             0
+  variable _dodragdrop_drop_target_accepts_drop   0
+  variable _dodragdrop_drop_target_accepts_action refuse_drop
+  variable _dodragdrop_current_cursor             $_dodragdrop_default_action
+  variable _dodragdrop_drop_occured               0
+  variable _dodragdrop_selection_requestor        0
+
+  ##
+  ## If we have more than 3 types, the property XdndTypeList must be set on
+  ## the drag source widget...
+  ##
+  if {$_dodragdrop_types_len > 3} {
+    _announce_type_list $_dodragdrop_drag_source $_dodragdrop_types
+  }
+
+  ##
+  ## Announce the actions & their descriptions on the XdndActionList &
+  ## XdndActionDescription properties...
+  ##
+  _announce_action_list $_dodragdrop_drag_source $_dodragdrop_actions \
+                        $_dodragdrop_action_descriptions
+
+  ##
+  ## Arrange selection handlers for our drag source, and all the supported types
+  ##
+  registerSelectionHandler $source $types
+
+  ##
+  ## Step 1: When a drag begins, the source takes ownership of XdndSelection.
+  ##
+  selection own -command ::tkdnd::xdnd::_selection_ownership_lost \
+                -selection XdndSelection $source
+  set _dragging 1
+
+  ## Grab the mouse pointer...
+  _grab_pointer $source $_dodragdrop_default_action
+
+  ## Register our generic event handler...
+  #  The generic event callback will report events by modifying variable
+  #  ::xdnd::_dodragdrop_event: a dict with event information will be set as
+  #  the value of the variable...
+  _register_generic_event_handler
+
+  ## Set a timeout for debugging purposes...
+  #  after 60000 {set ::tkdnd::xdnd::_dragging 0}
+
+  tkwait variable ::tkdnd::xdnd::_dragging
+  _SendXdndLeave
+
+  set _dragging 0
+  _ungrab_pointer $source
+  _unregister_generic_event_handler
+  catch {selection clear -selection XdndSelection}
+  unregisterSelectionHandler $source $types
+  return $_dodragdrop_drop_target_accepts_action
+};# xdnd::_dodragdrop
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::_process_drag_events
+# ----------------------------------------------------------------------------
+proc xdnd::_process_drag_events {event} {
+  # The return value from proc is normally 0. A non-zero return value indicates
+  # that the event is not to be handled further; that is, proc has done all
+  # processing that is to be allowed for the event
+  variable _dragging
+  if {!$_dragging} {return 0}
+  # puts $event
+
+  variable _dodragdrop_time
+  set time [dict get $event time]
+  set type [dict get $event type]
+  if {$time < $_dodragdrop_time && ![string equal $type SelectionRequest]} {
+    return 0
+  }
+  set _dodragdrop_time $time
+
+  variable _dodragdrop_drag_source
+  variable _dodragdrop_drop_target
+  variable _dodragdrop_drop_target_proxy
+  variable _dodragdrop_default_action
+  switch $type {
+    MotionNotify {
+      set rootx  [dict get $event x_root]
+      set rooty  [dict get $event y_root]
+      set window [_find_drop_target_window $_dodragdrop_drag_source \
+                                           $rootx $rooty]
+      if {[string length $window]} {
+        ## Examine the modifiers to suggest an action...
+        set _dodragdrop_default_action [_default_action $event]
+        ## Is it a Tk widget?
+        # set path [winfo containing $rootx $rooty]
+        # puts "Window under mouse: $window ($path)"
+        if {$_dodragdrop_drop_target != $window} {
+          ## Send XdndLeave to $_dodragdrop_drop_target
+          _SendXdndLeave
+          ## Is there a proxy? If not, _find_drop_target_proxy returns the
+          ## target window, so we always get a valid "proxy".
+          set proxy [_find_drop_target_proxy $_dodragdrop_drag_source $window]
+          ## Send XdndEnter to $window
+          _SendXdndEnter $window $proxy
+          ## Send XdndPosition to $_dodragdrop_drop_target
+          _SendXdndPosition $rootx $rooty $_dodragdrop_default_action
+        } else {
+          ## Send XdndPosition to $_dodragdrop_drop_target
+          _SendXdndPosition $rootx $rooty $_dodragdrop_default_action
+        }
+      } else {
+        ## No window under the mouse. Send XdndLeave to $_dodragdrop_drop_target
+        _SendXdndLeave
+      }
+    }
+    ButtonPress {
+    }
+    ButtonRelease {
+      variable _dodragdrop_button
+      set button [dict get $event button]
+      if {$button == $_dodragdrop_button} {
+        ## The button that initiated the drag was released. Trigger drop...
+        _SendXdndDrop
+      }
+      return 1
+    }
+    KeyPress {
+    }
+    KeyRelease {
+      set keysym [dict get $event keysym]
+      switch $keysym {
+        Escape {
+          ## The user has pressed escape. Abort...
+          if {$_dragging} {set _dragging 0}
+        }
+      }
+    }
+    SelectionRequest {
+      variable _dodragdrop_selection_requestor
+      variable _dodragdrop_selection_property
+      variable _dodragdrop_selection_selection
+      variable _dodragdrop_selection_target
+      variable _dodragdrop_selection_time
+      set _dodragdrop_selection_requestor [dict get $event requestor]
+      set _dodragdrop_selection_property  [dict get $event property]
+      set _dodragdrop_selection_selection [dict get $event selection]
+      set _dodragdrop_selection_target    [dict get $event target]
+      set _dodragdrop_selection_time      $time
+      return 0
+    }
+    default {
+      return 0
+    }
+  }
+  return 0
+};# _process_drag_events
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::_SendXdndEnter
+# ----------------------------------------------------------------------------
+proc xdnd::_SendXdndEnter {window proxy} {
+  variable _dodragdrop_drag_source
+  variable _dodragdrop_drop_target
+  variable _dodragdrop_drop_target_proxy
+  variable _dodragdrop_types
+  variable _dodragdrop_waiting_status
+  variable _dodragdrop_drop_occured
+  if {$_dodragdrop_drop_target > 0} _SendXdndLeave
+  if {$_dodragdrop_drop_occured} return
+  set _dodragdrop_drop_target       $window
+  set _dodragdrop_drop_target_proxy $proxy
+  set _dodragdrop_waiting_status    0
+  if {$_dodragdrop_drop_target < 1} return
+  # puts "XdndEnter: $_dodragdrop_drop_target $_dodragdrop_drop_target_proxy"
+  _send_XdndEnter $_dodragdrop_drag_source $_dodragdrop_drop_target \
+                  $_dodragdrop_drop_target_proxy $_dodragdrop_types
+};# xdnd::_SendXdndEnter
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::_SendXdndPosition
+# ----------------------------------------------------------------------------
+proc xdnd::_SendXdndPosition {rootx rooty action} {
+  variable _dodragdrop_drag_source
+  variable _dodragdrop_drop_target
+  if {$_dodragdrop_drop_target < 1} return
+  variable _dodragdrop_drop_occured
+  if {$_dodragdrop_drop_occured} return
+  variable _dodragdrop_drop_target_proxy
+  variable _dodragdrop_waiting_status
+  ## Arrange a new XdndPosition, to be send periodically...
+  variable _dodragdrop_xdnd_position_heartbeat
+  catch {after cancel $_dodragdrop_xdnd_position_heartbeat}
+  set _dodragdrop_xdnd_position_heartbeat [after 200 \
+    [list ::tkdnd::xdnd::_SendXdndPosition $rootx $rooty $action]]
+  if {$_dodragdrop_waiting_status} {return}
+  # puts "XdndPosition: $_dodragdrop_drop_target $rootx $rooty $action"
+  _send_XdndPosition $_dodragdrop_drag_source $_dodragdrop_drop_target \
+                     $_dodragdrop_drop_target_proxy $rootx $rooty $action
+  set _dodragdrop_waiting_status 1
+};# xdnd::_SendXdndPosition
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::_HandleXdndStatus
+# ----------------------------------------------------------------------------
+proc xdnd::_HandleXdndStatus {event} {
+  variable _dodragdrop_drop_target
+  variable _dodragdrop_waiting_status
+
+  variable _dodragdrop_drop_target_accepts_drop
+  variable _dodragdrop_drop_target_accepts_action
+  set _dodragdrop_waiting_status 0
+  foreach key {target accept want_position action x y w h} {
+    set $key [dict get $event $key]
+  }
+  set _dodragdrop_drop_target_accepts_drop   $accept
+  set _dodragdrop_drop_target_accepts_action $action
+  if {$_dodragdrop_drop_target < 1} return
+  variable _dodragdrop_drop_occured
+  if {$_dodragdrop_drop_occured} return
+  _update_cursor
+  # puts "XdndStatus: $event"
+};# xdnd::_HandleXdndStatus
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::_HandleXdndFinished
+# ----------------------------------------------------------------------------
+proc xdnd::_HandleXdndFinished {event} {
+  variable _dodragdrop_xdnd_finished_event_after_id
+  catch {after cancel $_dodragdrop_xdnd_finished_event_after_id}
+  set _dodragdrop_xdnd_finished_event_after_id {}
+  variable _dodragdrop_drop_target
+  set _dodragdrop_drop_target 0
+  variable _dragging
+  if {$_dragging} {set _dragging 0}
+
+  variable _dodragdrop_drop_target_accepts_drop
+  variable _dodragdrop_drop_target_accepts_action
+  if {[dict size $event]} {
+    foreach key {target accept action} {
+      set $key [dict get $event $key]
+    }
+    set _dodragdrop_drop_target_accepts_drop   $accept
+    set _dodragdrop_drop_target_accepts_action $action
+  } else {
+    set _dodragdrop_drop_target_accepts_drop 0
+  }
+  if {!$_dodragdrop_drop_target_accepts_drop} {
+    set _dodragdrop_drop_target_accepts_action refuse_drop
+  }
+  # puts "XdndFinished: $event"
+};# xdnd::_HandleXdndFinished
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::_SendXdndLeave
+# ----------------------------------------------------------------------------
+proc xdnd::_SendXdndLeave {} {
+  variable _dodragdrop_drag_source
+  variable _dodragdrop_drop_target
+  if {$_dodragdrop_drop_target < 1} return
+  variable _dodragdrop_drop_target_proxy
+  # puts "XdndLeave: $_dodragdrop_drop_target"
+  _send_XdndLeave $_dodragdrop_drag_source $_dodragdrop_drop_target \
+                  $_dodragdrop_drop_target_proxy
+  set _dodragdrop_drop_target 0
+  variable _dodragdrop_drop_target_accepts_drop
+  variable _dodragdrop_drop_target_accepts_action
+  set _dodragdrop_drop_target_accepts_drop   0
+  set _dodragdrop_drop_target_accepts_action refuse_drop
+  variable _dodragdrop_drop_occured
+  if {$_dodragdrop_drop_occured} return
+  _update_cursor
+};# xdnd::_SendXdndLeave
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::_SendXdndDrop
+# ----------------------------------------------------------------------------
+proc xdnd::_SendXdndDrop {} {
+  variable _dodragdrop_drag_source
+  variable _dodragdrop_drop_target
+  if {$_dodragdrop_drop_target < 1} {
+    ## The mouse has been released over a widget that does not accept drops.
+    _HandleXdndFinished {}
+    return
+  }
+  variable _dodragdrop_drop_occured
+  if {$_dodragdrop_drop_occured} {return}
+  variable _dodragdrop_drop_target_proxy
+  variable _dodragdrop_drop_target_accepts_drop
+  variable _dodragdrop_drop_target_accepts_action
+
+  set _dodragdrop_drop_occured 1
+  _update_cursor clock
+
+  if {!$_dodragdrop_drop_target_accepts_drop} {
+    _SendXdndLeave
+    _HandleXdndFinished {}
+    return
+  }
+  # puts "XdndDrop: $_dodragdrop_drop_target"
+  variable _dodragdrop_drop_timestamp
+  set _dodragdrop_drop_timestamp [_send_XdndDrop \
+                 $_dodragdrop_drag_source $_dodragdrop_drop_target \
+                 $_dodragdrop_drop_target_proxy]
+  set _dodragdrop_drop_target 0
+  # puts "XdndDrop: $_dodragdrop_drop_target"
+  ## Arrange a timeout for receiving XdndFinished...
+  variable _dodragdrop_xdnd_finished_event_after_id
+  set _dodragdrop_xdnd_finished_event_after_id \
+    [after 10000 [list ::tkdnd::xdnd::_HandleXdndFinished {}]]
+};# xdnd::_SendXdndDrop
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::_update_cursor
+# ----------------------------------------------------------------------------
+proc xdnd::_update_cursor { {cursor {}}} {
+  # puts "_update_cursor $cursor"
+  variable _dodragdrop_current_cursor
+  variable _dodragdrop_drag_source
+  variable _dodragdrop_drop_target_accepts_drop
+  variable _dodragdrop_drop_target_accepts_action
+
+  if {![string length $cursor]} {
+    set cursor refuse_drop
+    if {$_dodragdrop_drop_target_accepts_drop} {
+      set cursor $_dodragdrop_drop_target_accepts_action
+    }
+  }
+  if {![string equal $cursor $_dodragdrop_current_cursor]} {
+    _set_pointer_cursor $_dodragdrop_drag_source $cursor
+    set _dodragdrop_current_cursor $cursor
+  }
+};# xdnd::_update_cursor
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::_default_action
+# ----------------------------------------------------------------------------
+proc xdnd::_default_action {event} {
+  variable _dodragdrop_actions
+  variable _dodragdrop_actions_len
+  if {$_dodragdrop_actions_len == 1} {return [lindex $_dodragdrop_actions 0]}
+
+  set alt     [dict get $event Alt]
+  set shift   [dict get $event Shift]
+  set control [dict get $event Control]
+
+  if {$shift && $control && [lsearch $_dodragdrop_actions link] != -1} {
+    return link
+  } elseif {$control && [lsearch $_dodragdrop_actions copy] != -1} {
+    return copy
+  } elseif {$shift && [lsearch $_dodragdrop_actions move] != -1} {
+    return move
+  } elseif {$alt && [lsearch $_dodragdrop_actions link] != -1} {
+    return link
+  }
+  return default
+};# xdnd::_default_action
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::getFormatForType
+# ----------------------------------------------------------------------------
+proc xdnd::getFormatForType {type} {
+  switch -glob [string tolower $type] {
+    text/plain\;charset=utf-8 -
+    text/html\;charset=utf-8  -
+    utf8_string               {set format UTF8_STRING}
+    text/html                 -
+    text/plain                -
+    string                    -
+    text                      -
+    compound_text             {set format STRING}
+    text/uri-list*            {set format UTF8_STRING}
+    application/x-color       {set format $type}
+    default                   {set format $type}
+  }
+  return $format
+};# xdnd::getFormatForType
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::registerSelectionHandler
+# ----------------------------------------------------------------------------
+proc xdnd::registerSelectionHandler {source types} {
+  foreach type $types {
+    selection handle -selection XdndSelection \
+                     -type $type \
+                     -format [getFormatForType $type] \
+                     $source [list ::tkdnd::xdnd::_SendData $type]
+  }
+};# xdnd::registerSelectionHandler
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::unregisterSelectionHandler
+# ----------------------------------------------------------------------------
+proc xdnd::unregisterSelectionHandler {source types} {
+  foreach type $types {
+    catch {
+      selection handle -selection XdndSelection \
+                       -type $type \
+                       -format [getFormatForType $type] \
+                       $source {}
+    }
+  }
+};# xdnd::unregisterSelectionHandler
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::_convert_to_unsigned
+# ----------------------------------------------------------------------------
+proc xdnd::_convert_to_unsigned {data format} {
+  switch $format {
+    8  { set mask 0xff }
+    16 { set mask 0xffff }
+    32 { set mask 0xffffff }
+    default {error "unsupported format $format"}
+  }
+  ## Convert signed integer into unsigned...
+  set d [list]
+  foreach num $data {
+    lappend d [expr { $num & $mask }]
+  }
+  return $d
+};# xdnd::_convert_to_unsigned
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::_SendData
+# ----------------------------------------------------------------------------
+proc xdnd::_SendData {type offset bytes args} {
+  variable _dodragdrop_drag_source
+  variable _dodragdrop_types
+  variable _dodragdrop_data
+  variable _dodragdrop_transfer_data
+
+  ## The variable _dodragdrop_data contains a list of data, one for each
+  ## type in the _dodragdrop_types variable. We have to search types, and find
+  ## the corresponding entry in the _dodragdrop_data list.
+  set index [lsearch $_dodragdrop_types $type]
+  if {$index < 0} {
+    error "unable to locate data suitable for type \"$type\""
+  }
+  set typed_data [lindex $_dodragdrop_data $index]
+  set format 8
+  if {$offset == 0} {
+    ## Prepare the data to be transferred...
+    switch -glob $type {
+      text/plain* - UTF8_STRING - STRING - TEXT - COMPOUND_TEXT {
+        binary scan [encoding convertto utf-8 $typed_data] \
+                    c* _dodragdrop_transfer_data
+        set _dodragdrop_transfer_data \
+           [_convert_to_unsigned $_dodragdrop_transfer_data $format]
+      }
+      text/uri-list* {
+        set files [list]
+        foreach file $typed_data {
+          switch -glob $file {
+            *://*     {lappend files $file}
+            default   {lappend files file://$file}
+          }
+        }
+        binary scan [encoding convertto utf-8 "[join $files \r\n]\r\n"] \
+                    c* _dodragdrop_transfer_data
+        set _dodragdrop_transfer_data \
+           [_convert_to_unsigned $_dodragdrop_transfer_data $format]
+      }
+      application/x-color {
+        set format 16
+        ## Try to understand the provided data: we accept a standard Tk colour,
+        ## or a list of 3 values (red green blue) or a list of 4 values
+        ## (red green blue opacity).
+        switch [llength $typed_data] {
+          1 { set color [winfo rgb $_dodragdrop_drag_source $typed_data]
+              lappend color 65535 }
+          3 { set color $typed_data; lappend color 65535 }
+          4 { set color $typed_data }
+          default {error "unknown color data: \"$typed_data\""}
+        }
+        ## Convert the 4 elements into 16 bit values...
+        set _dodragdrop_transfer_data [list]
+        foreach c $color {
+          lappend _dodragdrop_transfer_data [format 0x%04X $c]
+        }
+      }
+      default {
+        set format 32
+        binary scan $typed_data c* _dodragdrop_transfer_data
+      }
+    }
+  }
+
+  ##
+  ## Data has been split into bytes. Count the bytes requested, and return them
+  ##
+  set data [lrange $_dodragdrop_transfer_data $offset [expr {$offset+$bytes-1}]]
+  switch $format {
+    8  {
+      set data [encoding convertfrom utf-8 [binary format c* $data]]
+    }
+    16 {
+      variable _dodragdrop_selection_requestor
+      if {$_dodragdrop_selection_requestor} {
+        ## Tk selection cannot process this format (only 8 & 32 supported).
+        ## Call our XChangeProperty...
+        set numItems [llength $data]
+        variable _dodragdrop_selection_property
+        variable _dodragdrop_selection_selection
+        variable _dodragdrop_selection_target
+        variable _dodragdrop_selection_time
+        XChangeProperty $_dodragdrop_drag_source \
+                        $_dodragdrop_selection_requestor \
+                        $_dodragdrop_selection_property \
+                        $_dodragdrop_selection_target \
+                        $format \
+                        $_dodragdrop_selection_time \
+                        $data $numItems
+        return -code break
+      }
+    }
+    32 {
+    }
+    default {
+      error "unsupported format $format"
+    }
+  }
+  # puts "SendData: $type $offset $bytes $args ($typed_data)"
+  # puts "          $data"
+  return $data
+};# xdnd::_SendData

tkinterdnd2/tkdnd/linux64/tkdnd_utils.tcl

@@ -0,0 +1,252 @@
+#
+# 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

tkinterdnd2/tkdnd/linux64/tkdnd_windows.tcl

@@ -0,0 +1,167 @@
+#
+# 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 {
+
+  proc initialise { } {
+    ## Mapping from platform types to TkDND types...
+    ::tkdnd::generic::initialise_platform_to_tkdnd_types [list \
+       CF_UNICODETEXT          DND_Text  \
+       CF_TEXT                 DND_Text  \
+       CF_HDROP                DND_Files \
+       UniformResourceLocator  DND_URL   \
+       CF_HTML                 DND_HTML  \
+       {HTML Format}           DND_HTML  \
+       CF_RTF                  DND_RTF   \
+       CF_RTFTEXT              DND_RTF   \
+       {Rich Text Format}      DND_RTF   \
+    ]
+    # FileGroupDescriptorW    DND_Files \
+    # FileGroupDescriptor     DND_Files \
+
+    ## Mapping from TkDND types to platform types...
+    ::tkdnd::generic::initialise_tkdnd_to_platform_types [list \
+       DND_Text  {CF_UNICODETEXT CF_TEXT}               \
+       DND_Files {CF_HDROP}                             \
+       DND_URL   {UniformResourceLocator UniformResourceLocatorW} \
+       DND_HTML  {CF_HTML {HTML Format}}                \
+       DND_RTF   {CF_RTF CF_RTFTEXT {Rich Text Format}} \
+    ]
+  };# initialise
+
+};# namespace olednd
+
+# ----------------------------------------------------------------------------
+#  Command olednd::HandleDragEnter
+# ----------------------------------------------------------------------------
+proc olednd::HandleDragEnter { drop_target typelist actionlist pressedkeys
+                               rootX rootY codelist { data {} } } {
+  ::tkdnd::generic::SetDroppedData $data
+  focus $drop_target
+  ::tkdnd::generic::HandleEnter $drop_target 0 $typelist \
+                                $codelist $actionlist $pressedkeys
+  set action [::tkdnd::generic::HandlePosition $drop_target {} \
+                                               $pressedkeys $rootX $rootY]
+  if {$::tkdnd::_auto_update} {update idletasks}
+  return $action
+};# olednd::HandleDragEnter
+
+# ----------------------------------------------------------------------------
+#  Command olednd::HandleDragOver
+# ----------------------------------------------------------------------------
+proc olednd::HandleDragOver { drop_target pressedkeys rootX rootY } {
+  set action [::tkdnd::generic::HandlePosition $drop_target {} \
+                                               $pressedkeys $rootX $rootY]
+  if {$::tkdnd::_auto_update} {update idletasks}
+  return $action
+};# olednd::HandleDragOver
+
+# ----------------------------------------------------------------------------
+#  Command olednd::HandleDragLeave
+# ----------------------------------------------------------------------------
+proc olednd::HandleDragLeave { drop_target } {
+  ::tkdnd::generic::HandleLeave
+  if {$::tkdnd::_auto_update} {update idletasks}
+};# olednd::HandleDragLeave
+
+# ----------------------------------------------------------------------------
+#  Command olednd::HandleDrop
+# ----------------------------------------------------------------------------
+proc olednd::HandleDrop { drop_target pressedkeys rootX rootY type data } {
+  ::tkdnd::generic::SetDroppedData [normalise_data $type $data]
+  set action [::tkdnd::generic::HandleDrop $drop_target {} \
+                                           $pressedkeys $rootX $rootY 0]
+  if {$::tkdnd::_auto_update} {update idletasks}
+  return $action
+};# olednd::HandleDrop
+
+# ----------------------------------------------------------------------------
+#  Command olednd::GetDataType
+# ----------------------------------------------------------------------------
+proc olednd::GetDataType { drop_target typelist } {
+  foreach {drop_target common_drag_source_types common_drop_target_types} \
+    [::tkdnd::generic::FindWindowWithCommonTypes $drop_target $typelist] {break}
+  lindex $common_drag_source_types 0
+};# olednd::GetDataType
+
+# ----------------------------------------------------------------------------
+#  Command olednd::GetDragSourceCommonTypes
+# ----------------------------------------------------------------------------
+proc olednd::GetDragSourceCommonTypes { drop_target } {
+  ::tkdnd::generic::GetDragSourceCommonTypes
+};# olednd::GetDragSourceCommonTypes
+
+# ----------------------------------------------------------------------------
+#  Command olednd::platform_specific_types
+# ----------------------------------------------------------------------------
+proc olednd::platform_specific_types { types } {
+  ::tkdnd::generic::platform_specific_types $types
+}; # olednd::platform_specific_types
+
+# ----------------------------------------------------------------------------
+#  Command olednd::platform_specific_type
+# ----------------------------------------------------------------------------
+proc olednd::platform_specific_type { type } {
+  ::tkdnd::generic::platform_specific_type $type
+}; # olednd::platform_specific_type
+
+# ----------------------------------------------------------------------------
+#  Command tkdnd::platform_independent_types
+# ----------------------------------------------------------------------------
+proc ::tkdnd::platform_independent_types { types } {
+  ::tkdnd::generic::platform_independent_types $types
+}; # tkdnd::platform_independent_types
+
+# ----------------------------------------------------------------------------
+#  Command olednd::platform_independent_type
+# ----------------------------------------------------------------------------
+proc olednd::platform_independent_type { type } {
+  ::tkdnd::generic::platform_independent_type $type
+}; # olednd::platform_independent_type
+
+# ----------------------------------------------------------------------------
+#  Command olednd::normalise_data
+# ----------------------------------------------------------------------------
+proc olednd::normalise_data { type data } {
+  switch [lindex [::tkdnd::generic::platform_independent_type $type] 0] {
+    DND_Text   {return $data}
+    DND_Files  {return $data}
+    DND_HTML   {return [encoding convertfrom utf-8 $data]}
+    default    {return $data}
+  }
+}; # olednd::normalise_data

tkinterdnd2/tkdnd/osx64/pkgIndex.tcl

@@ -0,0 +1,10 @@
+#
+# Tcl package index file
+#
+package ifneeded tkdnd 2.9.2 \
+  "source \{$dir/tkdnd.tcl\} ; \
+   tkdnd::initialise \{$dir\} libtkdnd2.9.2.dylib tkdnd"
+
+package ifneeded tkdnd::utils 2.9.2 \
+  "source \{$dir/tkdnd_utils.tcl\} ; \
+   package provide tkdnd::utils 2.9.2"

tkinterdnd2/tkdnd/osx64/tkdnd.tcl

@@ -0,0 +1,469 @@
+#
+# 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 _dx 3 ;# The difference in pixels before a drag is initiated.
+  variable _dy 3 ;# The difference in pixels before a drag is initiated.
+
+  variable _windowingsystem
+
+  bind TkDND_Drag1 <ButtonPress-1> {tkdnd::_begin_drag press  1 %W %s %X %Y %x %y}
+  bind TkDND_Drag1 <B1-Motion>     {tkdnd::_begin_drag motion 1 %W %s %X %Y %x %y}
+  bind TkDND_Drag2 <ButtonPress-2> {tkdnd::_begin_drag press  2 %W %s %X %Y %x %y}
+  bind TkDND_Drag2 <B2-Motion>     {tkdnd::_begin_drag motion 2 %W %s %X %Y %x %y}
+  bind TkDND_Drag3 <ButtonPress-3> {tkdnd::_begin_drag press  3 %W %s %X %Y %x %y}
+  bind TkDND_Drag3 <B3-Motion>     {tkdnd::_begin_drag motion 3 %W %s %X %Y %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]
+
+    source $dir/tkdnd_generic.tcl
+    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_macosx.tcl
+        set _platform_namespace macdnd
+      }
+      default {
+        error "unknown Tk windowing system"
+      }
+    }
+    load $dir/$PKG_LIB_FILE $PACKAGE_NAME
+    source $dir/tkdnd_compat.tcl
+    ${_platform_namespace}::initialise
+  };# 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 }
+                                      { tagprefix TkDND_Drag } } {
+  set tags [bindtags $path]
+  set idx  [lsearch $tags ${tagprefix}$event]
+  switch -- $mode {
+    register {
+      if { $idx != -1 } {
+        ## No need to do anything!
+        # bindtags $path [lreplace $tags $idx $idx ${tagprefix}$event]
+      } else {
+        bindtags $path [linsert $tags 1 ${tagprefix}$event]
+      }
+      _drag_source_update_types $path $types
+    }
+    unregister {
+      if { $idx != -1 } {
+        bindtags $path [lreplace $tags $idx $idx]
+      }
+    }
+  }
+};# tkdnd::drag_source
+
+proc ::tkdnd::_drag_source_update_types { path types } {
+  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
+};# ::tkdnd::_drag_source_update_types
+
+# ----------------------------------------------------------------------------
+#  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 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"] } {
+        variable _dx
+        variable _dy
+        if { abs($_x0-$X) > ${_dx} || abs($_y0-$Y) > ${_dy} } {
+          set _state "done"
+          _init_drag $button $source $state $X $Y $x $y
+        }
+      }
+    }
+  }
+};# tkdnd::_begin_drag
+
+# ----------------------------------------------------------------------------
+#  Command tkdnd::_init_drag
+# ----------------------------------------------------------------------------
+proc ::tkdnd::_init_drag { button source state rootX rootY X Y } {
+  # Call the <<DragInitCmd>> binding.
+  set cmd [bind $source <<DragInitCmd>>]
+  # puts "CMD: $cmd"
+  if {[string length $cmd]} {
+    set cmd [string map [list %W $source %X $rootX %Y $rootY %x $X %y $Y \
+                              %S $state  %e <<DragInitCmd>> %A \{\} %% % \
+                              %t [bind $source <<DragSourceTypes>>]] $cmd]
+    set code [catch {uplevel \#0 $cmd} info options]
+    # puts "CODE: $code ---- $info"
+    switch -exact -- $code {
+      0 {}
+      3 - 4 {
+        # FRINK: nocheck
+        return
+      }
+      default {
+        return -options $options $info
+      }
+    }
+
+    set len [llength $info]
+    if {$len == 3} {
+      foreach { actions types _data } $info { break }
+      set types [platform_specific_types $types]
+      set data [list]
+      foreach type $types {
+        lappend data $_data
+      }
+      unset _data
+    } elseif {$len == 2} {
+      foreach { actions _data } $info { break }
+      set data [list]; set types [list]
+      foreach {t d} $_data {
+        foreach t [platform_specific_types $t] {
+          lappend types $t; lappend data $d
+        }
+      }
+      unset _data t d
+    } else {
+      if {$len == 1 && [string equal [lindex $actions 0] "refuse_drop"]} {
+        return
+      }
+      error "not enough items in the result of the <<DragInitCmd>>\
+             event binding. Either 2 or 3 items are expected. The command
+             executed was: \"$cmd\"\nResult was: \"$info\""
+    }
+    set action refuse_drop
+    variable _windowingsystem
+    # puts "Source:   \"$source\""
+    # puts "Types:    \"[join $types {", "}]\""
+    # puts "Actions:  \"[join $actions {", "}]\""
+    # puts "Button:   \"$button\""
+    # puts "Data:     \"[string range $data 0 100]\""
+    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 $button]
+      }
+      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 $X $Y
+  }
+};# tkdnd::_init_drag
+
+# ----------------------------------------------------------------------------
+#  Command tkdnd::_end_drag
+# ----------------------------------------------------------------------------
+proc ::tkdnd::_end_drag { button source target action type data result
+                          state rootX rootY X Y } {
+  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 %x $X %y $Y %% % \
+                              %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
+  ${_platform_namespace}::platform_specific_types $types
+}; # tkdnd::platform_specific_types
+
+# ----------------------------------------------------------------------------
+#  Command tkdnd::platform_independent_types
+# ----------------------------------------------------------------------------
+proc ::tkdnd::platform_independent_types { types } {
+  variable _platform_namespace
+  ${_platform_namespace}::platform_independent_types $types
+}; # tkdnd::platform_independent_types
+
+# ----------------------------------------------------------------------------
+#  Command tkdnd::platform_specific_type
+# ----------------------------------------------------------------------------
+proc ::tkdnd::platform_specific_type { type } {
+  variable _platform_namespace
+  ${_platform_namespace}::platform_specific_type $type
+}; # tkdnd::platform_specific_type
+
+# ----------------------------------------------------------------------------
+#  Command tkdnd::platform_independent_type
+# ----------------------------------------------------------------------------
+proc ::tkdnd::platform_independent_type { type } {
+  variable _platform_namespace
+  ${_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 [encoding convertfrom utf-8 $result]
+};# tkdnd::urn_unquote

tkinterdnd2/tkdnd/osx64/tkdnd_compat.tcl

@@ -0,0 +1,160 @@
+#
+# 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 1 $window "press" 0 0 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} {
+  set type [normalise_type $type]
+  ::tkdnd::drag_source register $window $type
+  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

tkinterdnd2/tkdnd/osx64/tkdnd_generic.tcl

@@ -0,0 +1,520 @@
+#
+# tkdnd_generic.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 generic {
+  variable _types {}
+  variable _typelist {}
+  variable _codelist {}
+  variable _actionlist {}
+  variable _pressedkeys {}
+  variable _action {}
+  variable _common_drag_source_types {}
+  variable _common_drop_target_types {}
+  variable _drag_source {}
+  variable _drop_target {}
+
+  variable _last_mouse_root_x 0
+  variable _last_mouse_root_y 0
+
+  variable _tkdnd2platform
+  variable _platform2tkdnd
+
+  proc debug {msg} {
+    puts $msg
+  };# debug
+
+  proc initialise { } {
+  };# initialise
+
+  proc initialise_platform_to_tkdnd_types { types } {
+    variable _platform2tkdnd
+    variable _tkdnd2platform
+    set _platform2tkdnd [dict create {*}$types]
+    set _tkdnd2platform [dict create]
+    foreach type [dict keys $_platform2tkdnd] {
+      dict lappend _tkdnd2platform [dict get $_platform2tkdnd $type] $type
+    }
+  };# initialise_platform_to_tkdnd_types
+
+  proc initialise_tkdnd_to_platform_types { types } {
+    variable _tkdnd2platform
+    set _tkdnd2platform [dict create {*}$types]
+  };# initialise_tkdnd_to_platform_types
+
+};# namespace generic
+
+# ----------------------------------------------------------------------------
+#  Command generic::HandleEnter
+# ----------------------------------------------------------------------------
+proc generic::HandleEnter { drop_target drag_source typelist codelist
+                            actionlist pressedkeys } {
+  variable _typelist;                 set _typelist    $typelist
+  variable _pressedkeys;              set _pressedkeys $pressedkeys
+  variable _action;                   set _action      refuse_drop
+  variable _common_drag_source_types; set _common_drag_source_types {}
+  variable _common_drop_target_types; set _common_drop_target_types {}
+  variable _actionlist
+  variable _drag_source;              set _drag_source $drag_source
+  variable _drop_target;              set _drop_target {}
+  variable _actionlist;               set _actionlist  $actionlist
+  variable _codelist                  set _codelist    $codelist
+
+  variable _last_mouse_root_x;        set _last_mouse_root_x 0
+  variable _last_mouse_root_y;        set _last_mouse_root_y 0
+  # debug "\n==============================================================="
+  # debug "generic::HandleEnter: drop_target=$drop_target,\
+  #        drag_source=$drag_source,\
+  #        typelist=$typelist"
+  # debug "generic::HandleEnter: ACTION: default"
+  return default
+};# generic::HandleEnter
+
+# ----------------------------------------------------------------------------
+#  Command generic::HandlePosition
+# ----------------------------------------------------------------------------
+proc generic::HandlePosition { drop_target drag_source pressedkeys
+                               rootX rootY { time 0 } } {
+  variable _types
+  variable _typelist
+  variable _codelist
+  variable _actionlist
+  variable _pressedkeys
+  variable _action
+  variable _common_drag_source_types
+  variable _common_drop_target_types
+  variable _drag_source
+  variable _drop_target
+
+  variable _last_mouse_root_x;        set _last_mouse_root_x $rootX
+  variable _last_mouse_root_y;        set _last_mouse_root_y $rootY
+
+  # debug "generic::HandlePosition: drop_target=$drop_target,\
+  #            _drop_target=$_drop_target, rootX=$rootX, rootY=$rootY"
+
+  if {![info exists _drag_source] && ![string length $_drag_source]} {
+    # debug "generic::HandlePosition: no or empty _drag_source:\
+    #               return refuse_drop"
+    return refuse_drop
+  }
+
+  if {$drag_source ne "" && $drag_source ne $_drag_source} {
+    debug "generic position event from unexpected source: $_drag_source\
+           != $drag_source"
+    return refuse_drop
+  }
+
+  set _pressedkeys $pressedkeys
+
+  ## Does the new drop target support any of our new types?
+  # foreach {common_drag_source_types common_drop_target_types} \
+  #         [GetWindowCommonTypes $drop_target $_typelist] {break}
+  foreach {drop_target common_drag_source_types common_drop_target_types} \
+          [FindWindowWithCommonTypes $drop_target $_typelist] {break}
+  set data [GetDroppedData $time]
+
+  # debug "\t($_drop_target) -> ($drop_target)"
+  if {$drop_target != $_drop_target} {
+    if {[string length $_drop_target]} {
+      ## Call the <<DropLeave>> event.
+      # debug "\t<<DropLeave>> on $_drop_target"
+      set cmd [bind $_drop_target <<DropLeave>>]
+      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\} \
+          %CPT \{[lindex [platform_independent_type [lindex $_common_drag_source_types 0]] 0]\} \
+          %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]\} \
+          %c   \{$_codelist\}    %C  \{[lindex $_codelist 0]\} \
+          ] $cmd]
+        uplevel \#0 $cmd
+      }
+    }
+    set _drop_target $drop_target
+    set _action      refuse_drop
+
+    if {[llength $common_drag_source_types]} {
+      set _action [lindex $_actionlist 0]
+      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>>.
+      # puts "<<DropEnter>> -> $drop_target"
+      set cmd [bind $drop_target <<DropEnter>>]
+      if {[string length $cmd]} {
+        focus $drop_target
+        set cmd [string map [list %W $drop_target %X $rootX %Y $rootY \
+          %CST \{$_common_drag_source_types\} \
+          %CTT \{$_common_drop_target_types\} \
+          %CPT \{[lindex [platform_independent_type [lindex $_common_drag_source_types 0]] 0]\} \
+          %ST  \{$_typelist\}    %TT \{$_types\} \
+          %A   $_action          %a  \{$_actionlist\} \
+          %b   \{$_pressedkeys\} %m  \{$_pressedkeys\} \
+          %D   [list $data]      %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]
+        switch -exact -- $_action {
+          copy - move - link - ask - private - refuse_drop - default {}
+          default {set _action copy}
+        }
+      }
+    }
+  }
+
+  set _drop_target {}
+  if {[llength $common_drag_source_types]} {
+    set _common_drag_source_types $common_drag_source_types
+    set _common_drop_target_types $common_drop_target_types
+    set _drop_target $drop_target
+    ## Drop target supports at least one type. Send a <<DropPosition>>.
+    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\} \
+        %CPT \{[lindex [platform_independent_type [lindex $_common_drag_source_types 0]] 0]\} \
+        %ST  \{$_typelist\}    %TT \{$_types\} \
+        %A   $_action          %a  \{$_actionlist\} \
+        %b   \{$_pressedkeys\} %m  \{$_pressedkeys\} \
+        %D   [list $data]      %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]
+    }
+  }
+  # Return values: copy, move, link, ask, private, refuse_drop, default
+  # debug "generic::HandlePosition: ACTION: $_action"
+  switch -exact -- $_action {
+    copy - move - link - ask - private - refuse_drop - default {}
+    default {set _action copy}
+  }
+  return $_action
+};# generic::HandlePosition
+
+# ----------------------------------------------------------------------------
+#  Command generic::HandleLeave
+# ----------------------------------------------------------------------------
+proc generic::HandleLeave { } {
+  variable _types
+  variable _typelist
+  variable _codelist
+  variable _actionlist
+  variable _pressedkeys
+  variable _action
+  variable _common_drag_source_types
+  variable _common_drop_target_types
+  variable _drag_source
+  variable _drop_target
+  variable _last_mouse_root_x
+  variable _last_mouse_root_y
+  if {![info exists _drop_target]} {set _drop_target {}}
+  # debug "generic::HandleLeave: _drop_target=$_drop_target"
+  if {[info exists _drop_target] && [string length $_drop_target]} {
+    set cmd [bind $_drop_target <<DropLeave>>]
+    if {[string length $cmd]} {
+      set cmd [string map [list %W $_drop_target \
+        %X $_last_mouse_root_x %Y $_last_mouse_root_y \
+        %CST \{$_common_drag_source_types\} \
+        %CTT \{$_common_drop_target_types\} \
+        %CPT \{[lindex [platform_independent_type [lindex $_common_drag_source_types 0]] 0]\} \
+        %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]\} \
+        %c   \{$_codelist\}    %C  \{[lindex $_codelist 0]\} \
+        ] $cmd]
+      set _action [uplevel \#0 $cmd]
+    }
+  }
+  foreach var {_types _typelist _actionlist _pressedkeys _action
+               _common_drag_source_types _common_drop_target_types
+               _drag_source _drop_target} {
+    set $var {}
+  }
+};# generic::HandleLeave
+
+# ----------------------------------------------------------------------------
+#  Command generic::HandleDrop
+# ----------------------------------------------------------------------------
+proc generic::HandleDrop {drop_target drag_source pressedkeys rootX rootY time } {
+  variable _types
+  variable _typelist
+  variable _codelist
+  variable _actionlist
+  variable _pressedkeys
+  variable _action
+  variable _common_drag_source_types
+  variable _common_drop_target_types
+  variable _drag_source
+  variable _drop_target
+  variable _last_mouse_root_x
+  variable _last_mouse_root_y
+  variable _last_mouse_root_x;        set _last_mouse_root_x $rootX
+  variable _last_mouse_root_y;        set _last_mouse_root_y $rootY
+
+  set _pressedkeys $pressedkeys
+
+  # puts "generic::HandleDrop: $time"
+
+  if {![info exists _drag_source] && ![string length $_drag_source]} {
+    return refuse_drop
+  }
+  if {![info exists _drop_target] && ![string length $_drop_target]} {
+    return refuse_drop
+  }
+  if {![llength $_common_drag_source_types]} {return refuse_drop}
+  ## Get the dropped data.
+  set data [GetDroppedData $time]
+  ## 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\} \
+        %CPT \{[lindex [platform_independent_type [lindex $_common_drag_source_types 0]] 0]\} \
+        %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]
+      set _action [uplevel \#0 $cmd]
+      # Return values: copy, move, link, ask, private, refuse_drop
+      switch -exact -- $_action {
+        copy - move - link - ask - private - refuse_drop - default {}
+        default {set _action copy}
+      }
+      return $_action
+    }
+  }
+  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\} \
+      %CPT \{[lindex [platform_independent_type [lindex $_common_drag_source_types 0]] 0]\} \
+      %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]
+  }
+  # Return values: copy, move, link, ask, private, refuse_drop
+  switch -exact -- $_action {
+    copy - move - link - ask - private - refuse_drop - default {}
+    default {set _action copy}
+  }
+  return $_action
+};# generic::HandleDrop
+
+# ----------------------------------------------------------------------------
+#  Command generic::GetWindowCommonTypes
+# ----------------------------------------------------------------------------
+proc generic::GetWindowCommonTypes { win typelist } {
+  set types [bind $win <<DropTargetTypes>>]
+  # debug ">> Accepted types: $win $_types"
+  set common_drag_source_types {}
+  set common_drop_target_types {}
+  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
+      }
+    }
+  }
+  list $common_drag_source_types $common_drop_target_types
+};# generic::GetWindowCommonTypes
+
+# ----------------------------------------------------------------------------
+#  Command generic::FindWindowWithCommonTypes
+# ----------------------------------------------------------------------------
+proc generic::FindWindowWithCommonTypes { win typelist } {
+  set toplevel [winfo toplevel $win]
+  while {![string equal $win $toplevel]} {
+    foreach {common_drag_source_types common_drop_target_types} \
+            [GetWindowCommonTypes $win $typelist] {break}
+    if {[llength $common_drag_source_types]} {
+      return [list $win $common_drag_source_types $common_drop_target_types]
+    }
+    set win [winfo parent $win]
+  }
+  ## We have reached the toplevel, which may be also a target (SF Bug #30)
+  foreach {common_drag_source_types common_drop_target_types} \
+          [GetWindowCommonTypes $win $typelist] {break}
+  if {[llength $common_drag_source_types]} {
+    return [list $win $common_drag_source_types $common_drop_target_types]
+  }
+  return { {} {} {} }
+};# generic::FindWindowWithCommonTypes
+
+# ----------------------------------------------------------------------------
+#  Command generic::GetDroppedData
+# ----------------------------------------------------------------------------
+proc generic::GetDroppedData { time } {
+  variable _dropped_data
+  return  $_dropped_data
+};# generic::GetDroppedData
+
+# ----------------------------------------------------------------------------
+#  Command generic::SetDroppedData
+# ----------------------------------------------------------------------------
+proc generic::SetDroppedData { data } {
+  variable _dropped_data
+  set _dropped_data $data
+};# generic::SetDroppedData
+
+# ----------------------------------------------------------------------------
+#  Command generic::GetDragSource
+# ----------------------------------------------------------------------------
+proc generic::GetDragSource { } {
+  variable _drag_source
+  return  $_drag_source
+};# generic::GetDragSource
+
+# ----------------------------------------------------------------------------
+#  Command generic::GetDropTarget
+# ----------------------------------------------------------------------------
+proc generic::GetDropTarget { } {
+  variable _drop_target
+  return $_drop_target
+};# generic::GetDropTarget
+
+# ----------------------------------------------------------------------------
+#  Command generic::GetDragSourceCommonTypes
+# ----------------------------------------------------------------------------
+proc generic::GetDragSourceCommonTypes { } {
+  variable _common_drag_source_types
+  return  $_common_drag_source_types
+};# generic::GetDragSourceCommonTypes
+
+# ----------------------------------------------------------------------------
+#  Command generic::GetDropTargetCommonTypes
+# ----------------------------------------------------------------------------
+proc generic::GetDropTargetCommonTypes { } {
+  variable _common_drag_source_types
+  return  $_common_drag_source_types
+};# generic::GetDropTargetCommonTypes
+
+# ----------------------------------------------------------------------------
+#  Command generic::platform_specific_types
+# ----------------------------------------------------------------------------
+proc generic::platform_specific_types { types } {
+  set new_types {}
+  foreach type $types {
+    set new_types [concat $new_types [platform_specific_type $type]]
+  }
+  return $new_types
+}; # generic::platform_specific_types
+
+# ----------------------------------------------------------------------------
+#  Command generic::platform_specific_type
+# ----------------------------------------------------------------------------
+proc generic::platform_specific_type { type } {
+  variable _tkdnd2platform
+  if {[dict exists $_tkdnd2platform $type]} {
+    return [dict get $_tkdnd2platform $type]
+  }
+  list $type
+}; # generic::platform_specific_type
+
+# ----------------------------------------------------------------------------
+#  Command tkdnd::platform_independent_types
+# ----------------------------------------------------------------------------
+proc ::tkdnd::platform_independent_types { types } {
+  set new_types {}
+  foreach type $types {
+    set new_types [concat $new_types [platform_independent_type $type]]
+  }
+  return $new_types
+}; # tkdnd::platform_independent_types
+
+# ----------------------------------------------------------------------------
+#  Command generic::platform_independent_type
+# ----------------------------------------------------------------------------
+proc generic::platform_independent_type { type } {
+  variable _platform2tkdnd
+  if {[dict exists $_platform2tkdnd $type]} {
+    return [dict get $_platform2tkdnd $type]
+  }
+  return $type
+}; # generic::platform_independent_type
+
+# ----------------------------------------------------------------------------
+#  Command generic::supported_types
+# ----------------------------------------------------------------------------
+proc generic::supported_types { types } {
+  set new_types {}
+  foreach type $types {
+    if {[supported_type $type]} {lappend new_types $type}
+  }
+  return $new_types
+}; # generic::supported_types
+
+# ----------------------------------------------------------------------------
+#  Command generic::supported_type
+# ----------------------------------------------------------------------------
+proc generic::supported_type { type } {
+  variable _platform2tkdnd
+  if {[dict exists $_platform2tkdnd $type]} {
+    return 1
+  }
+  return 0
+}; # generic::supported_type

tkinterdnd2/tkdnd/osx64/tkdnd_macosx.tcl

@@ -0,0 +1,144 @@
+#
+# 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 {
+
+  proc initialise { } {
+     ## Mapping from platform types to TkDND types...
+    ::tkdnd::generic::initialise_platform_to_tkdnd_types [list \
+       NSPasteboardTypeString  DND_Text  \
+       NSFilenamesPboardType   DND_Files \
+       NSPasteboardTypeHTML    DND_HTML  \
+    ]
+  };# initialise
+
+};# namespace macdnd
+
+# ----------------------------------------------------------------------------
+#  Command macdnd::HandleEnter
+# ----------------------------------------------------------------------------
+proc macdnd::HandleEnter { path drag_source typelist { data {} } } {
+  variable _pressedkeys
+  variable _actionlist
+  set _pressedkeys 1
+  set _actionlist  { copy move link ask private }
+  ::tkdnd::generic::SetDroppedData $data
+  ::tkdnd::generic::HandleEnter $path $drag_source $typelist $typelist \
+           $_actionlist $_pressedkeys
+};# macdnd::HandleEnter
+
+# ----------------------------------------------------------------------------
+#  Command macdnd::HandlePosition
+# ----------------------------------------------------------------------------
+proc macdnd::HandlePosition { drop_target rootX rootY {drag_source {}} } {
+  variable _pressedkeys
+  variable _last_mouse_root_x; set _last_mouse_root_x $rootX
+  variable _last_mouse_root_y; set _last_mouse_root_y $rootY
+  ::tkdnd::generic::HandlePosition $drop_target $drag_source \
+                                   $_pressedkeys $rootX $rootY
+};# macdnd::HandlePosition
+
+# ----------------------------------------------------------------------------
+#  Command macdnd::HandleLeave
+# ----------------------------------------------------------------------------
+proc macdnd::HandleLeave { args } {
+  ::tkdnd::generic::HandleLeave
+};# macdnd::HandleLeave
+
+# ----------------------------------------------------------------------------
+#  Command macdnd::HandleDrop
+# ----------------------------------------------------------------------------
+proc macdnd::HandleDrop { drop_target data args } {
+  variable _pressedkeys
+  variable _last_mouse_root_x
+  variable _last_mouse_root_y
+  ## Get the dropped data...
+  ::tkdnd::generic::SetDroppedData $data
+  ::tkdnd::generic::HandleDrop {} {} $_pressedkeys \
+                               $_last_mouse_root_x $_last_mouse_root_y 0
+};# macdnd::HandleDrop
+
+# ----------------------------------------------------------------------------
+#  Command macdnd::GetDragSourceCommonTypes
+# ----------------------------------------------------------------------------
+proc macdnd::GetDragSourceCommonTypes { } {
+  ::tkdnd::generic::GetDragSourceCommonTypes
+};# macdnd::GetDragSourceCommonTypes
+
+# ----------------------------------------------------------------------------
+#  Command macdnd::platform_specific_types
+# ----------------------------------------------------------------------------
+proc macdnd::platform_specific_types { types } {
+  ::tkdnd::generic::platform_specific_types $types
+}; # macdnd::platform_specific_types
+
+# ----------------------------------------------------------------------------
+#  Command macdnd::platform_specific_type
+# ----------------------------------------------------------------------------
+proc macdnd::platform_specific_type { type } {
+  ::tkdnd::generic::platform_specific_type $type
+}; # macdnd::platform_specific_type
+
+# ----------------------------------------------------------------------------
+#  Command tkdnd::platform_independent_types
+# ----------------------------------------------------------------------------
+proc ::tkdnd::platform_independent_types { types } {
+  ::tkdnd::generic::platform_independent_types $types
+}; # tkdnd::platform_independent_types
+
+# ----------------------------------------------------------------------------
+#  Command macdnd::platform_independent_type
+# ----------------------------------------------------------------------------
+proc macdnd::platform_independent_type { type } {
+  ::tkdnd::generic::platform_independent_type $type
+}; # macdnd::platform_independent_type

tkinterdnd2/tkdnd/osx64/tkdnd_unix.tcl

@@ -0,0 +1,810 @@
+#
+# tkdnd_unix.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 xdnd {
+  variable _dragging 0
+
+  proc initialise { } {
+    ## Mapping from platform types to TkDND types...
+    ::tkdnd::generic::initialise_platform_to_tkdnd_types [list \
+       text/plain\;charset=utf-8     DND_Text  \
+       UTF8_STRING                   DND_Text  \
+       text/plain                    DND_Text  \
+       STRING                        DND_Text  \
+       TEXT                          DND_Text  \
+       COMPOUND_TEXT                 DND_Text  \
+       text/uri-list                 DND_Files \
+       text/html\;charset=utf-8      DND_HTML  \
+       text/html                     DND_HTML  \
+       application/x-color           DND_Color \
+    ]
+  };# initialise
+
+};# namespace xdnd
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::HandleXdndEnter
+# ----------------------------------------------------------------------------
+proc xdnd::HandleXdndEnter { path drag_source typelist time { data {} } } {
+  variable _pressedkeys
+  variable _actionlist
+  variable _typelist
+  set _pressedkeys 1
+  set _actionlist  { copy move link ask private }
+  set _typelist    $typelist
+  # puts "xdnd::HandleXdndEnter: $time"
+  ::tkdnd::generic::SetDroppedData $data
+  ::tkdnd::generic::HandleEnter $path $drag_source $typelist $typelist \
+           $_actionlist $_pressedkeys
+};# xdnd::HandleXdndEnter
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::HandleXdndPosition
+# ----------------------------------------------------------------------------
+proc xdnd::HandleXdndPosition { drop_target rootX rootY time {drag_source {}} } {
+  variable _pressedkeys
+  variable _typelist
+  variable _last_mouse_root_x; set _last_mouse_root_x $rootX
+  variable _last_mouse_root_y; set _last_mouse_root_y $rootY
+  # puts "xdnd::HandleXdndPosition: $time"
+  ## Get the dropped data...
+  catch {
+    ::tkdnd::generic::SetDroppedData [GetPositionData $drop_target $_typelist $time]
+  }
+  ::tkdnd::generic::HandlePosition $drop_target $drag_source \
+                                   $_pressedkeys $rootX $rootY
+};# xdnd::HandleXdndPosition
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::HandleXdndLeave
+# ----------------------------------------------------------------------------
+proc xdnd::HandleXdndLeave { } {
+  ::tkdnd::generic::HandleLeave
+};# xdnd::HandleXdndLeave
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::_HandleXdndDrop
+# ----------------------------------------------------------------------------
+proc xdnd::HandleXdndDrop { time } {
+  variable _pressedkeys
+  variable _last_mouse_root_x
+  variable _last_mouse_root_y
+  ## Get the dropped data...
+  ::tkdnd::generic::SetDroppedData [GetDroppedData \
+    [::tkdnd::generic::GetDragSource] [::tkdnd::generic::GetDropTarget] \
+    [::tkdnd::generic::GetDragSourceCommonTypes] $time]
+  ::tkdnd::generic::HandleDrop {} {} $_pressedkeys \
+                               $_last_mouse_root_x $_last_mouse_root_y $time
+};# xdnd::HandleXdndDrop
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::GetPositionData
+# ----------------------------------------------------------------------------
+proc xdnd::GetPositionData { drop_target typelist time } {
+  foreach {drop_target common_drag_source_types common_drop_target_types} \
+    [::tkdnd::generic::FindWindowWithCommonTypes $drop_target $typelist] {break}
+  GetDroppedData [::tkdnd::generic::GetDragSource] $drop_target \
+    $common_drag_source_types $time
+};# xdnd::GetPositionData
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::GetDroppedData
+# ----------------------------------------------------------------------------
+proc xdnd::GetDroppedData { _drag_source _drop_target _common_drag_source_types time } {
+  if {![llength $_common_drag_source_types]} {
+    error "no common data types between the drag source and drop target widgets"
+  }
+  ## Is drag source in this application?
+  if {[catch {winfo pathname -displayof $_drop_target $_drag_source} p]} {
+    set _use_tk_selection 0
+  } else {
+    set _use_tk_selection 1
+  }
+  foreach type $_common_drag_source_types {
+    # puts "TYPE: $type ($_drop_target)"
+    # _get_selection $_drop_target $time $type
+    if {$_use_tk_selection} {
+      if {![catch {
+        selection get -displayof $_drop_target -selection XdndSelection \
+                      -type $type
+                                              } result options]} {
+        return [normalise_data $type $result]
+      }
+    } else {
+      # puts "_selection_get -displayof $_drop_target -selection XdndSelection \
+      #                 -type $type -time $time"
+      #after 100 [list focus -force $_drop_target]
+      #after 50 [list raise [winfo toplevel $_drop_target]]
+      if {![catch {
+        _selection_get -displayof $_drop_target -selection XdndSelection \
+                      -type $type -time $time
+                                              } result options]} {
+        return [normalise_data $type $result]
+      }
+    }
+  }
+  return -options $options $result
+};# xdnd::GetDroppedData
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::platform_specific_types
+# ----------------------------------------------------------------------------
+proc xdnd::platform_specific_types { types } {
+  ::tkdnd::generic::platform_specific_types $types
+}; # xdnd::platform_specific_types
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::platform_specific_type
+# ----------------------------------------------------------------------------
+proc xdnd::platform_specific_type { type } {
+  ::tkdnd::generic::platform_specific_type $type
+}; # xdnd::platform_specific_type
+
+# ----------------------------------------------------------------------------
+#  Command tkdnd::platform_independent_types
+# ----------------------------------------------------------------------------
+proc ::tkdnd::platform_independent_types { types } {
+  ::tkdnd::generic::platform_independent_types $types
+}; # tkdnd::platform_independent_types
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::platform_independent_type
+# ----------------------------------------------------------------------------
+proc xdnd::platform_independent_type { type } {
+  ::tkdnd::generic::platform_independent_type $type
+}; # xdnd::platform_independent_type
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::_normalise_data
+# ----------------------------------------------------------------------------
+proc xdnd::normalise_data { type data } {
+  # Tk knows how to interpret the following types:
+  #    STRING, TEXT, COMPOUND_TEXT
+  #    UTF8_STRING
+  # Else, it returns a list of 8 or 32 bit numbers...
+  switch -glob $type {
+    STRING - UTF8_STRING - TEXT - COMPOUND_TEXT {return $data}
+    text/html {
+      if {[catch {
+            encoding convertfrom unicode $data
+           } string]} {
+        set string $data
+      }
+      return [string map {\r\n \n} $string]
+    }
+    text/html\;charset=utf-8  -
+    text/plain\;charset=utf-8 -
+    text/plain {
+      if {[catch {
+            encoding convertfrom utf-8 [tkdnd::bytes_to_string $data]
+           } string]} {
+        set string $data
+      }
+      return [string map {\r\n \n} $string]
+    }
+    text/uri-list* {
+      if {[catch {
+            encoding convertfrom utf-8 [tkdnd::bytes_to_string $data]
+          } string]} {
+        set string $data
+      }
+      ## Get rid of \r\n
+      set string [string trim [string map {\r\n \n} $string]]
+      set files {}
+      foreach quoted_file [split $string] {
+        set file [tkdnd::urn_unquote $quoted_file]
+        switch -glob $file {
+          \#*       {}
+          file://*  {lappend files [string range $file 7 end]}
+          ftp://*   -
+          https://* -
+          http://*  {lappend files $quoted_file}
+          default   {lappend files $file}
+        }
+      }
+      return $files
+    }
+    application/x-color {
+      return $data
+    }
+    text/x-moz-url -
+    application/q-iconlist -
+    default    {return $data}
+  }
+}; # xdnd::normalise_data
+
+#############################################################################
+##
+##  XDND drag implementation
+##
+#############################################################################
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::_selection_ownership_lost
+# ----------------------------------------------------------------------------
+proc xdnd::_selection_ownership_lost {} {
+  variable _dragging
+  set _dragging 0
+};# _selection_ownership_lost
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::_dodragdrop
+# ----------------------------------------------------------------------------
+proc xdnd::_dodragdrop { source actions types data button } {
+  variable _dragging
+
+  # puts "xdnd::_dodragdrop: source: $source, actions: $actions, types: $types,\
+  #       data: \"$data\", button: $button"
+  if {$_dragging} {
+    ## We are in the middle of another drag operation...
+    error "another drag operation in progress"
+  }
+
+  variable _dodragdrop_drag_source                $source
+  variable _dodragdrop_drop_target                0
+  variable _dodragdrop_drop_target_proxy          0
+  variable _dodragdrop_actions                    $actions
+  variable _dodragdrop_action_descriptions        $actions
+  variable _dodragdrop_actions_len                [llength $actions]
+  variable _dodragdrop_types                      $types
+  variable _dodragdrop_types_len                  [llength $types]
+  variable _dodragdrop_data                       $data
+  variable _dodragdrop_transfer_data              {}
+  variable _dodragdrop_button                     $button
+  variable _dodragdrop_time                       0
+  variable _dodragdrop_default_action             refuse_drop
+  variable _dodragdrop_waiting_status             0
+  variable _dodragdrop_drop_target_accepts_drop   0
+  variable _dodragdrop_drop_target_accepts_action refuse_drop
+  variable _dodragdrop_current_cursor             $_dodragdrop_default_action
+  variable _dodragdrop_drop_occured               0
+  variable _dodragdrop_selection_requestor        0
+
+  ##
+  ## If we have more than 3 types, the property XdndTypeList must be set on
+  ## the drag source widget...
+  ##
+  if {$_dodragdrop_types_len > 3} {
+    _announce_type_list $_dodragdrop_drag_source $_dodragdrop_types
+  }
+
+  ##
+  ## Announce the actions & their descriptions on the XdndActionList &
+  ## XdndActionDescription properties...
+  ##
+  _announce_action_list $_dodragdrop_drag_source $_dodragdrop_actions \
+                        $_dodragdrop_action_descriptions
+
+  ##
+  ## Arrange selection handlers for our drag source, and all the supported types
+  ##
+  registerSelectionHandler $source $types
+
+  ##
+  ## Step 1: When a drag begins, the source takes ownership of XdndSelection.
+  ##
+  selection own -command ::tkdnd::xdnd::_selection_ownership_lost \
+                -selection XdndSelection $source
+  set _dragging 1
+
+  ## Grab the mouse pointer...
+  _grab_pointer $source $_dodragdrop_default_action
+
+  ## Register our generic event handler...
+  #  The generic event callback will report events by modifying variable
+  #  ::xdnd::_dodragdrop_event: a dict with event information will be set as
+  #  the value of the variable...
+  _register_generic_event_handler
+
+  ## Set a timeout for debugging purposes...
+  #  after 60000 {set ::tkdnd::xdnd::_dragging 0}
+
+  tkwait variable ::tkdnd::xdnd::_dragging
+  _SendXdndLeave
+
+  set _dragging 0
+  _ungrab_pointer $source
+  _unregister_generic_event_handler
+  catch {selection clear -selection XdndSelection}
+  unregisterSelectionHandler $source $types
+  return $_dodragdrop_drop_target_accepts_action
+};# xdnd::_dodragdrop
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::_process_drag_events
+# ----------------------------------------------------------------------------
+proc xdnd::_process_drag_events {event} {
+  # The return value from proc is normally 0. A non-zero return value indicates
+  # that the event is not to be handled further; that is, proc has done all
+  # processing that is to be allowed for the event
+  variable _dragging
+  if {!$_dragging} {return 0}
+  # puts $event
+
+  variable _dodragdrop_time
+  set time [dict get $event time]
+  set type [dict get $event type]
+  if {$time < $_dodragdrop_time && ![string equal $type SelectionRequest]} {
+    return 0
+  }
+  set _dodragdrop_time $time
+
+  variable _dodragdrop_drag_source
+  variable _dodragdrop_drop_target
+  variable _dodragdrop_drop_target_proxy
+  variable _dodragdrop_default_action
+  switch $type {
+    MotionNotify {
+      set rootx  [dict get $event x_root]
+      set rooty  [dict get $event y_root]
+      set window [_find_drop_target_window $_dodragdrop_drag_source \
+                                           $rootx $rooty]
+      if {[string length $window]} {
+        ## Examine the modifiers to suggest an action...
+        set _dodragdrop_default_action [_default_action $event]
+        ## Is it a Tk widget?
+        # set path [winfo containing $rootx $rooty]
+        # puts "Window under mouse: $window ($path)"
+        if {$_dodragdrop_drop_target != $window} {
+          ## Send XdndLeave to $_dodragdrop_drop_target
+          _SendXdndLeave
+          ## Is there a proxy? If not, _find_drop_target_proxy returns the
+          ## target window, so we always get a valid "proxy".
+          set proxy [_find_drop_target_proxy $_dodragdrop_drag_source $window]
+          ## Send XdndEnter to $window
+          _SendXdndEnter $window $proxy
+          ## Send XdndPosition to $_dodragdrop_drop_target
+          _SendXdndPosition $rootx $rooty $_dodragdrop_default_action
+        } else {
+          ## Send XdndPosition to $_dodragdrop_drop_target
+          _SendXdndPosition $rootx $rooty $_dodragdrop_default_action
+        }
+      } else {
+        ## No window under the mouse. Send XdndLeave to $_dodragdrop_drop_target
+        _SendXdndLeave
+      }
+    }
+    ButtonPress {
+    }
+    ButtonRelease {
+      variable _dodragdrop_button
+      set button [dict get $event button]
+      if {$button == $_dodragdrop_button} {
+        ## The button that initiated the drag was released. Trigger drop...
+        _SendXdndDrop
+      }
+      return 1
+    }
+    KeyPress {
+    }
+    KeyRelease {
+      set keysym [dict get $event keysym]
+      switch $keysym {
+        Escape {
+          ## The user has pressed escape. Abort...
+          if {$_dragging} {set _dragging 0}
+        }
+      }
+    }
+    SelectionRequest {
+      variable _dodragdrop_selection_requestor
+      variable _dodragdrop_selection_property
+      variable _dodragdrop_selection_selection
+      variable _dodragdrop_selection_target
+      variable _dodragdrop_selection_time
+      set _dodragdrop_selection_requestor [dict get $event requestor]
+      set _dodragdrop_selection_property  [dict get $event property]
+      set _dodragdrop_selection_selection [dict get $event selection]
+      set _dodragdrop_selection_target    [dict get $event target]
+      set _dodragdrop_selection_time      $time
+      return 0
+    }
+    default {
+      return 0
+    }
+  }
+  return 0
+};# _process_drag_events
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::_SendXdndEnter
+# ----------------------------------------------------------------------------
+proc xdnd::_SendXdndEnter {window proxy} {
+  variable _dodragdrop_drag_source
+  variable _dodragdrop_drop_target
+  variable _dodragdrop_drop_target_proxy
+  variable _dodragdrop_types
+  variable _dodragdrop_waiting_status
+  variable _dodragdrop_drop_occured
+  if {$_dodragdrop_drop_target > 0} _SendXdndLeave
+  if {$_dodragdrop_drop_occured} return
+  set _dodragdrop_drop_target       $window
+  set _dodragdrop_drop_target_proxy $proxy
+  set _dodragdrop_waiting_status    0
+  if {$_dodragdrop_drop_target < 1} return
+  # puts "XdndEnter: $_dodragdrop_drop_target $_dodragdrop_drop_target_proxy"
+  _send_XdndEnter $_dodragdrop_drag_source $_dodragdrop_drop_target \
+                  $_dodragdrop_drop_target_proxy $_dodragdrop_types
+};# xdnd::_SendXdndEnter
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::_SendXdndPosition
+# ----------------------------------------------------------------------------
+proc xdnd::_SendXdndPosition {rootx rooty action} {
+  variable _dodragdrop_drag_source
+  variable _dodragdrop_drop_target
+  if {$_dodragdrop_drop_target < 1} return
+  variable _dodragdrop_drop_occured
+  if {$_dodragdrop_drop_occured} return
+  variable _dodragdrop_drop_target_proxy
+  variable _dodragdrop_waiting_status
+  ## Arrange a new XdndPosition, to be send periodically...
+  variable _dodragdrop_xdnd_position_heartbeat
+  catch {after cancel $_dodragdrop_xdnd_position_heartbeat}
+  set _dodragdrop_xdnd_position_heartbeat [after 200 \
+    [list ::tkdnd::xdnd::_SendXdndPosition $rootx $rooty $action]]
+  if {$_dodragdrop_waiting_status} {return}
+  # puts "XdndPosition: $_dodragdrop_drop_target $rootx $rooty $action"
+  _send_XdndPosition $_dodragdrop_drag_source $_dodragdrop_drop_target \
+                     $_dodragdrop_drop_target_proxy $rootx $rooty $action
+  set _dodragdrop_waiting_status 1
+};# xdnd::_SendXdndPosition
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::_HandleXdndStatus
+# ----------------------------------------------------------------------------
+proc xdnd::_HandleXdndStatus {event} {
+  variable _dodragdrop_drop_target
+  variable _dodragdrop_waiting_status
+
+  variable _dodragdrop_drop_target_accepts_drop
+  variable _dodragdrop_drop_target_accepts_action
+  set _dodragdrop_waiting_status 0
+  foreach key {target accept want_position action x y w h} {
+    set $key [dict get $event $key]
+  }
+  set _dodragdrop_drop_target_accepts_drop   $accept
+  set _dodragdrop_drop_target_accepts_action $action
+  if {$_dodragdrop_drop_target < 1} return
+  variable _dodragdrop_drop_occured
+  if {$_dodragdrop_drop_occured} return
+  _update_cursor
+  # puts "XdndStatus: $event"
+};# xdnd::_HandleXdndStatus
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::_HandleXdndFinished
+# ----------------------------------------------------------------------------
+proc xdnd::_HandleXdndFinished {event} {
+  variable _dodragdrop_xdnd_finished_event_after_id
+  catch {after cancel $_dodragdrop_xdnd_finished_event_after_id}
+  set _dodragdrop_xdnd_finished_event_after_id {}
+  variable _dodragdrop_drop_target
+  set _dodragdrop_drop_target 0
+  variable _dragging
+  if {$_dragging} {set _dragging 0}
+
+  variable _dodragdrop_drop_target_accepts_drop
+  variable _dodragdrop_drop_target_accepts_action
+  if {[dict size $event]} {
+    foreach key {target accept action} {
+      set $key [dict get $event $key]
+    }
+    set _dodragdrop_drop_target_accepts_drop   $accept
+    set _dodragdrop_drop_target_accepts_action $action
+  } else {
+    set _dodragdrop_drop_target_accepts_drop 0
+  }
+  if {!$_dodragdrop_drop_target_accepts_drop} {
+    set _dodragdrop_drop_target_accepts_action refuse_drop
+  }
+  # puts "XdndFinished: $event"
+};# xdnd::_HandleXdndFinished
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::_SendXdndLeave
+# ----------------------------------------------------------------------------
+proc xdnd::_SendXdndLeave {} {
+  variable _dodragdrop_drag_source
+  variable _dodragdrop_drop_target
+  if {$_dodragdrop_drop_target < 1} return
+  variable _dodragdrop_drop_target_proxy
+  # puts "XdndLeave: $_dodragdrop_drop_target"
+  _send_XdndLeave $_dodragdrop_drag_source $_dodragdrop_drop_target \
+                  $_dodragdrop_drop_target_proxy
+  set _dodragdrop_drop_target 0
+  variable _dodragdrop_drop_target_accepts_drop
+  variable _dodragdrop_drop_target_accepts_action
+  set _dodragdrop_drop_target_accepts_drop   0
+  set _dodragdrop_drop_target_accepts_action refuse_drop
+  variable _dodragdrop_drop_occured
+  if {$_dodragdrop_drop_occured} return
+  _update_cursor
+};# xdnd::_SendXdndLeave
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::_SendXdndDrop
+# ----------------------------------------------------------------------------
+proc xdnd::_SendXdndDrop {} {
+  variable _dodragdrop_drag_source
+  variable _dodragdrop_drop_target
+  if {$_dodragdrop_drop_target < 1} {
+    ## The mouse has been released over a widget that does not accept drops.
+    _HandleXdndFinished {}
+    return
+  }
+  variable _dodragdrop_drop_occured
+  if {$_dodragdrop_drop_occured} {return}
+  variable _dodragdrop_drop_target_proxy
+  variable _dodragdrop_drop_target_accepts_drop
+  variable _dodragdrop_drop_target_accepts_action
+
+  set _dodragdrop_drop_occured 1
+  _update_cursor clock
+
+  if {!$_dodragdrop_drop_target_accepts_drop} {
+    _SendXdndLeave
+    _HandleXdndFinished {}
+    return
+  }
+  # puts "XdndDrop: $_dodragdrop_drop_target"
+  variable _dodragdrop_drop_timestamp
+  set _dodragdrop_drop_timestamp [_send_XdndDrop \
+                 $_dodragdrop_drag_source $_dodragdrop_drop_target \
+                 $_dodragdrop_drop_target_proxy]
+  set _dodragdrop_drop_target 0
+  # puts "XdndDrop: $_dodragdrop_drop_target"
+  ## Arrange a timeout for receiving XdndFinished...
+  variable _dodragdrop_xdnd_finished_event_after_id
+  set _dodragdrop_xdnd_finished_event_after_id \
+    [after 10000 [list ::tkdnd::xdnd::_HandleXdndFinished {}]]
+};# xdnd::_SendXdndDrop
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::_update_cursor
+# ----------------------------------------------------------------------------
+proc xdnd::_update_cursor { {cursor {}}} {
+  # puts "_update_cursor $cursor"
+  variable _dodragdrop_current_cursor
+  variable _dodragdrop_drag_source
+  variable _dodragdrop_drop_target_accepts_drop
+  variable _dodragdrop_drop_target_accepts_action
+
+  if {![string length $cursor]} {
+    set cursor refuse_drop
+    if {$_dodragdrop_drop_target_accepts_drop} {
+      set cursor $_dodragdrop_drop_target_accepts_action
+    }
+  }
+  if {![string equal $cursor $_dodragdrop_current_cursor]} {
+    _set_pointer_cursor $_dodragdrop_drag_source $cursor
+    set _dodragdrop_current_cursor $cursor
+  }
+};# xdnd::_update_cursor
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::_default_action
+# ----------------------------------------------------------------------------
+proc xdnd::_default_action {event} {
+  variable _dodragdrop_actions
+  variable _dodragdrop_actions_len
+  if {$_dodragdrop_actions_len == 1} {return [lindex $_dodragdrop_actions 0]}
+
+  set alt     [dict get $event Alt]
+  set shift   [dict get $event Shift]
+  set control [dict get $event Control]
+
+  if {$shift && $control && [lsearch $_dodragdrop_actions link] != -1} {
+    return link
+  } elseif {$control && [lsearch $_dodragdrop_actions copy] != -1} {
+    return copy
+  } elseif {$shift && [lsearch $_dodragdrop_actions move] != -1} {
+    return move
+  } elseif {$alt && [lsearch $_dodragdrop_actions link] != -1} {
+    return link
+  }
+  return default
+};# xdnd::_default_action
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::getFormatForType
+# ----------------------------------------------------------------------------
+proc xdnd::getFormatForType {type} {
+  switch -glob [string tolower $type] {
+    text/plain\;charset=utf-8 -
+    text/html\;charset=utf-8  -
+    utf8_string               {set format UTF8_STRING}
+    text/html                 -
+    text/plain                -
+    string                    -
+    text                      -
+    compound_text             {set format STRING}
+    text/uri-list*            {set format UTF8_STRING}
+    application/x-color       {set format $type}
+    default                   {set format $type}
+  }
+  return $format
+};# xdnd::getFormatForType
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::registerSelectionHandler
+# ----------------------------------------------------------------------------
+proc xdnd::registerSelectionHandler {source types} {
+  foreach type $types {
+    selection handle -selection XdndSelection \
+                     -type $type \
+                     -format [getFormatForType $type] \
+                     $source [list ::tkdnd::xdnd::_SendData $type]
+  }
+};# xdnd::registerSelectionHandler
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::unregisterSelectionHandler
+# ----------------------------------------------------------------------------
+proc xdnd::unregisterSelectionHandler {source types} {
+  foreach type $types {
+    catch {
+      selection handle -selection XdndSelection \
+                       -type $type \
+                       -format [getFormatForType $type] \
+                       $source {}
+    }
+  }
+};# xdnd::unregisterSelectionHandler
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::_convert_to_unsigned
+# ----------------------------------------------------------------------------
+proc xdnd::_convert_to_unsigned {data format} {
+  switch $format {
+    8  { set mask 0xff }
+    16 { set mask 0xffff }
+    32 { set mask 0xffffff }
+    default {error "unsupported format $format"}
+  }
+  ## Convert signed integer into unsigned...
+  set d [list]
+  foreach num $data {
+    lappend d [expr { $num & $mask }]
+  }
+  return $d
+};# xdnd::_convert_to_unsigned
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::_SendData
+# ----------------------------------------------------------------------------
+proc xdnd::_SendData {type offset bytes args} {
+  variable _dodragdrop_drag_source
+  variable _dodragdrop_types
+  variable _dodragdrop_data
+  variable _dodragdrop_transfer_data
+
+  ## The variable _dodragdrop_data contains a list of data, one for each
+  ## type in the _dodragdrop_types variable. We have to search types, and find
+  ## the corresponding entry in the _dodragdrop_data list.
+  set index [lsearch $_dodragdrop_types $type]
+  if {$index < 0} {
+    error "unable to locate data suitable for type \"$type\""
+  }
+  set typed_data [lindex $_dodragdrop_data $index]
+  set format 8
+  if {$offset == 0} {
+    ## Prepare the data to be transferred...
+    switch -glob $type {
+      text/plain* - UTF8_STRING - STRING - TEXT - COMPOUND_TEXT {
+        binary scan [encoding convertto utf-8 $typed_data] \
+                    c* _dodragdrop_transfer_data
+        set _dodragdrop_transfer_data \
+           [_convert_to_unsigned $_dodragdrop_transfer_data $format]
+      }
+      text/uri-list* {
+        set files [list]
+        foreach file $typed_data {
+          switch -glob $file {
+            *://*     {lappend files $file}
+            default   {lappend files file://$file}
+          }
+        }
+        binary scan [encoding convertto utf-8 "[join $files \r\n]\r\n"] \
+                    c* _dodragdrop_transfer_data
+        set _dodragdrop_transfer_data \
+           [_convert_to_unsigned $_dodragdrop_transfer_data $format]
+      }
+      application/x-color {
+        set format 16
+        ## Try to understand the provided data: we accept a standard Tk colour,
+        ## or a list of 3 values (red green blue) or a list of 4 values
+        ## (red green blue opacity).
+        switch [llength $typed_data] {
+          1 { set color [winfo rgb $_dodragdrop_drag_source $typed_data]
+              lappend color 65535 }
+          3 { set color $typed_data; lappend color 65535 }
+          4 { set color $typed_data }
+          default {error "unknown color data: \"$typed_data\""}
+        }
+        ## Convert the 4 elements into 16 bit values...
+        set _dodragdrop_transfer_data [list]
+        foreach c $color {
+          lappend _dodragdrop_transfer_data [format 0x%04X $c]
+        }
+      }
+      default {
+        set format 32
+        binary scan $typed_data c* _dodragdrop_transfer_data
+      }
+    }
+  }
+
+  ##
+  ## Data has been split into bytes. Count the bytes requested, and return them
+  ##
+  set data [lrange $_dodragdrop_transfer_data $offset [expr {$offset+$bytes-1}]]
+  switch $format {
+    8  {
+      set data [encoding convertfrom utf-8 [binary format c* $data]]
+    }
+    16 {
+      variable _dodragdrop_selection_requestor
+      if {$_dodragdrop_selection_requestor} {
+        ## Tk selection cannot process this format (only 8 & 32 supported).
+        ## Call our XChangeProperty...
+        set numItems [llength $data]
+        variable _dodragdrop_selection_property
+        variable _dodragdrop_selection_selection
+        variable _dodragdrop_selection_target
+        variable _dodragdrop_selection_time
+        XChangeProperty $_dodragdrop_drag_source \
+                        $_dodragdrop_selection_requestor \
+                        $_dodragdrop_selection_property \
+                        $_dodragdrop_selection_target \
+                        $format \
+                        $_dodragdrop_selection_time \
+                        $data $numItems
+        return -code break
+      }
+    }
+    32 {
+    }
+    default {
+      error "unsupported format $format"
+    }
+  }
+  # puts "SendData: $type $offset $bytes $args ($typed_data)"
+  # puts "          $data"
+  return $data
+};# xdnd::_SendData

tkinterdnd2/tkdnd/osx64/tkdnd_utils.tcl

@@ -0,0 +1,252 @@
+#
+# 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

tkinterdnd2/tkdnd/osx64/tkdnd_windows.tcl

@@ -0,0 +1,167 @@
+#
+# 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 {
+
+  proc initialise { } {
+    ## Mapping from platform types to TkDND types...
+    ::tkdnd::generic::initialise_platform_to_tkdnd_types [list \
+       CF_UNICODETEXT          DND_Text  \
+       CF_TEXT                 DND_Text  \
+       CF_HDROP                DND_Files \
+       UniformResourceLocator  DND_URL   \
+       CF_HTML                 DND_HTML  \
+       {HTML Format}           DND_HTML  \
+       CF_RTF                  DND_RTF   \
+       CF_RTFTEXT              DND_RTF   \
+       {Rich Text Format}      DND_RTF   \
+    ]
+    # FileGroupDescriptorW    DND_Files \
+    # FileGroupDescriptor     DND_Files \
+
+    ## Mapping from TkDND types to platform types...
+    ::tkdnd::generic::initialise_tkdnd_to_platform_types [list \
+       DND_Text  {CF_UNICODETEXT CF_TEXT}               \
+       DND_Files {CF_HDROP}                             \
+       DND_URL   {UniformResourceLocator UniformResourceLocatorW} \
+       DND_HTML  {CF_HTML {HTML Format}}                \
+       DND_RTF   {CF_RTF CF_RTFTEXT {Rich Text Format}} \
+    ]
+  };# initialise
+
+};# namespace olednd
+
+# ----------------------------------------------------------------------------
+#  Command olednd::HandleDragEnter
+# ----------------------------------------------------------------------------
+proc olednd::HandleDragEnter { drop_target typelist actionlist pressedkeys
+                               rootX rootY codelist { data {} } } {
+  ::tkdnd::generic::SetDroppedData $data
+  focus $drop_target
+  ::tkdnd::generic::HandleEnter $drop_target 0 $typelist \
+                                $codelist $actionlist $pressedkeys
+  set action [::tkdnd::generic::HandlePosition $drop_target {} \
+                                               $pressedkeys $rootX $rootY]
+  if {$::tkdnd::_auto_update} {update idletasks}
+  return $action
+};# olednd::HandleDragEnter
+
+# ----------------------------------------------------------------------------
+#  Command olednd::HandleDragOver
+# ----------------------------------------------------------------------------
+proc olednd::HandleDragOver { drop_target pressedkeys rootX rootY } {
+  set action [::tkdnd::generic::HandlePosition $drop_target {} \
+                                               $pressedkeys $rootX $rootY]
+  if {$::tkdnd::_auto_update} {update idletasks}
+  return $action
+};# olednd::HandleDragOver
+
+# ----------------------------------------------------------------------------
+#  Command olednd::HandleDragLeave
+# ----------------------------------------------------------------------------
+proc olednd::HandleDragLeave { drop_target } {
+  ::tkdnd::generic::HandleLeave
+  if {$::tkdnd::_auto_update} {update idletasks}
+};# olednd::HandleDragLeave
+
+# ----------------------------------------------------------------------------
+#  Command olednd::HandleDrop
+# ----------------------------------------------------------------------------
+proc olednd::HandleDrop { drop_target pressedkeys rootX rootY type data } {
+  ::tkdnd::generic::SetDroppedData [normalise_data $type $data]
+  set action [::tkdnd::generic::HandleDrop $drop_target {} \
+                                           $pressedkeys $rootX $rootY 0]
+  if {$::tkdnd::_auto_update} {update idletasks}
+  return $action
+};# olednd::HandleDrop
+
+# ----------------------------------------------------------------------------
+#  Command olednd::GetDataType
+# ----------------------------------------------------------------------------
+proc olednd::GetDataType { drop_target typelist } {
+  foreach {drop_target common_drag_source_types common_drop_target_types} \
+    [::tkdnd::generic::FindWindowWithCommonTypes $drop_target $typelist] {break}
+  lindex $common_drag_source_types 0
+};# olednd::GetDataType
+
+# ----------------------------------------------------------------------------
+#  Command olednd::GetDragSourceCommonTypes
+# ----------------------------------------------------------------------------
+proc olednd::GetDragSourceCommonTypes { drop_target } {
+  ::tkdnd::generic::GetDragSourceCommonTypes
+};# olednd::GetDragSourceCommonTypes
+
+# ----------------------------------------------------------------------------
+#  Command olednd::platform_specific_types
+# ----------------------------------------------------------------------------
+proc olednd::platform_specific_types { types } {
+  ::tkdnd::generic::platform_specific_types $types
+}; # olednd::platform_specific_types
+
+# ----------------------------------------------------------------------------
+#  Command olednd::platform_specific_type
+# ----------------------------------------------------------------------------
+proc olednd::platform_specific_type { type } {
+  ::tkdnd::generic::platform_specific_type $type
+}; # olednd::platform_specific_type
+
+# ----------------------------------------------------------------------------
+#  Command tkdnd::platform_independent_types
+# ----------------------------------------------------------------------------
+proc ::tkdnd::platform_independent_types { types } {
+  ::tkdnd::generic::platform_independent_types $types
+}; # tkdnd::platform_independent_types
+
+# ----------------------------------------------------------------------------
+#  Command olednd::platform_independent_type
+# ----------------------------------------------------------------------------
+proc olednd::platform_independent_type { type } {
+  ::tkdnd::generic::platform_independent_type $type
+}; # olednd::platform_independent_type
+
+# ----------------------------------------------------------------------------
+#  Command olednd::normalise_data
+# ----------------------------------------------------------------------------
+proc olednd::normalise_data { type data } {
+  switch [lindex [::tkdnd::generic::platform_independent_type $type] 0] {
+    DND_Text   {return $data}
+    DND_Files  {return $data}
+    DND_HTML   {return [encoding convertfrom utf-8 $data]}
+    default    {return $data}
+  }
+}; # olednd::normalise_data

tkinterdnd2/tkdnd/win64/pkgIndex.tcl

@@ -0,0 +1,7 @@
+package ifneeded tkdnd 2.9.2 \
+  "source \{$dir/tkdnd.tcl\} ; \
+   tkdnd::initialise \{$dir\} libtkdnd2.9.2[info sharedlibextension] tkdnd"
+
+package ifneeded tkdnd::utils 2.9.2 \
+  "source \{$dir/tkdnd_utils.tcl\} ; \
+   package provide tkdnd::utils 2.9.2"

tkinterdnd2/tkdnd/win64/tkdnd.tcl

@@ -0,0 +1,469 @@
+#
+# 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 _dx 3 ;# The difference in pixels before a drag is initiated.
+  variable _dy 3 ;# The difference in pixels before a drag is initiated.
+
+  variable _windowingsystem
+
+  bind TkDND_Drag1 <ButtonPress-1> {tkdnd::_begin_drag press  1 %W %s %X %Y %x %y}
+  bind TkDND_Drag1 <B1-Motion>     {tkdnd::_begin_drag motion 1 %W %s %X %Y %x %y}
+  bind TkDND_Drag2 <ButtonPress-2> {tkdnd::_begin_drag press  2 %W %s %X %Y %x %y}
+  bind TkDND_Drag2 <B2-Motion>     {tkdnd::_begin_drag motion 2 %W %s %X %Y %x %y}
+  bind TkDND_Drag3 <ButtonPress-3> {tkdnd::_begin_drag press  3 %W %s %X %Y %x %y}
+  bind TkDND_Drag3 <B3-Motion>     {tkdnd::_begin_drag motion 3 %W %s %X %Y %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]
+
+    source $dir/tkdnd_generic.tcl
+    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_macosx.tcl
+        set _platform_namespace macdnd
+      }
+      default {
+        error "unknown Tk windowing system"
+      }
+    }
+    load $dir/$PKG_LIB_FILE $PACKAGE_NAME
+    source $dir/tkdnd_compat.tcl
+    ${_platform_namespace}::initialise
+  };# 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 }
+                                      { tagprefix TkDND_Drag } } {
+  set tags [bindtags $path]
+  set idx  [lsearch $tags ${tagprefix}$event]
+  switch -- $mode {
+    register {
+      if { $idx != -1 } {
+        ## No need to do anything!
+        # bindtags $path [lreplace $tags $idx $idx ${tagprefix}$event]
+      } else {
+        bindtags $path [linsert $tags 1 ${tagprefix}$event]
+      }
+      _drag_source_update_types $path $types
+    }
+    unregister {
+      if { $idx != -1 } {
+        bindtags $path [lreplace $tags $idx $idx]
+      }
+    }
+  }
+};# tkdnd::drag_source
+
+proc ::tkdnd::_drag_source_update_types { path types } {
+  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
+};# ::tkdnd::_drag_source_update_types
+
+# ----------------------------------------------------------------------------
+#  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 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"] } {
+        variable _dx
+        variable _dy
+        if { abs($_x0-$X) > ${_dx} || abs($_y0-$Y) > ${_dy} } {
+          set _state "done"
+          _init_drag $button $source $state $X $Y $x $y
+        }
+      }
+    }
+  }
+};# tkdnd::_begin_drag
+
+# ----------------------------------------------------------------------------
+#  Command tkdnd::_init_drag
+# ----------------------------------------------------------------------------
+proc ::tkdnd::_init_drag { button source state rootX rootY X Y } {
+  # Call the <<DragInitCmd>> binding.
+  set cmd [bind $source <<DragInitCmd>>]
+  # puts "CMD: $cmd"
+  if {[string length $cmd]} {
+    set cmd [string map [list %W $source %X $rootX %Y $rootY %x $X %y $Y \
+                              %S $state  %e <<DragInitCmd>> %A \{\} %% % \
+                              %t [bind $source <<DragSourceTypes>>]] $cmd]
+    set code [catch {uplevel \#0 $cmd} info options]
+    # puts "CODE: $code ---- $info"
+    switch -exact -- $code {
+      0 {}
+      3 - 4 {
+        # FRINK: nocheck
+        return
+      }
+      default {
+        return -options $options $info
+      }
+    }
+
+    set len [llength $info]
+    if {$len == 3} {
+      foreach { actions types _data } $info { break }
+      set types [platform_specific_types $types]
+      set data [list]
+      foreach type $types {
+        lappend data $_data
+      }
+      unset _data
+    } elseif {$len == 2} {
+      foreach { actions _data } $info { break }
+      set data [list]; set types [list]
+      foreach {t d} $_data {
+        foreach t [platform_specific_types $t] {
+          lappend types $t; lappend data $d
+        }
+      }
+      unset _data t d
+    } else {
+      if {$len == 1 && [string equal [lindex $actions 0] "refuse_drop"]} {
+        return
+      }
+      error "not enough items in the result of the <<DragInitCmd>>\
+             event binding. Either 2 or 3 items are expected. The command
+             executed was: \"$cmd\"\nResult was: \"$info\""
+    }
+    set action refuse_drop
+    variable _windowingsystem
+    # puts "Source:   \"$source\""
+    # puts "Types:    \"[join $types {", "}]\""
+    # puts "Actions:  \"[join $actions {", "}]\""
+    # puts "Button:   \"$button\""
+    # puts "Data:     \"[string range $data 0 100]\""
+    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 $button]
+      }
+      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 $X $Y
+  }
+};# tkdnd::_init_drag
+
+# ----------------------------------------------------------------------------
+#  Command tkdnd::_end_drag
+# ----------------------------------------------------------------------------
+proc ::tkdnd::_end_drag { button source target action type data result
+                          state rootX rootY X Y } {
+  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 %x $X %y $Y %% % \
+                              %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
+  ${_platform_namespace}::platform_specific_types $types
+}; # tkdnd::platform_specific_types
+
+# ----------------------------------------------------------------------------
+#  Command tkdnd::platform_independent_types
+# ----------------------------------------------------------------------------
+proc ::tkdnd::platform_independent_types { types } {
+  variable _platform_namespace
+  ${_platform_namespace}::platform_independent_types $types
+}; # tkdnd::platform_independent_types
+
+# ----------------------------------------------------------------------------
+#  Command tkdnd::platform_specific_type
+# ----------------------------------------------------------------------------
+proc ::tkdnd::platform_specific_type { type } {
+  variable _platform_namespace
+  ${_platform_namespace}::platform_specific_type $type
+}; # tkdnd::platform_specific_type
+
+# ----------------------------------------------------------------------------
+#  Command tkdnd::platform_independent_type
+# ----------------------------------------------------------------------------
+proc ::tkdnd::platform_independent_type { type } {
+  variable _platform_namespace
+  ${_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 [encoding convertfrom utf-8 $result]
+};# tkdnd::urn_unquote

tkinterdnd2/tkdnd/win64/tkdnd_compat.tcl

@@ -0,0 +1,160 @@
+#
+# 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 1 $window "press" 0 0 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} {
+  set type [normalise_type $type]
+  ::tkdnd::drag_source register $window $type
+  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

tkinterdnd2/tkdnd/win64/tkdnd_generic.tcl

@@ -0,0 +1,520 @@
+#
+# tkdnd_generic.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 generic {
+  variable _types {}
+  variable _typelist {}
+  variable _codelist {}
+  variable _actionlist {}
+  variable _pressedkeys {}
+  variable _action {}
+  variable _common_drag_source_types {}
+  variable _common_drop_target_types {}
+  variable _drag_source {}
+  variable _drop_target {}
+
+  variable _last_mouse_root_x 0
+  variable _last_mouse_root_y 0
+
+  variable _tkdnd2platform
+  variable _platform2tkdnd
+
+  proc debug {msg} {
+    puts $msg
+  };# debug
+
+  proc initialise { } {
+  };# initialise
+
+  proc initialise_platform_to_tkdnd_types { types } {
+    variable _platform2tkdnd
+    variable _tkdnd2platform
+    set _platform2tkdnd [dict create {*}$types]
+    set _tkdnd2platform [dict create]
+    foreach type [dict keys $_platform2tkdnd] {
+      dict lappend _tkdnd2platform [dict get $_platform2tkdnd $type] $type
+    }
+  };# initialise_platform_to_tkdnd_types
+
+  proc initialise_tkdnd_to_platform_types { types } {
+    variable _tkdnd2platform
+    set _tkdnd2platform [dict create {*}$types]
+  };# initialise_tkdnd_to_platform_types
+
+};# namespace generic
+
+# ----------------------------------------------------------------------------
+#  Command generic::HandleEnter
+# ----------------------------------------------------------------------------
+proc generic::HandleEnter { drop_target drag_source typelist codelist
+                            actionlist pressedkeys } {
+  variable _typelist;                 set _typelist    $typelist
+  variable _pressedkeys;              set _pressedkeys $pressedkeys
+  variable _action;                   set _action      refuse_drop
+  variable _common_drag_source_types; set _common_drag_source_types {}
+  variable _common_drop_target_types; set _common_drop_target_types {}
+  variable _actionlist
+  variable _drag_source;              set _drag_source $drag_source
+  variable _drop_target;              set _drop_target {}
+  variable _actionlist;               set _actionlist  $actionlist
+  variable _codelist                  set _codelist    $codelist
+
+  variable _last_mouse_root_x;        set _last_mouse_root_x 0
+  variable _last_mouse_root_y;        set _last_mouse_root_y 0
+  # debug "\n==============================================================="
+  # debug "generic::HandleEnter: drop_target=$drop_target,\
+  #        drag_source=$drag_source,\
+  #        typelist=$typelist"
+  # debug "generic::HandleEnter: ACTION: default"
+  return default
+};# generic::HandleEnter
+
+# ----------------------------------------------------------------------------
+#  Command generic::HandlePosition
+# ----------------------------------------------------------------------------
+proc generic::HandlePosition { drop_target drag_source pressedkeys
+                               rootX rootY { time 0 } } {
+  variable _types
+  variable _typelist
+  variable _codelist
+  variable _actionlist
+  variable _pressedkeys
+  variable _action
+  variable _common_drag_source_types
+  variable _common_drop_target_types
+  variable _drag_source
+  variable _drop_target
+
+  variable _last_mouse_root_x;        set _last_mouse_root_x $rootX
+  variable _last_mouse_root_y;        set _last_mouse_root_y $rootY
+
+  # debug "generic::HandlePosition: drop_target=$drop_target,\
+  #            _drop_target=$_drop_target, rootX=$rootX, rootY=$rootY"
+
+  if {![info exists _drag_source] && ![string length $_drag_source]} {
+    # debug "generic::HandlePosition: no or empty _drag_source:\
+    #               return refuse_drop"
+    return refuse_drop
+  }
+
+  if {$drag_source ne "" && $drag_source ne $_drag_source} {
+    debug "generic position event from unexpected source: $_drag_source\
+           != $drag_source"
+    return refuse_drop
+  }
+
+  set _pressedkeys $pressedkeys
+
+  ## Does the new drop target support any of our new types?
+  # foreach {common_drag_source_types common_drop_target_types} \
+  #         [GetWindowCommonTypes $drop_target $_typelist] {break}
+  foreach {drop_target common_drag_source_types common_drop_target_types} \
+          [FindWindowWithCommonTypes $drop_target $_typelist] {break}
+  set data [GetDroppedData $time]
+
+  # debug "\t($_drop_target) -> ($drop_target)"
+  if {$drop_target != $_drop_target} {
+    if {[string length $_drop_target]} {
+      ## Call the <<DropLeave>> event.
+      # debug "\t<<DropLeave>> on $_drop_target"
+      set cmd [bind $_drop_target <<DropLeave>>]
+      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\} \
+          %CPT \{[lindex [platform_independent_type [lindex $_common_drag_source_types 0]] 0]\} \
+          %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]\} \
+          %c   \{$_codelist\}    %C  \{[lindex $_codelist 0]\} \
+          ] $cmd]
+        uplevel \#0 $cmd
+      }
+    }
+    set _drop_target $drop_target
+    set _action      refuse_drop
+
+    if {[llength $common_drag_source_types]} {
+      set _action [lindex $_actionlist 0]
+      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>>.
+      # puts "<<DropEnter>> -> $drop_target"
+      set cmd [bind $drop_target <<DropEnter>>]
+      if {[string length $cmd]} {
+        focus $drop_target
+        set cmd [string map [list %W $drop_target %X $rootX %Y $rootY \
+          %CST \{$_common_drag_source_types\} \
+          %CTT \{$_common_drop_target_types\} \
+          %CPT \{[lindex [platform_independent_type [lindex $_common_drag_source_types 0]] 0]\} \
+          %ST  \{$_typelist\}    %TT \{$_types\} \
+          %A   $_action          %a  \{$_actionlist\} \
+          %b   \{$_pressedkeys\} %m  \{$_pressedkeys\} \
+          %D   [list $data]      %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]
+        switch -exact -- $_action {
+          copy - move - link - ask - private - refuse_drop - default {}
+          default {set _action copy}
+        }
+      }
+    }
+  }
+
+  set _drop_target {}
+  if {[llength $common_drag_source_types]} {
+    set _common_drag_source_types $common_drag_source_types
+    set _common_drop_target_types $common_drop_target_types
+    set _drop_target $drop_target
+    ## Drop target supports at least one type. Send a <<DropPosition>>.
+    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\} \
+        %CPT \{[lindex [platform_independent_type [lindex $_common_drag_source_types 0]] 0]\} \
+        %ST  \{$_typelist\}    %TT \{$_types\} \
+        %A   $_action          %a  \{$_actionlist\} \
+        %b   \{$_pressedkeys\} %m  \{$_pressedkeys\} \
+        %D   [list $data]      %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]
+    }
+  }
+  # Return values: copy, move, link, ask, private, refuse_drop, default
+  # debug "generic::HandlePosition: ACTION: $_action"
+  switch -exact -- $_action {
+    copy - move - link - ask - private - refuse_drop - default {}
+    default {set _action copy}
+  }
+  return $_action
+};# generic::HandlePosition
+
+# ----------------------------------------------------------------------------
+#  Command generic::HandleLeave
+# ----------------------------------------------------------------------------
+proc generic::HandleLeave { } {
+  variable _types
+  variable _typelist
+  variable _codelist
+  variable _actionlist
+  variable _pressedkeys
+  variable _action
+  variable _common_drag_source_types
+  variable _common_drop_target_types
+  variable _drag_source
+  variable _drop_target
+  variable _last_mouse_root_x
+  variable _last_mouse_root_y
+  if {![info exists _drop_target]} {set _drop_target {}}
+  # debug "generic::HandleLeave: _drop_target=$_drop_target"
+  if {[info exists _drop_target] && [string length $_drop_target]} {
+    set cmd [bind $_drop_target <<DropLeave>>]
+    if {[string length $cmd]} {
+      set cmd [string map [list %W $_drop_target \
+        %X $_last_mouse_root_x %Y $_last_mouse_root_y \
+        %CST \{$_common_drag_source_types\} \
+        %CTT \{$_common_drop_target_types\} \
+        %CPT \{[lindex [platform_independent_type [lindex $_common_drag_source_types 0]] 0]\} \
+        %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]\} \
+        %c   \{$_codelist\}    %C  \{[lindex $_codelist 0]\} \
+        ] $cmd]
+      set _action [uplevel \#0 $cmd]
+    }
+  }
+  foreach var {_types _typelist _actionlist _pressedkeys _action
+               _common_drag_source_types _common_drop_target_types
+               _drag_source _drop_target} {
+    set $var {}
+  }
+};# generic::HandleLeave
+
+# ----------------------------------------------------------------------------
+#  Command generic::HandleDrop
+# ----------------------------------------------------------------------------
+proc generic::HandleDrop {drop_target drag_source pressedkeys rootX rootY time } {
+  variable _types
+  variable _typelist
+  variable _codelist
+  variable _actionlist
+  variable _pressedkeys
+  variable _action
+  variable _common_drag_source_types
+  variable _common_drop_target_types
+  variable _drag_source
+  variable _drop_target
+  variable _last_mouse_root_x
+  variable _last_mouse_root_y
+  variable _last_mouse_root_x;        set _last_mouse_root_x $rootX
+  variable _last_mouse_root_y;        set _last_mouse_root_y $rootY
+
+  set _pressedkeys $pressedkeys
+
+  # puts "generic::HandleDrop: $time"
+
+  if {![info exists _drag_source] && ![string length $_drag_source]} {
+    return refuse_drop
+  }
+  if {![info exists _drop_target] && ![string length $_drop_target]} {
+    return refuse_drop
+  }
+  if {![llength $_common_drag_source_types]} {return refuse_drop}
+  ## Get the dropped data.
+  set data [GetDroppedData $time]
+  ## 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\} \
+        %CPT \{[lindex [platform_independent_type [lindex $_common_drag_source_types 0]] 0]\} \
+        %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]
+      set _action [uplevel \#0 $cmd]
+      # Return values: copy, move, link, ask, private, refuse_drop
+      switch -exact -- $_action {
+        copy - move - link - ask - private - refuse_drop - default {}
+        default {set _action copy}
+      }
+      return $_action
+    }
+  }
+  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\} \
+      %CPT \{[lindex [platform_independent_type [lindex $_common_drag_source_types 0]] 0]\} \
+      %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]
+  }
+  # Return values: copy, move, link, ask, private, refuse_drop
+  switch -exact -- $_action {
+    copy - move - link - ask - private - refuse_drop - default {}
+    default {set _action copy}
+  }
+  return $_action
+};# generic::HandleDrop
+
+# ----------------------------------------------------------------------------
+#  Command generic::GetWindowCommonTypes
+# ----------------------------------------------------------------------------
+proc generic::GetWindowCommonTypes { win typelist } {
+  set types [bind $win <<DropTargetTypes>>]
+  # debug ">> Accepted types: $win $_types"
+  set common_drag_source_types {}
+  set common_drop_target_types {}
+  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
+      }
+    }
+  }
+  list $common_drag_source_types $common_drop_target_types
+};# generic::GetWindowCommonTypes
+
+# ----------------------------------------------------------------------------
+#  Command generic::FindWindowWithCommonTypes
+# ----------------------------------------------------------------------------
+proc generic::FindWindowWithCommonTypes { win typelist } {
+  set toplevel [winfo toplevel $win]
+  while {![string equal $win $toplevel]} {
+    foreach {common_drag_source_types common_drop_target_types} \
+            [GetWindowCommonTypes $win $typelist] {break}
+    if {[llength $common_drag_source_types]} {
+      return [list $win $common_drag_source_types $common_drop_target_types]
+    }
+    set win [winfo parent $win]
+  }
+  ## We have reached the toplevel, which may be also a target (SF Bug #30)
+  foreach {common_drag_source_types common_drop_target_types} \
+          [GetWindowCommonTypes $win $typelist] {break}
+  if {[llength $common_drag_source_types]} {
+    return [list $win $common_drag_source_types $common_drop_target_types]
+  }
+  return { {} {} {} }
+};# generic::FindWindowWithCommonTypes
+
+# ----------------------------------------------------------------------------
+#  Command generic::GetDroppedData
+# ----------------------------------------------------------------------------
+proc generic::GetDroppedData { time } {
+  variable _dropped_data
+  return  $_dropped_data
+};# generic::GetDroppedData
+
+# ----------------------------------------------------------------------------
+#  Command generic::SetDroppedData
+# ----------------------------------------------------------------------------
+proc generic::SetDroppedData { data } {
+  variable _dropped_data
+  set _dropped_data $data
+};# generic::SetDroppedData
+
+# ----------------------------------------------------------------------------
+#  Command generic::GetDragSource
+# ----------------------------------------------------------------------------
+proc generic::GetDragSource { } {
+  variable _drag_source
+  return  $_drag_source
+};# generic::GetDragSource
+
+# ----------------------------------------------------------------------------
+#  Command generic::GetDropTarget
+# ----------------------------------------------------------------------------
+proc generic::GetDropTarget { } {
+  variable _drop_target
+  return $_drop_target
+};# generic::GetDropTarget
+
+# ----------------------------------------------------------------------------
+#  Command generic::GetDragSourceCommonTypes
+# ----------------------------------------------------------------------------
+proc generic::GetDragSourceCommonTypes { } {
+  variable _common_drag_source_types
+  return  $_common_drag_source_types
+};# generic::GetDragSourceCommonTypes
+
+# ----------------------------------------------------------------------------
+#  Command generic::GetDropTargetCommonTypes
+# ----------------------------------------------------------------------------
+proc generic::GetDropTargetCommonTypes { } {
+  variable _common_drag_source_types
+  return  $_common_drag_source_types
+};# generic::GetDropTargetCommonTypes
+
+# ----------------------------------------------------------------------------
+#  Command generic::platform_specific_types
+# ----------------------------------------------------------------------------
+proc generic::platform_specific_types { types } {
+  set new_types {}
+  foreach type $types {
+    set new_types [concat $new_types [platform_specific_type $type]]
+  }
+  return $new_types
+}; # generic::platform_specific_types
+
+# ----------------------------------------------------------------------------
+#  Command generic::platform_specific_type
+# ----------------------------------------------------------------------------
+proc generic::platform_specific_type { type } {
+  variable _tkdnd2platform
+  if {[dict exists $_tkdnd2platform $type]} {
+    return [dict get $_tkdnd2platform $type]
+  }
+  list $type
+}; # generic::platform_specific_type
+
+# ----------------------------------------------------------------------------
+#  Command tkdnd::platform_independent_types
+# ----------------------------------------------------------------------------
+proc ::tkdnd::platform_independent_types { types } {
+  set new_types {}
+  foreach type $types {
+    set new_types [concat $new_types [platform_independent_type $type]]
+  }
+  return $new_types
+}; # tkdnd::platform_independent_types
+
+# ----------------------------------------------------------------------------
+#  Command generic::platform_independent_type
+# ----------------------------------------------------------------------------
+proc generic::platform_independent_type { type } {
+  variable _platform2tkdnd
+  if {[dict exists $_platform2tkdnd $type]} {
+    return [dict get $_platform2tkdnd $type]
+  }
+  return $type
+}; # generic::platform_independent_type
+
+# ----------------------------------------------------------------------------
+#  Command generic::supported_types
+# ----------------------------------------------------------------------------
+proc generic::supported_types { types } {
+  set new_types {}
+  foreach type $types {
+    if {[supported_type $type]} {lappend new_types $type}
+  }
+  return $new_types
+}; # generic::supported_types
+
+# ----------------------------------------------------------------------------
+#  Command generic::supported_type
+# ----------------------------------------------------------------------------
+proc generic::supported_type { type } {
+  variable _platform2tkdnd
+  if {[dict exists $_platform2tkdnd $type]} {
+    return 1
+  }
+  return 0
+}; # generic::supported_type

tkinterdnd2/tkdnd/win64/tkdnd_macosx.tcl

@@ -0,0 +1,144 @@
+#
+# 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 {
+
+  proc initialise { } {
+     ## Mapping from platform types to TkDND types...
+    ::tkdnd::generic::initialise_platform_to_tkdnd_types [list \
+       NSPasteboardTypeString  DND_Text  \
+       NSFilenamesPboardType   DND_Files \
+       NSPasteboardTypeHTML    DND_HTML  \
+    ]
+  };# initialise
+
+};# namespace macdnd
+
+# ----------------------------------------------------------------------------
+#  Command macdnd::HandleEnter
+# ----------------------------------------------------------------------------
+proc macdnd::HandleEnter { path drag_source typelist { data {} } } {
+  variable _pressedkeys
+  variable _actionlist
+  set _pressedkeys 1
+  set _actionlist  { copy move link ask private }
+  ::tkdnd::generic::SetDroppedData $data
+  ::tkdnd::generic::HandleEnter $path $drag_source $typelist $typelist \
+           $_actionlist $_pressedkeys
+};# macdnd::HandleEnter
+
+# ----------------------------------------------------------------------------
+#  Command macdnd::HandlePosition
+# ----------------------------------------------------------------------------
+proc macdnd::HandlePosition { drop_target rootX rootY {drag_source {}} } {
+  variable _pressedkeys
+  variable _last_mouse_root_x; set _last_mouse_root_x $rootX
+  variable _last_mouse_root_y; set _last_mouse_root_y $rootY
+  ::tkdnd::generic::HandlePosition $drop_target $drag_source \
+                                   $_pressedkeys $rootX $rootY
+};# macdnd::HandlePosition
+
+# ----------------------------------------------------------------------------
+#  Command macdnd::HandleLeave
+# ----------------------------------------------------------------------------
+proc macdnd::HandleLeave { args } {
+  ::tkdnd::generic::HandleLeave
+};# macdnd::HandleLeave
+
+# ----------------------------------------------------------------------------
+#  Command macdnd::HandleDrop
+# ----------------------------------------------------------------------------
+proc macdnd::HandleDrop { drop_target data args } {
+  variable _pressedkeys
+  variable _last_mouse_root_x
+  variable _last_mouse_root_y
+  ## Get the dropped data...
+  ::tkdnd::generic::SetDroppedData $data
+  ::tkdnd::generic::HandleDrop {} {} $_pressedkeys \
+                               $_last_mouse_root_x $_last_mouse_root_y 0
+};# macdnd::HandleDrop
+
+# ----------------------------------------------------------------------------
+#  Command macdnd::GetDragSourceCommonTypes
+# ----------------------------------------------------------------------------
+proc macdnd::GetDragSourceCommonTypes { } {
+  ::tkdnd::generic::GetDragSourceCommonTypes
+};# macdnd::GetDragSourceCommonTypes
+
+# ----------------------------------------------------------------------------
+#  Command macdnd::platform_specific_types
+# ----------------------------------------------------------------------------
+proc macdnd::platform_specific_types { types } {
+  ::tkdnd::generic::platform_specific_types $types
+}; # macdnd::platform_specific_types
+
+# ----------------------------------------------------------------------------
+#  Command macdnd::platform_specific_type
+# ----------------------------------------------------------------------------
+proc macdnd::platform_specific_type { type } {
+  ::tkdnd::generic::platform_specific_type $type
+}; # macdnd::platform_specific_type
+
+# ----------------------------------------------------------------------------
+#  Command tkdnd::platform_independent_types
+# ----------------------------------------------------------------------------
+proc ::tkdnd::platform_independent_types { types } {
+  ::tkdnd::generic::platform_independent_types $types
+}; # tkdnd::platform_independent_types
+
+# ----------------------------------------------------------------------------
+#  Command macdnd::platform_independent_type
+# ----------------------------------------------------------------------------
+proc macdnd::platform_independent_type { type } {
+  ::tkdnd::generic::platform_independent_type $type
+}; # macdnd::platform_independent_type

tkinterdnd2/tkdnd/win64/tkdnd_unix.tcl

@@ -0,0 +1,810 @@
+#
+# tkdnd_unix.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 xdnd {
+  variable _dragging 0
+
+  proc initialise { } {
+    ## Mapping from platform types to TkDND types...
+    ::tkdnd::generic::initialise_platform_to_tkdnd_types [list \
+       text/plain\;charset=utf-8     DND_Text  \
+       UTF8_STRING                   DND_Text  \
+       text/plain                    DND_Text  \
+       STRING                        DND_Text  \
+       TEXT                          DND_Text  \
+       COMPOUND_TEXT                 DND_Text  \
+       text/uri-list                 DND_Files \
+       text/html\;charset=utf-8      DND_HTML  \
+       text/html                     DND_HTML  \
+       application/x-color           DND_Color \
+    ]
+  };# initialise
+
+};# namespace xdnd
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::HandleXdndEnter
+# ----------------------------------------------------------------------------
+proc xdnd::HandleXdndEnter { path drag_source typelist time { data {} } } {
+  variable _pressedkeys
+  variable _actionlist
+  variable _typelist
+  set _pressedkeys 1
+  set _actionlist  { copy move link ask private }
+  set _typelist    $typelist
+  # puts "xdnd::HandleXdndEnter: $time"
+  ::tkdnd::generic::SetDroppedData $data
+  ::tkdnd::generic::HandleEnter $path $drag_source $typelist $typelist \
+           $_actionlist $_pressedkeys
+};# xdnd::HandleXdndEnter
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::HandleXdndPosition
+# ----------------------------------------------------------------------------
+proc xdnd::HandleXdndPosition { drop_target rootX rootY time {drag_source {}} } {
+  variable _pressedkeys
+  variable _typelist
+  variable _last_mouse_root_x; set _last_mouse_root_x $rootX
+  variable _last_mouse_root_y; set _last_mouse_root_y $rootY
+  # puts "xdnd::HandleXdndPosition: $time"
+  ## Get the dropped data...
+  catch {
+    ::tkdnd::generic::SetDroppedData [GetPositionData $drop_target $_typelist $time]
+  }
+  ::tkdnd::generic::HandlePosition $drop_target $drag_source \
+                                   $_pressedkeys $rootX $rootY
+};# xdnd::HandleXdndPosition
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::HandleXdndLeave
+# ----------------------------------------------------------------------------
+proc xdnd::HandleXdndLeave { } {
+  ::tkdnd::generic::HandleLeave
+};# xdnd::HandleXdndLeave
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::_HandleXdndDrop
+# ----------------------------------------------------------------------------
+proc xdnd::HandleXdndDrop { time } {
+  variable _pressedkeys
+  variable _last_mouse_root_x
+  variable _last_mouse_root_y
+  ## Get the dropped data...
+  ::tkdnd::generic::SetDroppedData [GetDroppedData \
+    [::tkdnd::generic::GetDragSource] [::tkdnd::generic::GetDropTarget] \
+    [::tkdnd::generic::GetDragSourceCommonTypes] $time]
+  ::tkdnd::generic::HandleDrop {} {} $_pressedkeys \
+                               $_last_mouse_root_x $_last_mouse_root_y $time
+};# xdnd::HandleXdndDrop
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::GetPositionData
+# ----------------------------------------------------------------------------
+proc xdnd::GetPositionData { drop_target typelist time } {
+  foreach {drop_target common_drag_source_types common_drop_target_types} \
+    [::tkdnd::generic::FindWindowWithCommonTypes $drop_target $typelist] {break}
+  GetDroppedData [::tkdnd::generic::GetDragSource] $drop_target \
+    $common_drag_source_types $time
+};# xdnd::GetPositionData
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::GetDroppedData
+# ----------------------------------------------------------------------------
+proc xdnd::GetDroppedData { _drag_source _drop_target _common_drag_source_types time } {
+  if {![llength $_common_drag_source_types]} {
+    error "no common data types between the drag source and drop target widgets"
+  }
+  ## Is drag source in this application?
+  if {[catch {winfo pathname -displayof $_drop_target $_drag_source} p]} {
+    set _use_tk_selection 0
+  } else {
+    set _use_tk_selection 1
+  }
+  foreach type $_common_drag_source_types {
+    # puts "TYPE: $type ($_drop_target)"
+    # _get_selection $_drop_target $time $type
+    if {$_use_tk_selection} {
+      if {![catch {
+        selection get -displayof $_drop_target -selection XdndSelection \
+                      -type $type
+                                              } result options]} {
+        return [normalise_data $type $result]
+      }
+    } else {
+      # puts "_selection_get -displayof $_drop_target -selection XdndSelection \
+      #                 -type $type -time $time"
+      #after 100 [list focus -force $_drop_target]
+      #after 50 [list raise [winfo toplevel $_drop_target]]
+      if {![catch {
+        _selection_get -displayof $_drop_target -selection XdndSelection \
+                      -type $type -time $time
+                                              } result options]} {
+        return [normalise_data $type $result]
+      }
+    }
+  }
+  return -options $options $result
+};# xdnd::GetDroppedData
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::platform_specific_types
+# ----------------------------------------------------------------------------
+proc xdnd::platform_specific_types { types } {
+  ::tkdnd::generic::platform_specific_types $types
+}; # xdnd::platform_specific_types
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::platform_specific_type
+# ----------------------------------------------------------------------------
+proc xdnd::platform_specific_type { type } {
+  ::tkdnd::generic::platform_specific_type $type
+}; # xdnd::platform_specific_type
+
+# ----------------------------------------------------------------------------
+#  Command tkdnd::platform_independent_types
+# ----------------------------------------------------------------------------
+proc ::tkdnd::platform_independent_types { types } {
+  ::tkdnd::generic::platform_independent_types $types
+}; # tkdnd::platform_independent_types
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::platform_independent_type
+# ----------------------------------------------------------------------------
+proc xdnd::platform_independent_type { type } {
+  ::tkdnd::generic::platform_independent_type $type
+}; # xdnd::platform_independent_type
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::_normalise_data
+# ----------------------------------------------------------------------------
+proc xdnd::normalise_data { type data } {
+  # Tk knows how to interpret the following types:
+  #    STRING, TEXT, COMPOUND_TEXT
+  #    UTF8_STRING
+  # Else, it returns a list of 8 or 32 bit numbers...
+  switch -glob $type {
+    STRING - UTF8_STRING - TEXT - COMPOUND_TEXT {return $data}
+    text/html {
+      if {[catch {
+            encoding convertfrom unicode $data
+           } string]} {
+        set string $data
+      }
+      return [string map {\r\n \n} $string]
+    }
+    text/html\;charset=utf-8  -
+    text/plain\;charset=utf-8 -
+    text/plain {
+      if {[catch {
+            encoding convertfrom utf-8 [tkdnd::bytes_to_string $data]
+           } string]} {
+        set string $data
+      }
+      return [string map {\r\n \n} $string]
+    }
+    text/uri-list* {
+      if {[catch {
+            encoding convertfrom utf-8 [tkdnd::bytes_to_string $data]
+          } string]} {
+        set string $data
+      }
+      ## Get rid of \r\n
+      set string [string trim [string map {\r\n \n} $string]]
+      set files {}
+      foreach quoted_file [split $string] {
+        set file [tkdnd::urn_unquote $quoted_file]
+        switch -glob $file {
+          \#*       {}
+          file://*  {lappend files [string range $file 7 end]}
+          ftp://*   -
+          https://* -
+          http://*  {lappend files $quoted_file}
+          default   {lappend files $file}
+        }
+      }
+      return $files
+    }
+    application/x-color {
+      return $data
+    }
+    text/x-moz-url -
+    application/q-iconlist -
+    default    {return $data}
+  }
+}; # xdnd::normalise_data
+
+#############################################################################
+##
+##  XDND drag implementation
+##
+#############################################################################
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::_selection_ownership_lost
+# ----------------------------------------------------------------------------
+proc xdnd::_selection_ownership_lost {} {
+  variable _dragging
+  set _dragging 0
+};# _selection_ownership_lost
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::_dodragdrop
+# ----------------------------------------------------------------------------
+proc xdnd::_dodragdrop { source actions types data button } {
+  variable _dragging
+
+  # puts "xdnd::_dodragdrop: source: $source, actions: $actions, types: $types,\
+  #       data: \"$data\", button: $button"
+  if {$_dragging} {
+    ## We are in the middle of another drag operation...
+    error "another drag operation in progress"
+  }
+
+  variable _dodragdrop_drag_source                $source
+  variable _dodragdrop_drop_target                0
+  variable _dodragdrop_drop_target_proxy          0
+  variable _dodragdrop_actions                    $actions
+  variable _dodragdrop_action_descriptions        $actions
+  variable _dodragdrop_actions_len                [llength $actions]
+  variable _dodragdrop_types                      $types
+  variable _dodragdrop_types_len                  [llength $types]
+  variable _dodragdrop_data                       $data
+  variable _dodragdrop_transfer_data              {}
+  variable _dodragdrop_button                     $button
+  variable _dodragdrop_time                       0
+  variable _dodragdrop_default_action             refuse_drop
+  variable _dodragdrop_waiting_status             0
+  variable _dodragdrop_drop_target_accepts_drop   0
+  variable _dodragdrop_drop_target_accepts_action refuse_drop
+  variable _dodragdrop_current_cursor             $_dodragdrop_default_action
+  variable _dodragdrop_drop_occured               0
+  variable _dodragdrop_selection_requestor        0
+
+  ##
+  ## If we have more than 3 types, the property XdndTypeList must be set on
+  ## the drag source widget...
+  ##
+  if {$_dodragdrop_types_len > 3} {
+    _announce_type_list $_dodragdrop_drag_source $_dodragdrop_types
+  }
+
+  ##
+  ## Announce the actions & their descriptions on the XdndActionList &
+  ## XdndActionDescription properties...
+  ##
+  _announce_action_list $_dodragdrop_drag_source $_dodragdrop_actions \
+                        $_dodragdrop_action_descriptions
+
+  ##
+  ## Arrange selection handlers for our drag source, and all the supported types
+  ##
+  registerSelectionHandler $source $types
+
+  ##
+  ## Step 1: When a drag begins, the source takes ownership of XdndSelection.
+  ##
+  selection own -command ::tkdnd::xdnd::_selection_ownership_lost \
+                -selection XdndSelection $source
+  set _dragging 1
+
+  ## Grab the mouse pointer...
+  _grab_pointer $source $_dodragdrop_default_action
+
+  ## Register our generic event handler...
+  #  The generic event callback will report events by modifying variable
+  #  ::xdnd::_dodragdrop_event: a dict with event information will be set as
+  #  the value of the variable...
+  _register_generic_event_handler
+
+  ## Set a timeout for debugging purposes...
+  #  after 60000 {set ::tkdnd::xdnd::_dragging 0}
+
+  tkwait variable ::tkdnd::xdnd::_dragging
+  _SendXdndLeave
+
+  set _dragging 0
+  _ungrab_pointer $source
+  _unregister_generic_event_handler
+  catch {selection clear -selection XdndSelection}
+  unregisterSelectionHandler $source $types
+  return $_dodragdrop_drop_target_accepts_action
+};# xdnd::_dodragdrop
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::_process_drag_events
+# ----------------------------------------------------------------------------
+proc xdnd::_process_drag_events {event} {
+  # The return value from proc is normally 0. A non-zero return value indicates
+  # that the event is not to be handled further; that is, proc has done all
+  # processing that is to be allowed for the event
+  variable _dragging
+  if {!$_dragging} {return 0}
+  # puts $event
+
+  variable _dodragdrop_time
+  set time [dict get $event time]
+  set type [dict get $event type]
+  if {$time < $_dodragdrop_time && ![string equal $type SelectionRequest]} {
+    return 0
+  }
+  set _dodragdrop_time $time
+
+  variable _dodragdrop_drag_source
+  variable _dodragdrop_drop_target
+  variable _dodragdrop_drop_target_proxy
+  variable _dodragdrop_default_action
+  switch $type {
+    MotionNotify {
+      set rootx  [dict get $event x_root]
+      set rooty  [dict get $event y_root]
+      set window [_find_drop_target_window $_dodragdrop_drag_source \
+                                           $rootx $rooty]
+      if {[string length $window]} {
+        ## Examine the modifiers to suggest an action...
+        set _dodragdrop_default_action [_default_action $event]
+        ## Is it a Tk widget?
+        # set path [winfo containing $rootx $rooty]
+        # puts "Window under mouse: $window ($path)"
+        if {$_dodragdrop_drop_target != $window} {
+          ## Send XdndLeave to $_dodragdrop_drop_target
+          _SendXdndLeave
+          ## Is there a proxy? If not, _find_drop_target_proxy returns the
+          ## target window, so we always get a valid "proxy".
+          set proxy [_find_drop_target_proxy $_dodragdrop_drag_source $window]
+          ## Send XdndEnter to $window
+          _SendXdndEnter $window $proxy
+          ## Send XdndPosition to $_dodragdrop_drop_target
+          _SendXdndPosition $rootx $rooty $_dodragdrop_default_action
+        } else {
+          ## Send XdndPosition to $_dodragdrop_drop_target
+          _SendXdndPosition $rootx $rooty $_dodragdrop_default_action
+        }
+      } else {
+        ## No window under the mouse. Send XdndLeave to $_dodragdrop_drop_target
+        _SendXdndLeave
+      }
+    }
+    ButtonPress {
+    }
+    ButtonRelease {
+      variable _dodragdrop_button
+      set button [dict get $event button]
+      if {$button == $_dodragdrop_button} {
+        ## The button that initiated the drag was released. Trigger drop...
+        _SendXdndDrop
+      }
+      return 1
+    }
+    KeyPress {
+    }
+    KeyRelease {
+      set keysym [dict get $event keysym]
+      switch $keysym {
+        Escape {
+          ## The user has pressed escape. Abort...
+          if {$_dragging} {set _dragging 0}
+        }
+      }
+    }
+    SelectionRequest {
+      variable _dodragdrop_selection_requestor
+      variable _dodragdrop_selection_property
+      variable _dodragdrop_selection_selection
+      variable _dodragdrop_selection_target
+      variable _dodragdrop_selection_time
+      set _dodragdrop_selection_requestor [dict get $event requestor]
+      set _dodragdrop_selection_property  [dict get $event property]
+      set _dodragdrop_selection_selection [dict get $event selection]
+      set _dodragdrop_selection_target    [dict get $event target]
+      set _dodragdrop_selection_time      $time
+      return 0
+    }
+    default {
+      return 0
+    }
+  }
+  return 0
+};# _process_drag_events
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::_SendXdndEnter
+# ----------------------------------------------------------------------------
+proc xdnd::_SendXdndEnter {window proxy} {
+  variable _dodragdrop_drag_source
+  variable _dodragdrop_drop_target
+  variable _dodragdrop_drop_target_proxy
+  variable _dodragdrop_types
+  variable _dodragdrop_waiting_status
+  variable _dodragdrop_drop_occured
+  if {$_dodragdrop_drop_target > 0} _SendXdndLeave
+  if {$_dodragdrop_drop_occured} return
+  set _dodragdrop_drop_target       $window
+  set _dodragdrop_drop_target_proxy $proxy
+  set _dodragdrop_waiting_status    0
+  if {$_dodragdrop_drop_target < 1} return
+  # puts "XdndEnter: $_dodragdrop_drop_target $_dodragdrop_drop_target_proxy"
+  _send_XdndEnter $_dodragdrop_drag_source $_dodragdrop_drop_target \
+                  $_dodragdrop_drop_target_proxy $_dodragdrop_types
+};# xdnd::_SendXdndEnter
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::_SendXdndPosition
+# ----------------------------------------------------------------------------
+proc xdnd::_SendXdndPosition {rootx rooty action} {
+  variable _dodragdrop_drag_source
+  variable _dodragdrop_drop_target
+  if {$_dodragdrop_drop_target < 1} return
+  variable _dodragdrop_drop_occured
+  if {$_dodragdrop_drop_occured} return
+  variable _dodragdrop_drop_target_proxy
+  variable _dodragdrop_waiting_status
+  ## Arrange a new XdndPosition, to be send periodically...
+  variable _dodragdrop_xdnd_position_heartbeat
+  catch {after cancel $_dodragdrop_xdnd_position_heartbeat}
+  set _dodragdrop_xdnd_position_heartbeat [after 200 \
+    [list ::tkdnd::xdnd::_SendXdndPosition $rootx $rooty $action]]
+  if {$_dodragdrop_waiting_status} {return}
+  # puts "XdndPosition: $_dodragdrop_drop_target $rootx $rooty $action"
+  _send_XdndPosition $_dodragdrop_drag_source $_dodragdrop_drop_target \
+                     $_dodragdrop_drop_target_proxy $rootx $rooty $action
+  set _dodragdrop_waiting_status 1
+};# xdnd::_SendXdndPosition
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::_HandleXdndStatus
+# ----------------------------------------------------------------------------
+proc xdnd::_HandleXdndStatus {event} {
+  variable _dodragdrop_drop_target
+  variable _dodragdrop_waiting_status
+
+  variable _dodragdrop_drop_target_accepts_drop
+  variable _dodragdrop_drop_target_accepts_action
+  set _dodragdrop_waiting_status 0
+  foreach key {target accept want_position action x y w h} {
+    set $key [dict get $event $key]
+  }
+  set _dodragdrop_drop_target_accepts_drop   $accept
+  set _dodragdrop_drop_target_accepts_action $action
+  if {$_dodragdrop_drop_target < 1} return
+  variable _dodragdrop_drop_occured
+  if {$_dodragdrop_drop_occured} return
+  _update_cursor
+  # puts "XdndStatus: $event"
+};# xdnd::_HandleXdndStatus
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::_HandleXdndFinished
+# ----------------------------------------------------------------------------
+proc xdnd::_HandleXdndFinished {event} {
+  variable _dodragdrop_xdnd_finished_event_after_id
+  catch {after cancel $_dodragdrop_xdnd_finished_event_after_id}
+  set _dodragdrop_xdnd_finished_event_after_id {}
+  variable _dodragdrop_drop_target
+  set _dodragdrop_drop_target 0
+  variable _dragging
+  if {$_dragging} {set _dragging 0}
+
+  variable _dodragdrop_drop_target_accepts_drop
+  variable _dodragdrop_drop_target_accepts_action
+  if {[dict size $event]} {
+    foreach key {target accept action} {
+      set $key [dict get $event $key]
+    }
+    set _dodragdrop_drop_target_accepts_drop   $accept
+    set _dodragdrop_drop_target_accepts_action $action
+  } else {
+    set _dodragdrop_drop_target_accepts_drop 0
+  }
+  if {!$_dodragdrop_drop_target_accepts_drop} {
+    set _dodragdrop_drop_target_accepts_action refuse_drop
+  }
+  # puts "XdndFinished: $event"
+};# xdnd::_HandleXdndFinished
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::_SendXdndLeave
+# ----------------------------------------------------------------------------
+proc xdnd::_SendXdndLeave {} {
+  variable _dodragdrop_drag_source
+  variable _dodragdrop_drop_target
+  if {$_dodragdrop_drop_target < 1} return
+  variable _dodragdrop_drop_target_proxy
+  # puts "XdndLeave: $_dodragdrop_drop_target"
+  _send_XdndLeave $_dodragdrop_drag_source $_dodragdrop_drop_target \
+                  $_dodragdrop_drop_target_proxy
+  set _dodragdrop_drop_target 0
+  variable _dodragdrop_drop_target_accepts_drop
+  variable _dodragdrop_drop_target_accepts_action
+  set _dodragdrop_drop_target_accepts_drop   0
+  set _dodragdrop_drop_target_accepts_action refuse_drop
+  variable _dodragdrop_drop_occured
+  if {$_dodragdrop_drop_occured} return
+  _update_cursor
+};# xdnd::_SendXdndLeave
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::_SendXdndDrop
+# ----------------------------------------------------------------------------
+proc xdnd::_SendXdndDrop {} {
+  variable _dodragdrop_drag_source
+  variable _dodragdrop_drop_target
+  if {$_dodragdrop_drop_target < 1} {
+    ## The mouse has been released over a widget that does not accept drops.
+    _HandleXdndFinished {}
+    return
+  }
+  variable _dodragdrop_drop_occured
+  if {$_dodragdrop_drop_occured} {return}
+  variable _dodragdrop_drop_target_proxy
+  variable _dodragdrop_drop_target_accepts_drop
+  variable _dodragdrop_drop_target_accepts_action
+
+  set _dodragdrop_drop_occured 1
+  _update_cursor clock
+
+  if {!$_dodragdrop_drop_target_accepts_drop} {
+    _SendXdndLeave
+    _HandleXdndFinished {}
+    return
+  }
+  # puts "XdndDrop: $_dodragdrop_drop_target"
+  variable _dodragdrop_drop_timestamp
+  set _dodragdrop_drop_timestamp [_send_XdndDrop \
+                 $_dodragdrop_drag_source $_dodragdrop_drop_target \
+                 $_dodragdrop_drop_target_proxy]
+  set _dodragdrop_drop_target 0
+  # puts "XdndDrop: $_dodragdrop_drop_target"
+  ## Arrange a timeout for receiving XdndFinished...
+  variable _dodragdrop_xdnd_finished_event_after_id
+  set _dodragdrop_xdnd_finished_event_after_id \
+    [after 10000 [list ::tkdnd::xdnd::_HandleXdndFinished {}]]
+};# xdnd::_SendXdndDrop
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::_update_cursor
+# ----------------------------------------------------------------------------
+proc xdnd::_update_cursor { {cursor {}}} {
+  # puts "_update_cursor $cursor"
+  variable _dodragdrop_current_cursor
+  variable _dodragdrop_drag_source
+  variable _dodragdrop_drop_target_accepts_drop
+  variable _dodragdrop_drop_target_accepts_action
+
+  if {![string length $cursor]} {
+    set cursor refuse_drop
+    if {$_dodragdrop_drop_target_accepts_drop} {
+      set cursor $_dodragdrop_drop_target_accepts_action
+    }
+  }
+  if {![string equal $cursor $_dodragdrop_current_cursor]} {
+    _set_pointer_cursor $_dodragdrop_drag_source $cursor
+    set _dodragdrop_current_cursor $cursor
+  }
+};# xdnd::_update_cursor
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::_default_action
+# ----------------------------------------------------------------------------
+proc xdnd::_default_action {event} {
+  variable _dodragdrop_actions
+  variable _dodragdrop_actions_len
+  if {$_dodragdrop_actions_len == 1} {return [lindex $_dodragdrop_actions 0]}
+
+  set alt     [dict get $event Alt]
+  set shift   [dict get $event Shift]
+  set control [dict get $event Control]
+
+  if {$shift && $control && [lsearch $_dodragdrop_actions link] != -1} {
+    return link
+  } elseif {$control && [lsearch $_dodragdrop_actions copy] != -1} {
+    return copy
+  } elseif {$shift && [lsearch $_dodragdrop_actions move] != -1} {
+    return move
+  } elseif {$alt && [lsearch $_dodragdrop_actions link] != -1} {
+    return link
+  }
+  return default
+};# xdnd::_default_action
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::getFormatForType
+# ----------------------------------------------------------------------------
+proc xdnd::getFormatForType {type} {
+  switch -glob [string tolower $type] {
+    text/plain\;charset=utf-8 -
+    text/html\;charset=utf-8  -
+    utf8_string               {set format UTF8_STRING}
+    text/html                 -
+    text/plain                -
+    string                    -
+    text                      -
+    compound_text             {set format STRING}
+    text/uri-list*            {set format UTF8_STRING}
+    application/x-color       {set format $type}
+    default                   {set format $type}
+  }
+  return $format
+};# xdnd::getFormatForType
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::registerSelectionHandler
+# ----------------------------------------------------------------------------
+proc xdnd::registerSelectionHandler {source types} {
+  foreach type $types {
+    selection handle -selection XdndSelection \
+                     -type $type \
+                     -format [getFormatForType $type] \
+                     $source [list ::tkdnd::xdnd::_SendData $type]
+  }
+};# xdnd::registerSelectionHandler
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::unregisterSelectionHandler
+# ----------------------------------------------------------------------------
+proc xdnd::unregisterSelectionHandler {source types} {
+  foreach type $types {
+    catch {
+      selection handle -selection XdndSelection \
+                       -type $type \
+                       -format [getFormatForType $type] \
+                       $source {}
+    }
+  }
+};# xdnd::unregisterSelectionHandler
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::_convert_to_unsigned
+# ----------------------------------------------------------------------------
+proc xdnd::_convert_to_unsigned {data format} {
+  switch $format {
+    8  { set mask 0xff }
+    16 { set mask 0xffff }
+    32 { set mask 0xffffff }
+    default {error "unsupported format $format"}
+  }
+  ## Convert signed integer into unsigned...
+  set d [list]
+  foreach num $data {
+    lappend d [expr { $num & $mask }]
+  }
+  return $d
+};# xdnd::_convert_to_unsigned
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::_SendData
+# ----------------------------------------------------------------------------
+proc xdnd::_SendData {type offset bytes args} {
+  variable _dodragdrop_drag_source
+  variable _dodragdrop_types
+  variable _dodragdrop_data
+  variable _dodragdrop_transfer_data
+
+  ## The variable _dodragdrop_data contains a list of data, one for each
+  ## type in the _dodragdrop_types variable. We have to search types, and find
+  ## the corresponding entry in the _dodragdrop_data list.
+  set index [lsearch $_dodragdrop_types $type]
+  if {$index < 0} {
+    error "unable to locate data suitable for type \"$type\""
+  }
+  set typed_data [lindex $_dodragdrop_data $index]
+  set format 8
+  if {$offset == 0} {
+    ## Prepare the data to be transferred...
+    switch -glob $type {
+      text/plain* - UTF8_STRING - STRING - TEXT - COMPOUND_TEXT {
+        binary scan [encoding convertto utf-8 $typed_data] \
+                    c* _dodragdrop_transfer_data
+        set _dodragdrop_transfer_data \
+           [_convert_to_unsigned $_dodragdrop_transfer_data $format]
+      }
+      text/uri-list* {
+        set files [list]
+        foreach file $typed_data {
+          switch -glob $file {
+            *://*     {lappend files $file}
+            default   {lappend files file://$file}
+          }
+        }
+        binary scan [encoding convertto utf-8 "[join $files \r\n]\r\n"] \
+                    c* _dodragdrop_transfer_data
+        set _dodragdrop_transfer_data \
+           [_convert_to_unsigned $_dodragdrop_transfer_data $format]
+      }
+      application/x-color {
+        set format 16
+        ## Try to understand the provided data: we accept a standard Tk colour,
+        ## or a list of 3 values (red green blue) or a list of 4 values
+        ## (red green blue opacity).
+        switch [llength $typed_data] {
+          1 { set color [winfo rgb $_dodragdrop_drag_source $typed_data]
+              lappend color 65535 }
+          3 { set color $typed_data; lappend color 65535 }
+          4 { set color $typed_data }
+          default {error "unknown color data: \"$typed_data\""}
+        }
+        ## Convert the 4 elements into 16 bit values...
+        set _dodragdrop_transfer_data [list]
+        foreach c $color {
+          lappend _dodragdrop_transfer_data [format 0x%04X $c]
+        }
+      }
+      default {
+        set format 32
+        binary scan $typed_data c* _dodragdrop_transfer_data
+      }
+    }
+  }
+
+  ##
+  ## Data has been split into bytes. Count the bytes requested, and return them
+  ##
+  set data [lrange $_dodragdrop_transfer_data $offset [expr {$offset+$bytes-1}]]
+  switch $format {
+    8  {
+      set data [encoding convertfrom utf-8 [binary format c* $data]]
+    }
+    16 {
+      variable _dodragdrop_selection_requestor
+      if {$_dodragdrop_selection_requestor} {
+        ## Tk selection cannot process this format (only 8 & 32 supported).
+        ## Call our XChangeProperty...
+        set numItems [llength $data]
+        variable _dodragdrop_selection_property
+        variable _dodragdrop_selection_selection
+        variable _dodragdrop_selection_target
+        variable _dodragdrop_selection_time
+        XChangeProperty $_dodragdrop_drag_source \
+                        $_dodragdrop_selection_requestor \
+                        $_dodragdrop_selection_property \
+                        $_dodragdrop_selection_target \
+                        $format \
+                        $_dodragdrop_selection_time \
+                        $data $numItems
+        return -code break
+      }
+    }
+    32 {
+    }
+    default {
+      error "unsupported format $format"
+    }
+  }
+  # puts "SendData: $type $offset $bytes $args ($typed_data)"
+  # puts "          $data"
+  return $data
+};# xdnd::_SendData

tkinterdnd2/tkdnd/win64/tkdnd_utils.tcl

@@ -0,0 +1,252 @@
+#
+# 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

tkinterdnd2/tkdnd/win64/tkdnd_windows.tcl

@@ -0,0 +1,167 @@
+#
+# 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 {
+
+  proc initialise { } {
+    ## Mapping from platform types to TkDND types...
+    ::tkdnd::generic::initialise_platform_to_tkdnd_types [list \
+       CF_UNICODETEXT          DND_Text  \
+       CF_TEXT                 DND_Text  \
+       CF_HDROP                DND_Files \
+       UniformResourceLocator  DND_URL   \
+       CF_HTML                 DND_HTML  \
+       {HTML Format}           DND_HTML  \
+       CF_RTF                  DND_RTF   \
+       CF_RTFTEXT              DND_RTF   \
+       {Rich Text Format}      DND_RTF   \
+    ]
+    # FileGroupDescriptorW    DND_Files \
+    # FileGroupDescriptor     DND_Files \
+
+    ## Mapping from TkDND types to platform types...
+    ::tkdnd::generic::initialise_tkdnd_to_platform_types [list \
+       DND_Text  {CF_UNICODETEXT CF_TEXT}               \
+       DND_Files {CF_HDROP}                             \
+       DND_URL   {UniformResourceLocator UniformResourceLocatorW} \
+       DND_HTML  {CF_HTML {HTML Format}}                \
+       DND_RTF   {CF_RTF CF_RTFTEXT {Rich Text Format}} \
+    ]
+  };# initialise
+
+};# namespace olednd
+
+# ----------------------------------------------------------------------------
+#  Command olednd::HandleDragEnter
+# ----------------------------------------------------------------------------
+proc olednd::HandleDragEnter { drop_target typelist actionlist pressedkeys
+                               rootX rootY codelist { data {} } } {
+  ::tkdnd::generic::SetDroppedData $data
+  focus $drop_target
+  ::tkdnd::generic::HandleEnter $drop_target 0 $typelist \
+                                $codelist $actionlist $pressedkeys
+  set action [::tkdnd::generic::HandlePosition $drop_target {} \
+                                               $pressedkeys $rootX $rootY]
+  if {$::tkdnd::_auto_update} {update idletasks}
+  return $action
+};# olednd::HandleDragEnter
+
+# ----------------------------------------------------------------------------
+#  Command olednd::HandleDragOver
+# ----------------------------------------------------------------------------
+proc olednd::HandleDragOver { drop_target pressedkeys rootX rootY } {
+  set action [::tkdnd::generic::HandlePosition $drop_target {} \
+                                               $pressedkeys $rootX $rootY]
+  if {$::tkdnd::_auto_update} {update idletasks}
+  return $action
+};# olednd::HandleDragOver
+
+# ----------------------------------------------------------------------------
+#  Command olednd::HandleDragLeave
+# ----------------------------------------------------------------------------
+proc olednd::HandleDragLeave { drop_target } {
+  ::tkdnd::generic::HandleLeave
+  if {$::tkdnd::_auto_update} {update idletasks}
+};# olednd::HandleDragLeave
+
+# ----------------------------------------------------------------------------
+#  Command olednd::HandleDrop
+# ----------------------------------------------------------------------------
+proc olednd::HandleDrop { drop_target pressedkeys rootX rootY type data } {
+  ::tkdnd::generic::SetDroppedData [normalise_data $type $data]
+  set action [::tkdnd::generic::HandleDrop $drop_target {} \
+                                           $pressedkeys $rootX $rootY 0]
+  if {$::tkdnd::_auto_update} {update idletasks}
+  return $action
+};# olednd::HandleDrop
+
+# ----------------------------------------------------------------------------
+#  Command olednd::GetDataType
+# ----------------------------------------------------------------------------
+proc olednd::GetDataType { drop_target typelist } {
+  foreach {drop_target common_drag_source_types common_drop_target_types} \
+    [::tkdnd::generic::FindWindowWithCommonTypes $drop_target $typelist] {break}
+  lindex $common_drag_source_types 0
+};# olednd::GetDataType
+
+# ----------------------------------------------------------------------------
+#  Command olednd::GetDragSourceCommonTypes
+# ----------------------------------------------------------------------------
+proc olednd::GetDragSourceCommonTypes { drop_target } {
+  ::tkdnd::generic::GetDragSourceCommonTypes
+};# olednd::GetDragSourceCommonTypes
+
+# ----------------------------------------------------------------------------
+#  Command olednd::platform_specific_types
+# ----------------------------------------------------------------------------
+proc olednd::platform_specific_types { types } {
+  ::tkdnd::generic::platform_specific_types $types
+}; # olednd::platform_specific_types
+
+# ----------------------------------------------------------------------------
+#  Command olednd::platform_specific_type
+# ----------------------------------------------------------------------------
+proc olednd::platform_specific_type { type } {
+  ::tkdnd::generic::platform_specific_type $type
+}; # olednd::platform_specific_type
+
+# ----------------------------------------------------------------------------
+#  Command tkdnd::platform_independent_types
+# ----------------------------------------------------------------------------
+proc ::tkdnd::platform_independent_types { types } {
+  ::tkdnd::generic::platform_independent_types $types
+}; # tkdnd::platform_independent_types
+
+# ----------------------------------------------------------------------------
+#  Command olednd::platform_independent_type
+# ----------------------------------------------------------------------------
+proc olednd::platform_independent_type { type } {
+  ::tkdnd::generic::platform_independent_type $type
+}; # olednd::platform_independent_type
+
+# ----------------------------------------------------------------------------
+#  Command olednd::normalise_data
+# ----------------------------------------------------------------------------
+proc olednd::normalise_data { type data } {
+  switch [lindex [::tkdnd::generic::platform_independent_type $type] 0] {
+    DND_Text   {return $data}
+    DND_Files  {return $data}
+    DND_HTML   {return [encoding convertfrom utf-8 $data]}
+    default    {return $data}
+  }
+}; # olednd::normalise_data