├── requirements.txt ├── tkinterDnD ├── __init__.py ├── linux │ ├── libtkdnd2.9.2.so │ ├── pkgIndex.tcl │ ├── tkdnd_compat.tcl │ ├── tkdnd_utils.tcl │ ├── tkdnd.tcl │ └── tkdnd_generic.tcl ├── mac │ ├── libtkdnd2.9.2.dylib │ ├── pkgIndex.tcl │ ├── tkdnd_macosx.tcl │ ├── tkdnd_compat.tcl │ ├── tkdnd_utils.tcl │ ├── tkdnd.tcl │ └── tkdnd_generic.tcl ├── windows │ ├── tkdnd2.9.2.lib │ ├── libtkdnd2.9.2.dll │ ├── pkgIndex.tcl │ ├── tkdnd_compat.tcl │ ├── tkdnd_windows.tcl │ ├── tkdnd_utils.tcl │ ├── tkdnd.tcl │ └── tkdnd_generic.tcl ├── constants.py ├── tk.py ├── hook.py └── dnd.py ├── .github └── workflows │ └── python-publish.yml ├── LICENSE ├── setup.py ├── complex_example.py ├── README.md ├── .gitignore └── DOCUMENTATION.md /requirements.txt: -------------------------------------------------------------------------------- 1 | ttkwidgets>=0.12.0 2 | -------------------------------------------------------------------------------- /tkinterDnD/__init__.py: -------------------------------------------------------------------------------- 1 | from .dnd import * 2 | from . import hook 3 | from .tk import Tk 4 | from .constants import * 5 | -------------------------------------------------------------------------------- /tkinterDnD/linux/libtkdnd2.9.2.so: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rdbende/tkinterDnD/HEAD/tkinterDnD/linux/libtkdnd2.9.2.so -------------------------------------------------------------------------------- /tkinterDnD/mac/libtkdnd2.9.2.dylib: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rdbende/tkinterDnD/HEAD/tkinterDnD/mac/libtkdnd2.9.2.dylib -------------------------------------------------------------------------------- /tkinterDnD/windows/tkdnd2.9.2.lib: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rdbende/tkinterDnD/HEAD/tkinterDnD/windows/tkdnd2.9.2.lib -------------------------------------------------------------------------------- /tkinterDnD/windows/libtkdnd2.9.2.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rdbende/tkinterDnD/HEAD/tkinterDnD/windows/libtkdnd2.9.2.dll -------------------------------------------------------------------------------- /tkinterDnD/windows/pkgIndex.tcl: -------------------------------------------------------------------------------- 1 | package ifneeded tkdnd 2.9.2 \ 2 | "source \{$dir/tkdnd.tcl\} ; \ 3 | tkdnd::initialise \{$dir\} libtkdnd2.9.2[info sharedlibextension] tkdnd" 4 | 5 | package ifneeded tkdnd::utils 2.9.2 \ 6 | "source \{$dir/tkdnd_utils.tcl\} ; \ 7 | package provide tkdnd::utils 2.9.2" -------------------------------------------------------------------------------- /tkinterDnD/mac/pkgIndex.tcl: -------------------------------------------------------------------------------- 1 | # 2 | # Tcl package index file 3 | # 4 | package ifneeded tkdnd 2.9.2 \ 5 | "source \{$dir/tkdnd.tcl\} ; \ 6 | tkdnd::initialise \{$dir\} libtkdnd2.9.2.dylib tkdnd" 7 | 8 | package ifneeded tkdnd::utils 2.9.2 \ 9 | "source \{$dir/tkdnd_utils.tcl\} ; \ 10 | package provide tkdnd::utils 2.9.2" 11 | -------------------------------------------------------------------------------- /tkinterDnD/linux/pkgIndex.tcl: -------------------------------------------------------------------------------- 1 | # 2 | # Tcl package index file 3 | # 4 | 5 | package ifneeded tkdnd 2.9.2 \ 6 | "source \{$dir/tkdnd.tcl\} ; \ 7 | tkdnd::initialise \{$dir\} libtkdnd2.9.2.so tkdnd" 8 | 9 | package ifneeded tkdnd::utils 2.9.2 \ 10 | "source \{$dir/tkdnd_utils.tcl\} ; \ 11 | package provide tkdnd::utils 2.9.2" 12 | -------------------------------------------------------------------------------- /tkinterDnD/constants.py: -------------------------------------------------------------------------------- 1 | # DnD actions 2 | NONE = 'none' 3 | COPY = 'copy' 4 | MOVE = 'move' 5 | LINK = 'link' 6 | ASK = 'ask' 7 | PRIVATE = 'private' 8 | REFUSE_DROP = 'refuse_drop' 9 | 10 | # Content types 11 | TEXT = 'DND_Text' 12 | FILE = 'DND_Files' 13 | COLOR = 'DND_Color' 14 | ALL = '*' 15 | 16 | # Windows specific 17 | CF_UNICODETEXT = 'CF_UNICODETEXT' 18 | CF_TEXT = 'CF_TEXT' 19 | CF_HDROP = 'CF_HDROP' 20 | FileGroupDescriptor = 'FileGroupDescriptor - FileContents' 21 | FileGroupDescriptorW = 'FileGroupDescriptorW - FileContents' 22 | -------------------------------------------------------------------------------- /tkinterDnD/tk.py: -------------------------------------------------------------------------------- 1 | """ 2 | Author: rdbende 3 | License: MIT license 4 | Copyright: 2017 Michael Lange, 2021 rdbende 5 | """ 6 | 7 | import tkinter as tk 8 | from .dnd import DnDWrapper 9 | import os.path 10 | 11 | 12 | def _init_tkdnd(master: tk.Tk) -> None: 13 | """Add the tkdnd package to the auto_path, and import it""" 14 | 15 | platform = master.tk.call("tk", "windowingsystem") 16 | 17 | if platform == "win32": 18 | folder = "windows" 19 | elif platform == "x11": 20 | folder = "linux" 21 | elif platform == "aqua": 22 | folder = "mac" 23 | 24 | package_dir = os.path.join(os.path.dirname(os.path.realpath(__file__)), folder) 25 | 26 | master.tk.call('lappend', 'auto_path', package_dir) 27 | 28 | TkDnDVersion = master.tk.call('package', 'require', 'tkdnd') 29 | 30 | return TkDnDVersion 31 | 32 | 33 | class Tk(tk.Tk, DnDWrapper): 34 | def __init__(self, *args, **kwargs): 35 | tk.Tk.__init__(self, *args, **kwargs) 36 | self.TkDnDVersion = _init_tkdnd(self) 37 | -------------------------------------------------------------------------------- /.github/workflows/python-publish.yml: -------------------------------------------------------------------------------- 1 | # This workflow will upload a Python Package using Twine when a release is created 2 | # For more information see: https://help.github.com/en/actions/language-and-framework-guides/using-python-with-github-actions#publishing-to-package-registries 3 | 4 | name: Upload tkinterDnD to Pypi 5 | 6 | on: 7 | release: 8 | types: [published] 9 | 10 | jobs: 11 | deploy: 12 | 13 | runs-on: ubuntu-latest 14 | 15 | steps: 16 | - uses: actions/checkout@v2 17 | - name: Set up Python 18 | uses: actions/setup-python@v2 19 | with: 20 | python-version: 3.9 21 | - name: Install the dependencies 22 | run: | 23 | python -m pip install --upgrade pip 24 | pip install setuptools wheel twine ttkwidgets 25 | - name: Build and publish to Pypi 26 | env: 27 | TWINE_USERNAME: ${{ secrets.PYPI_USERNAME }} 28 | TWINE_PASSWORD: ${{ secrets.PYPI_PASSWORD }} 29 | run: | 30 | python setup.py sdist bdist_wheel 31 | twine upload dist/* 32 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2021 rdbende 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /setup.py: -------------------------------------------------------------------------------- 1 | from setuptools import setup 2 | import subprocess 3 | 4 | version = subprocess.check_output(["git", "describe", "--abbrev=0", "--tags"]).strip().decode() 5 | 6 | assert version[0] == "v" # Something went wrong 7 | 8 | with open("README.md", "r") as file: 9 | long_description = file.read() 10 | 11 | setup( 12 | name="python-tkdnd", 13 | version=version, 14 | description="Native drag & drop capabilities in tkinter. The tkinterDnD package is a nice and easy-to-use wrapper around the tkdnd tcl package.", 15 | author="rdbende", 16 | author_email="rdbende@gmail.com", 17 | url="https://github.com/rdbende/tkinterDnD", 18 | long_description=long_description, 19 | long_description_content_type="text/markdown", 20 | install_requires=["ttkwidgets >= 0.12.0"], 21 | python_requires=">=3.6", 22 | license="MIT license", 23 | classifiers=[ 24 | "Programming Language :: Python :: 3.6", 25 | "License :: OSI Approved :: MIT License", 26 | "Operating System :: OS Independent", 27 | ], 28 | packages=["tkinterDnD"], 29 | package_data={"tkinterDnD": ["windows/*", "linux/*", "mac/*"]} 30 | ) 31 | -------------------------------------------------------------------------------- /complex_example.py: -------------------------------------------------------------------------------- 1 | import tkinter as tk 2 | from tkinter import ttk 3 | import tkinterDnD 4 | 5 | 6 | root = tkinterDnD.Tk() 7 | 8 | root.title("tkinterDnD example") 9 | 10 | stringvar = tk.StringVar() 11 | stringvar.set('Drop here or drag from here!') 12 | 13 | 14 | def drop(event): 15 | stringvar.set(event.data) 16 | if "color" in event.type: 17 | label_1.config(bg=event.data) 18 | 19 | 20 | def drag_command(event): 21 | return (tkinterDnD.LINK, tkinterDnD.TEXT, "Some nice dropped text.") 22 | 23 | 24 | # Without DnD hook you need to register the widget for every purpose, 25 | # and bind it to the function you want to call 26 | label_1 = tk.Label(root, textvar=stringvar, relief="solid") 27 | label_1.pack(fill="both", expand=True, padx=10, pady=10) 28 | label_1.register_drop_target(tkinterDnD.FILE) 29 | label_1.register_drag_source("*") 30 | label_1.bind("<>", drop) 31 | label_1.bind("<>", drag_command) 32 | 33 | 34 | # With DnD hook you just pass the command to the needed argument, 35 | # and tkinterDnD will take care of the rest 36 | # NOTE: You need a ttk widget to use these arguments 37 | label_2 = ttk.Label(root, onfiledrop=drop, ondragstart=drag_command, 38 | textvar=stringvar, padding=50, relief="solid") 39 | label_2.pack(fill="both", expand=True, padx=10, pady=10) 40 | 41 | 42 | root.mainloop() 43 | 44 | -------------------------------------------------------------------------------- /tkinterDnD/hook.py: -------------------------------------------------------------------------------- 1 | """ 2 | Author: rdbende 3 | License: MIT license 4 | Copyright: 2021 rdbende 5 | """ 6 | 7 | from ttkwidgets.hook import hook_ttk_widgets, is_hooked 8 | 9 | 10 | HOOK_OPTIONS = {"ontextdrop": None, "onfiledrop": None, "oncolordrop": None, "ondrop": None, 11 | "ondragstart": None, "ondragend": None, "ondragenter": None, 12 | "ondragleave": None, "ondragmove": None} 13 | 14 | 15 | def dnd_options_hook(self, option, value) -> None: 16 | if option in HOOK_OPTIONS: 17 | dnd_hook_bind(self, option, value) 18 | else: # This isn't really necessary, but it's good to have 19 | raise RuntimeError(f"Invalid tkinterDnD hook option: '{option}'") 20 | 21 | 22 | def dnd_hook_bind(self, option, value) -> None: 23 | if callable(value): 24 | if option == "ontextdrop": 25 | self.bind("<>", value) 26 | self.register_drop_target("DND_Text") 27 | elif option == "onfiledrop": 28 | self.bind("<>", value) 29 | self.register_drop_target("DND_Files") 30 | elif option == "oncolordrop": 31 | self.bind("<>", value) 32 | self.register_drop_target("DND_Color") 33 | elif option == "ondrop": 34 | self.bind("<>", value) 35 | self.register_drop_target("*") 36 | elif option == "ondragstart": 37 | self.bind("<>", value) 38 | self.register_drag_source("*") 39 | elif option == "ondragend": 40 | self.bind("<>", value) 41 | self.register_drag_source("*") 42 | elif option == "ondragenter": 43 | self.bind("<>", value) 44 | self.register_drop_target("*") 45 | elif option == "ondragleave": 46 | self.bind("<>", value) 47 | self.register_drop_target("*") 48 | elif option == "ondragmove": 49 | self.bind("<>", value) 50 | self.register_drop_target("*") 51 | elif value is not None and not callable(value): 52 | raise TypeError(f"Cant bind '{option}' to '{value}', '{value}' is not callable!") 53 | 54 | 55 | if not is_hooked(HOOK_OPTIONS): 56 | hook_ttk_widgets(dnd_options_hook, HOOK_OPTIONS) 57 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # tkinterDnD 2 | A nice and easy-to-use wrapper around the tkdnd package. No tcl installation, no build is required, **just install and use it!** 3 | 4 | ## Install 5 | The Pypi name is python-tkdnd, because tkinterDnD was already taken, but you can import the package as `tkinterDnD` 6 | 7 | ``` 8 | pip3 install python-tkdnd 9 | ``` 10 | or if you're using a distro like Windows 7, 10, or 11 replace `pip3` with `pip` 11 | 12 | 13 | ## Credits 14 | ``` 15 | Copyright (c) 2021 rdbende 16 | Copyright (c) 2012-2020 Petasis - the tkdnd package 17 | Copyright (c) 2020 Philippe Gagné - for Mac binaries 18 | Copyright (c) 2017 Michael Lange - the TkinterDnD package 19 | ``` 20 | 21 | ## Little example 22 | ```python 23 | import tkinter as tk 24 | from tkinter import ttk 25 | import tkinterDnD # Importing the tkinterDnD module 26 | 27 | # You have to use the tkinterDnD.Tk object for super easy initialization, 28 | # and to be able to use the main window as a dnd widget 29 | root = tkinterDnD.Tk() 30 | root.title("tkinterDnD example") 31 | 32 | stringvar = tk.StringVar() 33 | stringvar.set('Drop here or drag from here!') 34 | 35 | 36 | def drop(event): 37 | # This function is called, when stuff is dropped into a widget 38 | stringvar.set(event.data) 39 | 40 | def drag_command(event): 41 | # This function is called at the start of the drag, 42 | # it returns the drag type, the content type, and the actual content 43 | return (tkinterDnD.COPY, "DND_Text", "Some nice dropped text!") 44 | 45 | 46 | # Without DnD hook you need to register the widget for every purpose, 47 | # and bind it to the function you want to call 48 | label_1 = tk.Label(root, textvar=stringvar, relief="solid") 49 | label_1.pack(fill="both", expand=True, padx=10, pady=10) 50 | 51 | label_1.register_drop_target("*") 52 | label_1.bind("<>", drop) 53 | 54 | label_1.register_drag_source("*") 55 | label_1.bind("<>", drag_command) 56 | 57 | 58 | # With DnD hook you just pass the command to the proper argument, 59 | # and tkinterDnD will take care of the rest 60 | # NOTE: You need a ttk widget to use these arguments 61 | label_2 = ttk.Label(root, ondrop=drop, ondragstart=drag_command, 62 | textvar=stringvar, padding=50, relief="solid") 63 | label_2.pack(fill="both", expand=True, padx=10, pady=10) 64 | 65 | 66 | root.mainloop() 67 | ``` 68 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # Byte-compiled / optimized / DLL files 2 | __pycache__/ 3 | *.py[cod] 4 | *$py.class 5 | 6 | # C extensions 7 | *.so 8 | 9 | # Distribution / packaging 10 | .Python 11 | build/ 12 | develop-eggs/ 13 | dist/ 14 | downloads/ 15 | eggs/ 16 | .eggs/ 17 | lib/ 18 | lib64/ 19 | parts/ 20 | sdist/ 21 | var/ 22 | wheels/ 23 | pip-wheel-metadata/ 24 | share/python-wheels/ 25 | *.egg-info/ 26 | .installed.cfg 27 | *.egg 28 | MANIFEST 29 | 30 | # PyInstaller 31 | # Usually these files are written by a python script from a template 32 | # before PyInstaller builds the exe, so as to inject date/other infos into it. 33 | *.manifest 34 | *.spec 35 | 36 | # Installer logs 37 | pip-log.txt 38 | pip-delete-this-directory.txt 39 | 40 | # Unit test / coverage reports 41 | htmlcov/ 42 | .tox/ 43 | .nox/ 44 | .coverage 45 | .coverage.* 46 | .cache 47 | nosetests.xml 48 | coverage.xml 49 | *.cover 50 | *.py,cover 51 | .hypothesis/ 52 | .pytest_cache/ 53 | 54 | # Translations 55 | *.mo 56 | *.pot 57 | 58 | # Django stuff: 59 | *.log 60 | local_settings.py 61 | db.sqlite3 62 | db.sqlite3-journal 63 | 64 | # Flask stuff: 65 | instance/ 66 | .webassets-cache 67 | 68 | # Scrapy stuff: 69 | .scrapy 70 | 71 | # Sphinx documentation 72 | docs/_build/ 73 | 74 | # PyBuilder 75 | target/ 76 | 77 | # Jupyter Notebook 78 | .ipynb_checkpoints 79 | 80 | # IPython 81 | profile_default/ 82 | ipython_config.py 83 | 84 | # pyenv 85 | .python-version 86 | 87 | # pipenv 88 | # According to pypa/pipenv#598, it is recommended to include Pipfile.lock in version control. 89 | # However, in case of collaboration, if having platform-specific dependencies or dependencies 90 | # having no cross-platform support, pipenv may install dependencies that don't work, or not 91 | # install all needed dependencies. 92 | #Pipfile.lock 93 | 94 | # PEP 582; used by e.g. github.com/David-OConnor/pyflow 95 | __pypackages__/ 96 | 97 | # Celery stuff 98 | celerybeat-schedule 99 | celerybeat.pid 100 | 101 | # SageMath parsed files 102 | *.sage.py 103 | 104 | # Environments 105 | .env 106 | .venv 107 | env/ 108 | venv/ 109 | ENV/ 110 | env.bak/ 111 | venv.bak/ 112 | 113 | # Spyder project settings 114 | .spyderproject 115 | .spyproject 116 | 117 | # Rope project settings 118 | .ropeproject 119 | 120 | # mkdocs documentation 121 | /site 122 | 123 | # mypy 124 | .mypy_cache/ 125 | .dmypy.json 126 | dmypy.json 127 | 128 | # Pyre type checker 129 | .pyre/ 130 | -------------------------------------------------------------------------------- /tkinterDnD/mac/tkdnd_macosx.tcl: -------------------------------------------------------------------------------- 1 | # 2 | # tkdnd_macosx.tcl -- 3 | # 4 | # This file implements some utility procedures that are used by the TkDND 5 | # package. 6 | 7 | # This software is copyrighted by: 8 | # Georgios Petasis, Athens, Greece. 9 | # e-mail: petasisg@yahoo.gr, petasis@iit.demokritos.gr 10 | # 11 | # Mac portions (c) 2009 Kevin Walzer/WordTech Communications LLC, 12 | # kw@codebykevin.com 13 | # 14 | # 15 | # The following terms apply to all files associated 16 | # with the software unless explicitly disclaimed in individual files. 17 | # 18 | # The authors hereby grant permission to use, copy, modify, distribute, 19 | # and license this software and its documentation for any purpose, provided 20 | # that existing copyright notices are retained in all copies and that this 21 | # notice is included verbatim in any distributions. No written agreement, 22 | # license, or royalty fee is required for any of the authorized uses. 23 | # Modifications to this software may be copyrighted by their authors 24 | # and need not follow the licensing terms described here, provided that 25 | # the new terms are clearly indicated on the first page of each file where 26 | # they apply. 27 | # 28 | # IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY 29 | # FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES 30 | # ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY 31 | # DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE 32 | # POSSIBILITY OF SUCH DAMAGE. 33 | # 34 | # THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, 35 | # INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, 36 | # FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE 37 | # IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE 38 | # NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR 39 | # MODIFICATIONS. 40 | # 41 | 42 | #basic API for Mac Drag and Drop 43 | 44 | #two data types supported: strings and file paths 45 | 46 | #two commands at C level: ::tkdnd::macdnd::registerdragwidget, ::tkdnd::macdnd::unregisterdragwidget 47 | 48 | #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 49 | 50 | if {[tk windowingsystem] eq "aqua" && "AppKit" ni [winfo server .]} { 51 | error {TkAqua Cocoa required} 52 | } 53 | 54 | namespace eval macdnd { 55 | 56 | proc initialise { } { 57 | ## Mapping from platform types to TkDND types... 58 | ::tkdnd::generic::initialise_platform_to_tkdnd_types [list \ 59 | NSPasteboardTypeString DND_Text \ 60 | NSFilenamesPboardType DND_Files \ 61 | NSPasteboardTypeHTML DND_HTML \ 62 | ] 63 | };# initialise 64 | 65 | };# namespace macdnd 66 | 67 | # ---------------------------------------------------------------------------- 68 | # Command macdnd::HandleEnter 69 | # ---------------------------------------------------------------------------- 70 | proc macdnd::HandleEnter { path drag_source typelist { data {} } } { 71 | variable _pressedkeys 72 | variable _actionlist 73 | set _pressedkeys 1 74 | set _actionlist { copy move link ask private } 75 | ::tkdnd::generic::SetDroppedData $data 76 | ::tkdnd::generic::HandleEnter $path $drag_source $typelist $typelist \ 77 | $_actionlist $_pressedkeys 78 | };# macdnd::HandleEnter 79 | 80 | # ---------------------------------------------------------------------------- 81 | # Command macdnd::HandlePosition 82 | # ---------------------------------------------------------------------------- 83 | proc macdnd::HandlePosition { drop_target rootX rootY {drag_source {}} } { 84 | variable _pressedkeys 85 | variable _last_mouse_root_x; set _last_mouse_root_x $rootX 86 | variable _last_mouse_root_y; set _last_mouse_root_y $rootY 87 | ::tkdnd::generic::HandlePosition $drop_target $drag_source \ 88 | $_pressedkeys $rootX $rootY 89 | };# macdnd::HandlePosition 90 | 91 | # ---------------------------------------------------------------------------- 92 | # Command macdnd::HandleLeave 93 | # ---------------------------------------------------------------------------- 94 | proc macdnd::HandleLeave { args } { 95 | ::tkdnd::generic::HandleLeave 96 | };# macdnd::HandleLeave 97 | 98 | # ---------------------------------------------------------------------------- 99 | # Command macdnd::HandleDrop 100 | # ---------------------------------------------------------------------------- 101 | proc macdnd::HandleDrop { drop_target data args } { 102 | variable _pressedkeys 103 | variable _last_mouse_root_x 104 | variable _last_mouse_root_y 105 | ## Get the dropped data... 106 | ::tkdnd::generic::SetDroppedData $data 107 | ::tkdnd::generic::HandleDrop {} {} $_pressedkeys \ 108 | $_last_mouse_root_x $_last_mouse_root_y 0 109 | };# macdnd::HandleDrop 110 | 111 | # ---------------------------------------------------------------------------- 112 | # Command macdnd::GetDragSourceCommonTypes 113 | # ---------------------------------------------------------------------------- 114 | proc macdnd::GetDragSourceCommonTypes { } { 115 | ::tkdnd::generic::GetDragSourceCommonTypes 116 | };# macdnd::GetDragSourceCommonTypes 117 | 118 | # ---------------------------------------------------------------------------- 119 | # Command macdnd::platform_specific_types 120 | # ---------------------------------------------------------------------------- 121 | proc macdnd::platform_specific_types { types } { 122 | ::tkdnd::generic::platform_specific_types $types 123 | }; # macdnd::platform_specific_types 124 | 125 | # ---------------------------------------------------------------------------- 126 | # Command macdnd::platform_specific_type 127 | # ---------------------------------------------------------------------------- 128 | proc macdnd::platform_specific_type { type } { 129 | ::tkdnd::generic::platform_specific_type $type 130 | }; # macdnd::platform_specific_type 131 | 132 | # ---------------------------------------------------------------------------- 133 | # Command tkdnd::platform_independent_types 134 | # ---------------------------------------------------------------------------- 135 | proc ::tkdnd::platform_independent_types { types } { 136 | ::tkdnd::generic::platform_independent_types $types 137 | }; # tkdnd::platform_independent_types 138 | 139 | # ---------------------------------------------------------------------------- 140 | # Command macdnd::platform_independent_type 141 | # ---------------------------------------------------------------------------- 142 | proc macdnd::platform_independent_type { type } { 143 | ::tkdnd::generic::platform_independent_type $type 144 | }; # macdnd::platform_independent_type 145 | -------------------------------------------------------------------------------- /tkinterDnD/linux/tkdnd_compat.tcl: -------------------------------------------------------------------------------- 1 | # 2 | # tkdnd_compat.tcl -- 3 | # 4 | # This file implements some utility procedures, to support older versions 5 | # of the TkDND package. 6 | # 7 | # This software is copyrighted by: 8 | # George Petasis, National Centre for Scientific Research "Demokritos", 9 | # Aghia Paraskevi, Athens, Greece. 10 | # e-mail: petasis@iit.demokritos.gr 11 | # 12 | # The following terms apply to all files associated 13 | # with the software unless explicitly disclaimed in individual files. 14 | # 15 | # The authors hereby grant permission to use, copy, modify, distribute, 16 | # and license this software and its documentation for any purpose, provided 17 | # that existing copyright notices are retained in all copies and that this 18 | # notice is included verbatim in any distributions. No written agreement, 19 | # license, or royalty fee is required for any of the authorized uses. 20 | # Modifications to this software may be copyrighted by their authors 21 | # and need not follow the licensing terms described here, provided that 22 | # the new terms are clearly indicated on the first page of each file where 23 | # they apply. 24 | # 25 | # IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY 26 | # FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES 27 | # ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY 28 | # DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE 29 | # POSSIBILITY OF SUCH DAMAGE. 30 | # 31 | # THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, 32 | # INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, 33 | # FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE 34 | # IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE 35 | # NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR 36 | # MODIFICATIONS. 37 | # 38 | 39 | namespace eval compat { 40 | 41 | };# namespace compat 42 | 43 | # ---------------------------------------------------------------------------- 44 | # Command ::dnd 45 | # ---------------------------------------------------------------------------- 46 | proc ::dnd {method window args} { 47 | switch $method { 48 | bindtarget { 49 | switch [llength $args] { 50 | 0 {return [tkdnd::compat::bindtarget0 $window]} 51 | 1 {return [tkdnd::compat::bindtarget1 $window [lindex $args 0]]} 52 | 2 {return [tkdnd::compat::bindtarget2 $window [lindex $args 0] \ 53 | [lindex $args 1]]} 54 | 3 {return [tkdnd::compat::bindtarget3 $window [lindex $args 0] \ 55 | [lindex $args 1] [lindex $args 2]]} 56 | 4 {return [tkdnd::compat::bindtarget4 $window [lindex $args 0] \ 57 | [lindex $args 1] [lindex $args 2] [lindex $args 3]]} 58 | } 59 | } 60 | cleartarget { 61 | return [tkdnd::compat::cleartarget $window] 62 | } 63 | bindsource { 64 | switch [llength $args] { 65 | 0 {return [tkdnd::compat::bindsource0 $window]} 66 | 1 {return [tkdnd::compat::bindsource1 $window [lindex $args 0]]} 67 | 2 {return [tkdnd::compat::bindsource2 $window [lindex $args 0] \ 68 | [lindex $args 1]]} 69 | 3 {return [tkdnd::compat::bindsource3 $window [lindex $args 0] \ 70 | [lindex $args 1] [lindex $args 2]]} 71 | } 72 | } 73 | clearsource { 74 | return [tkdnd::compat::clearsource $window] 75 | } 76 | drag { 77 | return [tkdnd::_init_drag 1 $window "press" 0 0 0 0] 78 | } 79 | } 80 | error "invalid number of arguments!" 81 | };# ::dnd 82 | 83 | # ---------------------------------------------------------------------------- 84 | # Command compat::bindtarget 85 | # ---------------------------------------------------------------------------- 86 | proc compat::bindtarget0 {window} { 87 | return [bind $window <>] 88 | };# compat::bindtarget0 89 | 90 | proc compat::bindtarget1 {window type} { 91 | return [bindtarget2 $window $type ] 92 | };# compat::bindtarget1 93 | 94 | proc compat::bindtarget2 {window type event} { 95 | switch $event { 96 | {return [bind $window <>]} 97 | {return [bind $window <>]} 98 | {return [bind $window <>]} 99 | {return [bind $window <>]} 100 | } 101 | };# compat::bindtarget2 102 | 103 | proc compat::bindtarget3 {window type event script} { 104 | set type [normalise_type $type] 105 | ::tkdnd::drop_target register $window [list $type] 106 | switch $event { 107 | {return [bind $window <> $script]} 108 | {return [bind $window <> $script]} 109 | {return [bind $window <> $script]} 110 | {return [bind $window <> $script]} 111 | } 112 | };# compat::bindtarget3 113 | 114 | proc compat::bindtarget4 {window type event script priority} { 115 | return [bindtarget3 $window $type $event $script] 116 | };# compat::bindtarget4 117 | 118 | proc compat::normalise_type { type } { 119 | switch $type { 120 | text/plain - 121 | {text/plain;charset=UTF-8} - 122 | Text {return DND_Text} 123 | text/uri-list - 124 | Files {return DND_Files} 125 | default {return $type} 126 | } 127 | };# compat::normalise_type 128 | 129 | # ---------------------------------------------------------------------------- 130 | # Command compat::bindsource 131 | # ---------------------------------------------------------------------------- 132 | proc compat::bindsource0 {window} { 133 | return [bind $window <>] 134 | };# compat::bindsource0 135 | 136 | proc compat::bindsource1 {window type} { 137 | return [bindsource2 $window $type ] 138 | };# compat::bindsource1 139 | 140 | proc compat::bindsource2 {window type script} { 141 | set type [normalise_type $type] 142 | ::tkdnd::drag_source register $window $type 143 | bind $window <> "list {copy} {%t} \[$script\]" 144 | };# compat::bindsource2 145 | 146 | proc compat::bindsource3 {window type script priority} { 147 | return [bindsource2 $window $type $script] 148 | };# compat::bindsource3 149 | 150 | # ---------------------------------------------------------------------------- 151 | # Command compat::cleartarget 152 | # ---------------------------------------------------------------------------- 153 | proc compat::cleartarget {window} { 154 | };# compat::cleartarget 155 | 156 | # ---------------------------------------------------------------------------- 157 | # Command compat::clearsource 158 | # ---------------------------------------------------------------------------- 159 | proc compat::clearsource {window} { 160 | };# compat::clearsource 161 | -------------------------------------------------------------------------------- /tkinterDnD/mac/tkdnd_compat.tcl: -------------------------------------------------------------------------------- 1 | # 2 | # tkdnd_compat.tcl -- 3 | # 4 | # This file implements some utility procedures, to support older versions 5 | # of the TkDND package. 6 | # 7 | # This software is copyrighted by: 8 | # George Petasis, National Centre for Scientific Research "Demokritos", 9 | # Aghia Paraskevi, Athens, Greece. 10 | # e-mail: petasis@iit.demokritos.gr 11 | # 12 | # The following terms apply to all files associated 13 | # with the software unless explicitly disclaimed in individual files. 14 | # 15 | # The authors hereby grant permission to use, copy, modify, distribute, 16 | # and license this software and its documentation for any purpose, provided 17 | # that existing copyright notices are retained in all copies and that this 18 | # notice is included verbatim in any distributions. No written agreement, 19 | # license, or royalty fee is required for any of the authorized uses. 20 | # Modifications to this software may be copyrighted by their authors 21 | # and need not follow the licensing terms described here, provided that 22 | # the new terms are clearly indicated on the first page of each file where 23 | # they apply. 24 | # 25 | # IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY 26 | # FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES 27 | # ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY 28 | # DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE 29 | # POSSIBILITY OF SUCH DAMAGE. 30 | # 31 | # THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, 32 | # INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, 33 | # FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE 34 | # IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE 35 | # NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR 36 | # MODIFICATIONS. 37 | # 38 | 39 | namespace eval compat { 40 | 41 | };# namespace compat 42 | 43 | # ---------------------------------------------------------------------------- 44 | # Command ::dnd 45 | # ---------------------------------------------------------------------------- 46 | proc ::dnd {method window args} { 47 | switch $method { 48 | bindtarget { 49 | switch [llength $args] { 50 | 0 {return [tkdnd::compat::bindtarget0 $window]} 51 | 1 {return [tkdnd::compat::bindtarget1 $window [lindex $args 0]]} 52 | 2 {return [tkdnd::compat::bindtarget2 $window [lindex $args 0] \ 53 | [lindex $args 1]]} 54 | 3 {return [tkdnd::compat::bindtarget3 $window [lindex $args 0] \ 55 | [lindex $args 1] [lindex $args 2]]} 56 | 4 {return [tkdnd::compat::bindtarget4 $window [lindex $args 0] \ 57 | [lindex $args 1] [lindex $args 2] [lindex $args 3]]} 58 | } 59 | } 60 | cleartarget { 61 | return [tkdnd::compat::cleartarget $window] 62 | } 63 | bindsource { 64 | switch [llength $args] { 65 | 0 {return [tkdnd::compat::bindsource0 $window]} 66 | 1 {return [tkdnd::compat::bindsource1 $window [lindex $args 0]]} 67 | 2 {return [tkdnd::compat::bindsource2 $window [lindex $args 0] \ 68 | [lindex $args 1]]} 69 | 3 {return [tkdnd::compat::bindsource3 $window [lindex $args 0] \ 70 | [lindex $args 1] [lindex $args 2]]} 71 | } 72 | } 73 | clearsource { 74 | return [tkdnd::compat::clearsource $window] 75 | } 76 | drag { 77 | return [tkdnd::_init_drag 1 $window "press" 0 0 0 0] 78 | } 79 | } 80 | error "invalid number of arguments!" 81 | };# ::dnd 82 | 83 | # ---------------------------------------------------------------------------- 84 | # Command compat::bindtarget 85 | # ---------------------------------------------------------------------------- 86 | proc compat::bindtarget0 {window} { 87 | return [bind $window <>] 88 | };# compat::bindtarget0 89 | 90 | proc compat::bindtarget1 {window type} { 91 | return [bindtarget2 $window $type ] 92 | };# compat::bindtarget1 93 | 94 | proc compat::bindtarget2 {window type event} { 95 | switch $event { 96 | {return [bind $window <>]} 97 | {return [bind $window <>]} 98 | {return [bind $window <>]} 99 | {return [bind $window <>]} 100 | } 101 | };# compat::bindtarget2 102 | 103 | proc compat::bindtarget3 {window type event script} { 104 | set type [normalise_type $type] 105 | ::tkdnd::drop_target register $window [list $type] 106 | switch $event { 107 | {return [bind $window <> $script]} 108 | {return [bind $window <> $script]} 109 | {return [bind $window <> $script]} 110 | {return [bind $window <> $script]} 111 | } 112 | };# compat::bindtarget3 113 | 114 | proc compat::bindtarget4 {window type event script priority} { 115 | return [bindtarget3 $window $type $event $script] 116 | };# compat::bindtarget4 117 | 118 | proc compat::normalise_type { type } { 119 | switch $type { 120 | text/plain - 121 | {text/plain;charset=UTF-8} - 122 | Text {return DND_Text} 123 | text/uri-list - 124 | Files {return DND_Files} 125 | default {return $type} 126 | } 127 | };# compat::normalise_type 128 | 129 | # ---------------------------------------------------------------------------- 130 | # Command compat::bindsource 131 | # ---------------------------------------------------------------------------- 132 | proc compat::bindsource0 {window} { 133 | return [bind $window <>] 134 | };# compat::bindsource0 135 | 136 | proc compat::bindsource1 {window type} { 137 | return [bindsource2 $window $type ] 138 | };# compat::bindsource1 139 | 140 | proc compat::bindsource2 {window type script} { 141 | set type [normalise_type $type] 142 | ::tkdnd::drag_source register $window $type 143 | bind $window <> "list {copy} {%t} \[$script\]" 144 | };# compat::bindsource2 145 | 146 | proc compat::bindsource3 {window type script priority} { 147 | return [bindsource2 $window $type $script] 148 | };# compat::bindsource3 149 | 150 | # ---------------------------------------------------------------------------- 151 | # Command compat::cleartarget 152 | # ---------------------------------------------------------------------------- 153 | proc compat::cleartarget {window} { 154 | };# compat::cleartarget 155 | 156 | # ---------------------------------------------------------------------------- 157 | # Command compat::clearsource 158 | # ---------------------------------------------------------------------------- 159 | proc compat::clearsource {window} { 160 | };# compat::clearsource 161 | -------------------------------------------------------------------------------- /tkinterDnD/windows/tkdnd_compat.tcl: -------------------------------------------------------------------------------- 1 | # 2 | # tkdnd_compat.tcl -- 3 | # 4 | # This file implements some utility procedures, to support older versions 5 | # of the TkDND package. 6 | # 7 | # This software is copyrighted by: 8 | # George Petasis, National Centre for Scientific Research "Demokritos", 9 | # Aghia Paraskevi, Athens, Greece. 10 | # e-mail: petasis@iit.demokritos.gr 11 | # 12 | # The following terms apply to all files associated 13 | # with the software unless explicitly disclaimed in individual files. 14 | # 15 | # The authors hereby grant permission to use, copy, modify, distribute, 16 | # and license this software and its documentation for any purpose, provided 17 | # that existing copyright notices are retained in all copies and that this 18 | # notice is included verbatim in any distributions. No written agreement, 19 | # license, or royalty fee is required for any of the authorized uses. 20 | # Modifications to this software may be copyrighted by their authors 21 | # and need not follow the licensing terms described here, provided that 22 | # the new terms are clearly indicated on the first page of each file where 23 | # they apply. 24 | # 25 | # IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY 26 | # FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES 27 | # ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY 28 | # DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE 29 | # POSSIBILITY OF SUCH DAMAGE. 30 | # 31 | # THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, 32 | # INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, 33 | # FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE 34 | # IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE 35 | # NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR 36 | # MODIFICATIONS. 37 | # 38 | 39 | namespace eval compat { 40 | 41 | };# namespace compat 42 | 43 | # ---------------------------------------------------------------------------- 44 | # Command ::dnd 45 | # ---------------------------------------------------------------------------- 46 | proc ::dnd {method window args} { 47 | switch $method { 48 | bindtarget { 49 | switch [llength $args] { 50 | 0 {return [tkdnd::compat::bindtarget0 $window]} 51 | 1 {return [tkdnd::compat::bindtarget1 $window [lindex $args 0]]} 52 | 2 {return [tkdnd::compat::bindtarget2 $window [lindex $args 0] \ 53 | [lindex $args 1]]} 54 | 3 {return [tkdnd::compat::bindtarget3 $window [lindex $args 0] \ 55 | [lindex $args 1] [lindex $args 2]]} 56 | 4 {return [tkdnd::compat::bindtarget4 $window [lindex $args 0] \ 57 | [lindex $args 1] [lindex $args 2] [lindex $args 3]]} 58 | } 59 | } 60 | cleartarget { 61 | return [tkdnd::compat::cleartarget $window] 62 | } 63 | bindsource { 64 | switch [llength $args] { 65 | 0 {return [tkdnd::compat::bindsource0 $window]} 66 | 1 {return [tkdnd::compat::bindsource1 $window [lindex $args 0]]} 67 | 2 {return [tkdnd::compat::bindsource2 $window [lindex $args 0] \ 68 | [lindex $args 1]]} 69 | 3 {return [tkdnd::compat::bindsource3 $window [lindex $args 0] \ 70 | [lindex $args 1] [lindex $args 2]]} 71 | } 72 | } 73 | clearsource { 74 | return [tkdnd::compat::clearsource $window] 75 | } 76 | drag { 77 | return [tkdnd::_init_drag 1 $window "press" 0 0 0 0] 78 | } 79 | } 80 | error "invalid number of arguments!" 81 | };# ::dnd 82 | 83 | # ---------------------------------------------------------------------------- 84 | # Command compat::bindtarget 85 | # ---------------------------------------------------------------------------- 86 | proc compat::bindtarget0 {window} { 87 | return [bind $window <>] 88 | };# compat::bindtarget0 89 | 90 | proc compat::bindtarget1 {window type} { 91 | return [bindtarget2 $window $type ] 92 | };# compat::bindtarget1 93 | 94 | proc compat::bindtarget2 {window type event} { 95 | switch $event { 96 | {return [bind $window <>]} 97 | {return [bind $window <>]} 98 | {return [bind $window <>]} 99 | {return [bind $window <>]} 100 | } 101 | };# compat::bindtarget2 102 | 103 | proc compat::bindtarget3 {window type event script} { 104 | set type [normalise_type $type] 105 | ::tkdnd::drop_target register $window [list $type] 106 | switch $event { 107 | {return [bind $window <> $script]} 108 | {return [bind $window <> $script]} 109 | {return [bind $window <> $script]} 110 | {return [bind $window <> $script]} 111 | } 112 | };# compat::bindtarget3 113 | 114 | proc compat::bindtarget4 {window type event script priority} { 115 | return [bindtarget3 $window $type $event $script] 116 | };# compat::bindtarget4 117 | 118 | proc compat::normalise_type { type } { 119 | switch $type { 120 | text/plain - 121 | {text/plain;charset=UTF-8} - 122 | Text {return DND_Text} 123 | text/uri-list - 124 | Files {return DND_Files} 125 | default {return $type} 126 | } 127 | };# compat::normalise_type 128 | 129 | # ---------------------------------------------------------------------------- 130 | # Command compat::bindsource 131 | # ---------------------------------------------------------------------------- 132 | proc compat::bindsource0 {window} { 133 | return [bind $window <>] 134 | };# compat::bindsource0 135 | 136 | proc compat::bindsource1 {window type} { 137 | return [bindsource2 $window $type ] 138 | };# compat::bindsource1 139 | 140 | proc compat::bindsource2 {window type script} { 141 | set type [normalise_type $type] 142 | ::tkdnd::drag_source register $window $type 143 | bind $window <> "list {copy} {%t} \[$script\]" 144 | };# compat::bindsource2 145 | 146 | proc compat::bindsource3 {window type script priority} { 147 | return [bindsource2 $window $type $script] 148 | };# compat::bindsource3 149 | 150 | # ---------------------------------------------------------------------------- 151 | # Command compat::cleartarget 152 | # ---------------------------------------------------------------------------- 153 | proc compat::cleartarget {window} { 154 | };# compat::cleartarget 155 | 156 | # ---------------------------------------------------------------------------- 157 | # Command compat::clearsource 158 | # ---------------------------------------------------------------------------- 159 | proc compat::clearsource {window} { 160 | };# compat::clearsource 161 | -------------------------------------------------------------------------------- /tkinterDnD/windows/tkdnd_windows.tcl: -------------------------------------------------------------------------------- 1 | # 2 | # tkdnd_windows.tcl -- 3 | # 4 | # This file implements some utility procedures that are used by the TkDND 5 | # package. 6 | # 7 | # This software is copyrighted by: 8 | # George Petasis, National Centre for Scientific Research "Demokritos", 9 | # Aghia Paraskevi, Athens, Greece. 10 | # e-mail: petasis@iit.demokritos.gr 11 | # 12 | # The following terms apply to all files associated 13 | # with the software unless explicitly disclaimed in individual files. 14 | # 15 | # The authors hereby grant permission to use, copy, modify, distribute, 16 | # and license this software and its documentation for any purpose, provided 17 | # that existing copyright notices are retained in all copies and that this 18 | # notice is included verbatim in any distributions. No written agreement, 19 | # license, or royalty fee is required for any of the authorized uses. 20 | # Modifications to this software may be copyrighted by their authors 21 | # and need not follow the licensing terms described here, provided that 22 | # the new terms are clearly indicated on the first page of each file where 23 | # they apply. 24 | # 25 | # IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY 26 | # FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES 27 | # ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY 28 | # DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE 29 | # POSSIBILITY OF SUCH DAMAGE. 30 | # 31 | # THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, 32 | # INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, 33 | # FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE 34 | # IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE 35 | # NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR 36 | # MODIFICATIONS. 37 | # 38 | 39 | namespace eval olednd { 40 | 41 | proc initialise { } { 42 | ## Mapping from platform types to TkDND types... 43 | ::tkdnd::generic::initialise_platform_to_tkdnd_types [list \ 44 | CF_UNICODETEXT DND_Text \ 45 | CF_TEXT DND_Text \ 46 | CF_HDROP DND_Files \ 47 | UniformResourceLocator DND_URL \ 48 | CF_HTML DND_HTML \ 49 | {HTML Format} DND_HTML \ 50 | CF_RTF DND_RTF \ 51 | CF_RTFTEXT DND_RTF \ 52 | {Rich Text Format} DND_RTF \ 53 | ] 54 | # FileGroupDescriptorW DND_Files \ 55 | # FileGroupDescriptor DND_Files \ 56 | 57 | ## Mapping from TkDND types to platform types... 58 | ::tkdnd::generic::initialise_tkdnd_to_platform_types [list \ 59 | DND_Text {CF_UNICODETEXT CF_TEXT} \ 60 | DND_Files {CF_HDROP} \ 61 | DND_URL {UniformResourceLocator UniformResourceLocatorW} \ 62 | DND_HTML {CF_HTML {HTML Format}} \ 63 | DND_RTF {CF_RTF CF_RTFTEXT {Rich Text Format}} \ 64 | ] 65 | };# initialise 66 | 67 | };# namespace olednd 68 | 69 | # ---------------------------------------------------------------------------- 70 | # Command olednd::HandleDragEnter 71 | # ---------------------------------------------------------------------------- 72 | proc olednd::HandleDragEnter { drop_target typelist actionlist pressedkeys 73 | rootX rootY codelist { data {} } } { 74 | ::tkdnd::generic::SetDroppedData $data 75 | focus $drop_target 76 | ::tkdnd::generic::HandleEnter $drop_target 0 $typelist \ 77 | $codelist $actionlist $pressedkeys 78 | set action [::tkdnd::generic::HandlePosition $drop_target {} \ 79 | $pressedkeys $rootX $rootY] 80 | if {$::tkdnd::_auto_update} {update idletasks} 81 | return $action 82 | };# olednd::HandleDragEnter 83 | 84 | # ---------------------------------------------------------------------------- 85 | # Command olednd::HandleDragOver 86 | # ---------------------------------------------------------------------------- 87 | proc olednd::HandleDragOver { drop_target pressedkeys rootX rootY } { 88 | set action [::tkdnd::generic::HandlePosition $drop_target {} \ 89 | $pressedkeys $rootX $rootY] 90 | if {$::tkdnd::_auto_update} {update idletasks} 91 | return $action 92 | };# olednd::HandleDragOver 93 | 94 | # ---------------------------------------------------------------------------- 95 | # Command olednd::HandleDragLeave 96 | # ---------------------------------------------------------------------------- 97 | proc olednd::HandleDragLeave { drop_target } { 98 | ::tkdnd::generic::HandleLeave 99 | if {$::tkdnd::_auto_update} {update idletasks} 100 | };# olednd::HandleDragLeave 101 | 102 | # ---------------------------------------------------------------------------- 103 | # Command olednd::HandleDrop 104 | # ---------------------------------------------------------------------------- 105 | proc olednd::HandleDrop { drop_target pressedkeys rootX rootY type data } { 106 | ::tkdnd::generic::SetDroppedData [normalise_data $type $data] 107 | set action [::tkdnd::generic::HandleDrop $drop_target {} \ 108 | $pressedkeys $rootX $rootY 0] 109 | if {$::tkdnd::_auto_update} {update idletasks} 110 | return $action 111 | };# olednd::HandleDrop 112 | 113 | # ---------------------------------------------------------------------------- 114 | # Command olednd::GetDataType 115 | # ---------------------------------------------------------------------------- 116 | proc olednd::GetDataType { drop_target typelist } { 117 | foreach {drop_target common_drag_source_types common_drop_target_types} \ 118 | [::tkdnd::generic::FindWindowWithCommonTypes $drop_target $typelist] {break} 119 | lindex $common_drag_source_types 0 120 | };# olednd::GetDataType 121 | 122 | # ---------------------------------------------------------------------------- 123 | # Command olednd::GetDragSourceCommonTypes 124 | # ---------------------------------------------------------------------------- 125 | proc olednd::GetDragSourceCommonTypes { drop_target } { 126 | ::tkdnd::generic::GetDragSourceCommonTypes 127 | };# olednd::GetDragSourceCommonTypes 128 | 129 | # ---------------------------------------------------------------------------- 130 | # Command olednd::platform_specific_types 131 | # ---------------------------------------------------------------------------- 132 | proc olednd::platform_specific_types { types } { 133 | ::tkdnd::generic::platform_specific_types $types 134 | }; # olednd::platform_specific_types 135 | 136 | # ---------------------------------------------------------------------------- 137 | # Command olednd::platform_specific_type 138 | # ---------------------------------------------------------------------------- 139 | proc olednd::platform_specific_type { type } { 140 | ::tkdnd::generic::platform_specific_type $type 141 | }; # olednd::platform_specific_type 142 | 143 | # ---------------------------------------------------------------------------- 144 | # Command tkdnd::platform_independent_types 145 | # ---------------------------------------------------------------------------- 146 | proc ::tkdnd::platform_independent_types { types } { 147 | ::tkdnd::generic::platform_independent_types $types 148 | }; # tkdnd::platform_independent_types 149 | 150 | # ---------------------------------------------------------------------------- 151 | # Command olednd::platform_independent_type 152 | # ---------------------------------------------------------------------------- 153 | proc olednd::platform_independent_type { type } { 154 | ::tkdnd::generic::platform_independent_type $type 155 | }; # olednd::platform_independent_type 156 | 157 | # ---------------------------------------------------------------------------- 158 | # Command olednd::normalise_data 159 | # ---------------------------------------------------------------------------- 160 | proc olednd::normalise_data { type data } { 161 | switch [lindex [::tkdnd::generic::platform_independent_type $type] 0] { 162 | DND_Text {return $data} 163 | DND_Files {return $data} 164 | DND_HTML {return [encoding convertfrom utf-8 $data]} 165 | default {return $data} 166 | } 167 | }; # olednd::normalise_data 168 | -------------------------------------------------------------------------------- /tkinterDnD/dnd.py: -------------------------------------------------------------------------------- 1 | """ 2 | Author: rdbende 3 | License: MIT license 4 | Copyright: 2017 Michael Lange, 2021 rdbende 5 | """ 6 | 7 | import tkinter as tk 8 | 9 | 10 | class DnDEvent: 11 | """ 12 | Container for the properties of a DnD event, similar to a normal tk.Event. 13 | A DnDEvent instance has the following attributes: 14 | 15 | action: string 16 | actions: tuple 17 | button: int 18 | code: string 19 | codes: tuple 20 | commonsourcetypes: tuple 21 | commontargettypes: tuple 22 | data: string 23 | name: string 24 | types: tuple 25 | modifiers: tuple 26 | supportedsourcetypes: tuple 27 | sourcetypes: tuple 28 | type: string 29 | supportedtargettypes: (tuple 30 | widget: widget 31 | x_root: int 32 | y_root: int 33 | """ 34 | pass 35 | 36 | 37 | class DnDWrapper: 38 | _subst_format_dnd = ("%A", "%a", "%b", "%C", "%c", "{%CST}", "{%CTT}", "%D", 39 | "%e", "{%L}", "{%m}", "{%ST}", "%T", "{%t}", "{%TT}", "%W", "%X", "%Y") 40 | _subst_format_str_dnd = " ".join(_subst_format_dnd) 41 | 42 | tk.BaseWidget._subst_format_dnd = _subst_format_dnd 43 | tk.BaseWidget._subst_format_str_dnd = _subst_format_str_dnd 44 | 45 | def _substitute_dnd(self, *args): 46 | if len(args) != len(self._subst_format_dnd): 47 | return args 48 | 49 | action, actions, button, code, codes, cm_src_types, cm_trgt_types, data, name, types, modifiers, sp_src_types, type, src_types, sp_trgt_types, widget, x, y = args 50 | 51 | def getint_event(arg): 52 | try: 53 | return int(arg) 54 | except ValueError: 55 | return arg 56 | 57 | def splitlist_event(arg): 58 | try: 59 | return self.tk.splitlist(arg) 60 | except ValueError: 61 | return arg 62 | 63 | def proc_data(arg): 64 | if "color" in type: 65 | return splitlist_color(arg) 66 | else: 67 | return arg 68 | 69 | def splitlist_color(arg): 70 | """If the drop type is color converts it to hex""" 71 | return ("#" + "".join(i[4:] for i in self.tk.splitlist(arg)))[:7] 72 | 73 | event = DnDEvent() 74 | 75 | event.action = action 76 | event.actions = splitlist_event(actions) 77 | event.button = getint_event(button) 78 | event.code = code 79 | event.codes = splitlist_event(codes) 80 | event.commonsourcetypes = splitlist_event(cm_src_types) 81 | event.commontargettypes = splitlist_event(cm_trgt_types) 82 | event.data = proc_data(data) 83 | event.name = name 84 | event.modifiers = splitlist_event(modifiers) 85 | event.sourcetypes = splitlist_event(src_types) 86 | event.supportedsourcetypes = splitlist_event(sp_src_types) 87 | event.supportedtargettypes = splitlist_event(sp_trgt_types) 88 | event.type = type 89 | event.types = splitlist_event(types) 90 | try: 91 | event.widget = self.nametowidget(widget) 92 | except KeyError: 93 | event.widget = widget 94 | event.x_root = getint_event(x) 95 | event.y_root = getint_event(y) 96 | 97 | return (event, ) # It must be an iterable 98 | 99 | tk.BaseWidget._substitute_dnd = _substitute_dnd 100 | 101 | def _dnd_bind(self, what, sequence, func, add, needcleanup=True): 102 | """The method, that does the actual binding""" 103 | if isinstance(func, str): 104 | self.tk.call(what + (sequence, func)) 105 | elif func: 106 | funcid = self._register(func, self._substitute_dnd, needcleanup) 107 | cmd = f"{add and '+' or ''}{funcid} {self._subst_format_str_dnd}" 108 | self.tk.call(what + (sequence, cmd)) 109 | 110 | return funcid 111 | elif sequence: 112 | return self.tk.call(what + (sequence, )) 113 | else: 114 | return self.tk.splitlist(self.tk.call(what)) 115 | 116 | tk.BaseWidget._dnd_bind = _dnd_bind 117 | 118 | def dnd_bind(self, sequence=None, func=None, add=None): 119 | """ 120 | Overwrites the tk.BaseWidget.bind method 121 | so we don't have to use a separate method for regular and 122 | dnd binding, simply checks which one to call, 123 | and if a dnd sequence is specified, and converts the simple 124 | and clear tkinterDnD events to tkdnd events 125 | 126 | Original tkdnd events: 127 | 128 | <> 129 | <> 130 | <> 131 | <> 132 | <> 133 | <> 134 | <> 135 | <> 136 | <> 137 | <> 138 | 139 | Simple and clear tkinterDnD events: 140 | 141 | <> 142 | <> 143 | <> 144 | <> 145 | <> 146 | <> 147 | <> 148 | <> 149 | <> 150 | """ 151 | 152 | bind_func = self._bind 153 | if sequence in {"<>", "<>", "<>", 154 | "<>", "<>", 155 | "<>", "<>", "<>", 156 | "<>", "<>", "<>", 157 | "<>", "<>", "<>", 158 | "<>", "<>", "<>", 159 | "<>", "<>"}: 160 | 161 | if sequence == "<>": 162 | sequence = "<>" 163 | elif sequence == "<>": 164 | sequence = "<>" 165 | elif sequence == "<>": 166 | sequence = "<>" 167 | elif sequence == "<>": 168 | sequence = "<>" 169 | elif sequence == "<>": 170 | sequence = "<>" 171 | elif sequence == "<>": 172 | sequence = "<>" 173 | elif sequence == "<>": 174 | sequence = "<>" 175 | elif sequence == "<>": 176 | sequence = "<>" 177 | elif sequence == "<>": 178 | sequence = "<>" 179 | 180 | bind_func = self._dnd_bind 181 | 182 | return bind_func(("bind", self._w), sequence, func, add) 183 | 184 | tk.BaseWidget.bind = dnd_bind 185 | 186 | def register_drag_source(self, dndtypes="*", button=1): 187 | """Registers the widget as drag source""" 188 | if type(button) != int: 189 | raise TypeError("Mouse button number must be an integer between 1 and 3") 190 | 191 | if button > 3: 192 | raise ValueError(f"Invalid mouse button number: '{button}'") 193 | 194 | self.tk.call("tkdnd::drag_source", "register", self._w, dndtypes, button) 195 | 196 | tk.BaseWidget.register_drag_source = register_drag_source 197 | 198 | def unregister_drag_source(self): 199 | """Unregisters the widget from drag source""" 200 | self.tk.call("tkdnd::drag_source", "unregister", self._w) 201 | 202 | tk.BaseWidget.unregister_drag_source = unregister_drag_source 203 | 204 | def register_drop_target(self, dndtypes="*"): 205 | """Registers the widget as drop target""" 206 | self.tk.call("tkdnd::drop_target", "register", self._w, dndtypes) 207 | 208 | tk.BaseWidget.register_drop_target = register_drop_target 209 | 210 | def unregister_drop_target(self): 211 | """Unregisters the widget from drop target""" 212 | self.tk.call("tkdnd::drop_target", "unregister", self._w) 213 | 214 | tk.BaseWidget.unregister_drop_target = unregister_drop_target 215 | 216 | def platform_independent_types(self, *dndtypes): 217 | return self.tk.split(self.tk.call("tkdnd::platform_independent_types", dndtypes)) 218 | 219 | tk.BaseWidget.platform_independent_types = platform_independent_types 220 | 221 | def platform_specific_types(self, *dndtypes): 222 | return self.tk.split(self.tk.call("tkdnd::platform_specific_types", dndtypes)) 223 | 224 | tk.BaseWidget.platform_specific_types = platform_specific_types 225 | 226 | def get_dropfile_tempdir(self): 227 | return self.tk.call("tkdnd::GetDropFileTempDirectory") 228 | 229 | tk.BaseWidget.get_dropfile_tempdir = get_dropfile_tempdir 230 | 231 | def set_dropfile_tempdir(self, tempdir): 232 | self.tk.call("tkdnd::SetDropFileTempDirectory", tempdir) 233 | 234 | tk.BaseWidget.set_dropfile_tempdir = set_dropfile_tempdir 235 | 236 | -------------------------------------------------------------------------------- /DOCUMENTATION.md: -------------------------------------------------------------------------------- 1 | # tkinterDnD documentation 2 | 3 | ### Note: It seems like color drag-n-drop don't work on Windows 4 | ### Note: It seems like text drag-n-drop don't work with KDE Plasma 5 | 6 | 7 |
8 | 9 | ## DnD with virtual events 10 | If you have a plain tk widget you have register the widget as drag source, or drop target (or even both), and then you have to bind the DnD event to the function you want to call. For ttk widgets there's a [cool feature](#dnd_hook), with `ttkwidgets.hook`, which does these for you 11 | 12 | ```python 13 | label = tk.Label(master) 14 | label.register_drop_target((tkinterDnD.FILE, tkinterDnD.COLOR)) 15 | label.register_drag_source("*") 16 | label.bind("<>", change_bg_color) 17 | label.bind("<>", start_drag) 18 | ``` 19 | 20 | #### Here are the methods with which you can register your widget as a drag source or drop target 21 | Method name | Desription 22 | -|- 23 | `register_drag_source` | Register the widget as a drag source, the first argument must be a tuple with the [acceptable DnD types](#dnd_types_constants), or a string if just one type is specified, if this argument isn't specified, then it will register the widget for any (`"tkinterDnD.ALL"`) type. `button` is optional, specifies which mouse button can be used to drag (default is `1`). Valid values are `1` (left mouse button), `2` (middle mouse button - wheel) and `3` (right mouse button). 24 | `unregister_drag_source` | If the widget was a drag source, unregiters it, so no drag can be started from the widget anymore. 25 | `register_drop_target` | Register the widget as a drop target, any number of arguments can be given in a tuple to specify acceptable drop types, if this argument isn't specified, then it will register the widget for any (`"tkinterDnD.ALL"`) type. 26 | `unregister_drop_target` | If the widget was a drop target, unregiters it, so nothing can be dropped into the widget anymore. 27 | 28 | #### And here's the full list of DnD events, tkinterDnD has replaced the original events of tkdnd with simple and clear event names, although you can use the tkdnd names as well 29 | DnD event | Generated at | Same as (deprecated) 30 | -|-|- 31 | `<>` | This event is generated when anything was dropped into the widget. | `<>`, `<>` 32 | `<>` | This event is generated when a text was dropped into the widget. | `<>` 33 | `<>` | This event is generated when a file was dropped into the widget, e.g from a file manager. | `<>` 34 | `<>` | This event is generated when a color was dropped into the widget, e.g from the Inkscape palette. | `<>` 35 | `<>` | This event is generated when the user starts a drag from the widget, the called function should return a list with the drop action (which can be any of `tkinterDnD.COPY`, `tkinterDnD.MOVE`, `tkinterDnD.LINK`, `tkinterDnD.ASK`, and `tkinterDnD.PRIVATE`), the type of the content (which can be `tkinterDnD.TEXT`, `tkinterDnD.FILE` or `tkinterDnD.COLOR`), and the actual content. | `<>` 36 | `<>` | This event is generated when the drag action has finished. | `<>` 37 | `<>` | This event is generated when the mouse enters the widget during a drop action. | `<>` 38 | `<>` | This event is generated when the mouse leaves the widget, without a drop happening. | `<>` 39 | `<>` | This events is generated when the mouse moves inside the window during a drop action. Thus, the script can decide that the drop can only occur at certain coordinates. The script binding for such an event can get the mouse coordinates and is expected to return the drop action (which can be any of `tkinterDnD.COPY`, `tkinterDnD.MOVE`, `tkinterDnD.LINK`, `tkinterDnD.ASK`, and `tkinterDnD.PRIVATE`). This event is not mandatory, but if it is defined, it has to return an action. In case an action is not returned, the drop is refused. | `<>` 40 | 41 | 42 |

43 | 44 | ## DnD with arguments 45 | 46 | This feature only works for ttk widgets. When you import tkinterDnD it implicitly creates a hook for ttk widgets, and passes all DnD arguments to tkinterDnD. This way you don't have to register the widget as a drag source, or as drop target, and bind it, because tkinterDnD does these for you. 47 | 48 | ```python 49 | label = ttk.Label(master, oncolordrop=change_accent_color, ondragstart=start_drag) 50 | ``` 51 | Argument name | Description 52 | -|- 53 | `ontextdrop` | Registers the widget as text drop target, and binds the given function to `<>` event. 54 | `onfiledrop` | Registers the widget as file drop target, and binds the given function to `<>` event. 55 | `oncolordrop` | Registers the widget as color drop target, and binds the given function to `<>` event. 56 | `ondrop` | Registers the widget as any type drop target, and binds the given function to `<>` event. 57 | `ondragstart` | Registers the widget as any type drag source, and binds the given function to `<>` event. 58 | `ondragend` | Registers the widget as any type drag source, and binds the given function to `<>` event. 59 | `ondragenter` | Registers the widget as any type drop target, and binds the given function to `<>` event. 60 | `ondragleave` | Registers the widget as any type drop target, and binds the given function to `<>` event. 61 | `ondragmove` | Registers the widget as any type drop target, and binds the given function to `<>` event. 62 | 63 | 64 |

65 | 66 | ## Other methods 67 | Method | Description 68 | -|- 69 | `get_dropfile_tempdir` | This method will return the temporary directory used by tkinterDnD for storing temporary files. When the tkdnd package is loaded, this temporary directory will be initialised to a proper directory according to the operating system. 70 | `set_dropfile_tempdir` | This method will change the temporary directory used by tkinterDnD for storing temporary files. The only argument is `tempdir`, which means the temporary directory path. 71 | 72 | 73 | 74 |

75 | 76 | ## TkinterDnD constants 77 | 78 | ### DnD actions 79 | Constant name | Description | Actual value 80 | -|-|- 81 | `NONE` | Used when DnD action is none | none 82 | `COPY` | Used when DnD action is copy. Useful, if you don't want to move a file, instead copy it. | copy 83 | `MOVE` | Used when DnD action is move. Useful, if you don't want to copy a file, just move it. | move 84 | `LINK` | Used when DnD action is link. Useful, if you don't want either copy or move a file, instead create a shortcut for it. | link 85 | `ASK` | Used when DnD action is ask. The drop target can decide, what action to happen. | ask 86 | `PRIVATE` | Used when DnD action is private. The drop can only happen inside the tkinter window. | private 87 | `REFUSE_DROP` | Used when DnD action is refuse_drop. Use it, when the drag action should be refused right after it starts (when the init function is returned this action), or if the widget don't want to accept a drop. | refuse_drop 88 | 89 | 90 | ### DnD types 91 | Constant name | Description | Actual value 92 | -|-|- 93 | `TEXT` | The drag content should be interpreted as simple text. | DND_Text 94 | `FILE` | The drag content should be interpreted as a file path. | DND_Files 95 | `COLOR` | The drag content should be interpreted as a hex color name. | DND_Color 96 | `ALL` | The drag content can be any of text, file, color | * 97 | 98 | 99 | ### Windows specific 100 | Note: I currently didn't mess with these on Windows, so I can't provide any useful info 101 | Constant name | Description | Actual value 102 | -|-|- 103 | `CF_UNICODETEXT` | Text transfer encoded in Unicode. | CF_UNICODETEXT 104 | `CF_TEXT` | Text transfer with application dependent encoding. If an encoding locale is specified through `CF_LOCALE` it is used, else the system encoding is used for the conversion. | CF_TEXT 105 | `CF_HDROP` | Files transfer encoded in UTF-8. | CF_HDROP 106 | `FileGroupDescriptor` | These two types are used for transferring a set of files that do not appear physically on disk, like files from compressed folders or Outlook e-mail messages. File names are transferred as in the `CF_TEXT` type, while file contents are transferred in binary. tkinterDnD retrieves both the file names and the file contents, and saves then in a temporary directory. When the transfer is complete, the file names of the saved files in the temporary folder are returned. Note that tkinterDnD support this type pair only as drop targets and not as drag sources. | FileGroupDescriptor - FileContents 107 | `FileGroupDescriptorW` | These two types are used for transferring a set of files that do not appear physically on disk, like files from compressed folders or Outlook e-mail messages. File names are transferred as in the `CF_UNICODETEXT` type, while file contents are transferred in binary. tkinterDnD retrieves both the file names and the file contents, and saves then in a temporary directory. When the transfer is complete, the file names of the saved files in the temporary folder are returned. Note that tkinterDnD support this type pair only as drop targets and not as drag sources. | FileGroupDescriptorW - FileContents 108 | -------------------------------------------------------------------------------- /tkinterDnD/mac/tkdnd_utils.tcl: -------------------------------------------------------------------------------- 1 | # 2 | # tkdnd_utils.tcl -- 3 | # 4 | # This file implements some utility procedures that are used by the TkDND 5 | # package. 6 | # 7 | # This software is copyrighted by: 8 | # George Petasis, National Centre for Scientific Research "Demokritos", 9 | # Aghia Paraskevi, Athens, Greece. 10 | # e-mail: petasis@iit.demokritos.gr 11 | # 12 | # The following terms apply to all files associated 13 | # with the software unless explicitly disclaimed in individual files. 14 | # 15 | # The authors hereby grant permission to use, copy, modify, distribute, 16 | # and license this software and its documentation for any purpose, provided 17 | # that existing copyright notices are retained in all copies and that this 18 | # notice is included verbatim in any distributions. No written agreement, 19 | # license, or royalty fee is required for any of the authorized uses. 20 | # Modifications to this software may be copyrighted by their authors 21 | # and need not follow the licensing terms described here, provided that 22 | # the new terms are clearly indicated on the first page of each file where 23 | # they apply. 24 | # 25 | # IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY 26 | # FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES 27 | # ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY 28 | # DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE 29 | # POSSIBILITY OF SUCH DAMAGE. 30 | # 31 | # THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, 32 | # INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, 33 | # FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE 34 | # IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE 35 | # NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR 36 | # MODIFICATIONS. 37 | # 38 | 39 | package require tkdnd 40 | namespace eval ::tkdnd { 41 | namespace eval utils { 42 | };# namespace ::tkdnd::utils 43 | namespace eval text { 44 | variable _drag_tag tkdnd::drag::selection::tag 45 | variable _state {} 46 | variable _drag_source_widget {} 47 | variable _drop_target_widget {} 48 | variable _now_dragging 0 49 | };# namespace ::tkdnd::text 50 | };# namespace ::tkdnd 51 | 52 | bind TkDND_Drag_Text1 {tkdnd::text::_begin_drag clear 1 %W %s %X %Y %x %y} 53 | bind TkDND_Drag_Text1 {tkdnd::text::_begin_drag motion 1 %W %s %X %Y %x %y} 54 | bind TkDND_Drag_Text1 {tkdnd::text::_TextAutoScan %W %x %y} 55 | bind TkDND_Drag_Text1 {tkdnd::text::_begin_drag reset 1 %W %s %X %Y %x %y} 56 | bind TkDND_Drag_Text2 {tkdnd::text::_begin_drag clear 2 %W %s %X %Y %x %y} 57 | bind TkDND_Drag_Text2 {tkdnd::text::_begin_drag motion 2 %W %s %X %Y %x %y} 58 | bind TkDND_Drag_Text2 {tkdnd::text::_begin_drag reset 2 %W %s %X %Y %x %y} 59 | bind TkDND_Drag_Text3 {tkdnd::text::_begin_drag clear 3 %W %s %X %Y %x %y} 60 | bind TkDND_Drag_Text3 {tkdnd::text::_begin_drag motion 3 %W %s %X %Y %x %y} 61 | bind TkDND_Drag_Text3 {tkdnd::text::_begin_drag reset 3 %W %s %X %Y %x %y} 62 | 63 | # ---------------------------------------------------------------------------- 64 | # Command tkdnd::text::drag_source 65 | # ---------------------------------------------------------------------------- 66 | proc ::tkdnd::text::drag_source { mode path { types DND_Text } { event 1 } { tagprefix TkDND_Drag_Text } { tag sel } } { 67 | switch -exact -- $mode { 68 | register { 69 | $path tag bind $tag \ 70 | "tkdnd::text::_begin_drag press ${event} %W %s %X %Y %x %y" 71 | ## Set a binding to the widget, to put selection as data... 72 | bind $path <> "::tkdnd::text::DragInitCmd $path {%t} $tag" 73 | ## Set a binding to the widget, to remove selection if action is move... 74 | bind $path <> "::tkdnd::text::DragEndCmd $path %A $tag" 75 | } 76 | unregister { 77 | $path tag bind $tag {} 78 | bind $path <> {} 79 | bind $path <> {} 80 | } 81 | } 82 | ::tkdnd::drag_source $mode $path $types $event $tagprefix 83 | };# ::tkdnd::text::drag_source 84 | 85 | # ---------------------------------------------------------------------------- 86 | # Command tkdnd::text::drop_target 87 | # ---------------------------------------------------------------------------- 88 | proc ::tkdnd::text::drop_target { mode path { types DND_Text } } { 89 | switch -exact -- $mode { 90 | register { 91 | bind $path <> "::tkdnd::text::DropPosition $path %X %Y %A %a %m" 92 | bind $path <> "::tkdnd::text::Drop $path %D %X %Y %A %a %m" 93 | } 94 | unregister { 95 | bind $path <> {} 96 | bind $path <> {} 97 | bind $path <> {} 98 | bind $path <> {} 99 | } 100 | } 101 | ::tkdnd::drop_target $mode $path $types 102 | };# ::tkdnd::text::drop_target 103 | 104 | # ---------------------------------------------------------------------------- 105 | # Command tkdnd::text::DragInitCmd 106 | # ---------------------------------------------------------------------------- 107 | proc ::tkdnd::text::DragInitCmd { path { types DND_Text } { tag sel } { actions { copy move } } } { 108 | ## Save the selection indices... 109 | variable _drag_source_widget 110 | variable _drop_target_widget 111 | set _drag_source_widget $path 112 | set _drop_target_widget {} 113 | _save_selection $path $tag 114 | list $actions $types [$path get $tag.first $tag.last] 115 | };# ::tkdnd::text::DragInitCmd 116 | 117 | # ---------------------------------------------------------------------------- 118 | # Command tkdnd::text::DragEndCmd 119 | # ---------------------------------------------------------------------------- 120 | proc ::tkdnd::text::DragEndCmd { path action { tag sel } } { 121 | variable _drag_source_widget 122 | variable _drop_target_widget 123 | set _drag_source_widget {} 124 | set _drop_target_widget {} 125 | _restore_selection $path $tag 126 | switch -exact -- $action { 127 | move { 128 | ## Delete the original selected text... 129 | variable _selection_first 130 | variable _selection_last 131 | $path delete $_selection_first $_selection_last 132 | } 133 | } 134 | };# ::tkdnd::text::DragEndCmd 135 | 136 | # ---------------------------------------------------------------------------- 137 | # Command tkdnd::text::DropPosition 138 | # ---------------------------------------------------------------------------- 139 | proc ::tkdnd::text::DropPosition { path X Y action actions keys} { 140 | variable _drag_source_widget 141 | variable _drop_target_widget 142 | set _drop_target_widget $path 143 | ## This check is primitive, a more accurate one is needed! 144 | if {$path eq $_drag_source_widget} { 145 | ## This is a drag within the same widget! Set action to move... 146 | if {"move" in $actions} {set action move} 147 | } 148 | incr X -[winfo rootx $path] 149 | incr Y -[winfo rooty $path] 150 | $path mark set insert @$X,$Y; update 151 | return $action 152 | };# ::tkdnd::text::DropPosition 153 | 154 | # ---------------------------------------------------------------------------- 155 | # Command tkdnd::text::Drop 156 | # ---------------------------------------------------------------------------- 157 | proc ::tkdnd::text::Drop { path data X Y action actions keys } { 158 | incr X -[winfo rootx $path] 159 | incr Y -[winfo rooty $path] 160 | $path mark set insert @$X,$Y 161 | $path insert [$path index insert] $data 162 | return $action 163 | };# ::tkdnd::text::Drop 164 | 165 | # ---------------------------------------------------------------------------- 166 | # Command tkdnd::text::_save_selection 167 | # ---------------------------------------------------------------------------- 168 | proc ::tkdnd::text::_save_selection { path tag} { 169 | variable _drag_tag 170 | variable _selection_first 171 | variable _selection_last 172 | variable _selection_tag $tag 173 | set _selection_first [$path index $tag.first] 174 | set _selection_last [$path index $tag.last] 175 | $path tag add $_drag_tag $_selection_first $_selection_last 176 | $path tag configure $_drag_tag \ 177 | -background [$path tag cget $tag -background] \ 178 | -foreground [$path tag cget $tag -foreground] 179 | };# tkdnd::text::_save_selection 180 | 181 | # ---------------------------------------------------------------------------- 182 | # Command tkdnd::text::_restore_selection 183 | # ---------------------------------------------------------------------------- 184 | proc ::tkdnd::text::_restore_selection { path tag} { 185 | variable _drag_tag 186 | variable _selection_first 187 | variable _selection_last 188 | $path tag delete $_drag_tag 189 | $path tag remove $tag 0.0 end 190 | #$path tag add $tag $_selection_first $_selection_last 191 | };# tkdnd::text::_restore_selection 192 | 193 | # ---------------------------------------------------------------------------- 194 | # Command tkdnd::text::_begin_drag 195 | # ---------------------------------------------------------------------------- 196 | proc ::tkdnd::text::_begin_drag { event button source state X Y x y } { 197 | variable _drop_target_widget 198 | variable _state 199 | # puts "::tkdnd::text::_begin_drag $event $button $source $state $X $Y $x $y" 200 | 201 | switch -exact -- $event { 202 | clear { 203 | switch -exact -- $_state { 204 | press { 205 | ## Do not execute other bindings, as they will erase selection... 206 | return -code break 207 | } 208 | } 209 | set _state clear 210 | } 211 | motion { 212 | variable _now_dragging 213 | if {$_now_dragging} {return -code break} 214 | if { [string equal $_state "press"] } { 215 | variable _x0; variable _y0 216 | if { abs($_x0-$X) > ${::tkdnd::_dx} || abs($_y0-$Y) > ${::tkdnd::_dy} } { 217 | set _state "done" 218 | set _drop_target_widget {} 219 | set _now_dragging 1 220 | set code [catch { 221 | ::tkdnd::_init_drag $button $source $state $X $Y $x $y 222 | } info options] 223 | set _drop_target_widget {} 224 | set _now_dragging 0 225 | if {$code != 0} { 226 | ## Something strange occurred... 227 | return -options $options $info 228 | } 229 | } 230 | return -code break 231 | } 232 | set _state clear 233 | } 234 | press { 235 | variable _x0; variable _y0 236 | set _x0 $X 237 | set _y0 $Y 238 | set _state "press" 239 | } 240 | reset { 241 | set _state {} 242 | } 243 | } 244 | if {$source eq $_drop_target_widget} {return -code break} 245 | return -code continue 246 | };# tkdnd::text::_begin_drag 247 | 248 | proc tkdnd::text::_TextAutoScan {w x y} { 249 | variable _now_dragging 250 | if {$_now_dragging} {return -code break} 251 | return -code continue 252 | };# tkdnd::text::_TextAutoScan 253 | -------------------------------------------------------------------------------- /tkinterDnD/linux/tkdnd_utils.tcl: -------------------------------------------------------------------------------- 1 | # 2 | # tkdnd_utils.tcl -- 3 | # 4 | # This file implements some utility procedures that are used by the TkDND 5 | # package. 6 | # 7 | # This software is copyrighted by: 8 | # George Petasis, National Centre for Scientific Research "Demokritos", 9 | # Aghia Paraskevi, Athens, Greece. 10 | # e-mail: petasis@iit.demokritos.gr 11 | # 12 | # The following terms apply to all files associated 13 | # with the software unless explicitly disclaimed in individual files. 14 | # 15 | # The authors hereby grant permission to use, copy, modify, distribute, 16 | # and license this software and its documentation for any purpose, provided 17 | # that existing copyright notices are retained in all copies and that this 18 | # notice is included verbatim in any distributions. No written agreement, 19 | # license, or royalty fee is required for any of the authorized uses. 20 | # Modifications to this software may be copyrighted by their authors 21 | # and need not follow the licensing terms described here, provided that 22 | # the new terms are clearly indicated on the first page of each file where 23 | # they apply. 24 | # 25 | # IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY 26 | # FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES 27 | # ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY 28 | # DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE 29 | # POSSIBILITY OF SUCH DAMAGE. 30 | # 31 | # THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, 32 | # INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, 33 | # FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE 34 | # IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE 35 | # NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR 36 | # MODIFICATIONS. 37 | # 38 | 39 | package require tkdnd 40 | namespace eval ::tkdnd { 41 | namespace eval utils { 42 | };# namespace ::tkdnd::utils 43 | namespace eval text { 44 | variable _drag_tag tkdnd::drag::selection::tag 45 | variable _state {} 46 | variable _drag_source_widget {} 47 | variable _drop_target_widget {} 48 | variable _now_dragging 0 49 | };# namespace ::tkdnd::text 50 | };# namespace ::tkdnd 51 | 52 | bind TkDND_Drag_Text1 {tkdnd::text::_begin_drag clear 1 %W %s %X %Y %x %y} 53 | bind TkDND_Drag_Text1 {tkdnd::text::_begin_drag motion 1 %W %s %X %Y %x %y} 54 | bind TkDND_Drag_Text1 {tkdnd::text::_TextAutoScan %W %x %y} 55 | bind TkDND_Drag_Text1 {tkdnd::text::_begin_drag reset 1 %W %s %X %Y %x %y} 56 | bind TkDND_Drag_Text2 {tkdnd::text::_begin_drag clear 2 %W %s %X %Y %x %y} 57 | bind TkDND_Drag_Text2 {tkdnd::text::_begin_drag motion 2 %W %s %X %Y %x %y} 58 | bind TkDND_Drag_Text2 {tkdnd::text::_begin_drag reset 2 %W %s %X %Y %x %y} 59 | bind TkDND_Drag_Text3 {tkdnd::text::_begin_drag clear 3 %W %s %X %Y %x %y} 60 | bind TkDND_Drag_Text3 {tkdnd::text::_begin_drag motion 3 %W %s %X %Y %x %y} 61 | bind TkDND_Drag_Text3 {tkdnd::text::_begin_drag reset 3 %W %s %X %Y %x %y} 62 | 63 | # ---------------------------------------------------------------------------- 64 | # Command tkdnd::text::drag_source 65 | # ---------------------------------------------------------------------------- 66 | proc ::tkdnd::text::drag_source { mode path { types DND_Text } { event 1 } { tagprefix TkDND_Drag_Text } { tag sel } } { 67 | switch -exact -- $mode { 68 | register { 69 | $path tag bind $tag \ 70 | "tkdnd::text::_begin_drag press ${event} %W %s %X %Y %x %y" 71 | ## Set a binding to the widget, to put selection as data... 72 | bind $path <> "::tkdnd::text::DragInitCmd $path {%t} $tag" 73 | ## Set a binding to the widget, to remove selection if action is move... 74 | bind $path <> "::tkdnd::text::DragEndCmd $path %A $tag" 75 | } 76 | unregister { 77 | $path tag bind $tag {} 78 | bind $path <> {} 79 | bind $path <> {} 80 | } 81 | } 82 | ::tkdnd::drag_source $mode $path $types $event $tagprefix 83 | };# ::tkdnd::text::drag_source 84 | 85 | # ---------------------------------------------------------------------------- 86 | # Command tkdnd::text::drop_target 87 | # ---------------------------------------------------------------------------- 88 | proc ::tkdnd::text::drop_target { mode path { types DND_Text } } { 89 | switch -exact -- $mode { 90 | register { 91 | bind $path <> "::tkdnd::text::DropPosition $path %X %Y %A %a %m" 92 | bind $path <> "::tkdnd::text::Drop $path %D %X %Y %A %a %m" 93 | } 94 | unregister { 95 | bind $path <> {} 96 | bind $path <> {} 97 | bind $path <> {} 98 | bind $path <> {} 99 | } 100 | } 101 | ::tkdnd::drop_target $mode $path $types 102 | };# ::tkdnd::text::drop_target 103 | 104 | # ---------------------------------------------------------------------------- 105 | # Command tkdnd::text::DragInitCmd 106 | # ---------------------------------------------------------------------------- 107 | proc ::tkdnd::text::DragInitCmd { path { types DND_Text } { tag sel } { actions { copy move } } } { 108 | ## Save the selection indices... 109 | variable _drag_source_widget 110 | variable _drop_target_widget 111 | set _drag_source_widget $path 112 | set _drop_target_widget {} 113 | _save_selection $path $tag 114 | list $actions $types [$path get $tag.first $tag.last] 115 | };# ::tkdnd::text::DragInitCmd 116 | 117 | # ---------------------------------------------------------------------------- 118 | # Command tkdnd::text::DragEndCmd 119 | # ---------------------------------------------------------------------------- 120 | proc ::tkdnd::text::DragEndCmd { path action { tag sel } } { 121 | variable _drag_source_widget 122 | variable _drop_target_widget 123 | set _drag_source_widget {} 124 | set _drop_target_widget {} 125 | _restore_selection $path $tag 126 | switch -exact -- $action { 127 | move { 128 | ## Delete the original selected text... 129 | variable _selection_first 130 | variable _selection_last 131 | $path delete $_selection_first $_selection_last 132 | } 133 | } 134 | };# ::tkdnd::text::DragEndCmd 135 | 136 | # ---------------------------------------------------------------------------- 137 | # Command tkdnd::text::DropPosition 138 | # ---------------------------------------------------------------------------- 139 | proc ::tkdnd::text::DropPosition { path X Y action actions keys} { 140 | variable _drag_source_widget 141 | variable _drop_target_widget 142 | set _drop_target_widget $path 143 | ## This check is primitive, a more accurate one is needed! 144 | if {$path eq $_drag_source_widget} { 145 | ## This is a drag within the same widget! Set action to move... 146 | if {"move" in $actions} {set action move} 147 | } 148 | incr X -[winfo rootx $path] 149 | incr Y -[winfo rooty $path] 150 | $path mark set insert @$X,$Y; update 151 | return $action 152 | };# ::tkdnd::text::DropPosition 153 | 154 | # ---------------------------------------------------------------------------- 155 | # Command tkdnd::text::Drop 156 | # ---------------------------------------------------------------------------- 157 | proc ::tkdnd::text::Drop { path data X Y action actions keys } { 158 | incr X -[winfo rootx $path] 159 | incr Y -[winfo rooty $path] 160 | $path mark set insert @$X,$Y 161 | $path insert [$path index insert] $data 162 | return $action 163 | };# ::tkdnd::text::Drop 164 | 165 | # ---------------------------------------------------------------------------- 166 | # Command tkdnd::text::_save_selection 167 | # ---------------------------------------------------------------------------- 168 | proc ::tkdnd::text::_save_selection { path tag} { 169 | variable _drag_tag 170 | variable _selection_first 171 | variable _selection_last 172 | variable _selection_tag $tag 173 | set _selection_first [$path index $tag.first] 174 | set _selection_last [$path index $tag.last] 175 | $path tag add $_drag_tag $_selection_first $_selection_last 176 | $path tag configure $_drag_tag \ 177 | -background [$path tag cget $tag -background] \ 178 | -foreground [$path tag cget $tag -foreground] 179 | };# tkdnd::text::_save_selection 180 | 181 | # ---------------------------------------------------------------------------- 182 | # Command tkdnd::text::_restore_selection 183 | # ---------------------------------------------------------------------------- 184 | proc ::tkdnd::text::_restore_selection { path tag} { 185 | variable _drag_tag 186 | variable _selection_first 187 | variable _selection_last 188 | $path tag delete $_drag_tag 189 | $path tag remove $tag 0.0 end 190 | #$path tag add $tag $_selection_first $_selection_last 191 | };# tkdnd::text::_restore_selection 192 | 193 | # ---------------------------------------------------------------------------- 194 | # Command tkdnd::text::_begin_drag 195 | # ---------------------------------------------------------------------------- 196 | proc ::tkdnd::text::_begin_drag { event button source state X Y x y } { 197 | variable _drop_target_widget 198 | variable _state 199 | # puts "::tkdnd::text::_begin_drag $event $button $source $state $X $Y $x $y" 200 | 201 | switch -exact -- $event { 202 | clear { 203 | switch -exact -- $_state { 204 | press { 205 | ## Do not execute other bindings, as they will erase selection... 206 | return -code break 207 | } 208 | } 209 | set _state clear 210 | } 211 | motion { 212 | variable _now_dragging 213 | if {$_now_dragging} {return -code break} 214 | if { [string equal $_state "press"] } { 215 | variable _x0; variable _y0 216 | if { abs($_x0-$X) > ${::tkdnd::_dx} || abs($_y0-$Y) > ${::tkdnd::_dy} } { 217 | set _state "done" 218 | set _drop_target_widget {} 219 | set _now_dragging 1 220 | set code [catch { 221 | ::tkdnd::_init_drag $button $source $state $X $Y $x $y 222 | } info options] 223 | set _drop_target_widget {} 224 | set _now_dragging 0 225 | if {$code != 0} { 226 | ## Something strange occurred... 227 | return -options $options $info 228 | } 229 | } 230 | return -code break 231 | } 232 | set _state clear 233 | } 234 | press { 235 | variable _x0; variable _y0 236 | set _x0 $X 237 | set _y0 $Y 238 | set _state "press" 239 | } 240 | reset { 241 | set _state {} 242 | } 243 | } 244 | if {$source eq $_drop_target_widget} {return -code break} 245 | return -code continue 246 | };# tkdnd::text::_begin_drag 247 | 248 | proc tkdnd::text::_TextAutoScan {w x y} { 249 | variable _now_dragging 250 | if {$_now_dragging} {return -code break} 251 | return -code continue 252 | };# tkdnd::text::_TextAutoScan 253 | -------------------------------------------------------------------------------- /tkinterDnD/windows/tkdnd_utils.tcl: -------------------------------------------------------------------------------- 1 | # 2 | # tkdnd_utils.tcl -- 3 | # 4 | # This file implements some utility procedures that are used by the TkDND 5 | # package. 6 | # 7 | # This software is copyrighted by: 8 | # George Petasis, National Centre for Scientific Research "Demokritos", 9 | # Aghia Paraskevi, Athens, Greece. 10 | # e-mail: petasis@iit.demokritos.gr 11 | # 12 | # The following terms apply to all files associated 13 | # with the software unless explicitly disclaimed in individual files. 14 | # 15 | # The authors hereby grant permission to use, copy, modify, distribute, 16 | # and license this software and its documentation for any purpose, provided 17 | # that existing copyright notices are retained in all copies and that this 18 | # notice is included verbatim in any distributions. No written agreement, 19 | # license, or royalty fee is required for any of the authorized uses. 20 | # Modifications to this software may be copyrighted by their authors 21 | # and need not follow the licensing terms described here, provided that 22 | # the new terms are clearly indicated on the first page of each file where 23 | # they apply. 24 | # 25 | # IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY 26 | # FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES 27 | # ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY 28 | # DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE 29 | # POSSIBILITY OF SUCH DAMAGE. 30 | # 31 | # THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, 32 | # INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, 33 | # FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE 34 | # IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE 35 | # NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR 36 | # MODIFICATIONS. 37 | # 38 | 39 | package require tkdnd 40 | namespace eval ::tkdnd { 41 | namespace eval utils { 42 | };# namespace ::tkdnd::utils 43 | namespace eval text { 44 | variable _drag_tag tkdnd::drag::selection::tag 45 | variable _state {} 46 | variable _drag_source_widget {} 47 | variable _drop_target_widget {} 48 | variable _now_dragging 0 49 | };# namespace ::tkdnd::text 50 | };# namespace ::tkdnd 51 | 52 | bind TkDND_Drag_Text1 {tkdnd::text::_begin_drag clear 1 %W %s %X %Y %x %y} 53 | bind TkDND_Drag_Text1 {tkdnd::text::_begin_drag motion 1 %W %s %X %Y %x %y} 54 | bind TkDND_Drag_Text1 {tkdnd::text::_TextAutoScan %W %x %y} 55 | bind TkDND_Drag_Text1 {tkdnd::text::_begin_drag reset 1 %W %s %X %Y %x %y} 56 | bind TkDND_Drag_Text2 {tkdnd::text::_begin_drag clear 2 %W %s %X %Y %x %y} 57 | bind TkDND_Drag_Text2 {tkdnd::text::_begin_drag motion 2 %W %s %X %Y %x %y} 58 | bind TkDND_Drag_Text2 {tkdnd::text::_begin_drag reset 2 %W %s %X %Y %x %y} 59 | bind TkDND_Drag_Text3 {tkdnd::text::_begin_drag clear 3 %W %s %X %Y %x %y} 60 | bind TkDND_Drag_Text3 {tkdnd::text::_begin_drag motion 3 %W %s %X %Y %x %y} 61 | bind TkDND_Drag_Text3 {tkdnd::text::_begin_drag reset 3 %W %s %X %Y %x %y} 62 | 63 | # ---------------------------------------------------------------------------- 64 | # Command tkdnd::text::drag_source 65 | # ---------------------------------------------------------------------------- 66 | proc ::tkdnd::text::drag_source { mode path { types DND_Text } { event 1 } { tagprefix TkDND_Drag_Text } { tag sel } } { 67 | switch -exact -- $mode { 68 | register { 69 | $path tag bind $tag \ 70 | "tkdnd::text::_begin_drag press ${event} %W %s %X %Y %x %y" 71 | ## Set a binding to the widget, to put selection as data... 72 | bind $path <> "::tkdnd::text::DragInitCmd $path {%t} $tag" 73 | ## Set a binding to the widget, to remove selection if action is move... 74 | bind $path <> "::tkdnd::text::DragEndCmd $path %A $tag" 75 | } 76 | unregister { 77 | $path tag bind $tag {} 78 | bind $path <> {} 79 | bind $path <> {} 80 | } 81 | } 82 | ::tkdnd::drag_source $mode $path $types $event $tagprefix 83 | };# ::tkdnd::text::drag_source 84 | 85 | # ---------------------------------------------------------------------------- 86 | # Command tkdnd::text::drop_target 87 | # ---------------------------------------------------------------------------- 88 | proc ::tkdnd::text::drop_target { mode path { types DND_Text } } { 89 | switch -exact -- $mode { 90 | register { 91 | bind $path <> "::tkdnd::text::DropPosition $path %X %Y %A %a %m" 92 | bind $path <> "::tkdnd::text::Drop $path %D %X %Y %A %a %m" 93 | } 94 | unregister { 95 | bind $path <> {} 96 | bind $path <> {} 97 | bind $path <> {} 98 | bind $path <> {} 99 | } 100 | } 101 | ::tkdnd::drop_target $mode $path $types 102 | };# ::tkdnd::text::drop_target 103 | 104 | # ---------------------------------------------------------------------------- 105 | # Command tkdnd::text::DragInitCmd 106 | # ---------------------------------------------------------------------------- 107 | proc ::tkdnd::text::DragInitCmd { path { types DND_Text } { tag sel } { actions { copy move } } } { 108 | ## Save the selection indices... 109 | variable _drag_source_widget 110 | variable _drop_target_widget 111 | set _drag_source_widget $path 112 | set _drop_target_widget {} 113 | _save_selection $path $tag 114 | list $actions $types [$path get $tag.first $tag.last] 115 | };# ::tkdnd::text::DragInitCmd 116 | 117 | # ---------------------------------------------------------------------------- 118 | # Command tkdnd::text::DragEndCmd 119 | # ---------------------------------------------------------------------------- 120 | proc ::tkdnd::text::DragEndCmd { path action { tag sel } } { 121 | variable _drag_source_widget 122 | variable _drop_target_widget 123 | set _drag_source_widget {} 124 | set _drop_target_widget {} 125 | _restore_selection $path $tag 126 | switch -exact -- $action { 127 | move { 128 | ## Delete the original selected text... 129 | variable _selection_first 130 | variable _selection_last 131 | $path delete $_selection_first $_selection_last 132 | } 133 | } 134 | };# ::tkdnd::text::DragEndCmd 135 | 136 | # ---------------------------------------------------------------------------- 137 | # Command tkdnd::text::DropPosition 138 | # ---------------------------------------------------------------------------- 139 | proc ::tkdnd::text::DropPosition { path X Y action actions keys} { 140 | variable _drag_source_widget 141 | variable _drop_target_widget 142 | set _drop_target_widget $path 143 | ## This check is primitive, a more accurate one is needed! 144 | if {$path eq $_drag_source_widget} { 145 | ## This is a drag within the same widget! Set action to move... 146 | if {"move" in $actions} {set action move} 147 | } 148 | incr X -[winfo rootx $path] 149 | incr Y -[winfo rooty $path] 150 | $path mark set insert @$X,$Y; update 151 | return $action 152 | };# ::tkdnd::text::DropPosition 153 | 154 | # ---------------------------------------------------------------------------- 155 | # Command tkdnd::text::Drop 156 | # ---------------------------------------------------------------------------- 157 | proc ::tkdnd::text::Drop { path data X Y action actions keys } { 158 | incr X -[winfo rootx $path] 159 | incr Y -[winfo rooty $path] 160 | $path mark set insert @$X,$Y 161 | $path insert [$path index insert] $data 162 | return $action 163 | };# ::tkdnd::text::Drop 164 | 165 | # ---------------------------------------------------------------------------- 166 | # Command tkdnd::text::_save_selection 167 | # ---------------------------------------------------------------------------- 168 | proc ::tkdnd::text::_save_selection { path tag} { 169 | variable _drag_tag 170 | variable _selection_first 171 | variable _selection_last 172 | variable _selection_tag $tag 173 | set _selection_first [$path index $tag.first] 174 | set _selection_last [$path index $tag.last] 175 | $path tag add $_drag_tag $_selection_first $_selection_last 176 | $path tag configure $_drag_tag \ 177 | -background [$path tag cget $tag -background] \ 178 | -foreground [$path tag cget $tag -foreground] 179 | };# tkdnd::text::_save_selection 180 | 181 | # ---------------------------------------------------------------------------- 182 | # Command tkdnd::text::_restore_selection 183 | # ---------------------------------------------------------------------------- 184 | proc ::tkdnd::text::_restore_selection { path tag} { 185 | variable _drag_tag 186 | variable _selection_first 187 | variable _selection_last 188 | $path tag delete $_drag_tag 189 | $path tag remove $tag 0.0 end 190 | #$path tag add $tag $_selection_first $_selection_last 191 | };# tkdnd::text::_restore_selection 192 | 193 | # ---------------------------------------------------------------------------- 194 | # Command tkdnd::text::_begin_drag 195 | # ---------------------------------------------------------------------------- 196 | proc ::tkdnd::text::_begin_drag { event button source state X Y x y } { 197 | variable _drop_target_widget 198 | variable _state 199 | # puts "::tkdnd::text::_begin_drag $event $button $source $state $X $Y $x $y" 200 | 201 | switch -exact -- $event { 202 | clear { 203 | switch -exact -- $_state { 204 | press { 205 | ## Do not execute other bindings, as they will erase selection... 206 | return -code break 207 | } 208 | } 209 | set _state clear 210 | } 211 | motion { 212 | variable _now_dragging 213 | if {$_now_dragging} {return -code break} 214 | if { [string equal $_state "press"] } { 215 | variable _x0; variable _y0 216 | if { abs($_x0-$X) > ${::tkdnd::_dx} || abs($_y0-$Y) > ${::tkdnd::_dy} } { 217 | set _state "done" 218 | set _drop_target_widget {} 219 | set _now_dragging 1 220 | set code [catch { 221 | ::tkdnd::_init_drag $button $source $state $X $Y $x $y 222 | } info options] 223 | set _drop_target_widget {} 224 | set _now_dragging 0 225 | if {$code != 0} { 226 | ## Something strange occurred... 227 | return -options $options $info 228 | } 229 | } 230 | return -code break 231 | } 232 | set _state clear 233 | } 234 | press { 235 | variable _x0; variable _y0 236 | set _x0 $X 237 | set _y0 $Y 238 | set _state "press" 239 | } 240 | reset { 241 | set _state {} 242 | } 243 | } 244 | if {$source eq $_drop_target_widget} {return -code break} 245 | return -code continue 246 | };# tkdnd::text::_begin_drag 247 | 248 | proc tkdnd::text::_TextAutoScan {w x y} { 249 | variable _now_dragging 250 | if {$_now_dragging} {return -code break} 251 | return -code continue 252 | };# tkdnd::text::_TextAutoScan 253 | -------------------------------------------------------------------------------- /tkinterDnD/linux/tkdnd.tcl: -------------------------------------------------------------------------------- 1 | # 2 | # tkdnd.tcl -- 3 | # 4 | # This file implements some utility procedures that are used by the TkDND 5 | # package. 6 | # 7 | # This software is copyrighted by: 8 | # George Petasis, National Centre for Scientific Research "Demokritos", 9 | # Aghia Paraskevi, Athens, Greece. 10 | # e-mail: petasis@iit.demokritos.gr 11 | # 12 | # The following terms apply to all files associated 13 | # with the software unless explicitly disclaimed in individual files. 14 | # 15 | # The authors hereby grant permission to use, copy, modify, distribute, 16 | # and license this software and its documentation for any purpose, provided 17 | # that existing copyright notices are retained in all copies and that this 18 | # notice is included verbatim in any distributions. No written agreement, 19 | # license, or royalty fee is required for any of the authorized uses. 20 | # Modifications to this software may be copyrighted by their authors 21 | # and need not follow the licensing terms described here, provided that 22 | # the new terms are clearly indicated on the first page of each file where 23 | # they apply. 24 | # 25 | # IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY 26 | # FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES 27 | # ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY 28 | # DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE 29 | # POSSIBILITY OF SUCH DAMAGE. 30 | # 31 | # THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, 32 | # INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, 33 | # FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE 34 | # IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE 35 | # NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR 36 | # MODIFICATIONS. 37 | # 38 | 39 | package require Tk 40 | 41 | namespace eval ::tkdnd { 42 | variable _topw ".drag" 43 | variable _tabops 44 | variable _state 45 | variable _x0 46 | variable _y0 47 | variable _platform_namespace 48 | variable _drop_file_temp_dir 49 | variable _auto_update 1 50 | variable _dx 3 ;# The difference in pixels before a drag is initiated. 51 | variable _dy 3 ;# The difference in pixels before a drag is initiated. 52 | 53 | variable _windowingsystem 54 | 55 | bind TkDND_Drag1 {tkdnd::_begin_drag press 1 %W %s %X %Y %x %y} 56 | bind TkDND_Drag1 {tkdnd::_begin_drag motion 1 %W %s %X %Y %x %y} 57 | bind TkDND_Drag2 {tkdnd::_begin_drag press 2 %W %s %X %Y %x %y} 58 | bind TkDND_Drag2 {tkdnd::_begin_drag motion 2 %W %s %X %Y %x %y} 59 | bind TkDND_Drag3 {tkdnd::_begin_drag press 3 %W %s %X %Y %x %y} 60 | bind TkDND_Drag3 {tkdnd::_begin_drag motion 3 %W %s %X %Y %x %y} 61 | 62 | # ---------------------------------------------------------------------------- 63 | # Command tkdnd::initialise: Initialise the TkDND package. 64 | # ---------------------------------------------------------------------------- 65 | proc initialise { dir PKG_LIB_FILE PACKAGE_NAME} { 66 | variable _platform_namespace 67 | variable _drop_file_temp_dir 68 | variable _windowingsystem 69 | global env 70 | 71 | switch [tk windowingsystem] { 72 | x11 { 73 | set _windowingsystem x11 74 | } 75 | win32 - 76 | windows { 77 | set _windowingsystem windows 78 | } 79 | aqua { 80 | set _windowingsystem aqua 81 | } 82 | default { 83 | error "unknown Tk windowing system" 84 | } 85 | } 86 | 87 | ## Get User's home directory: We try to locate the proper path from a set of 88 | ## environmental variables... 89 | foreach var {HOME HOMEPATH USERPROFILE ALLUSERSPROFILE APPDATA} { 90 | if {[info exists env($var)]} { 91 | if {[file isdirectory $env($var)]} { 92 | set UserHomeDir $env($var) 93 | break 94 | } 95 | } 96 | } 97 | 98 | ## Should use [tk windowingsystem] instead of tcl platform array: 99 | ## OS X returns "unix," but that's not useful because it has its own 100 | ## windowing system, aqua 101 | ## Under windows we have to also combine HOMEDRIVE & HOMEPATH... 102 | if {![info exists UserHomeDir] && 103 | [string equal $_windowingsystem windows] && 104 | [info exists env(HOMEDRIVE)] && [info exists env(HOMEPATH)]} { 105 | if {[file isdirectory $env(HOMEDRIVE)$env(HOMEPATH)]} { 106 | set UserHomeDir $env(HOMEDRIVE)$env(HOMEPATH) 107 | } 108 | } 109 | ## Have we located the needed path? 110 | if {![info exists UserHomeDir]} { 111 | set UserHomeDir [pwd] 112 | } 113 | set UserHomeDir [file normalize $UserHomeDir] 114 | 115 | ## Try to locate a temporary directory... 116 | foreach var {TKDND_TEMP_DIR TEMP TMP} { 117 | if {[info exists env($var)]} { 118 | if {[file isdirectory $env($var)] && [file writable $env($var)]} { 119 | set _drop_file_temp_dir $env($var) 120 | break 121 | } 122 | } 123 | } 124 | if {![info exists _drop_file_temp_dir]} { 125 | foreach _dir [list "$UserHomeDir/Local Settings/Temp" \ 126 | "$UserHomeDir/AppData/Local/Temp" \ 127 | /tmp \ 128 | C:/WINDOWS/Temp C:/Temp C:/tmp \ 129 | D:/WINDOWS/Temp D:/Temp D:/tmp] { 130 | if {[file isdirectory $_dir] && [file writable $_dir]} { 131 | set _drop_file_temp_dir $_dir 132 | break 133 | } 134 | } 135 | } 136 | if {![info exists _drop_file_temp_dir]} { 137 | set _drop_file_temp_dir $UserHomeDir 138 | } 139 | set _drop_file_temp_dir [file native $_drop_file_temp_dir] 140 | 141 | source $dir/tkdnd_generic.tcl 142 | switch $_windowingsystem { 143 | x11 { 144 | source $dir/tkdnd_unix.tcl 145 | set _platform_namespace xdnd 146 | } 147 | win32 - 148 | windows { 149 | source $dir/tkdnd_windows.tcl 150 | set _platform_namespace olednd 151 | } 152 | aqua { 153 | source $dir/tkdnd_macosx.tcl 154 | set _platform_namespace macdnd 155 | } 156 | default { 157 | error "unknown Tk windowing system" 158 | } 159 | } 160 | load $dir/$PKG_LIB_FILE $PACKAGE_NAME 161 | source $dir/tkdnd_compat.tcl 162 | ${_platform_namespace}::initialise 163 | };# initialise 164 | 165 | proc GetDropFileTempDirectory { } { 166 | variable _drop_file_temp_dir 167 | return $_drop_file_temp_dir 168 | } 169 | proc SetDropFileTempDirectory { dir } { 170 | variable _drop_file_temp_dir 171 | set _drop_file_temp_dir $dir 172 | } 173 | 174 | };# namespace ::tkdnd 175 | 176 | # ---------------------------------------------------------------------------- 177 | # Command tkdnd::drag_source 178 | # ---------------------------------------------------------------------------- 179 | proc ::tkdnd::drag_source { mode path { types {} } { event 1 } 180 | { tagprefix TkDND_Drag } } { 181 | set tags [bindtags $path] 182 | set idx [lsearch $tags ${tagprefix}$event] 183 | switch -- $mode { 184 | register { 185 | if { $idx != -1 } { 186 | ## No need to do anything! 187 | # bindtags $path [lreplace $tags $idx $idx ${tagprefix}$event] 188 | } else { 189 | bindtags $path [linsert $tags 1 ${tagprefix}$event] 190 | } 191 | _drag_source_update_types $path $types 192 | } 193 | unregister { 194 | if { $idx != -1 } { 195 | bindtags $path [lreplace $tags $idx $idx] 196 | } 197 | } 198 | } 199 | };# tkdnd::drag_source 200 | 201 | proc ::tkdnd::_drag_source_update_types { path types } { 202 | set types [platform_specific_types $types] 203 | set old_types [bind $path <>] 204 | foreach type $types { 205 | if {[lsearch $old_types $type] < 0} {lappend old_types $type} 206 | } 207 | bind $path <> $old_types 208 | };# ::tkdnd::_drag_source_update_types 209 | 210 | # ---------------------------------------------------------------------------- 211 | # Command tkdnd::drop_target 212 | # ---------------------------------------------------------------------------- 213 | proc ::tkdnd::drop_target { mode path { types {} } } { 214 | variable _windowingsystem 215 | set types [platform_specific_types $types] 216 | switch -- $mode { 217 | register { 218 | switch $_windowingsystem { 219 | x11 { 220 | _register_types $path [winfo toplevel $path] $types 221 | } 222 | win32 - 223 | windows { 224 | _RegisterDragDrop $path 225 | bind $path {+ tkdnd::_RevokeDragDrop %W} 226 | } 227 | aqua { 228 | macdnd::registerdragwidget [winfo toplevel $path] $types 229 | } 230 | default { 231 | error "unknown Tk windowing system" 232 | } 233 | } 234 | set old_types [bind $path <>] 235 | set new_types {} 236 | foreach type $types { 237 | if {[lsearch -exact $old_types $type] < 0} {lappend new_types $type} 238 | } 239 | if {[llength $new_types]} { 240 | bind $path <> [concat $old_types $new_types] 241 | } 242 | } 243 | unregister { 244 | switch $_windowingsystem { 245 | x11 { 246 | } 247 | win32 - 248 | windows { 249 | _RevokeDragDrop $path 250 | } 251 | aqua { 252 | error todo 253 | } 254 | default { 255 | error "unknown Tk windowing system" 256 | } 257 | } 258 | bind $path <> {} 259 | } 260 | } 261 | };# tkdnd::drop_target 262 | 263 | # ---------------------------------------------------------------------------- 264 | # Command tkdnd::_begin_drag 265 | # ---------------------------------------------------------------------------- 266 | proc ::tkdnd::_begin_drag { event button source state X Y x y } { 267 | variable _x0 268 | variable _y0 269 | variable _state 270 | 271 | switch -- $event { 272 | press { 273 | set _x0 $X 274 | set _y0 $Y 275 | set _state "press" 276 | } 277 | motion { 278 | if { ![info exists _state] } { 279 | # This is just extra protection. There seem to be 280 | # rare cases where the motion comes before the press. 281 | return 282 | } 283 | if { [string equal $_state "press"] } { 284 | variable _dx 285 | variable _dy 286 | if { abs($_x0-$X) > ${_dx} || abs($_y0-$Y) > ${_dy} } { 287 | set _state "done" 288 | _init_drag $button $source $state $X $Y $x $y 289 | } 290 | } 291 | } 292 | } 293 | };# tkdnd::_begin_drag 294 | 295 | # ---------------------------------------------------------------------------- 296 | # Command tkdnd::_init_drag 297 | # ---------------------------------------------------------------------------- 298 | proc ::tkdnd::_init_drag { button source state rootX rootY X Y } { 299 | # Call the <> binding. 300 | set cmd [bind $source <>] 301 | # puts "CMD: $cmd" 302 | if {[string length $cmd]} { 303 | set cmd [string map [list %W $source %X $rootX %Y $rootY %x $X %y $Y \ 304 | %S $state %e <> %A \{\} %% % \ 305 | %t [bind $source <>]] $cmd] 306 | set code [catch {uplevel \#0 $cmd} info options] 307 | # puts "CODE: $code ---- $info" 308 | switch -exact -- $code { 309 | 0 {} 310 | 3 - 4 { 311 | # FRINK: nocheck 312 | return 313 | } 314 | default { 315 | return -options $options $info 316 | } 317 | } 318 | 319 | set len [llength $info] 320 | if {$len == 3} { 321 | foreach { actions types _data } $info { break } 322 | set types [platform_specific_types $types] 323 | set data [list] 324 | foreach type $types { 325 | lappend data $_data 326 | } 327 | unset _data 328 | } elseif {$len == 2} { 329 | foreach { actions _data } $info { break } 330 | set data [list]; set types [list] 331 | foreach {t d} $_data { 332 | foreach t [platform_specific_types $t] { 333 | lappend types $t; lappend data $d 334 | } 335 | } 336 | unset _data t d 337 | } else { 338 | if {$len == 1 && [string equal [lindex $actions 0] "refuse_drop"]} { 339 | return 340 | } 341 | error "not enough items in the result of the <>\ 342 | event binding. Either 2 or 3 items are expected. The command 343 | executed was: \"$cmd\"\nResult was: \"$info\"" 344 | } 345 | set action refuse_drop 346 | variable _windowingsystem 347 | # puts "Source: \"$source\"" 348 | # puts "Types: \"[join $types {", "}]\"" 349 | # puts "Actions: \"[join $actions {", "}]\"" 350 | # puts "Button: \"$button\"" 351 | # puts "Data: \"[string range $data 0 100]\"" 352 | switch $_windowingsystem { 353 | x11 { 354 | set action [xdnd::_dodragdrop $source $actions $types $data $button] 355 | } 356 | win32 - 357 | windows { 358 | set action [_DoDragDrop $source $actions $types $data $button] 359 | } 360 | aqua { 361 | set action [macdnd::dodragdrop $source $actions $types $data $button] 362 | } 363 | default { 364 | error "unknown Tk windowing system" 365 | } 366 | } 367 | ## Call _end_drag to notify the widget of the result of the drag 368 | ## operation... 369 | _end_drag $button $source {} $action {} $data {} $state $rootX $rootY $X $Y 370 | } 371 | };# tkdnd::_init_drag 372 | 373 | # ---------------------------------------------------------------------------- 374 | # Command tkdnd::_end_drag 375 | # ---------------------------------------------------------------------------- 376 | proc ::tkdnd::_end_drag { button source target action type data result 377 | state rootX rootY X Y } { 378 | set rootX 0 379 | set rootY 0 380 | # Call the <> binding. 381 | set cmd [bind $source <>] 382 | if {[string length $cmd]} { 383 | set cmd [string map [list %W $source %X $rootX %Y $rootY %x $X %y $Y %% % \ 384 | %S $state %e <> %A \{$action\}] $cmd] 385 | set info [uplevel \#0 $cmd] 386 | # if { $info != "" } { 387 | # variable _windowingsystem 388 | # foreach { actions types data } $info { break } 389 | # set types [platform_specific_types $types] 390 | # switch $_windowingsystem { 391 | # x11 { 392 | # error "dragging from Tk widgets not yet supported" 393 | # } 394 | # win32 - 395 | # windows { 396 | # set action [_DoDragDrop $source $actions $types $data $button] 397 | # } 398 | # aqua { 399 | # macdnd::dodragdrop $source $actions $types $data 400 | # } 401 | # default { 402 | # error "unknown Tk windowing system" 403 | # } 404 | # } 405 | # ## Call _end_drag to notify the widget of the result of the drag 406 | # ## operation... 407 | # _end_drag $button $source {} $action {} $data {} $state $rootX $rootY 408 | # } 409 | } 410 | };# tkdnd::_end_drag 411 | 412 | # ---------------------------------------------------------------------------- 413 | # Command tkdnd::platform_specific_types 414 | # ---------------------------------------------------------------------------- 415 | proc ::tkdnd::platform_specific_types { types } { 416 | variable _platform_namespace 417 | ${_platform_namespace}::platform_specific_types $types 418 | }; # tkdnd::platform_specific_types 419 | 420 | # ---------------------------------------------------------------------------- 421 | # Command tkdnd::platform_independent_types 422 | # ---------------------------------------------------------------------------- 423 | proc ::tkdnd::platform_independent_types { types } { 424 | variable _platform_namespace 425 | ${_platform_namespace}::platform_independent_types $types 426 | }; # tkdnd::platform_independent_types 427 | 428 | # ---------------------------------------------------------------------------- 429 | # Command tkdnd::platform_specific_type 430 | # ---------------------------------------------------------------------------- 431 | proc ::tkdnd::platform_specific_type { type } { 432 | variable _platform_namespace 433 | ${_platform_namespace}::platform_specific_type $type 434 | }; # tkdnd::platform_specific_type 435 | 436 | # ---------------------------------------------------------------------------- 437 | # Command tkdnd::platform_independent_type 438 | # ---------------------------------------------------------------------------- 439 | proc ::tkdnd::platform_independent_type { type } { 440 | variable _platform_namespace 441 | ${_platform_namespace}::platform_independent_type $type 442 | }; # tkdnd::platform_independent_type 443 | 444 | # ---------------------------------------------------------------------------- 445 | # Command tkdnd::bytes_to_string 446 | # ---------------------------------------------------------------------------- 447 | proc ::tkdnd::bytes_to_string { bytes } { 448 | set string {} 449 | foreach byte $bytes { 450 | append string [binary format c $byte] 451 | } 452 | return $string 453 | };# tkdnd::bytes_to_string 454 | 455 | # ---------------------------------------------------------------------------- 456 | # Command tkdnd::urn_unquote 457 | # ---------------------------------------------------------------------------- 458 | proc ::tkdnd::urn_unquote {url} { 459 | set result "" 460 | set start 0 461 | while {[regexp -start $start -indices {%[0-9a-fA-F]{2}} $url match]} { 462 | foreach {first last} $match break 463 | append result [string range $url $start [expr {$first - 1}]] 464 | append result [format %c 0x[string range $url [incr first] $last]] 465 | set start [incr last] 466 | } 467 | append result [string range $url $start end] 468 | return [encoding convertfrom utf-8 $result] 469 | };# tkdnd::urn_unquote 470 | -------------------------------------------------------------------------------- /tkinterDnD/mac/tkdnd.tcl: -------------------------------------------------------------------------------- 1 | # 2 | # tkdnd.tcl -- 3 | # 4 | # This file implements some utility procedures that are used by the TkDND 5 | # package. 6 | # 7 | # This software is copyrighted by: 8 | # George Petasis, National Centre for Scientific Research "Demokritos", 9 | # Aghia Paraskevi, Athens, Greece. 10 | # e-mail: petasis@iit.demokritos.gr 11 | # 12 | # The following terms apply to all files associated 13 | # with the software unless explicitly disclaimed in individual files. 14 | # 15 | # The authors hereby grant permission to use, copy, modify, distribute, 16 | # and license this software and its documentation for any purpose, provided 17 | # that existing copyright notices are retained in all copies and that this 18 | # notice is included verbatim in any distributions. No written agreement, 19 | # license, or royalty fee is required for any of the authorized uses. 20 | # Modifications to this software may be copyrighted by their authors 21 | # and need not follow the licensing terms described here, provided that 22 | # the new terms are clearly indicated on the first page of each file where 23 | # they apply. 24 | # 25 | # IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY 26 | # FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES 27 | # ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY 28 | # DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE 29 | # POSSIBILITY OF SUCH DAMAGE. 30 | # 31 | # THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, 32 | # INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, 33 | # FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE 34 | # IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE 35 | # NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR 36 | # MODIFICATIONS. 37 | # 38 | 39 | package require Tk 40 | 41 | namespace eval ::tkdnd { 42 | variable _topw ".drag" 43 | variable _tabops 44 | variable _state 45 | variable _x0 46 | variable _y0 47 | variable _platform_namespace 48 | variable _drop_file_temp_dir 49 | variable _auto_update 1 50 | variable _dx 3 ;# The difference in pixels before a drag is initiated. 51 | variable _dy 3 ;# The difference in pixels before a drag is initiated. 52 | 53 | variable _windowingsystem 54 | 55 | bind TkDND_Drag1 {tkdnd::_begin_drag press 1 %W %s %X %Y %x %y} 56 | bind TkDND_Drag1 {tkdnd::_begin_drag motion 1 %W %s %X %Y %x %y} 57 | bind TkDND_Drag2 {tkdnd::_begin_drag press 2 %W %s %X %Y %x %y} 58 | bind TkDND_Drag2 {tkdnd::_begin_drag motion 2 %W %s %X %Y %x %y} 59 | bind TkDND_Drag3 {tkdnd::_begin_drag press 3 %W %s %X %Y %x %y} 60 | bind TkDND_Drag3 {tkdnd::_begin_drag motion 3 %W %s %X %Y %x %y} 61 | 62 | # ---------------------------------------------------------------------------- 63 | # Command tkdnd::initialise: Initialise the TkDND package. 64 | # ---------------------------------------------------------------------------- 65 | proc initialise { dir PKG_LIB_FILE PACKAGE_NAME} { 66 | variable _platform_namespace 67 | variable _drop_file_temp_dir 68 | variable _windowingsystem 69 | global env 70 | 71 | switch [tk windowingsystem] { 72 | x11 { 73 | set _windowingsystem x11 74 | } 75 | win32 - 76 | windows { 77 | set _windowingsystem windows 78 | } 79 | aqua { 80 | set _windowingsystem aqua 81 | } 82 | default { 83 | error "unknown Tk windowing system" 84 | } 85 | } 86 | 87 | ## Get User's home directory: We try to locate the proper path from a set of 88 | ## environmental variables... 89 | foreach var {HOME HOMEPATH USERPROFILE ALLUSERSPROFILE APPDATA} { 90 | if {[info exists env($var)]} { 91 | if {[file isdirectory $env($var)]} { 92 | set UserHomeDir $env($var) 93 | break 94 | } 95 | } 96 | } 97 | 98 | ## Should use [tk windowingsystem] instead of tcl platform array: 99 | ## OS X returns "unix," but that's not useful because it has its own 100 | ## windowing system, aqua 101 | ## Under windows we have to also combine HOMEDRIVE & HOMEPATH... 102 | if {![info exists UserHomeDir] && 103 | [string equal $_windowingsystem windows] && 104 | [info exists env(HOMEDRIVE)] && [info exists env(HOMEPATH)]} { 105 | if {[file isdirectory $env(HOMEDRIVE)$env(HOMEPATH)]} { 106 | set UserHomeDir $env(HOMEDRIVE)$env(HOMEPATH) 107 | } 108 | } 109 | ## Have we located the needed path? 110 | if {![info exists UserHomeDir]} { 111 | set UserHomeDir [pwd] 112 | } 113 | set UserHomeDir [file normalize $UserHomeDir] 114 | 115 | ## Try to locate a temporary directory... 116 | foreach var {TKDND_TEMP_DIR TEMP TMP} { 117 | if {[info exists env($var)]} { 118 | if {[file isdirectory $env($var)] && [file writable $env($var)]} { 119 | set _drop_file_temp_dir $env($var) 120 | break 121 | } 122 | } 123 | } 124 | if {![info exists _drop_file_temp_dir]} { 125 | foreach _dir [list "$UserHomeDir/Local Settings/Temp" \ 126 | "$UserHomeDir/AppData/Local/Temp" \ 127 | /tmp \ 128 | C:/WINDOWS/Temp C:/Temp C:/tmp \ 129 | D:/WINDOWS/Temp D:/Temp D:/tmp] { 130 | if {[file isdirectory $_dir] && [file writable $_dir]} { 131 | set _drop_file_temp_dir $_dir 132 | break 133 | } 134 | } 135 | } 136 | if {![info exists _drop_file_temp_dir]} { 137 | set _drop_file_temp_dir $UserHomeDir 138 | } 139 | set _drop_file_temp_dir [file native $_drop_file_temp_dir] 140 | 141 | source $dir/tkdnd_generic.tcl 142 | switch $_windowingsystem { 143 | x11 { 144 | source $dir/tkdnd_unix.tcl 145 | set _platform_namespace xdnd 146 | } 147 | win32 - 148 | windows { 149 | source $dir/tkdnd_windows.tcl 150 | set _platform_namespace olednd 151 | } 152 | aqua { 153 | source $dir/tkdnd_macosx.tcl 154 | set _platform_namespace macdnd 155 | } 156 | default { 157 | error "unknown Tk windowing system" 158 | } 159 | } 160 | load $dir/$PKG_LIB_FILE $PACKAGE_NAME 161 | source $dir/tkdnd_compat.tcl 162 | ${_platform_namespace}::initialise 163 | };# initialise 164 | 165 | proc GetDropFileTempDirectory { } { 166 | variable _drop_file_temp_dir 167 | return $_drop_file_temp_dir 168 | } 169 | proc SetDropFileTempDirectory { dir } { 170 | variable _drop_file_temp_dir 171 | set _drop_file_temp_dir $dir 172 | } 173 | 174 | };# namespace ::tkdnd 175 | 176 | # ---------------------------------------------------------------------------- 177 | # Command tkdnd::drag_source 178 | # ---------------------------------------------------------------------------- 179 | proc ::tkdnd::drag_source { mode path { types {} } { event 1 } 180 | { tagprefix TkDND_Drag } } { 181 | set tags [bindtags $path] 182 | set idx [lsearch $tags ${tagprefix}$event] 183 | switch -- $mode { 184 | register { 185 | if { $idx != -1 } { 186 | ## No need to do anything! 187 | # bindtags $path [lreplace $tags $idx $idx ${tagprefix}$event] 188 | } else { 189 | bindtags $path [linsert $tags 1 ${tagprefix}$event] 190 | } 191 | _drag_source_update_types $path $types 192 | } 193 | unregister { 194 | if { $idx != -1 } { 195 | bindtags $path [lreplace $tags $idx $idx] 196 | } 197 | } 198 | } 199 | };# tkdnd::drag_source 200 | 201 | proc ::tkdnd::_drag_source_update_types { path types } { 202 | set types [platform_specific_types $types] 203 | set old_types [bind $path <>] 204 | foreach type $types { 205 | if {[lsearch $old_types $type] < 0} {lappend old_types $type} 206 | } 207 | bind $path <> $old_types 208 | };# ::tkdnd::_drag_source_update_types 209 | 210 | # ---------------------------------------------------------------------------- 211 | # Command tkdnd::drop_target 212 | # ---------------------------------------------------------------------------- 213 | proc ::tkdnd::drop_target { mode path { types {} } } { 214 | variable _windowingsystem 215 | set types [platform_specific_types $types] 216 | switch -- $mode { 217 | register { 218 | switch $_windowingsystem { 219 | x11 { 220 | _register_types $path [winfo toplevel $path] $types 221 | } 222 | win32 - 223 | windows { 224 | _RegisterDragDrop $path 225 | bind $path {+ tkdnd::_RevokeDragDrop %W} 226 | } 227 | aqua { 228 | macdnd::registerdragwidget [winfo toplevel $path] $types 229 | } 230 | default { 231 | error "unknown Tk windowing system" 232 | } 233 | } 234 | set old_types [bind $path <>] 235 | set new_types {} 236 | foreach type $types { 237 | if {[lsearch -exact $old_types $type] < 0} {lappend new_types $type} 238 | } 239 | if {[llength $new_types]} { 240 | bind $path <> [concat $old_types $new_types] 241 | } 242 | } 243 | unregister { 244 | switch $_windowingsystem { 245 | x11 { 246 | } 247 | win32 - 248 | windows { 249 | _RevokeDragDrop $path 250 | } 251 | aqua { 252 | error todo 253 | } 254 | default { 255 | error "unknown Tk windowing system" 256 | } 257 | } 258 | bind $path <> {} 259 | } 260 | } 261 | };# tkdnd::drop_target 262 | 263 | # ---------------------------------------------------------------------------- 264 | # Command tkdnd::_begin_drag 265 | # ---------------------------------------------------------------------------- 266 | proc ::tkdnd::_begin_drag { event button source state X Y x y } { 267 | variable _x0 268 | variable _y0 269 | variable _state 270 | 271 | switch -- $event { 272 | press { 273 | set _x0 $X 274 | set _y0 $Y 275 | set _state "press" 276 | } 277 | motion { 278 | if { ![info exists _state] } { 279 | # This is just extra protection. There seem to be 280 | # rare cases where the motion comes before the press. 281 | return 282 | } 283 | if { [string equal $_state "press"] } { 284 | variable _dx 285 | variable _dy 286 | if { abs($_x0-$X) > ${_dx} || abs($_y0-$Y) > ${_dy} } { 287 | set _state "done" 288 | _init_drag $button $source $state $X $Y $x $y 289 | } 290 | } 291 | } 292 | } 293 | };# tkdnd::_begin_drag 294 | 295 | # ---------------------------------------------------------------------------- 296 | # Command tkdnd::_init_drag 297 | # ---------------------------------------------------------------------------- 298 | proc ::tkdnd::_init_drag { button source state rootX rootY X Y } { 299 | # Call the <> binding. 300 | set cmd [bind $source <>] 301 | # puts "CMD: $cmd" 302 | if {[string length $cmd]} { 303 | set cmd [string map [list %W $source %X $rootX %Y $rootY %x $X %y $Y \ 304 | %S $state %e <> %A \{\} %% % \ 305 | %t [bind $source <>]] $cmd] 306 | set code [catch {uplevel \#0 $cmd} info options] 307 | # puts "CODE: $code ---- $info" 308 | switch -exact -- $code { 309 | 0 {} 310 | 3 - 4 { 311 | # FRINK: nocheck 312 | return 313 | } 314 | default { 315 | return -options $options $info 316 | } 317 | } 318 | 319 | set len [llength $info] 320 | if {$len == 3} { 321 | foreach { actions types _data } $info { break } 322 | set types [platform_specific_types $types] 323 | set data [list] 324 | foreach type $types { 325 | lappend data $_data 326 | } 327 | unset _data 328 | } elseif {$len == 2} { 329 | foreach { actions _data } $info { break } 330 | set data [list]; set types [list] 331 | foreach {t d} $_data { 332 | foreach t [platform_specific_types $t] { 333 | lappend types $t; lappend data $d 334 | } 335 | } 336 | unset _data t d 337 | } else { 338 | if {$len == 1 && [string equal [lindex $actions 0] "refuse_drop"]} { 339 | return 340 | } 341 | error "not enough items in the result of the <>\ 342 | event binding. Either 2 or 3 items are expected. The command 343 | executed was: \"$cmd\"\nResult was: \"$info\"" 344 | } 345 | set action refuse_drop 346 | variable _windowingsystem 347 | # puts "Source: \"$source\"" 348 | # puts "Types: \"[join $types {", "}]\"" 349 | # puts "Actions: \"[join $actions {", "}]\"" 350 | # puts "Button: \"$button\"" 351 | # puts "Data: \"[string range $data 0 100]\"" 352 | switch $_windowingsystem { 353 | x11 { 354 | set action [xdnd::_dodragdrop $source $actions $types $data $button] 355 | } 356 | win32 - 357 | windows { 358 | set action [_DoDragDrop $source $actions $types $data $button] 359 | } 360 | aqua { 361 | set action [macdnd::dodragdrop $source $actions $types $data $button] 362 | } 363 | default { 364 | error "unknown Tk windowing system" 365 | } 366 | } 367 | ## Call _end_drag to notify the widget of the result of the drag 368 | ## operation... 369 | _end_drag $button $source {} $action {} $data {} $state $rootX $rootY $X $Y 370 | } 371 | };# tkdnd::_init_drag 372 | 373 | # ---------------------------------------------------------------------------- 374 | # Command tkdnd::_end_drag 375 | # ---------------------------------------------------------------------------- 376 | proc ::tkdnd::_end_drag { button source target action type data result 377 | state rootX rootY X Y } { 378 | set rootX 0 379 | set rootY 0 380 | # Call the <> binding. 381 | set cmd [bind $source <>] 382 | if {[string length $cmd]} { 383 | set cmd [string map [list %W $source %X $rootX %Y $rootY %x $X %y $Y %% % \ 384 | %S $state %e <> %A \{$action\}] $cmd] 385 | set info [uplevel \#0 $cmd] 386 | # if { $info != "" } { 387 | # variable _windowingsystem 388 | # foreach { actions types data } $info { break } 389 | # set types [platform_specific_types $types] 390 | # switch $_windowingsystem { 391 | # x11 { 392 | # error "dragging from Tk widgets not yet supported" 393 | # } 394 | # win32 - 395 | # windows { 396 | # set action [_DoDragDrop $source $actions $types $data $button] 397 | # } 398 | # aqua { 399 | # macdnd::dodragdrop $source $actions $types $data 400 | # } 401 | # default { 402 | # error "unknown Tk windowing system" 403 | # } 404 | # } 405 | # ## Call _end_drag to notify the widget of the result of the drag 406 | # ## operation... 407 | # _end_drag $button $source {} $action {} $data {} $state $rootX $rootY 408 | # } 409 | } 410 | };# tkdnd::_end_drag 411 | 412 | # ---------------------------------------------------------------------------- 413 | # Command tkdnd::platform_specific_types 414 | # ---------------------------------------------------------------------------- 415 | proc ::tkdnd::platform_specific_types { types } { 416 | variable _platform_namespace 417 | ${_platform_namespace}::platform_specific_types $types 418 | }; # tkdnd::platform_specific_types 419 | 420 | # ---------------------------------------------------------------------------- 421 | # Command tkdnd::platform_independent_types 422 | # ---------------------------------------------------------------------------- 423 | proc ::tkdnd::platform_independent_types { types } { 424 | variable _platform_namespace 425 | ${_platform_namespace}::platform_independent_types $types 426 | }; # tkdnd::platform_independent_types 427 | 428 | # ---------------------------------------------------------------------------- 429 | # Command tkdnd::platform_specific_type 430 | # ---------------------------------------------------------------------------- 431 | proc ::tkdnd::platform_specific_type { type } { 432 | variable _platform_namespace 433 | ${_platform_namespace}::platform_specific_type $type 434 | }; # tkdnd::platform_specific_type 435 | 436 | # ---------------------------------------------------------------------------- 437 | # Command tkdnd::platform_independent_type 438 | # ---------------------------------------------------------------------------- 439 | proc ::tkdnd::platform_independent_type { type } { 440 | variable _platform_namespace 441 | ${_platform_namespace}::platform_independent_type $type 442 | }; # tkdnd::platform_independent_type 443 | 444 | # ---------------------------------------------------------------------------- 445 | # Command tkdnd::bytes_to_string 446 | # ---------------------------------------------------------------------------- 447 | proc ::tkdnd::bytes_to_string { bytes } { 448 | set string {} 449 | foreach byte $bytes { 450 | append string [binary format c $byte] 451 | } 452 | return $string 453 | };# tkdnd::bytes_to_string 454 | 455 | # ---------------------------------------------------------------------------- 456 | # Command tkdnd::urn_unquote 457 | # ---------------------------------------------------------------------------- 458 | proc ::tkdnd::urn_unquote {url} { 459 | set result "" 460 | set start 0 461 | while {[regexp -start $start -indices {%[0-9a-fA-F]{2}} $url match]} { 462 | foreach {first last} $match break 463 | append result [string range $url $start [expr {$first - 1}]] 464 | append result [format %c 0x[string range $url [incr first] $last]] 465 | set start [incr last] 466 | } 467 | append result [string range $url $start end] 468 | return [encoding convertfrom utf-8 $result] 469 | };# tkdnd::urn_unquote 470 | -------------------------------------------------------------------------------- /tkinterDnD/windows/tkdnd.tcl: -------------------------------------------------------------------------------- 1 | # 2 | # tkdnd.tcl -- 3 | # 4 | # This file implements some utility procedures that are used by the TkDND 5 | # package. 6 | # 7 | # This software is copyrighted by: 8 | # George Petasis, National Centre for Scientific Research "Demokritos", 9 | # Aghia Paraskevi, Athens, Greece. 10 | # e-mail: petasis@iit.demokritos.gr 11 | # 12 | # The following terms apply to all files associated 13 | # with the software unless explicitly disclaimed in individual files. 14 | # 15 | # The authors hereby grant permission to use, copy, modify, distribute, 16 | # and license this software and its documentation for any purpose, provided 17 | # that existing copyright notices are retained in all copies and that this 18 | # notice is included verbatim in any distributions. No written agreement, 19 | # license, or royalty fee is required for any of the authorized uses. 20 | # Modifications to this software may be copyrighted by their authors 21 | # and need not follow the licensing terms described here, provided that 22 | # the new terms are clearly indicated on the first page of each file where 23 | # they apply. 24 | # 25 | # IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY 26 | # FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES 27 | # ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY 28 | # DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE 29 | # POSSIBILITY OF SUCH DAMAGE. 30 | # 31 | # THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, 32 | # INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, 33 | # FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE 34 | # IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE 35 | # NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR 36 | # MODIFICATIONS. 37 | # 38 | 39 | package require Tk 40 | 41 | namespace eval ::tkdnd { 42 | variable _topw ".drag" 43 | variable _tabops 44 | variable _state 45 | variable _x0 46 | variable _y0 47 | variable _platform_namespace 48 | variable _drop_file_temp_dir 49 | variable _auto_update 1 50 | variable _dx 3 ;# The difference in pixels before a drag is initiated. 51 | variable _dy 3 ;# The difference in pixels before a drag is initiated. 52 | 53 | variable _windowingsystem 54 | 55 | bind TkDND_Drag1 {tkdnd::_begin_drag press 1 %W %s %X %Y %x %y} 56 | bind TkDND_Drag1 {tkdnd::_begin_drag motion 1 %W %s %X %Y %x %y} 57 | bind TkDND_Drag2 {tkdnd::_begin_drag press 2 %W %s %X %Y %x %y} 58 | bind TkDND_Drag2 {tkdnd::_begin_drag motion 2 %W %s %X %Y %x %y} 59 | bind TkDND_Drag3 {tkdnd::_begin_drag press 3 %W %s %X %Y %x %y} 60 | bind TkDND_Drag3 {tkdnd::_begin_drag motion 3 %W %s %X %Y %x %y} 61 | 62 | # ---------------------------------------------------------------------------- 63 | # Command tkdnd::initialise: Initialise the TkDND package. 64 | # ---------------------------------------------------------------------------- 65 | proc initialise { dir PKG_LIB_FILE PACKAGE_NAME} { 66 | variable _platform_namespace 67 | variable _drop_file_temp_dir 68 | variable _windowingsystem 69 | global env 70 | 71 | switch [tk windowingsystem] { 72 | x11 { 73 | set _windowingsystem x11 74 | } 75 | win32 - 76 | windows { 77 | set _windowingsystem windows 78 | } 79 | aqua { 80 | set _windowingsystem aqua 81 | } 82 | default { 83 | error "unknown Tk windowing system" 84 | } 85 | } 86 | 87 | ## Get User's home directory: We try to locate the proper path from a set of 88 | ## environmental variables... 89 | foreach var {HOME HOMEPATH USERPROFILE ALLUSERSPROFILE APPDATA} { 90 | if {[info exists env($var)]} { 91 | if {[file isdirectory $env($var)]} { 92 | set UserHomeDir $env($var) 93 | break 94 | } 95 | } 96 | } 97 | 98 | ## Should use [tk windowingsystem] instead of tcl platform array: 99 | ## OS X returns "unix," but that's not useful because it has its own 100 | ## windowing system, aqua 101 | ## Under windows we have to also combine HOMEDRIVE & HOMEPATH... 102 | if {![info exists UserHomeDir] && 103 | [string equal $_windowingsystem windows] && 104 | [info exists env(HOMEDRIVE)] && [info exists env(HOMEPATH)]} { 105 | if {[file isdirectory $env(HOMEDRIVE)$env(HOMEPATH)]} { 106 | set UserHomeDir $env(HOMEDRIVE)$env(HOMEPATH) 107 | } 108 | } 109 | ## Have we located the needed path? 110 | if {![info exists UserHomeDir]} { 111 | set UserHomeDir [pwd] 112 | } 113 | set UserHomeDir [file normalize $UserHomeDir] 114 | 115 | ## Try to locate a temporary directory... 116 | foreach var {TKDND_TEMP_DIR TEMP TMP} { 117 | if {[info exists env($var)]} { 118 | if {[file isdirectory $env($var)] && [file writable $env($var)]} { 119 | set _drop_file_temp_dir $env($var) 120 | break 121 | } 122 | } 123 | } 124 | if {![info exists _drop_file_temp_dir]} { 125 | foreach _dir [list "$UserHomeDir/Local Settings/Temp" \ 126 | "$UserHomeDir/AppData/Local/Temp" \ 127 | /tmp \ 128 | C:/WINDOWS/Temp C:/Temp C:/tmp \ 129 | D:/WINDOWS/Temp D:/Temp D:/tmp] { 130 | if {[file isdirectory $_dir] && [file writable $_dir]} { 131 | set _drop_file_temp_dir $_dir 132 | break 133 | } 134 | } 135 | } 136 | if {![info exists _drop_file_temp_dir]} { 137 | set _drop_file_temp_dir $UserHomeDir 138 | } 139 | set _drop_file_temp_dir [file native $_drop_file_temp_dir] 140 | 141 | source $dir/tkdnd_generic.tcl 142 | switch $_windowingsystem { 143 | x11 { 144 | source $dir/tkdnd_unix.tcl 145 | set _platform_namespace xdnd 146 | } 147 | win32 - 148 | windows { 149 | source $dir/tkdnd_windows.tcl 150 | set _platform_namespace olednd 151 | } 152 | aqua { 153 | source $dir/tkdnd_macosx.tcl 154 | set _platform_namespace macdnd 155 | } 156 | default { 157 | error "unknown Tk windowing system" 158 | } 159 | } 160 | load $dir/$PKG_LIB_FILE $PACKAGE_NAME 161 | source $dir/tkdnd_compat.tcl 162 | ${_platform_namespace}::initialise 163 | };# initialise 164 | 165 | proc GetDropFileTempDirectory { } { 166 | variable _drop_file_temp_dir 167 | return $_drop_file_temp_dir 168 | } 169 | proc SetDropFileTempDirectory { dir } { 170 | variable _drop_file_temp_dir 171 | set _drop_file_temp_dir $dir 172 | } 173 | 174 | };# namespace ::tkdnd 175 | 176 | # ---------------------------------------------------------------------------- 177 | # Command tkdnd::drag_source 178 | # ---------------------------------------------------------------------------- 179 | proc ::tkdnd::drag_source { mode path { types {} } { event 1 } 180 | { tagprefix TkDND_Drag } } { 181 | set tags [bindtags $path] 182 | set idx [lsearch $tags ${tagprefix}$event] 183 | switch -- $mode { 184 | register { 185 | if { $idx != -1 } { 186 | ## No need to do anything! 187 | # bindtags $path [lreplace $tags $idx $idx ${tagprefix}$event] 188 | } else { 189 | bindtags $path [linsert $tags 1 ${tagprefix}$event] 190 | } 191 | _drag_source_update_types $path $types 192 | } 193 | unregister { 194 | if { $idx != -1 } { 195 | bindtags $path [lreplace $tags $idx $idx] 196 | } 197 | } 198 | } 199 | };# tkdnd::drag_source 200 | 201 | proc ::tkdnd::_drag_source_update_types { path types } { 202 | set types [platform_specific_types $types] 203 | set old_types [bind $path <>] 204 | foreach type $types { 205 | if {[lsearch $old_types $type] < 0} {lappend old_types $type} 206 | } 207 | bind $path <> $old_types 208 | };# ::tkdnd::_drag_source_update_types 209 | 210 | # ---------------------------------------------------------------------------- 211 | # Command tkdnd::drop_target 212 | # ---------------------------------------------------------------------------- 213 | proc ::tkdnd::drop_target { mode path { types {} } } { 214 | variable _windowingsystem 215 | set types [platform_specific_types $types] 216 | switch -- $mode { 217 | register { 218 | switch $_windowingsystem { 219 | x11 { 220 | _register_types $path [winfo toplevel $path] $types 221 | } 222 | win32 - 223 | windows { 224 | _RegisterDragDrop $path 225 | bind $path {+ tkdnd::_RevokeDragDrop %W} 226 | } 227 | aqua { 228 | macdnd::registerdragwidget [winfo toplevel $path] $types 229 | } 230 | default { 231 | error "unknown Tk windowing system" 232 | } 233 | } 234 | set old_types [bind $path <>] 235 | set new_types {} 236 | foreach type $types { 237 | if {[lsearch -exact $old_types $type] < 0} {lappend new_types $type} 238 | } 239 | if {[llength $new_types]} { 240 | bind $path <> [concat $old_types $new_types] 241 | } 242 | } 243 | unregister { 244 | switch $_windowingsystem { 245 | x11 { 246 | } 247 | win32 - 248 | windows { 249 | _RevokeDragDrop $path 250 | } 251 | aqua { 252 | error todo 253 | } 254 | default { 255 | error "unknown Tk windowing system" 256 | } 257 | } 258 | bind $path <> {} 259 | } 260 | } 261 | };# tkdnd::drop_target 262 | 263 | # ---------------------------------------------------------------------------- 264 | # Command tkdnd::_begin_drag 265 | # ---------------------------------------------------------------------------- 266 | proc ::tkdnd::_begin_drag { event button source state X Y x y } { 267 | variable _x0 268 | variable _y0 269 | variable _state 270 | 271 | switch -- $event { 272 | press { 273 | set _x0 $X 274 | set _y0 $Y 275 | set _state "press" 276 | } 277 | motion { 278 | if { ![info exists _state] } { 279 | # This is just extra protection. There seem to be 280 | # rare cases where the motion comes before the press. 281 | return 282 | } 283 | if { [string equal $_state "press"] } { 284 | variable _dx 285 | variable _dy 286 | if { abs($_x0-$X) > ${_dx} || abs($_y0-$Y) > ${_dy} } { 287 | set _state "done" 288 | _init_drag $button $source $state $X $Y $x $y 289 | } 290 | } 291 | } 292 | } 293 | };# tkdnd::_begin_drag 294 | 295 | # ---------------------------------------------------------------------------- 296 | # Command tkdnd::_init_drag 297 | # ---------------------------------------------------------------------------- 298 | proc ::tkdnd::_init_drag { button source state rootX rootY X Y } { 299 | # Call the <> binding. 300 | set cmd [bind $source <>] 301 | # puts "CMD: $cmd" 302 | if {[string length $cmd]} { 303 | set cmd [string map [list %W $source %X $rootX %Y $rootY %x $X %y $Y \ 304 | %S $state %e <> %A \{\} %% % \ 305 | %t [bind $source <>]] $cmd] 306 | set code [catch {uplevel \#0 $cmd} info options] 307 | # puts "CODE: $code ---- $info" 308 | switch -exact -- $code { 309 | 0 {} 310 | 3 - 4 { 311 | # FRINK: nocheck 312 | return 313 | } 314 | default { 315 | return -options $options $info 316 | } 317 | } 318 | 319 | set len [llength $info] 320 | if {$len == 3} { 321 | foreach { actions types _data } $info { break } 322 | set types [platform_specific_types $types] 323 | set data [list] 324 | foreach type $types { 325 | lappend data $_data 326 | } 327 | unset _data 328 | } elseif {$len == 2} { 329 | foreach { actions _data } $info { break } 330 | set data [list]; set types [list] 331 | foreach {t d} $_data { 332 | foreach t [platform_specific_types $t] { 333 | lappend types $t; lappend data $d 334 | } 335 | } 336 | unset _data t d 337 | } else { 338 | if {$len == 1 && [string equal [lindex $actions 0] "refuse_drop"]} { 339 | return 340 | } 341 | error "not enough items in the result of the <>\ 342 | event binding. Either 2 or 3 items are expected. The command 343 | executed was: \"$cmd\"\nResult was: \"$info\"" 344 | } 345 | set action refuse_drop 346 | variable _windowingsystem 347 | # puts "Source: \"$source\"" 348 | # puts "Types: \"[join $types {", "}]\"" 349 | # puts "Actions: \"[join $actions {", "}]\"" 350 | # puts "Button: \"$button\"" 351 | # puts "Data: \"[string range $data 0 100]\"" 352 | switch $_windowingsystem { 353 | x11 { 354 | set action [xdnd::_dodragdrop $source $actions $types $data $button] 355 | } 356 | win32 - 357 | windows { 358 | set action [_DoDragDrop $source $actions $types $data $button] 359 | } 360 | aqua { 361 | set action [macdnd::dodragdrop $source $actions $types $data $button] 362 | } 363 | default { 364 | error "unknown Tk windowing system" 365 | } 366 | } 367 | ## Call _end_drag to notify the widget of the result of the drag 368 | ## operation... 369 | _end_drag $button $source {} $action {} $data {} $state $rootX $rootY $X $Y 370 | } 371 | };# tkdnd::_init_drag 372 | 373 | # ---------------------------------------------------------------------------- 374 | # Command tkdnd::_end_drag 375 | # ---------------------------------------------------------------------------- 376 | proc ::tkdnd::_end_drag { button source target action type data result 377 | state rootX rootY X Y } { 378 | set rootX 0 379 | set rootY 0 380 | # Call the <> binding. 381 | set cmd [bind $source <>] 382 | if {[string length $cmd]} { 383 | set cmd [string map [list %W $source %X $rootX %Y $rootY %x $X %y $Y %% % \ 384 | %S $state %e <> %A \{$action\}] $cmd] 385 | set info [uplevel \#0 $cmd] 386 | # if { $info != "" } { 387 | # variable _windowingsystem 388 | # foreach { actions types data } $info { break } 389 | # set types [platform_specific_types $types] 390 | # switch $_windowingsystem { 391 | # x11 { 392 | # error "dragging from Tk widgets not yet supported" 393 | # } 394 | # win32 - 395 | # windows { 396 | # set action [_DoDragDrop $source $actions $types $data $button] 397 | # } 398 | # aqua { 399 | # macdnd::dodragdrop $source $actions $types $data 400 | # } 401 | # default { 402 | # error "unknown Tk windowing system" 403 | # } 404 | # } 405 | # ## Call _end_drag to notify the widget of the result of the drag 406 | # ## operation... 407 | # _end_drag $button $source {} $action {} $data {} $state $rootX $rootY 408 | # } 409 | } 410 | };# tkdnd::_end_drag 411 | 412 | # ---------------------------------------------------------------------------- 413 | # Command tkdnd::platform_specific_types 414 | # ---------------------------------------------------------------------------- 415 | proc ::tkdnd::platform_specific_types { types } { 416 | variable _platform_namespace 417 | ${_platform_namespace}::platform_specific_types $types 418 | }; # tkdnd::platform_specific_types 419 | 420 | # ---------------------------------------------------------------------------- 421 | # Command tkdnd::platform_independent_types 422 | # ---------------------------------------------------------------------------- 423 | proc ::tkdnd::platform_independent_types { types } { 424 | variable _platform_namespace 425 | ${_platform_namespace}::platform_independent_types $types 426 | }; # tkdnd::platform_independent_types 427 | 428 | # ---------------------------------------------------------------------------- 429 | # Command tkdnd::platform_specific_type 430 | # ---------------------------------------------------------------------------- 431 | proc ::tkdnd::platform_specific_type { type } { 432 | variable _platform_namespace 433 | ${_platform_namespace}::platform_specific_type $type 434 | }; # tkdnd::platform_specific_type 435 | 436 | # ---------------------------------------------------------------------------- 437 | # Command tkdnd::platform_independent_type 438 | # ---------------------------------------------------------------------------- 439 | proc ::tkdnd::platform_independent_type { type } { 440 | variable _platform_namespace 441 | ${_platform_namespace}::platform_independent_type $type 442 | }; # tkdnd::platform_independent_type 443 | 444 | # ---------------------------------------------------------------------------- 445 | # Command tkdnd::bytes_to_string 446 | # ---------------------------------------------------------------------------- 447 | proc ::tkdnd::bytes_to_string { bytes } { 448 | set string {} 449 | foreach byte $bytes { 450 | append string [binary format c $byte] 451 | } 452 | return $string 453 | };# tkdnd::bytes_to_string 454 | 455 | # ---------------------------------------------------------------------------- 456 | # Command tkdnd::urn_unquote 457 | # ---------------------------------------------------------------------------- 458 | proc ::tkdnd::urn_unquote {url} { 459 | set result "" 460 | set start 0 461 | while {[regexp -start $start -indices {%[0-9a-fA-F]{2}} $url match]} { 462 | foreach {first last} $match break 463 | append result [string range $url $start [expr {$first - 1}]] 464 | append result [format %c 0x[string range $url [incr first] $last]] 465 | set start [incr last] 466 | } 467 | append result [string range $url $start end] 468 | return [encoding convertfrom utf-8 $result] 469 | };# tkdnd::urn_unquote 470 | -------------------------------------------------------------------------------- /tkinterDnD/linux/tkdnd_generic.tcl: -------------------------------------------------------------------------------- 1 | # 2 | # tkdnd_generic.tcl -- 3 | # 4 | # This file implements some utility procedures that are used by the TkDND 5 | # package. 6 | # 7 | # This software is copyrighted by: 8 | # George Petasis, National Centre for Scientific Research "Demokritos", 9 | # Aghia Paraskevi, Athens, Greece. 10 | # e-mail: petasis@iit.demokritos.gr 11 | # 12 | # The following terms apply to all files associated 13 | # with the software unless explicitly disclaimed in individual files. 14 | # 15 | # The authors hereby grant permission to use, copy, modify, distribute, 16 | # and license this software and its documentation for any purpose, provided 17 | # that existing copyright notices are retained in all copies and that this 18 | # notice is included verbatim in any distributions. No written agreement, 19 | # license, or royalty fee is required for any of the authorized uses. 20 | # Modifications to this software may be copyrighted by their authors 21 | # and need not follow the licensing terms described here, provided that 22 | # the new terms are clearly indicated on the first page of each file where 23 | # they apply. 24 | # 25 | # IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY 26 | # FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES 27 | # ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY 28 | # DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE 29 | # POSSIBILITY OF SUCH DAMAGE. 30 | # 31 | # THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, 32 | # INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, 33 | # FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE 34 | # IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE 35 | # NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR 36 | # MODIFICATIONS. 37 | # 38 | 39 | namespace eval generic { 40 | variable _types {} 41 | variable _typelist {} 42 | variable _codelist {} 43 | variable _actionlist {} 44 | variable _pressedkeys {} 45 | variable _action {} 46 | variable _common_drag_source_types {} 47 | variable _common_drop_target_types {} 48 | variable _drag_source {} 49 | variable _drop_target {} 50 | 51 | variable _last_mouse_root_x 0 52 | variable _last_mouse_root_y 0 53 | 54 | variable _tkdnd2platform 55 | variable _platform2tkdnd 56 | 57 | proc debug {msg} { 58 | puts $msg 59 | };# debug 60 | 61 | proc initialise { } { 62 | };# initialise 63 | 64 | proc initialise_platform_to_tkdnd_types { types } { 65 | variable _platform2tkdnd 66 | variable _tkdnd2platform 67 | set _platform2tkdnd [dict create {*}$types] 68 | set _tkdnd2platform [dict create] 69 | foreach type [dict keys $_platform2tkdnd] { 70 | dict lappend _tkdnd2platform [dict get $_platform2tkdnd $type] $type 71 | } 72 | };# initialise_platform_to_tkdnd_types 73 | 74 | proc initialise_tkdnd_to_platform_types { types } { 75 | variable _tkdnd2platform 76 | set _tkdnd2platform [dict create {*}$types] 77 | };# initialise_tkdnd_to_platform_types 78 | 79 | };# namespace generic 80 | 81 | # ---------------------------------------------------------------------------- 82 | # Command generic::HandleEnter 83 | # ---------------------------------------------------------------------------- 84 | proc generic::HandleEnter { drop_target drag_source typelist codelist 85 | actionlist pressedkeys } { 86 | variable _typelist; set _typelist $typelist 87 | variable _pressedkeys; set _pressedkeys $pressedkeys 88 | variable _action; set _action refuse_drop 89 | variable _common_drag_source_types; set _common_drag_source_types {} 90 | variable _common_drop_target_types; set _common_drop_target_types {} 91 | variable _actionlist 92 | variable _drag_source; set _drag_source $drag_source 93 | variable _drop_target; set _drop_target {} 94 | variable _actionlist; set _actionlist $actionlist 95 | variable _codelist set _codelist $codelist 96 | 97 | variable _last_mouse_root_x; set _last_mouse_root_x 0 98 | variable _last_mouse_root_y; set _last_mouse_root_y 0 99 | # debug "\n===============================================================" 100 | # debug "generic::HandleEnter: drop_target=$drop_target,\ 101 | # drag_source=$drag_source,\ 102 | # typelist=$typelist" 103 | # debug "generic::HandleEnter: ACTION: default" 104 | return default 105 | };# generic::HandleEnter 106 | 107 | # ---------------------------------------------------------------------------- 108 | # Command generic::HandlePosition 109 | # ---------------------------------------------------------------------------- 110 | proc generic::HandlePosition { drop_target drag_source pressedkeys 111 | rootX rootY { time 0 } } { 112 | variable _types 113 | variable _typelist 114 | variable _codelist 115 | variable _actionlist 116 | variable _pressedkeys 117 | variable _action 118 | variable _common_drag_source_types 119 | variable _common_drop_target_types 120 | variable _drag_source 121 | variable _drop_target 122 | 123 | variable _last_mouse_root_x; set _last_mouse_root_x $rootX 124 | variable _last_mouse_root_y; set _last_mouse_root_y $rootY 125 | 126 | # debug "generic::HandlePosition: drop_target=$drop_target,\ 127 | # _drop_target=$_drop_target, rootX=$rootX, rootY=$rootY" 128 | 129 | if {![info exists _drag_source] && ![string length $_drag_source]} { 130 | # debug "generic::HandlePosition: no or empty _drag_source:\ 131 | # return refuse_drop" 132 | return refuse_drop 133 | } 134 | 135 | if {$drag_source ne "" && $drag_source ne $_drag_source} { 136 | debug "generic position event from unexpected source: $_drag_source\ 137 | != $drag_source" 138 | return refuse_drop 139 | } 140 | 141 | set _pressedkeys $pressedkeys 142 | 143 | ## Does the new drop target support any of our new types? 144 | # foreach {common_drag_source_types common_drop_target_types} \ 145 | # [GetWindowCommonTypes $drop_target $_typelist] {break} 146 | foreach {drop_target common_drag_source_types common_drop_target_types} \ 147 | [FindWindowWithCommonTypes $drop_target $_typelist] {break} 148 | set data [GetDroppedData $time] 149 | 150 | # debug "\t($_drop_target) -> ($drop_target)" 151 | if {$drop_target != $_drop_target} { 152 | if {[string length $_drop_target]} { 153 | ## Call the <> event. 154 | # debug "\t<> on $_drop_target" 155 | set cmd [bind $_drop_target <>] 156 | if {[string length $cmd]} { 157 | set cmd [string map [list %W $_drop_target %X $rootX %Y $rootY \ 158 | %CST \{$_common_drag_source_types\} \ 159 | %CTT \{$_common_drop_target_types\} \ 160 | %CPT \{[lindex [platform_independent_type [lindex $_common_drag_source_types 0]] 0]\} \ 161 | %ST \{$_typelist\} %TT \{$_types\} \ 162 | %A \{$_action\} %a \{$_actionlist\} \ 163 | %b \{$_pressedkeys\} %m \{$_pressedkeys\} \ 164 | %D \{\} %e <> \ 165 | %L \{$_typelist\} %% % \ 166 | %t \{$_typelist\} %T \{[lindex $_common_drag_source_types 0]\} \ 167 | %c \{$_codelist\} %C \{[lindex $_codelist 0]\} \ 168 | ] $cmd] 169 | uplevel \#0 $cmd 170 | } 171 | } 172 | set _drop_target $drop_target 173 | set _action refuse_drop 174 | 175 | if {[llength $common_drag_source_types]} { 176 | set _action [lindex $_actionlist 0] 177 | set _common_drag_source_types $common_drag_source_types 178 | set _common_drop_target_types $common_drop_target_types 179 | ## Drop target supports at least one type. Send a <>. 180 | # puts "<> -> $drop_target" 181 | set cmd [bind $drop_target <>] 182 | if {[string length $cmd]} { 183 | focus $drop_target 184 | set cmd [string map [list %W $drop_target %X $rootX %Y $rootY \ 185 | %CST \{$_common_drag_source_types\} \ 186 | %CTT \{$_common_drop_target_types\} \ 187 | %CPT \{[lindex [platform_independent_type [lindex $_common_drag_source_types 0]] 0]\} \ 188 | %ST \{$_typelist\} %TT \{$_types\} \ 189 | %A $_action %a \{$_actionlist\} \ 190 | %b \{$_pressedkeys\} %m \{$_pressedkeys\} \ 191 | %D [list $data] %e <> \ 192 | %L \{$_typelist\} %% % \ 193 | %t \{$_typelist\} %T \{[lindex $_common_drag_source_types 0]\} \ 194 | %c \{$_codelist\} %C \{[lindex $_codelist 0]\} \ 195 | ] $cmd] 196 | set _action [uplevel \#0 $cmd] 197 | switch -exact -- $_action { 198 | copy - move - link - ask - private - refuse_drop - default {} 199 | default {set _action copy} 200 | } 201 | } 202 | } 203 | } 204 | 205 | set _drop_target {} 206 | if {[llength $common_drag_source_types]} { 207 | set _common_drag_source_types $common_drag_source_types 208 | set _common_drop_target_types $common_drop_target_types 209 | set _drop_target $drop_target 210 | ## Drop target supports at least one type. Send a <>. 211 | set cmd [bind $drop_target <>] 212 | if {[string length $cmd]} { 213 | set cmd [string map [list %W $drop_target %X $rootX %Y $rootY \ 214 | %CST \{$_common_drag_source_types\} \ 215 | %CTT \{$_common_drop_target_types\} \ 216 | %CPT \{[lindex [platform_independent_type [lindex $_common_drag_source_types 0]] 0]\} \ 217 | %ST \{$_typelist\} %TT \{$_types\} \ 218 | %A $_action %a \{$_actionlist\} \ 219 | %b \{$_pressedkeys\} %m \{$_pressedkeys\} \ 220 | %D [list $data] %e <> \ 221 | %L \{$_typelist\} %% % \ 222 | %t \{$_typelist\} %T \{[lindex $_common_drag_source_types 0]\} \ 223 | %c \{$_codelist\} %C \{[lindex $_codelist 0]\} \ 224 | ] $cmd] 225 | set _action [uplevel \#0 $cmd] 226 | } 227 | } 228 | # Return values: copy, move, link, ask, private, refuse_drop, default 229 | # debug "generic::HandlePosition: ACTION: $_action" 230 | switch -exact -- $_action { 231 | copy - move - link - ask - private - refuse_drop - default {} 232 | default {set _action copy} 233 | } 234 | return $_action 235 | };# generic::HandlePosition 236 | 237 | # ---------------------------------------------------------------------------- 238 | # Command generic::HandleLeave 239 | # ---------------------------------------------------------------------------- 240 | proc generic::HandleLeave { } { 241 | variable _types 242 | variable _typelist 243 | variable _codelist 244 | variable _actionlist 245 | variable _pressedkeys 246 | variable _action 247 | variable _common_drag_source_types 248 | variable _common_drop_target_types 249 | variable _drag_source 250 | variable _drop_target 251 | variable _last_mouse_root_x 252 | variable _last_mouse_root_y 253 | if {![info exists _drop_target]} {set _drop_target {}} 254 | # debug "generic::HandleLeave: _drop_target=$_drop_target" 255 | if {[info exists _drop_target] && [string length $_drop_target]} { 256 | set cmd [bind $_drop_target <>] 257 | if {[string length $cmd]} { 258 | set cmd [string map [list %W $_drop_target \ 259 | %X $_last_mouse_root_x %Y $_last_mouse_root_y \ 260 | %CST \{$_common_drag_source_types\} \ 261 | %CTT \{$_common_drop_target_types\} \ 262 | %CPT \{[lindex [platform_independent_type [lindex $_common_drag_source_types 0]] 0]\} \ 263 | %ST \{$_typelist\} %TT \{$_types\} \ 264 | %A \{$_action\} %a \{$_actionlist\} \ 265 | %b \{$_pressedkeys\} %m \{$_pressedkeys\} \ 266 | %D \{\} %e <> \ 267 | %L \{$_typelist\} %% % \ 268 | %t \{$_typelist\} %T \{[lindex $_common_drag_source_types 0]\} \ 269 | %c \{$_codelist\} %C \{[lindex $_codelist 0]\} \ 270 | ] $cmd] 271 | set _action [uplevel \#0 $cmd] 272 | } 273 | } 274 | foreach var {_types _typelist _actionlist _pressedkeys _action 275 | _common_drag_source_types _common_drop_target_types 276 | _drag_source _drop_target} { 277 | set $var {} 278 | } 279 | };# generic::HandleLeave 280 | 281 | # ---------------------------------------------------------------------------- 282 | # Command generic::HandleDrop 283 | # ---------------------------------------------------------------------------- 284 | proc generic::HandleDrop {drop_target drag_source pressedkeys rootX rootY time } { 285 | variable _types 286 | variable _typelist 287 | variable _codelist 288 | variable _actionlist 289 | variable _pressedkeys 290 | variable _action 291 | variable _common_drag_source_types 292 | variable _common_drop_target_types 293 | variable _drag_source 294 | variable _drop_target 295 | variable _last_mouse_root_x 296 | variable _last_mouse_root_y 297 | variable _last_mouse_root_x; set _last_mouse_root_x $rootX 298 | variable _last_mouse_root_y; set _last_mouse_root_y $rootY 299 | 300 | set _pressedkeys $pressedkeys 301 | 302 | # puts "generic::HandleDrop: $time" 303 | 304 | if {![info exists _drag_source] && ![string length $_drag_source]} { 305 | return refuse_drop 306 | } 307 | if {![info exists _drop_target] && ![string length $_drop_target]} { 308 | return refuse_drop 309 | } 310 | if {![llength $_common_drag_source_types]} {return refuse_drop} 311 | ## Get the dropped data. 312 | set data [GetDroppedData $time] 313 | ## Try to select the most specific <> event. 314 | foreach type [concat $_common_drag_source_types $_common_drop_target_types] { 315 | set type [platform_independent_type $type] 316 | set cmd [bind $_drop_target <>] 317 | if {[string length $cmd]} { 318 | set cmd [string map [list %W $_drop_target %X $rootX %Y $rootY \ 319 | %CST \{$_common_drag_source_types\} \ 320 | %CTT \{$_common_drop_target_types\} \ 321 | %CPT \{[lindex [platform_independent_type [lindex $_common_drag_source_types 0]] 0]\} \ 322 | %ST \{$_typelist\} %TT \{$_types\} \ 323 | %A $_action %a \{$_actionlist\} \ 324 | %b \{$_pressedkeys\} %m \{$_pressedkeys\} \ 325 | %D [list $data] %e <> \ 326 | %L \{$_typelist\} %% % \ 327 | %t \{$_typelist\} %T \{[lindex $_common_drag_source_types 0]\} \ 328 | %c \{$_codelist\} %C \{[lindex $_codelist 0]\} \ 329 | ] $cmd] 330 | set _action [uplevel \#0 $cmd] 331 | # Return values: copy, move, link, ask, private, refuse_drop 332 | switch -exact -- $_action { 333 | copy - move - link - ask - private - refuse_drop - default {} 334 | default {set _action copy} 335 | } 336 | return $_action 337 | } 338 | } 339 | set cmd [bind $_drop_target <>] 340 | if {[string length $cmd]} { 341 | set cmd [string map [list %W $_drop_target %X $rootX %Y $rootY \ 342 | %CST \{$_common_drag_source_types\} \ 343 | %CTT \{$_common_drop_target_types\} \ 344 | %CPT \{[lindex [platform_independent_type [lindex $_common_drag_source_types 0]] 0]\} \ 345 | %ST \{$_typelist\} %TT \{$_types\} \ 346 | %A $_action %a \{$_actionlist\} \ 347 | %b \{$_pressedkeys\} %m \{$_pressedkeys\} \ 348 | %D [list $data] %e <> \ 349 | %L \{$_typelist\} %% % \ 350 | %t \{$_typelist\} %T \{[lindex $_common_drag_source_types 0]\} \ 351 | %c \{$_codelist\} %C \{[lindex $_codelist 0]\} \ 352 | ] $cmd] 353 | set _action [uplevel \#0 $cmd] 354 | } 355 | # Return values: copy, move, link, ask, private, refuse_drop 356 | switch -exact -- $_action { 357 | copy - move - link - ask - private - refuse_drop - default {} 358 | default {set _action copy} 359 | } 360 | return $_action 361 | };# generic::HandleDrop 362 | 363 | # ---------------------------------------------------------------------------- 364 | # Command generic::GetWindowCommonTypes 365 | # ---------------------------------------------------------------------------- 366 | proc generic::GetWindowCommonTypes { win typelist } { 367 | set types [bind $win <>] 368 | # debug ">> Accepted types: $win $_types" 369 | set common_drag_source_types {} 370 | set common_drop_target_types {} 371 | if {[llength $types]} { 372 | ## Examine the drop target types, to find at least one match with the drag 373 | ## source types... 374 | set supported_types [supported_types $typelist] 375 | foreach type $types { 376 | foreach matched [lsearch -glob -all -inline $supported_types $type] { 377 | ## Drop target supports this type. 378 | lappend common_drag_source_types $matched 379 | lappend common_drop_target_types $type 380 | } 381 | } 382 | } 383 | list $common_drag_source_types $common_drop_target_types 384 | };# generic::GetWindowCommonTypes 385 | 386 | # ---------------------------------------------------------------------------- 387 | # Command generic::FindWindowWithCommonTypes 388 | # ---------------------------------------------------------------------------- 389 | proc generic::FindWindowWithCommonTypes { win typelist } { 390 | set toplevel [winfo toplevel $win] 391 | while {![string equal $win $toplevel]} { 392 | foreach {common_drag_source_types common_drop_target_types} \ 393 | [GetWindowCommonTypes $win $typelist] {break} 394 | if {[llength $common_drag_source_types]} { 395 | return [list $win $common_drag_source_types $common_drop_target_types] 396 | } 397 | set win [winfo parent $win] 398 | } 399 | ## We have reached the toplevel, which may be also a target (SF Bug #30) 400 | foreach {common_drag_source_types common_drop_target_types} \ 401 | [GetWindowCommonTypes $win $typelist] {break} 402 | if {[llength $common_drag_source_types]} { 403 | return [list $win $common_drag_source_types $common_drop_target_types] 404 | } 405 | return { {} {} {} } 406 | };# generic::FindWindowWithCommonTypes 407 | 408 | # ---------------------------------------------------------------------------- 409 | # Command generic::GetDroppedData 410 | # ---------------------------------------------------------------------------- 411 | proc generic::GetDroppedData { time } { 412 | variable _dropped_data 413 | return $_dropped_data 414 | };# generic::GetDroppedData 415 | 416 | # ---------------------------------------------------------------------------- 417 | # Command generic::SetDroppedData 418 | # ---------------------------------------------------------------------------- 419 | proc generic::SetDroppedData { data } { 420 | variable _dropped_data 421 | set _dropped_data $data 422 | };# generic::SetDroppedData 423 | 424 | # ---------------------------------------------------------------------------- 425 | # Command generic::GetDragSource 426 | # ---------------------------------------------------------------------------- 427 | proc generic::GetDragSource { } { 428 | variable _drag_source 429 | return $_drag_source 430 | };# generic::GetDragSource 431 | 432 | # ---------------------------------------------------------------------------- 433 | # Command generic::GetDropTarget 434 | # ---------------------------------------------------------------------------- 435 | proc generic::GetDropTarget { } { 436 | variable _drop_target 437 | return $_drop_target 438 | };# generic::GetDropTarget 439 | 440 | # ---------------------------------------------------------------------------- 441 | # Command generic::GetDragSourceCommonTypes 442 | # ---------------------------------------------------------------------------- 443 | proc generic::GetDragSourceCommonTypes { } { 444 | variable _common_drag_source_types 445 | return $_common_drag_source_types 446 | };# generic::GetDragSourceCommonTypes 447 | 448 | # ---------------------------------------------------------------------------- 449 | # Command generic::GetDropTargetCommonTypes 450 | # ---------------------------------------------------------------------------- 451 | proc generic::GetDropTargetCommonTypes { } { 452 | variable _common_drag_source_types 453 | return $_common_drag_source_types 454 | };# generic::GetDropTargetCommonTypes 455 | 456 | # ---------------------------------------------------------------------------- 457 | # Command generic::platform_specific_types 458 | # ---------------------------------------------------------------------------- 459 | proc generic::platform_specific_types { types } { 460 | set new_types {} 461 | foreach type $types { 462 | set new_types [concat $new_types [platform_specific_type $type]] 463 | } 464 | return $new_types 465 | }; # generic::platform_specific_types 466 | 467 | # ---------------------------------------------------------------------------- 468 | # Command generic::platform_specific_type 469 | # ---------------------------------------------------------------------------- 470 | proc generic::platform_specific_type { type } { 471 | variable _tkdnd2platform 472 | if {[dict exists $_tkdnd2platform $type]} { 473 | return [dict get $_tkdnd2platform $type] 474 | } 475 | list $type 476 | }; # generic::platform_specific_type 477 | 478 | # ---------------------------------------------------------------------------- 479 | # Command tkdnd::platform_independent_types 480 | # ---------------------------------------------------------------------------- 481 | proc ::tkdnd::platform_independent_types { types } { 482 | set new_types {} 483 | foreach type $types { 484 | set new_types [concat $new_types [platform_independent_type $type]] 485 | } 486 | return $new_types 487 | }; # tkdnd::platform_independent_types 488 | 489 | # ---------------------------------------------------------------------------- 490 | # Command generic::platform_independent_type 491 | # ---------------------------------------------------------------------------- 492 | proc generic::platform_independent_type { type } { 493 | variable _platform2tkdnd 494 | if {[dict exists $_platform2tkdnd $type]} { 495 | return [dict get $_platform2tkdnd $type] 496 | } 497 | return $type 498 | }; # generic::platform_independent_type 499 | 500 | # ---------------------------------------------------------------------------- 501 | # Command generic::supported_types 502 | # ---------------------------------------------------------------------------- 503 | proc generic::supported_types { types } { 504 | set new_types {} 505 | foreach type $types { 506 | if {[supported_type $type]} {lappend new_types $type} 507 | } 508 | return $new_types 509 | }; # generic::supported_types 510 | 511 | # ---------------------------------------------------------------------------- 512 | # Command generic::supported_type 513 | # ---------------------------------------------------------------------------- 514 | proc generic::supported_type { type } { 515 | variable _platform2tkdnd 516 | if {[dict exists $_platform2tkdnd $type]} { 517 | return 1 518 | } 519 | return 0 520 | }; # generic::supported_type 521 | -------------------------------------------------------------------------------- /tkinterDnD/mac/tkdnd_generic.tcl: -------------------------------------------------------------------------------- 1 | # 2 | # tkdnd_generic.tcl -- 3 | # 4 | # This file implements some utility procedures that are used by the TkDND 5 | # package. 6 | # 7 | # This software is copyrighted by: 8 | # George Petasis, National Centre for Scientific Research "Demokritos", 9 | # Aghia Paraskevi, Athens, Greece. 10 | # e-mail: petasis@iit.demokritos.gr 11 | # 12 | # The following terms apply to all files associated 13 | # with the software unless explicitly disclaimed in individual files. 14 | # 15 | # The authors hereby grant permission to use, copy, modify, distribute, 16 | # and license this software and its documentation for any purpose, provided 17 | # that existing copyright notices are retained in all copies and that this 18 | # notice is included verbatim in any distributions. No written agreement, 19 | # license, or royalty fee is required for any of the authorized uses. 20 | # Modifications to this software may be copyrighted by their authors 21 | # and need not follow the licensing terms described here, provided that 22 | # the new terms are clearly indicated on the first page of each file where 23 | # they apply. 24 | # 25 | # IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY 26 | # FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES 27 | # ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY 28 | # DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE 29 | # POSSIBILITY OF SUCH DAMAGE. 30 | # 31 | # THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, 32 | # INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, 33 | # FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE 34 | # IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE 35 | # NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR 36 | # MODIFICATIONS. 37 | # 38 | 39 | namespace eval generic { 40 | variable _types {} 41 | variable _typelist {} 42 | variable _codelist {} 43 | variable _actionlist {} 44 | variable _pressedkeys {} 45 | variable _action {} 46 | variable _common_drag_source_types {} 47 | variable _common_drop_target_types {} 48 | variable _drag_source {} 49 | variable _drop_target {} 50 | 51 | variable _last_mouse_root_x 0 52 | variable _last_mouse_root_y 0 53 | 54 | variable _tkdnd2platform 55 | variable _platform2tkdnd 56 | 57 | proc debug {msg} { 58 | puts $msg 59 | };# debug 60 | 61 | proc initialise { } { 62 | };# initialise 63 | 64 | proc initialise_platform_to_tkdnd_types { types } { 65 | variable _platform2tkdnd 66 | variable _tkdnd2platform 67 | set _platform2tkdnd [dict create {*}$types] 68 | set _tkdnd2platform [dict create] 69 | foreach type [dict keys $_platform2tkdnd] { 70 | dict lappend _tkdnd2platform [dict get $_platform2tkdnd $type] $type 71 | } 72 | };# initialise_platform_to_tkdnd_types 73 | 74 | proc initialise_tkdnd_to_platform_types { types } { 75 | variable _tkdnd2platform 76 | set _tkdnd2platform [dict create {*}$types] 77 | };# initialise_tkdnd_to_platform_types 78 | 79 | };# namespace generic 80 | 81 | # ---------------------------------------------------------------------------- 82 | # Command generic::HandleEnter 83 | # ---------------------------------------------------------------------------- 84 | proc generic::HandleEnter { drop_target drag_source typelist codelist 85 | actionlist pressedkeys } { 86 | variable _typelist; set _typelist $typelist 87 | variable _pressedkeys; set _pressedkeys $pressedkeys 88 | variable _action; set _action refuse_drop 89 | variable _common_drag_source_types; set _common_drag_source_types {} 90 | variable _common_drop_target_types; set _common_drop_target_types {} 91 | variable _actionlist 92 | variable _drag_source; set _drag_source $drag_source 93 | variable _drop_target; set _drop_target {} 94 | variable _actionlist; set _actionlist $actionlist 95 | variable _codelist set _codelist $codelist 96 | 97 | variable _last_mouse_root_x; set _last_mouse_root_x 0 98 | variable _last_mouse_root_y; set _last_mouse_root_y 0 99 | # debug "\n===============================================================" 100 | # debug "generic::HandleEnter: drop_target=$drop_target,\ 101 | # drag_source=$drag_source,\ 102 | # typelist=$typelist" 103 | # debug "generic::HandleEnter: ACTION: default" 104 | return default 105 | };# generic::HandleEnter 106 | 107 | # ---------------------------------------------------------------------------- 108 | # Command generic::HandlePosition 109 | # ---------------------------------------------------------------------------- 110 | proc generic::HandlePosition { drop_target drag_source pressedkeys 111 | rootX rootY { time 0 } } { 112 | variable _types 113 | variable _typelist 114 | variable _codelist 115 | variable _actionlist 116 | variable _pressedkeys 117 | variable _action 118 | variable _common_drag_source_types 119 | variable _common_drop_target_types 120 | variable _drag_source 121 | variable _drop_target 122 | 123 | variable _last_mouse_root_x; set _last_mouse_root_x $rootX 124 | variable _last_mouse_root_y; set _last_mouse_root_y $rootY 125 | 126 | # debug "generic::HandlePosition: drop_target=$drop_target,\ 127 | # _drop_target=$_drop_target, rootX=$rootX, rootY=$rootY" 128 | 129 | if {![info exists _drag_source] && ![string length $_drag_source]} { 130 | # debug "generic::HandlePosition: no or empty _drag_source:\ 131 | # return refuse_drop" 132 | return refuse_drop 133 | } 134 | 135 | if {$drag_source ne "" && $drag_source ne $_drag_source} { 136 | debug "generic position event from unexpected source: $_drag_source\ 137 | != $drag_source" 138 | return refuse_drop 139 | } 140 | 141 | set _pressedkeys $pressedkeys 142 | 143 | ## Does the new drop target support any of our new types? 144 | # foreach {common_drag_source_types common_drop_target_types} \ 145 | # [GetWindowCommonTypes $drop_target $_typelist] {break} 146 | foreach {drop_target common_drag_source_types common_drop_target_types} \ 147 | [FindWindowWithCommonTypes $drop_target $_typelist] {break} 148 | set data [GetDroppedData $time] 149 | 150 | # debug "\t($_drop_target) -> ($drop_target)" 151 | if {$drop_target != $_drop_target} { 152 | if {[string length $_drop_target]} { 153 | ## Call the <> event. 154 | # debug "\t<> on $_drop_target" 155 | set cmd [bind $_drop_target <>] 156 | if {[string length $cmd]} { 157 | set cmd [string map [list %W $_drop_target %X $rootX %Y $rootY \ 158 | %CST \{$_common_drag_source_types\} \ 159 | %CTT \{$_common_drop_target_types\} \ 160 | %CPT \{[lindex [platform_independent_type [lindex $_common_drag_source_types 0]] 0]\} \ 161 | %ST \{$_typelist\} %TT \{$_types\} \ 162 | %A \{$_action\} %a \{$_actionlist\} \ 163 | %b \{$_pressedkeys\} %m \{$_pressedkeys\} \ 164 | %D \{\} %e <> \ 165 | %L \{$_typelist\} %% % \ 166 | %t \{$_typelist\} %T \{[lindex $_common_drag_source_types 0]\} \ 167 | %c \{$_codelist\} %C \{[lindex $_codelist 0]\} \ 168 | ] $cmd] 169 | uplevel \#0 $cmd 170 | } 171 | } 172 | set _drop_target $drop_target 173 | set _action refuse_drop 174 | 175 | if {[llength $common_drag_source_types]} { 176 | set _action [lindex $_actionlist 0] 177 | set _common_drag_source_types $common_drag_source_types 178 | set _common_drop_target_types $common_drop_target_types 179 | ## Drop target supports at least one type. Send a <>. 180 | # puts "<> -> $drop_target" 181 | set cmd [bind $drop_target <>] 182 | if {[string length $cmd]} { 183 | focus $drop_target 184 | set cmd [string map [list %W $drop_target %X $rootX %Y $rootY \ 185 | %CST \{$_common_drag_source_types\} \ 186 | %CTT \{$_common_drop_target_types\} \ 187 | %CPT \{[lindex [platform_independent_type [lindex $_common_drag_source_types 0]] 0]\} \ 188 | %ST \{$_typelist\} %TT \{$_types\} \ 189 | %A $_action %a \{$_actionlist\} \ 190 | %b \{$_pressedkeys\} %m \{$_pressedkeys\} \ 191 | %D [list $data] %e <> \ 192 | %L \{$_typelist\} %% % \ 193 | %t \{$_typelist\} %T \{[lindex $_common_drag_source_types 0]\} \ 194 | %c \{$_codelist\} %C \{[lindex $_codelist 0]\} \ 195 | ] $cmd] 196 | set _action [uplevel \#0 $cmd] 197 | switch -exact -- $_action { 198 | copy - move - link - ask - private - refuse_drop - default {} 199 | default {set _action copy} 200 | } 201 | } 202 | } 203 | } 204 | 205 | set _drop_target {} 206 | if {[llength $common_drag_source_types]} { 207 | set _common_drag_source_types $common_drag_source_types 208 | set _common_drop_target_types $common_drop_target_types 209 | set _drop_target $drop_target 210 | ## Drop target supports at least one type. Send a <>. 211 | set cmd [bind $drop_target <>] 212 | if {[string length $cmd]} { 213 | set cmd [string map [list %W $drop_target %X $rootX %Y $rootY \ 214 | %CST \{$_common_drag_source_types\} \ 215 | %CTT \{$_common_drop_target_types\} \ 216 | %CPT \{[lindex [platform_independent_type [lindex $_common_drag_source_types 0]] 0]\} \ 217 | %ST \{$_typelist\} %TT \{$_types\} \ 218 | %A $_action %a \{$_actionlist\} \ 219 | %b \{$_pressedkeys\} %m \{$_pressedkeys\} \ 220 | %D [list $data] %e <> \ 221 | %L \{$_typelist\} %% % \ 222 | %t \{$_typelist\} %T \{[lindex $_common_drag_source_types 0]\} \ 223 | %c \{$_codelist\} %C \{[lindex $_codelist 0]\} \ 224 | ] $cmd] 225 | set _action [uplevel \#0 $cmd] 226 | } 227 | } 228 | # Return values: copy, move, link, ask, private, refuse_drop, default 229 | # debug "generic::HandlePosition: ACTION: $_action" 230 | switch -exact -- $_action { 231 | copy - move - link - ask - private - refuse_drop - default {} 232 | default {set _action copy} 233 | } 234 | return $_action 235 | };# generic::HandlePosition 236 | 237 | # ---------------------------------------------------------------------------- 238 | # Command generic::HandleLeave 239 | # ---------------------------------------------------------------------------- 240 | proc generic::HandleLeave { } { 241 | variable _types 242 | variable _typelist 243 | variable _codelist 244 | variable _actionlist 245 | variable _pressedkeys 246 | variable _action 247 | variable _common_drag_source_types 248 | variable _common_drop_target_types 249 | variable _drag_source 250 | variable _drop_target 251 | variable _last_mouse_root_x 252 | variable _last_mouse_root_y 253 | if {![info exists _drop_target]} {set _drop_target {}} 254 | # debug "generic::HandleLeave: _drop_target=$_drop_target" 255 | if {[info exists _drop_target] && [string length $_drop_target]} { 256 | set cmd [bind $_drop_target <>] 257 | if {[string length $cmd]} { 258 | set cmd [string map [list %W $_drop_target \ 259 | %X $_last_mouse_root_x %Y $_last_mouse_root_y \ 260 | %CST \{$_common_drag_source_types\} \ 261 | %CTT \{$_common_drop_target_types\} \ 262 | %CPT \{[lindex [platform_independent_type [lindex $_common_drag_source_types 0]] 0]\} \ 263 | %ST \{$_typelist\} %TT \{$_types\} \ 264 | %A \{$_action\} %a \{$_actionlist\} \ 265 | %b \{$_pressedkeys\} %m \{$_pressedkeys\} \ 266 | %D \{\} %e <> \ 267 | %L \{$_typelist\} %% % \ 268 | %t \{$_typelist\} %T \{[lindex $_common_drag_source_types 0]\} \ 269 | %c \{$_codelist\} %C \{[lindex $_codelist 0]\} \ 270 | ] $cmd] 271 | set _action [uplevel \#0 $cmd] 272 | } 273 | } 274 | foreach var {_types _typelist _actionlist _pressedkeys _action 275 | _common_drag_source_types _common_drop_target_types 276 | _drag_source _drop_target} { 277 | set $var {} 278 | } 279 | };# generic::HandleLeave 280 | 281 | # ---------------------------------------------------------------------------- 282 | # Command generic::HandleDrop 283 | # ---------------------------------------------------------------------------- 284 | proc generic::HandleDrop {drop_target drag_source pressedkeys rootX rootY time } { 285 | variable _types 286 | variable _typelist 287 | variable _codelist 288 | variable _actionlist 289 | variable _pressedkeys 290 | variable _action 291 | variable _common_drag_source_types 292 | variable _common_drop_target_types 293 | variable _drag_source 294 | variable _drop_target 295 | variable _last_mouse_root_x 296 | variable _last_mouse_root_y 297 | variable _last_mouse_root_x; set _last_mouse_root_x $rootX 298 | variable _last_mouse_root_y; set _last_mouse_root_y $rootY 299 | 300 | set _pressedkeys $pressedkeys 301 | 302 | # puts "generic::HandleDrop: $time" 303 | 304 | if {![info exists _drag_source] && ![string length $_drag_source]} { 305 | return refuse_drop 306 | } 307 | if {![info exists _drop_target] && ![string length $_drop_target]} { 308 | return refuse_drop 309 | } 310 | if {![llength $_common_drag_source_types]} {return refuse_drop} 311 | ## Get the dropped data. 312 | set data [GetDroppedData $time] 313 | ## Try to select the most specific <> event. 314 | foreach type [concat $_common_drag_source_types $_common_drop_target_types] { 315 | set type [platform_independent_type $type] 316 | set cmd [bind $_drop_target <>] 317 | if {[string length $cmd]} { 318 | set cmd [string map [list %W $_drop_target %X $rootX %Y $rootY \ 319 | %CST \{$_common_drag_source_types\} \ 320 | %CTT \{$_common_drop_target_types\} \ 321 | %CPT \{[lindex [platform_independent_type [lindex $_common_drag_source_types 0]] 0]\} \ 322 | %ST \{$_typelist\} %TT \{$_types\} \ 323 | %A $_action %a \{$_actionlist\} \ 324 | %b \{$_pressedkeys\} %m \{$_pressedkeys\} \ 325 | %D [list $data] %e <> \ 326 | %L \{$_typelist\} %% % \ 327 | %t \{$_typelist\} %T \{[lindex $_common_drag_source_types 0]\} \ 328 | %c \{$_codelist\} %C \{[lindex $_codelist 0]\} \ 329 | ] $cmd] 330 | set _action [uplevel \#0 $cmd] 331 | # Return values: copy, move, link, ask, private, refuse_drop 332 | switch -exact -- $_action { 333 | copy - move - link - ask - private - refuse_drop - default {} 334 | default {set _action copy} 335 | } 336 | return $_action 337 | } 338 | } 339 | set cmd [bind $_drop_target <>] 340 | if {[string length $cmd]} { 341 | set cmd [string map [list %W $_drop_target %X $rootX %Y $rootY \ 342 | %CST \{$_common_drag_source_types\} \ 343 | %CTT \{$_common_drop_target_types\} \ 344 | %CPT \{[lindex [platform_independent_type [lindex $_common_drag_source_types 0]] 0]\} \ 345 | %ST \{$_typelist\} %TT \{$_types\} \ 346 | %A $_action %a \{$_actionlist\} \ 347 | %b \{$_pressedkeys\} %m \{$_pressedkeys\} \ 348 | %D [list $data] %e <> \ 349 | %L \{$_typelist\} %% % \ 350 | %t \{$_typelist\} %T \{[lindex $_common_drag_source_types 0]\} \ 351 | %c \{$_codelist\} %C \{[lindex $_codelist 0]\} \ 352 | ] $cmd] 353 | set _action [uplevel \#0 $cmd] 354 | } 355 | # Return values: copy, move, link, ask, private, refuse_drop 356 | switch -exact -- $_action { 357 | copy - move - link - ask - private - refuse_drop - default {} 358 | default {set _action copy} 359 | } 360 | return $_action 361 | };# generic::HandleDrop 362 | 363 | # ---------------------------------------------------------------------------- 364 | # Command generic::GetWindowCommonTypes 365 | # ---------------------------------------------------------------------------- 366 | proc generic::GetWindowCommonTypes { win typelist } { 367 | set types [bind $win <>] 368 | # debug ">> Accepted types: $win $_types" 369 | set common_drag_source_types {} 370 | set common_drop_target_types {} 371 | if {[llength $types]} { 372 | ## Examine the drop target types, to find at least one match with the drag 373 | ## source types... 374 | set supported_types [supported_types $typelist] 375 | foreach type $types { 376 | foreach matched [lsearch -glob -all -inline $supported_types $type] { 377 | ## Drop target supports this type. 378 | lappend common_drag_source_types $matched 379 | lappend common_drop_target_types $type 380 | } 381 | } 382 | } 383 | list $common_drag_source_types $common_drop_target_types 384 | };# generic::GetWindowCommonTypes 385 | 386 | # ---------------------------------------------------------------------------- 387 | # Command generic::FindWindowWithCommonTypes 388 | # ---------------------------------------------------------------------------- 389 | proc generic::FindWindowWithCommonTypes { win typelist } { 390 | set toplevel [winfo toplevel $win] 391 | while {![string equal $win $toplevel]} { 392 | foreach {common_drag_source_types common_drop_target_types} \ 393 | [GetWindowCommonTypes $win $typelist] {break} 394 | if {[llength $common_drag_source_types]} { 395 | return [list $win $common_drag_source_types $common_drop_target_types] 396 | } 397 | set win [winfo parent $win] 398 | } 399 | ## We have reached the toplevel, which may be also a target (SF Bug #30) 400 | foreach {common_drag_source_types common_drop_target_types} \ 401 | [GetWindowCommonTypes $win $typelist] {break} 402 | if {[llength $common_drag_source_types]} { 403 | return [list $win $common_drag_source_types $common_drop_target_types] 404 | } 405 | return { {} {} {} } 406 | };# generic::FindWindowWithCommonTypes 407 | 408 | # ---------------------------------------------------------------------------- 409 | # Command generic::GetDroppedData 410 | # ---------------------------------------------------------------------------- 411 | proc generic::GetDroppedData { time } { 412 | variable _dropped_data 413 | return $_dropped_data 414 | };# generic::GetDroppedData 415 | 416 | # ---------------------------------------------------------------------------- 417 | # Command generic::SetDroppedData 418 | # ---------------------------------------------------------------------------- 419 | proc generic::SetDroppedData { data } { 420 | variable _dropped_data 421 | set _dropped_data $data 422 | };# generic::SetDroppedData 423 | 424 | # ---------------------------------------------------------------------------- 425 | # Command generic::GetDragSource 426 | # ---------------------------------------------------------------------------- 427 | proc generic::GetDragSource { } { 428 | variable _drag_source 429 | return $_drag_source 430 | };# generic::GetDragSource 431 | 432 | # ---------------------------------------------------------------------------- 433 | # Command generic::GetDropTarget 434 | # ---------------------------------------------------------------------------- 435 | proc generic::GetDropTarget { } { 436 | variable _drop_target 437 | return $_drop_target 438 | };# generic::GetDropTarget 439 | 440 | # ---------------------------------------------------------------------------- 441 | # Command generic::GetDragSourceCommonTypes 442 | # ---------------------------------------------------------------------------- 443 | proc generic::GetDragSourceCommonTypes { } { 444 | variable _common_drag_source_types 445 | return $_common_drag_source_types 446 | };# generic::GetDragSourceCommonTypes 447 | 448 | # ---------------------------------------------------------------------------- 449 | # Command generic::GetDropTargetCommonTypes 450 | # ---------------------------------------------------------------------------- 451 | proc generic::GetDropTargetCommonTypes { } { 452 | variable _common_drag_source_types 453 | return $_common_drag_source_types 454 | };# generic::GetDropTargetCommonTypes 455 | 456 | # ---------------------------------------------------------------------------- 457 | # Command generic::platform_specific_types 458 | # ---------------------------------------------------------------------------- 459 | proc generic::platform_specific_types { types } { 460 | set new_types {} 461 | foreach type $types { 462 | set new_types [concat $new_types [platform_specific_type $type]] 463 | } 464 | return $new_types 465 | }; # generic::platform_specific_types 466 | 467 | # ---------------------------------------------------------------------------- 468 | # Command generic::platform_specific_type 469 | # ---------------------------------------------------------------------------- 470 | proc generic::platform_specific_type { type } { 471 | variable _tkdnd2platform 472 | if {[dict exists $_tkdnd2platform $type]} { 473 | return [dict get $_tkdnd2platform $type] 474 | } 475 | list $type 476 | }; # generic::platform_specific_type 477 | 478 | # ---------------------------------------------------------------------------- 479 | # Command tkdnd::platform_independent_types 480 | # ---------------------------------------------------------------------------- 481 | proc ::tkdnd::platform_independent_types { types } { 482 | set new_types {} 483 | foreach type $types { 484 | set new_types [concat $new_types [platform_independent_type $type]] 485 | } 486 | return $new_types 487 | }; # tkdnd::platform_independent_types 488 | 489 | # ---------------------------------------------------------------------------- 490 | # Command generic::platform_independent_type 491 | # ---------------------------------------------------------------------------- 492 | proc generic::platform_independent_type { type } { 493 | variable _platform2tkdnd 494 | if {[dict exists $_platform2tkdnd $type]} { 495 | return [dict get $_platform2tkdnd $type] 496 | } 497 | return $type 498 | }; # generic::platform_independent_type 499 | 500 | # ---------------------------------------------------------------------------- 501 | # Command generic::supported_types 502 | # ---------------------------------------------------------------------------- 503 | proc generic::supported_types { types } { 504 | set new_types {} 505 | foreach type $types { 506 | if {[supported_type $type]} {lappend new_types $type} 507 | } 508 | return $new_types 509 | }; # generic::supported_types 510 | 511 | # ---------------------------------------------------------------------------- 512 | # Command generic::supported_type 513 | # ---------------------------------------------------------------------------- 514 | proc generic::supported_type { type } { 515 | variable _platform2tkdnd 516 | if {[dict exists $_platform2tkdnd $type]} { 517 | return 1 518 | } 519 | return 0 520 | }; # generic::supported_type 521 | -------------------------------------------------------------------------------- /tkinterDnD/windows/tkdnd_generic.tcl: -------------------------------------------------------------------------------- 1 | # 2 | # tkdnd_generic.tcl -- 3 | # 4 | # This file implements some utility procedures that are used by the TkDND 5 | # package. 6 | # 7 | # This software is copyrighted by: 8 | # George Petasis, National Centre for Scientific Research "Demokritos", 9 | # Aghia Paraskevi, Athens, Greece. 10 | # e-mail: petasis@iit.demokritos.gr 11 | # 12 | # The following terms apply to all files associated 13 | # with the software unless explicitly disclaimed in individual files. 14 | # 15 | # The authors hereby grant permission to use, copy, modify, distribute, 16 | # and license this software and its documentation for any purpose, provided 17 | # that existing copyright notices are retained in all copies and that this 18 | # notice is included verbatim in any distributions. No written agreement, 19 | # license, or royalty fee is required for any of the authorized uses. 20 | # Modifications to this software may be copyrighted by their authors 21 | # and need not follow the licensing terms described here, provided that 22 | # the new terms are clearly indicated on the first page of each file where 23 | # they apply. 24 | # 25 | # IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY 26 | # FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES 27 | # ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY 28 | # DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE 29 | # POSSIBILITY OF SUCH DAMAGE. 30 | # 31 | # THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, 32 | # INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, 33 | # FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE 34 | # IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE 35 | # NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR 36 | # MODIFICATIONS. 37 | # 38 | 39 | namespace eval generic { 40 | variable _types {} 41 | variable _typelist {} 42 | variable _codelist {} 43 | variable _actionlist {} 44 | variable _pressedkeys {} 45 | variable _action {} 46 | variable _common_drag_source_types {} 47 | variable _common_drop_target_types {} 48 | variable _drag_source {} 49 | variable _drop_target {} 50 | 51 | variable _last_mouse_root_x 0 52 | variable _last_mouse_root_y 0 53 | 54 | variable _tkdnd2platform 55 | variable _platform2tkdnd 56 | 57 | proc debug {msg} { 58 | puts $msg 59 | };# debug 60 | 61 | proc initialise { } { 62 | };# initialise 63 | 64 | proc initialise_platform_to_tkdnd_types { types } { 65 | variable _platform2tkdnd 66 | variable _tkdnd2platform 67 | set _platform2tkdnd [dict create {*}$types] 68 | set _tkdnd2platform [dict create] 69 | foreach type [dict keys $_platform2tkdnd] { 70 | dict lappend _tkdnd2platform [dict get $_platform2tkdnd $type] $type 71 | } 72 | };# initialise_platform_to_tkdnd_types 73 | 74 | proc initialise_tkdnd_to_platform_types { types } { 75 | variable _tkdnd2platform 76 | set _tkdnd2platform [dict create {*}$types] 77 | };# initialise_tkdnd_to_platform_types 78 | 79 | };# namespace generic 80 | 81 | # ---------------------------------------------------------------------------- 82 | # Command generic::HandleEnter 83 | # ---------------------------------------------------------------------------- 84 | proc generic::HandleEnter { drop_target drag_source typelist codelist 85 | actionlist pressedkeys } { 86 | variable _typelist; set _typelist $typelist 87 | variable _pressedkeys; set _pressedkeys $pressedkeys 88 | variable _action; set _action refuse_drop 89 | variable _common_drag_source_types; set _common_drag_source_types {} 90 | variable _common_drop_target_types; set _common_drop_target_types {} 91 | variable _actionlist 92 | variable _drag_source; set _drag_source $drag_source 93 | variable _drop_target; set _drop_target {} 94 | variable _actionlist; set _actionlist $actionlist 95 | variable _codelist set _codelist $codelist 96 | 97 | variable _last_mouse_root_x; set _last_mouse_root_x 0 98 | variable _last_mouse_root_y; set _last_mouse_root_y 0 99 | # debug "\n===============================================================" 100 | # debug "generic::HandleEnter: drop_target=$drop_target,\ 101 | # drag_source=$drag_source,\ 102 | # typelist=$typelist" 103 | # debug "generic::HandleEnter: ACTION: default" 104 | return default 105 | };# generic::HandleEnter 106 | 107 | # ---------------------------------------------------------------------------- 108 | # Command generic::HandlePosition 109 | # ---------------------------------------------------------------------------- 110 | proc generic::HandlePosition { drop_target drag_source pressedkeys 111 | rootX rootY { time 0 } } { 112 | variable _types 113 | variable _typelist 114 | variable _codelist 115 | variable _actionlist 116 | variable _pressedkeys 117 | variable _action 118 | variable _common_drag_source_types 119 | variable _common_drop_target_types 120 | variable _drag_source 121 | variable _drop_target 122 | 123 | variable _last_mouse_root_x; set _last_mouse_root_x $rootX 124 | variable _last_mouse_root_y; set _last_mouse_root_y $rootY 125 | 126 | # debug "generic::HandlePosition: drop_target=$drop_target,\ 127 | # _drop_target=$_drop_target, rootX=$rootX, rootY=$rootY" 128 | 129 | if {![info exists _drag_source] && ![string length $_drag_source]} { 130 | # debug "generic::HandlePosition: no or empty _drag_source:\ 131 | # return refuse_drop" 132 | return refuse_drop 133 | } 134 | 135 | if {$drag_source ne "" && $drag_source ne $_drag_source} { 136 | debug "generic position event from unexpected source: $_drag_source\ 137 | != $drag_source" 138 | return refuse_drop 139 | } 140 | 141 | set _pressedkeys $pressedkeys 142 | 143 | ## Does the new drop target support any of our new types? 144 | # foreach {common_drag_source_types common_drop_target_types} \ 145 | # [GetWindowCommonTypes $drop_target $_typelist] {break} 146 | foreach {drop_target common_drag_source_types common_drop_target_types} \ 147 | [FindWindowWithCommonTypes $drop_target $_typelist] {break} 148 | set data [GetDroppedData $time] 149 | 150 | # debug "\t($_drop_target) -> ($drop_target)" 151 | if {$drop_target != $_drop_target} { 152 | if {[string length $_drop_target]} { 153 | ## Call the <> event. 154 | # debug "\t<> on $_drop_target" 155 | set cmd [bind $_drop_target <>] 156 | if {[string length $cmd]} { 157 | set cmd [string map [list %W $_drop_target %X $rootX %Y $rootY \ 158 | %CST \{$_common_drag_source_types\} \ 159 | %CTT \{$_common_drop_target_types\} \ 160 | %CPT \{[lindex [platform_independent_type [lindex $_common_drag_source_types 0]] 0]\} \ 161 | %ST \{$_typelist\} %TT \{$_types\} \ 162 | %A \{$_action\} %a \{$_actionlist\} \ 163 | %b \{$_pressedkeys\} %m \{$_pressedkeys\} \ 164 | %D \{\} %e <> \ 165 | %L \{$_typelist\} %% % \ 166 | %t \{$_typelist\} %T \{[lindex $_common_drag_source_types 0]\} \ 167 | %c \{$_codelist\} %C \{[lindex $_codelist 0]\} \ 168 | ] $cmd] 169 | uplevel \#0 $cmd 170 | } 171 | } 172 | set _drop_target $drop_target 173 | set _action refuse_drop 174 | 175 | if {[llength $common_drag_source_types]} { 176 | set _action [lindex $_actionlist 0] 177 | set _common_drag_source_types $common_drag_source_types 178 | set _common_drop_target_types $common_drop_target_types 179 | ## Drop target supports at least one type. Send a <>. 180 | # puts "<> -> $drop_target" 181 | set cmd [bind $drop_target <>] 182 | if {[string length $cmd]} { 183 | focus $drop_target 184 | set cmd [string map [list %W $drop_target %X $rootX %Y $rootY \ 185 | %CST \{$_common_drag_source_types\} \ 186 | %CTT \{$_common_drop_target_types\} \ 187 | %CPT \{[lindex [platform_independent_type [lindex $_common_drag_source_types 0]] 0]\} \ 188 | %ST \{$_typelist\} %TT \{$_types\} \ 189 | %A $_action %a \{$_actionlist\} \ 190 | %b \{$_pressedkeys\} %m \{$_pressedkeys\} \ 191 | %D [list $data] %e <> \ 192 | %L \{$_typelist\} %% % \ 193 | %t \{$_typelist\} %T \{[lindex $_common_drag_source_types 0]\} \ 194 | %c \{$_codelist\} %C \{[lindex $_codelist 0]\} \ 195 | ] $cmd] 196 | set _action [uplevel \#0 $cmd] 197 | switch -exact -- $_action { 198 | copy - move - link - ask - private - refuse_drop - default {} 199 | default {set _action copy} 200 | } 201 | } 202 | } 203 | } 204 | 205 | set _drop_target {} 206 | if {[llength $common_drag_source_types]} { 207 | set _common_drag_source_types $common_drag_source_types 208 | set _common_drop_target_types $common_drop_target_types 209 | set _drop_target $drop_target 210 | ## Drop target supports at least one type. Send a <>. 211 | set cmd [bind $drop_target <>] 212 | if {[string length $cmd]} { 213 | set cmd [string map [list %W $drop_target %X $rootX %Y $rootY \ 214 | %CST \{$_common_drag_source_types\} \ 215 | %CTT \{$_common_drop_target_types\} \ 216 | %CPT \{[lindex [platform_independent_type [lindex $_common_drag_source_types 0]] 0]\} \ 217 | %ST \{$_typelist\} %TT \{$_types\} \ 218 | %A $_action %a \{$_actionlist\} \ 219 | %b \{$_pressedkeys\} %m \{$_pressedkeys\} \ 220 | %D [list $data] %e <> \ 221 | %L \{$_typelist\} %% % \ 222 | %t \{$_typelist\} %T \{[lindex $_common_drag_source_types 0]\} \ 223 | %c \{$_codelist\} %C \{[lindex $_codelist 0]\} \ 224 | ] $cmd] 225 | set _action [uplevel \#0 $cmd] 226 | } 227 | } 228 | # Return values: copy, move, link, ask, private, refuse_drop, default 229 | # debug "generic::HandlePosition: ACTION: $_action" 230 | switch -exact -- $_action { 231 | copy - move - link - ask - private - refuse_drop - default {} 232 | default {set _action copy} 233 | } 234 | return $_action 235 | };# generic::HandlePosition 236 | 237 | # ---------------------------------------------------------------------------- 238 | # Command generic::HandleLeave 239 | # ---------------------------------------------------------------------------- 240 | proc generic::HandleLeave { } { 241 | variable _types 242 | variable _typelist 243 | variable _codelist 244 | variable _actionlist 245 | variable _pressedkeys 246 | variable _action 247 | variable _common_drag_source_types 248 | variable _common_drop_target_types 249 | variable _drag_source 250 | variable _drop_target 251 | variable _last_mouse_root_x 252 | variable _last_mouse_root_y 253 | if {![info exists _drop_target]} {set _drop_target {}} 254 | # debug "generic::HandleLeave: _drop_target=$_drop_target" 255 | if {[info exists _drop_target] && [string length $_drop_target]} { 256 | set cmd [bind $_drop_target <>] 257 | if {[string length $cmd]} { 258 | set cmd [string map [list %W $_drop_target \ 259 | %X $_last_mouse_root_x %Y $_last_mouse_root_y \ 260 | %CST \{$_common_drag_source_types\} \ 261 | %CTT \{$_common_drop_target_types\} \ 262 | %CPT \{[lindex [platform_independent_type [lindex $_common_drag_source_types 0]] 0]\} \ 263 | %ST \{$_typelist\} %TT \{$_types\} \ 264 | %A \{$_action\} %a \{$_actionlist\} \ 265 | %b \{$_pressedkeys\} %m \{$_pressedkeys\} \ 266 | %D \{\} %e <> \ 267 | %L \{$_typelist\} %% % \ 268 | %t \{$_typelist\} %T \{[lindex $_common_drag_source_types 0]\} \ 269 | %c \{$_codelist\} %C \{[lindex $_codelist 0]\} \ 270 | ] $cmd] 271 | set _action [uplevel \#0 $cmd] 272 | } 273 | } 274 | foreach var {_types _typelist _actionlist _pressedkeys _action 275 | _common_drag_source_types _common_drop_target_types 276 | _drag_source _drop_target} { 277 | set $var {} 278 | } 279 | };# generic::HandleLeave 280 | 281 | # ---------------------------------------------------------------------------- 282 | # Command generic::HandleDrop 283 | # ---------------------------------------------------------------------------- 284 | proc generic::HandleDrop {drop_target drag_source pressedkeys rootX rootY time } { 285 | variable _types 286 | variable _typelist 287 | variable _codelist 288 | variable _actionlist 289 | variable _pressedkeys 290 | variable _action 291 | variable _common_drag_source_types 292 | variable _common_drop_target_types 293 | variable _drag_source 294 | variable _drop_target 295 | variable _last_mouse_root_x 296 | variable _last_mouse_root_y 297 | variable _last_mouse_root_x; set _last_mouse_root_x $rootX 298 | variable _last_mouse_root_y; set _last_mouse_root_y $rootY 299 | 300 | set _pressedkeys $pressedkeys 301 | 302 | # puts "generic::HandleDrop: $time" 303 | 304 | if {![info exists _drag_source] && ![string length $_drag_source]} { 305 | return refuse_drop 306 | } 307 | if {![info exists _drop_target] && ![string length $_drop_target]} { 308 | return refuse_drop 309 | } 310 | if {![llength $_common_drag_source_types]} {return refuse_drop} 311 | ## Get the dropped data. 312 | set data [GetDroppedData $time] 313 | ## Try to select the most specific <> event. 314 | foreach type [concat $_common_drag_source_types $_common_drop_target_types] { 315 | set type [platform_independent_type $type] 316 | set cmd [bind $_drop_target <>] 317 | if {[string length $cmd]} { 318 | set cmd [string map [list %W $_drop_target %X $rootX %Y $rootY \ 319 | %CST \{$_common_drag_source_types\} \ 320 | %CTT \{$_common_drop_target_types\} \ 321 | %CPT \{[lindex [platform_independent_type [lindex $_common_drag_source_types 0]] 0]\} \ 322 | %ST \{$_typelist\} %TT \{$_types\} \ 323 | %A $_action %a \{$_actionlist\} \ 324 | %b \{$_pressedkeys\} %m \{$_pressedkeys\} \ 325 | %D [list $data] %e <> \ 326 | %L \{$_typelist\} %% % \ 327 | %t \{$_typelist\} %T \{[lindex $_common_drag_source_types 0]\} \ 328 | %c \{$_codelist\} %C \{[lindex $_codelist 0]\} \ 329 | ] $cmd] 330 | set _action [uplevel \#0 $cmd] 331 | # Return values: copy, move, link, ask, private, refuse_drop 332 | switch -exact -- $_action { 333 | copy - move - link - ask - private - refuse_drop - default {} 334 | default {set _action copy} 335 | } 336 | return $_action 337 | } 338 | } 339 | set cmd [bind $_drop_target <>] 340 | if {[string length $cmd]} { 341 | set cmd [string map [list %W $_drop_target %X $rootX %Y $rootY \ 342 | %CST \{$_common_drag_source_types\} \ 343 | %CTT \{$_common_drop_target_types\} \ 344 | %CPT \{[lindex [platform_independent_type [lindex $_common_drag_source_types 0]] 0]\} \ 345 | %ST \{$_typelist\} %TT \{$_types\} \ 346 | %A $_action %a \{$_actionlist\} \ 347 | %b \{$_pressedkeys\} %m \{$_pressedkeys\} \ 348 | %D [list $data] %e <> \ 349 | %L \{$_typelist\} %% % \ 350 | %t \{$_typelist\} %T \{[lindex $_common_drag_source_types 0]\} \ 351 | %c \{$_codelist\} %C \{[lindex $_codelist 0]\} \ 352 | ] $cmd] 353 | set _action [uplevel \#0 $cmd] 354 | } 355 | # Return values: copy, move, link, ask, private, refuse_drop 356 | switch -exact -- $_action { 357 | copy - move - link - ask - private - refuse_drop - default {} 358 | default {set _action copy} 359 | } 360 | return $_action 361 | };# generic::HandleDrop 362 | 363 | # ---------------------------------------------------------------------------- 364 | # Command generic::GetWindowCommonTypes 365 | # ---------------------------------------------------------------------------- 366 | proc generic::GetWindowCommonTypes { win typelist } { 367 | set types [bind $win <>] 368 | # debug ">> Accepted types: $win $_types" 369 | set common_drag_source_types {} 370 | set common_drop_target_types {} 371 | if {[llength $types]} { 372 | ## Examine the drop target types, to find at least one match with the drag 373 | ## source types... 374 | set supported_types [supported_types $typelist] 375 | foreach type $types { 376 | foreach matched [lsearch -glob -all -inline $supported_types $type] { 377 | ## Drop target supports this type. 378 | lappend common_drag_source_types $matched 379 | lappend common_drop_target_types $type 380 | } 381 | } 382 | } 383 | list $common_drag_source_types $common_drop_target_types 384 | };# generic::GetWindowCommonTypes 385 | 386 | # ---------------------------------------------------------------------------- 387 | # Command generic::FindWindowWithCommonTypes 388 | # ---------------------------------------------------------------------------- 389 | proc generic::FindWindowWithCommonTypes { win typelist } { 390 | set toplevel [winfo toplevel $win] 391 | while {![string equal $win $toplevel]} { 392 | foreach {common_drag_source_types common_drop_target_types} \ 393 | [GetWindowCommonTypes $win $typelist] {break} 394 | if {[llength $common_drag_source_types]} { 395 | return [list $win $common_drag_source_types $common_drop_target_types] 396 | } 397 | set win [winfo parent $win] 398 | } 399 | ## We have reached the toplevel, which may be also a target (SF Bug #30) 400 | foreach {common_drag_source_types common_drop_target_types} \ 401 | [GetWindowCommonTypes $win $typelist] {break} 402 | if {[llength $common_drag_source_types]} { 403 | return [list $win $common_drag_source_types $common_drop_target_types] 404 | } 405 | return { {} {} {} } 406 | };# generic::FindWindowWithCommonTypes 407 | 408 | # ---------------------------------------------------------------------------- 409 | # Command generic::GetDroppedData 410 | # ---------------------------------------------------------------------------- 411 | proc generic::GetDroppedData { time } { 412 | variable _dropped_data 413 | return $_dropped_data 414 | };# generic::GetDroppedData 415 | 416 | # ---------------------------------------------------------------------------- 417 | # Command generic::SetDroppedData 418 | # ---------------------------------------------------------------------------- 419 | proc generic::SetDroppedData { data } { 420 | variable _dropped_data 421 | set _dropped_data $data 422 | };# generic::SetDroppedData 423 | 424 | # ---------------------------------------------------------------------------- 425 | # Command generic::GetDragSource 426 | # ---------------------------------------------------------------------------- 427 | proc generic::GetDragSource { } { 428 | variable _drag_source 429 | return $_drag_source 430 | };# generic::GetDragSource 431 | 432 | # ---------------------------------------------------------------------------- 433 | # Command generic::GetDropTarget 434 | # ---------------------------------------------------------------------------- 435 | proc generic::GetDropTarget { } { 436 | variable _drop_target 437 | return $_drop_target 438 | };# generic::GetDropTarget 439 | 440 | # ---------------------------------------------------------------------------- 441 | # Command generic::GetDragSourceCommonTypes 442 | # ---------------------------------------------------------------------------- 443 | proc generic::GetDragSourceCommonTypes { } { 444 | variable _common_drag_source_types 445 | return $_common_drag_source_types 446 | };# generic::GetDragSourceCommonTypes 447 | 448 | # ---------------------------------------------------------------------------- 449 | # Command generic::GetDropTargetCommonTypes 450 | # ---------------------------------------------------------------------------- 451 | proc generic::GetDropTargetCommonTypes { } { 452 | variable _common_drag_source_types 453 | return $_common_drag_source_types 454 | };# generic::GetDropTargetCommonTypes 455 | 456 | # ---------------------------------------------------------------------------- 457 | # Command generic::platform_specific_types 458 | # ---------------------------------------------------------------------------- 459 | proc generic::platform_specific_types { types } { 460 | set new_types {} 461 | foreach type $types { 462 | set new_types [concat $new_types [platform_specific_type $type]] 463 | } 464 | return $new_types 465 | }; # generic::platform_specific_types 466 | 467 | # ---------------------------------------------------------------------------- 468 | # Command generic::platform_specific_type 469 | # ---------------------------------------------------------------------------- 470 | proc generic::platform_specific_type { type } { 471 | variable _tkdnd2platform 472 | if {[dict exists $_tkdnd2platform $type]} { 473 | return [dict get $_tkdnd2platform $type] 474 | } 475 | list $type 476 | }; # generic::platform_specific_type 477 | 478 | # ---------------------------------------------------------------------------- 479 | # Command tkdnd::platform_independent_types 480 | # ---------------------------------------------------------------------------- 481 | proc ::tkdnd::platform_independent_types { types } { 482 | set new_types {} 483 | foreach type $types { 484 | set new_types [concat $new_types [platform_independent_type $type]] 485 | } 486 | return $new_types 487 | }; # tkdnd::platform_independent_types 488 | 489 | # ---------------------------------------------------------------------------- 490 | # Command generic::platform_independent_type 491 | # ---------------------------------------------------------------------------- 492 | proc generic::platform_independent_type { type } { 493 | variable _platform2tkdnd 494 | if {[dict exists $_platform2tkdnd $type]} { 495 | return [dict get $_platform2tkdnd $type] 496 | } 497 | return $type 498 | }; # generic::platform_independent_type 499 | 500 | # ---------------------------------------------------------------------------- 501 | # Command generic::supported_types 502 | # ---------------------------------------------------------------------------- 503 | proc generic::supported_types { types } { 504 | set new_types {} 505 | foreach type $types { 506 | if {[supported_type $type]} {lappend new_types $type} 507 | } 508 | return $new_types 509 | }; # generic::supported_types 510 | 511 | # ---------------------------------------------------------------------------- 512 | # Command generic::supported_type 513 | # ---------------------------------------------------------------------------- 514 | proc generic::supported_type { type } { 515 | variable _platform2tkdnd 516 | if {[dict exists $_platform2tkdnd $type]} { 517 | return 1 518 | } 519 | return 0 520 | }; # generic::supported_type 521 | --------------------------------------------------------------------------------