diff --git a/tkinterdnd2/TkinterDnD.py b/tkinterdnd2/TkinterDnD.py deleted file mode 100644 index f7e2c1e..0000000 --- a/tkinterdnd2/TkinterDnD.py +++ /dev/null @@ -1,292 +0,0 @@ -'''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): - # <> : %W, %X, %Y %e, %t - # <> : %A, %W, %e - # <> : all except : %D (always empty) - # <> : all except %D (always empty) - # <> :all except %D (always empty) - # <> : 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: - <>, <>, <>, <>, - <>, <>, <> . - The callbacks for the > events, with the exception of - <>, should always return an action (i.e. one of COPY, - MOVE, LINK, ASK or PRIVATE). - The callback for the <> 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) diff --git a/tkinterdnd2/__init__.py b/tkinterdnd2/__init__.py deleted file mode 100644 index 17f037d..0000000 --- a/tkinterdnd2/__init__.py +++ /dev/null @@ -1,25 +0,0 @@ -# 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 - - diff --git a/tkinterdnd2/tkdnd/linux64/libtkdnd2.9.2.so b/tkinterdnd2/tkdnd/linux64/libtkdnd2.9.2.so deleted file mode 100644 index 03dbd1b..0000000 Binary files a/tkinterdnd2/tkdnd/linux64/libtkdnd2.9.2.so and /dev/null differ diff --git a/tkinterdnd2/tkdnd/linux64/pkgIndex.tcl b/tkinterdnd2/tkdnd/linux64/pkgIndex.tcl deleted file mode 100644 index 9edcc8f..0000000 --- a/tkinterdnd2/tkdnd/linux64/pkgIndex.tcl +++ /dev/null @@ -1,10 +0,0 @@ -# -# 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" diff --git a/tkinterdnd2/tkdnd/linux64/tkdnd.tcl b/tkinterdnd2/tkdnd/linux64/tkdnd.tcl deleted file mode 100644 index 12d1dd2..0000000 --- a/tkinterdnd2/tkdnd/linux64/tkdnd.tcl +++ /dev/null @@ -1,469 +0,0 @@ -# -# 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 {tkdnd::_begin_drag press 1 %W %s %X %Y %x %y} - bind TkDND_Drag1 {tkdnd::_begin_drag motion 1 %W %s %X %Y %x %y} - bind TkDND_Drag2 {tkdnd::_begin_drag press 2 %W %s %X %Y %x %y} - bind TkDND_Drag2 {tkdnd::_begin_drag motion 2 %W %s %X %Y %x %y} - bind TkDND_Drag3 {tkdnd::_begin_drag press 3 %W %s %X %Y %x %y} - bind TkDND_Drag3 {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 <>] - foreach type $types { - if {[lsearch $old_types $type] < 0} {lappend old_types $type} - } - bind $path <> $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 $path {+ tkdnd::_RevokeDragDrop %W} - } - aqua { - macdnd::registerdragwidget [winfo toplevel $path] $types - } - default { - error "unknown Tk windowing system" - } - } - set old_types [bind $path <>] - set new_types {} - foreach type $types { - if {[lsearch -exact $old_types $type] < 0} {lappend new_types $type} - } - if {[llength $new_types]} { - bind $path <> [concat $old_types $new_types] - } - } - unregister { - switch $_windowingsystem { - x11 { - } - win32 - - windows { - _RevokeDragDrop $path - } - aqua { - error todo - } - default { - error "unknown Tk windowing system" - } - } - bind $path <> {} - } - } -};# 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 <> binding. - set cmd [bind $source <>] - # 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 <> %A \{\} %% % \ - %t [bind $source <>]] $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 <>\ - 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 <> binding. - set cmd [bind $source <>] - if {[string length $cmd]} { - set cmd [string map [list %W $source %X $rootX %Y $rootY %x $X %y $Y %% % \ - %S $state %e <> %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 diff --git a/tkinterdnd2/tkdnd/linux64/tkdnd_compat.tcl b/tkinterdnd2/tkdnd/linux64/tkdnd_compat.tcl deleted file mode 100644 index efc96f7..0000000 --- a/tkinterdnd2/tkdnd/linux64/tkdnd_compat.tcl +++ /dev/null @@ -1,160 +0,0 @@ -# -# 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 <>] -};# compat::bindtarget0 - -proc compat::bindtarget1 {window type} { - return [bindtarget2 $window $type ] -};# compat::bindtarget1 - -proc compat::bindtarget2 {window type event} { - switch $event { - {return [bind $window <>]} - {return [bind $window <>]} - {return [bind $window <>]} - {return [bind $window <>]} - } -};# compat::bindtarget2 - -proc compat::bindtarget3 {window type event script} { - set type [normalise_type $type] - ::tkdnd::drop_target register $window [list $type] - switch $event { - {return [bind $window <> $script]} - {return [bind $window <> $script]} - {return [bind $window <> $script]} - {return [bind $window <> $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 <>] -};# compat::bindsource0 - -proc compat::bindsource1 {window type} { - return [bindsource2 $window $type ] -};# compat::bindsource1 - -proc compat::bindsource2 {window type script} { - set type [normalise_type $type] - ::tkdnd::drag_source register $window $type - bind $window <> "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 diff --git a/tkinterdnd2/tkdnd/linux64/tkdnd_generic.tcl b/tkinterdnd2/tkdnd/linux64/tkdnd_generic.tcl deleted file mode 100644 index 698b464..0000000 --- a/tkinterdnd2/tkdnd/linux64/tkdnd_generic.tcl +++ /dev/null @@ -1,520 +0,0 @@ -# -# 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 <> event. - # debug "\t<> on $_drop_target" - set cmd [bind $_drop_target <>] - 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 <> \ - %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 <>. - # puts "<> -> $drop_target" - set cmd [bind $drop_target <>] - 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 <> \ - %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 <>. - set cmd [bind $drop_target <>] - 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 <> \ - %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 <>] - 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 <> \ - %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 <> event. - foreach type [concat $_common_drag_source_types $_common_drop_target_types] { - set type [platform_independent_type $type] - set cmd [bind $_drop_target <>] - 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 <> \ - %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 <>] - 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 <> \ - %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 <>] - # 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 diff --git a/tkinterdnd2/tkdnd/linux64/tkdnd_macosx.tcl b/tkinterdnd2/tkdnd/linux64/tkdnd_macosx.tcl deleted file mode 100644 index 307f6da..0000000 --- a/tkinterdnd2/tkdnd/linux64/tkdnd_macosx.tcl +++ /dev/null @@ -1,144 +0,0 @@ -# -# 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 diff --git a/tkinterdnd2/tkdnd/linux64/tkdnd_unix.tcl b/tkinterdnd2/tkdnd/linux64/tkdnd_unix.tcl deleted file mode 100644 index 56d17c4..0000000 --- a/tkinterdnd2/tkdnd/linux64/tkdnd_unix.tcl +++ /dev/null @@ -1,810 +0,0 @@ -# -# 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 diff --git a/tkinterdnd2/tkdnd/linux64/tkdnd_utils.tcl b/tkinterdnd2/tkdnd/linux64/tkdnd_utils.tcl deleted file mode 100644 index ee961dd..0000000 --- a/tkinterdnd2/tkdnd/linux64/tkdnd_utils.tcl +++ /dev/null @@ -1,252 +0,0 @@ -# -# 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 {tkdnd::text::_begin_drag clear 1 %W %s %X %Y %x %y} -bind TkDND_Drag_Text1 {tkdnd::text::_begin_drag motion 1 %W %s %X %Y %x %y} -bind TkDND_Drag_Text1 {tkdnd::text::_TextAutoScan %W %x %y} -bind TkDND_Drag_Text1 {tkdnd::text::_begin_drag reset 1 %W %s %X %Y %x %y} -bind TkDND_Drag_Text2 {tkdnd::text::_begin_drag clear 2 %W %s %X %Y %x %y} -bind TkDND_Drag_Text2 {tkdnd::text::_begin_drag motion 2 %W %s %X %Y %x %y} -bind TkDND_Drag_Text2 {tkdnd::text::_begin_drag reset 2 %W %s %X %Y %x %y} -bind TkDND_Drag_Text3 {tkdnd::text::_begin_drag clear 3 %W %s %X %Y %x %y} -bind TkDND_Drag_Text3 {tkdnd::text::_begin_drag motion 3 %W %s %X %Y %x %y} -bind TkDND_Drag_Text3 {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 \ - "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 <> "::tkdnd::text::DragInitCmd $path {%t} $tag" - ## Set a binding to the widget, to remove selection if action is move... - bind $path <> "::tkdnd::text::DragEndCmd $path %A $tag" - } - unregister { - $path tag bind $tag {} - bind $path <> {} - bind $path <> {} - } - } - ::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 <> "::tkdnd::text::DropPosition $path %X %Y %A %a %m" - bind $path <> "::tkdnd::text::Drop $path %D %X %Y %A %a %m" - } - unregister { - bind $path <> {} - bind $path <> {} - bind $path <> {} - bind $path <> {} - } - } - ::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 diff --git a/tkinterdnd2/tkdnd/linux64/tkdnd_windows.tcl b/tkinterdnd2/tkdnd/linux64/tkdnd_windows.tcl deleted file mode 100644 index a1d01f3..0000000 --- a/tkinterdnd2/tkdnd/linux64/tkdnd_windows.tcl +++ /dev/null @@ -1,167 +0,0 @@ -# -# 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 diff --git a/tkinterdnd2/tkdnd/osx64/libtkdnd2.9.2.dylib b/tkinterdnd2/tkdnd/osx64/libtkdnd2.9.2.dylib deleted file mode 100644 index 2f511c4..0000000 Binary files a/tkinterdnd2/tkdnd/osx64/libtkdnd2.9.2.dylib and /dev/null differ diff --git a/tkinterdnd2/tkdnd/osx64/pkgIndex.tcl b/tkinterdnd2/tkdnd/osx64/pkgIndex.tcl deleted file mode 100644 index d46e91c..0000000 --- a/tkinterdnd2/tkdnd/osx64/pkgIndex.tcl +++ /dev/null @@ -1,10 +0,0 @@ -# -# 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" diff --git a/tkinterdnd2/tkdnd/osx64/tkdnd.tcl b/tkinterdnd2/tkdnd/osx64/tkdnd.tcl deleted file mode 100644 index 12d1dd2..0000000 --- a/tkinterdnd2/tkdnd/osx64/tkdnd.tcl +++ /dev/null @@ -1,469 +0,0 @@ -# -# 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 {tkdnd::_begin_drag press 1 %W %s %X %Y %x %y} - bind TkDND_Drag1 {tkdnd::_begin_drag motion 1 %W %s %X %Y %x %y} - bind TkDND_Drag2 {tkdnd::_begin_drag press 2 %W %s %X %Y %x %y} - bind TkDND_Drag2 {tkdnd::_begin_drag motion 2 %W %s %X %Y %x %y} - bind TkDND_Drag3 {tkdnd::_begin_drag press 3 %W %s %X %Y %x %y} - bind TkDND_Drag3 {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 <>] - foreach type $types { - if {[lsearch $old_types $type] < 0} {lappend old_types $type} - } - bind $path <> $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 $path {+ tkdnd::_RevokeDragDrop %W} - } - aqua { - macdnd::registerdragwidget [winfo toplevel $path] $types - } - default { - error "unknown Tk windowing system" - } - } - set old_types [bind $path <>] - set new_types {} - foreach type $types { - if {[lsearch -exact $old_types $type] < 0} {lappend new_types $type} - } - if {[llength $new_types]} { - bind $path <> [concat $old_types $new_types] - } - } - unregister { - switch $_windowingsystem { - x11 { - } - win32 - - windows { - _RevokeDragDrop $path - } - aqua { - error todo - } - default { - error "unknown Tk windowing system" - } - } - bind $path <> {} - } - } -};# 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 <> binding. - set cmd [bind $source <>] - # 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 <> %A \{\} %% % \ - %t [bind $source <>]] $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 <>\ - 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 <> binding. - set cmd [bind $source <>] - if {[string length $cmd]} { - set cmd [string map [list %W $source %X $rootX %Y $rootY %x $X %y $Y %% % \ - %S $state %e <> %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 diff --git a/tkinterdnd2/tkdnd/osx64/tkdnd_compat.tcl b/tkinterdnd2/tkdnd/osx64/tkdnd_compat.tcl deleted file mode 100644 index efc96f7..0000000 --- a/tkinterdnd2/tkdnd/osx64/tkdnd_compat.tcl +++ /dev/null @@ -1,160 +0,0 @@ -# -# 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 <>] -};# compat::bindtarget0 - -proc compat::bindtarget1 {window type} { - return [bindtarget2 $window $type ] -};# compat::bindtarget1 - -proc compat::bindtarget2 {window type event} { - switch $event { - {return [bind $window <>]} - {return [bind $window <>]} - {return [bind $window <>]} - {return [bind $window <>]} - } -};# compat::bindtarget2 - -proc compat::bindtarget3 {window type event script} { - set type [normalise_type $type] - ::tkdnd::drop_target register $window [list $type] - switch $event { - {return [bind $window <> $script]} - {return [bind $window <> $script]} - {return [bind $window <> $script]} - {return [bind $window <> $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 <>] -};# compat::bindsource0 - -proc compat::bindsource1 {window type} { - return [bindsource2 $window $type ] -};# compat::bindsource1 - -proc compat::bindsource2 {window type script} { - set type [normalise_type $type] - ::tkdnd::drag_source register $window $type - bind $window <> "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 diff --git a/tkinterdnd2/tkdnd/osx64/tkdnd_generic.tcl b/tkinterdnd2/tkdnd/osx64/tkdnd_generic.tcl deleted file mode 100644 index 698b464..0000000 --- a/tkinterdnd2/tkdnd/osx64/tkdnd_generic.tcl +++ /dev/null @@ -1,520 +0,0 @@ -# -# 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 <> event. - # debug "\t<> on $_drop_target" - set cmd [bind $_drop_target <>] - 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 <> \ - %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 <>. - # puts "<> -> $drop_target" - set cmd [bind $drop_target <>] - 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 <> \ - %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 <>. - set cmd [bind $drop_target <>] - 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 <> \ - %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 <>] - 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 <> \ - %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 <> event. - foreach type [concat $_common_drag_source_types $_common_drop_target_types] { - set type [platform_independent_type $type] - set cmd [bind $_drop_target <>] - 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 <> \ - %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 <>] - 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 <> \ - %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 <>] - # 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 diff --git a/tkinterdnd2/tkdnd/osx64/tkdnd_macosx.tcl b/tkinterdnd2/tkdnd/osx64/tkdnd_macosx.tcl deleted file mode 100644 index 307f6da..0000000 --- a/tkinterdnd2/tkdnd/osx64/tkdnd_macosx.tcl +++ /dev/null @@ -1,144 +0,0 @@ -# -# 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 diff --git a/tkinterdnd2/tkdnd/osx64/tkdnd_unix.tcl b/tkinterdnd2/tkdnd/osx64/tkdnd_unix.tcl deleted file mode 100644 index 56d17c4..0000000 --- a/tkinterdnd2/tkdnd/osx64/tkdnd_unix.tcl +++ /dev/null @@ -1,810 +0,0 @@ -# -# 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 diff --git a/tkinterdnd2/tkdnd/osx64/tkdnd_utils.tcl b/tkinterdnd2/tkdnd/osx64/tkdnd_utils.tcl deleted file mode 100644 index ee961dd..0000000 --- a/tkinterdnd2/tkdnd/osx64/tkdnd_utils.tcl +++ /dev/null @@ -1,252 +0,0 @@ -# -# 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 {tkdnd::text::_begin_drag clear 1 %W %s %X %Y %x %y} -bind TkDND_Drag_Text1 {tkdnd::text::_begin_drag motion 1 %W %s %X %Y %x %y} -bind TkDND_Drag_Text1 {tkdnd::text::_TextAutoScan %W %x %y} -bind TkDND_Drag_Text1 {tkdnd::text::_begin_drag reset 1 %W %s %X %Y %x %y} -bind TkDND_Drag_Text2 {tkdnd::text::_begin_drag clear 2 %W %s %X %Y %x %y} -bind TkDND_Drag_Text2 {tkdnd::text::_begin_drag motion 2 %W %s %X %Y %x %y} -bind TkDND_Drag_Text2 {tkdnd::text::_begin_drag reset 2 %W %s %X %Y %x %y} -bind TkDND_Drag_Text3 {tkdnd::text::_begin_drag clear 3 %W %s %X %Y %x %y} -bind TkDND_Drag_Text3 {tkdnd::text::_begin_drag motion 3 %W %s %X %Y %x %y} -bind TkDND_Drag_Text3 {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 \ - "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 <> "::tkdnd::text::DragInitCmd $path {%t} $tag" - ## Set a binding to the widget, to remove selection if action is move... - bind $path <> "::tkdnd::text::DragEndCmd $path %A $tag" - } - unregister { - $path tag bind $tag {} - bind $path <> {} - bind $path <> {} - } - } - ::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 <> "::tkdnd::text::DropPosition $path %X %Y %A %a %m" - bind $path <> "::tkdnd::text::Drop $path %D %X %Y %A %a %m" - } - unregister { - bind $path <> {} - bind $path <> {} - bind $path <> {} - bind $path <> {} - } - } - ::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 diff --git a/tkinterdnd2/tkdnd/osx64/tkdnd_windows.tcl b/tkinterdnd2/tkdnd/osx64/tkdnd_windows.tcl deleted file mode 100644 index a1d01f3..0000000 --- a/tkinterdnd2/tkdnd/osx64/tkdnd_windows.tcl +++ /dev/null @@ -1,167 +0,0 @@ -# -# 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 diff --git a/tkinterdnd2/tkdnd/win64/libtkdnd2.9.2.dll b/tkinterdnd2/tkdnd/win64/libtkdnd2.9.2.dll deleted file mode 100644 index c9cc5ab..0000000 Binary files a/tkinterdnd2/tkdnd/win64/libtkdnd2.9.2.dll and /dev/null differ diff --git a/tkinterdnd2/tkdnd/win64/pkgIndex.tcl b/tkinterdnd2/tkdnd/win64/pkgIndex.tcl deleted file mode 100644 index 733ae7d..0000000 --- a/tkinterdnd2/tkdnd/win64/pkgIndex.tcl +++ /dev/null @@ -1,7 +0,0 @@ -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" \ No newline at end of file diff --git a/tkinterdnd2/tkdnd/win64/tkdnd.tcl b/tkinterdnd2/tkdnd/win64/tkdnd.tcl deleted file mode 100644 index 12d1dd2..0000000 --- a/tkinterdnd2/tkdnd/win64/tkdnd.tcl +++ /dev/null @@ -1,469 +0,0 @@ -# -# 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 {tkdnd::_begin_drag press 1 %W %s %X %Y %x %y} - bind TkDND_Drag1 {tkdnd::_begin_drag motion 1 %W %s %X %Y %x %y} - bind TkDND_Drag2 {tkdnd::_begin_drag press 2 %W %s %X %Y %x %y} - bind TkDND_Drag2 {tkdnd::_begin_drag motion 2 %W %s %X %Y %x %y} - bind TkDND_Drag3 {tkdnd::_begin_drag press 3 %W %s %X %Y %x %y} - bind TkDND_Drag3 {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 <>] - foreach type $types { - if {[lsearch $old_types $type] < 0} {lappend old_types $type} - } - bind $path <> $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 $path {+ tkdnd::_RevokeDragDrop %W} - } - aqua { - macdnd::registerdragwidget [winfo toplevel $path] $types - } - default { - error "unknown Tk windowing system" - } - } - set old_types [bind $path <>] - set new_types {} - foreach type $types { - if {[lsearch -exact $old_types $type] < 0} {lappend new_types $type} - } - if {[llength $new_types]} { - bind $path <> [concat $old_types $new_types] - } - } - unregister { - switch $_windowingsystem { - x11 { - } - win32 - - windows { - _RevokeDragDrop $path - } - aqua { - error todo - } - default { - error "unknown Tk windowing system" - } - } - bind $path <> {} - } - } -};# 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 <> binding. - set cmd [bind $source <>] - # 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 <> %A \{\} %% % \ - %t [bind $source <>]] $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 <>\ - 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 <> binding. - set cmd [bind $source <>] - if {[string length $cmd]} { - set cmd [string map [list %W $source %X $rootX %Y $rootY %x $X %y $Y %% % \ - %S $state %e <> %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 diff --git a/tkinterdnd2/tkdnd/win64/tkdnd2.9.2.lib b/tkinterdnd2/tkdnd/win64/tkdnd2.9.2.lib deleted file mode 100644 index c5a956b..0000000 Binary files a/tkinterdnd2/tkdnd/win64/tkdnd2.9.2.lib and /dev/null differ diff --git a/tkinterdnd2/tkdnd/win64/tkdnd_compat.tcl b/tkinterdnd2/tkdnd/win64/tkdnd_compat.tcl deleted file mode 100644 index efc96f7..0000000 --- a/tkinterdnd2/tkdnd/win64/tkdnd_compat.tcl +++ /dev/null @@ -1,160 +0,0 @@ -# -# 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 <>] -};# compat::bindtarget0 - -proc compat::bindtarget1 {window type} { - return [bindtarget2 $window $type ] -};# compat::bindtarget1 - -proc compat::bindtarget2 {window type event} { - switch $event { - {return [bind $window <>]} - {return [bind $window <>]} - {return [bind $window <>]} - {return [bind $window <>]} - } -};# compat::bindtarget2 - -proc compat::bindtarget3 {window type event script} { - set type [normalise_type $type] - ::tkdnd::drop_target register $window [list $type] - switch $event { - {return [bind $window <> $script]} - {return [bind $window <> $script]} - {return [bind $window <> $script]} - {return [bind $window <> $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 <>] -};# compat::bindsource0 - -proc compat::bindsource1 {window type} { - return [bindsource2 $window $type ] -};# compat::bindsource1 - -proc compat::bindsource2 {window type script} { - set type [normalise_type $type] - ::tkdnd::drag_source register $window $type - bind $window <> "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 diff --git a/tkinterdnd2/tkdnd/win64/tkdnd_generic.tcl b/tkinterdnd2/tkdnd/win64/tkdnd_generic.tcl deleted file mode 100644 index 698b464..0000000 --- a/tkinterdnd2/tkdnd/win64/tkdnd_generic.tcl +++ /dev/null @@ -1,520 +0,0 @@ -# -# 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 <> event. - # debug "\t<> on $_drop_target" - set cmd [bind $_drop_target <>] - 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 <> \ - %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 <>. - # puts "<> -> $drop_target" - set cmd [bind $drop_target <>] - 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 <> \ - %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 <>. - set cmd [bind $drop_target <>] - 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 <> \ - %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 <>] - 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 <> \ - %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 <> event. - foreach type [concat $_common_drag_source_types $_common_drop_target_types] { - set type [platform_independent_type $type] - set cmd [bind $_drop_target <>] - 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 <> \ - %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 <>] - 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 <> \ - %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 <>] - # 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 diff --git a/tkinterdnd2/tkdnd/win64/tkdnd_macosx.tcl b/tkinterdnd2/tkdnd/win64/tkdnd_macosx.tcl deleted file mode 100644 index 307f6da..0000000 --- a/tkinterdnd2/tkdnd/win64/tkdnd_macosx.tcl +++ /dev/null @@ -1,144 +0,0 @@ -# -# 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 diff --git a/tkinterdnd2/tkdnd/win64/tkdnd_unix.tcl b/tkinterdnd2/tkdnd/win64/tkdnd_unix.tcl deleted file mode 100644 index 56d17c4..0000000 --- a/tkinterdnd2/tkdnd/win64/tkdnd_unix.tcl +++ /dev/null @@ -1,810 +0,0 @@ -# -# 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 diff --git a/tkinterdnd2/tkdnd/win64/tkdnd_utils.tcl b/tkinterdnd2/tkdnd/win64/tkdnd_utils.tcl deleted file mode 100644 index ee961dd..0000000 --- a/tkinterdnd2/tkdnd/win64/tkdnd_utils.tcl +++ /dev/null @@ -1,252 +0,0 @@ -# -# 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 {tkdnd::text::_begin_drag clear 1 %W %s %X %Y %x %y} -bind TkDND_Drag_Text1 {tkdnd::text::_begin_drag motion 1 %W %s %X %Y %x %y} -bind TkDND_Drag_Text1 {tkdnd::text::_TextAutoScan %W %x %y} -bind TkDND_Drag_Text1 {tkdnd::text::_begin_drag reset 1 %W %s %X %Y %x %y} -bind TkDND_Drag_Text2 {tkdnd::text::_begin_drag clear 2 %W %s %X %Y %x %y} -bind TkDND_Drag_Text2 {tkdnd::text::_begin_drag motion 2 %W %s %X %Y %x %y} -bind TkDND_Drag_Text2 {tkdnd::text::_begin_drag reset 2 %W %s %X %Y %x %y} -bind TkDND_Drag_Text3 {tkdnd::text::_begin_drag clear 3 %W %s %X %Y %x %y} -bind TkDND_Drag_Text3 {tkdnd::text::_begin_drag motion 3 %W %s %X %Y %x %y} -bind TkDND_Drag_Text3 {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 \ - "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 <> "::tkdnd::text::DragInitCmd $path {%t} $tag" - ## Set a binding to the widget, to remove selection if action is move... - bind $path <> "::tkdnd::text::DragEndCmd $path %A $tag" - } - unregister { - $path tag bind $tag {} - bind $path <> {} - bind $path <> {} - } - } - ::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 <> "::tkdnd::text::DropPosition $path %X %Y %A %a %m" - bind $path <> "::tkdnd::text::Drop $path %D %X %Y %A %a %m" - } - unregister { - bind $path <> {} - bind $path <> {} - bind $path <> {} - bind $path <> {} - } - } - ::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 diff --git a/tkinterdnd2/tkdnd/win64/tkdnd_windows.tcl b/tkinterdnd2/tkdnd/win64/tkdnd_windows.tcl deleted file mode 100644 index a1d01f3..0000000 --- a/tkinterdnd2/tkdnd/win64/tkdnd_windows.tcl +++ /dev/null @@ -1,167 +0,0 @@ -# -# 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