diff --git a/.gitattribute b/.gitattribute new file mode 100644 index 0000000..b4471b2 --- /dev/null +++ b/.gitattribute @@ -0,0 +1 @@ +modules/* linguist-vendored \ No newline at end of file diff --git a/PyInstallerGUI.py b/PyInstallerGUI.py new file mode 100644 index 0000000..b01ddbd --- /dev/null +++ b/PyInstallerGUI.py @@ -0,0 +1,461 @@ +__author__ = 'Victor Santiago' +__copyright__ = 'Copyright (C) 2014, Victor Santiago' +__credits__ = 'Victor Santiago' +__license__ = 'GNU GPL v2.0' +__version__ = '1.0.0.0' +__maintainer__ = 'Victor Santiago' +__email__ = 'vsantiago@vs113dev.com' +__status__ = 'Beta' + +# PyInstaller GUI Dependencies: +# The Libraries below are required for PyInstaller GUI to run. + # pywin32: http://sourceforge.net/projects/pywin32/ + # Pillow(PIL): https://pypi.python.org/pypi/Pillow + +# The library below is already part of PyInstaller GUI but I got it from the link below. +# http://stackoverflow.com/questions/14267900/python-drag-and-drop-explorer-files-to-tkinter-entry-widget + +import Tkinter as tk +import ttk, win32api, urllib2, tkFileDialog, os, webbrowser, win32clipboard, win32con +import tkFont as font +import tkMessageBox as messagebox +try: + # For Pillow: This is the new version of PIL. + from PIL import Image, ImageTk, ImageOps +except ImportError: + try: + # For PIL: This is the old version of PIL I recommend that you use Pillow. + import Image, ImageTk, ImageOps + except ImportError as ex: + print 'Please download Pillow or PIL' + print ex +os.environ['TKDND_LIBRARY'] = 'modules/tkdnd2.6/' +from modules.untested_tkdnd_wrapper import TkDND + +COLOR='#E0E0DA' + +class MainApp: + def __init__(self, parent, dnd): + + def CheckUpdate(): + try: + data = urllib2.urlopen('http://vs113dev.com/projects/pyinstallergui/version.txt').read() + if str(data) > str(__version__): + messagebox.showinfo('Software Update','Update Available!') + else: + messagebox.showinfo('Software Update','No Updates are Available.') + except Exception as ex: + print ex + messagebox.showinfo('Software Update','Unable to Check for Update ') + + def AboutMe(): + CallDisplayAboutMe = DisplayAboutMe(parent) + + def CallSetVersion(): + CallSetVersionFile = SetVersionFile(parent, dnd) + + def CallGrabVersion(): + CallGrabVersionFile = GrabVersionFile(parent, dnd) + + def OpenWebsite(): + link = 'http://www.pyinstaller.org/export/v2.0/project/doc/Manual.html' + webbrowser.open_new_tab(link) + + def DownloadPyInstaller(): + link = 'https://github.com/pyinstaller/pyinstaller' + webbrowser.open_new_tab(link) + + def DownloadUPX(): + link = 'http://upx.sourceforge.net' + webbrowser.open_new_tab(link) + + def CommandInfo(string): + if string == 'onefile': + messagebox.showinfo('Info','Create a single file deployment') + elif string == 'name': + messagebox.showinfo('Info','Optional name to assign to the project (from which the spec file name is generated). If omitted, the basename of the (first) script is used.') + elif string == 'subsystem': + messagebox.showinfo('Info','Use a console subsystem executable (default) or use a windowed subsystem executable, which on Windows does not open the console when the program is launched') + elif string == 'noupx': + messagebox.showinfo('Info','Do not use UPX even if available (works differently between Windows and *nix)') + elif string == 'versionfile': + messagebox.showinfo('Info','Add a version resource from FILE to the exe') + elif string == 'icon': + messagebox.showinfo('Info','If FILE is an .ico file, add the icon to the final executable.') + + def GetDirectoryString(string): + if string == 'versionfile': + filename = tkFileDialog.askopenfilename(filetypes = [('Version File', '*.txt')]) + entry2.delete(0, tk.END) + if filename == '': + pass + else: + entry2.insert(tk.END, str(filename)) + elif string == 'script': + filename = tkFileDialog.askopenfilename(filetypes = [('Python Script', '*.py | *.pyw')]) + entry3.delete(0, tk.END) + if filename == '': + pass + else: + entry3.insert(tk.END, str(filename)) + elif string == 'icon': + filename = tkFileDialog.askopenfilename(filetypes = [('Icon', '*.ico')]) + entry4.delete(0, tk.END) + if filename == '': + pass + else: + entry4.insert(tk.END, str(filename)) + + BuildCommand('') + + def BuildCommand(event): + string = 'PyInstaller\\pyinstaller.py'+self.ComboBoxVar1.get()+self.CheckBoxVar2.get()+self.CheckBoxVar3.get() + if self.CheckBoxVar1.get() == '' or entry1.get().strip() == '': + pass + else: + string += self.CheckBoxVar1.get()+'="'+entry1.get().strip()+'"' + if self.CheckBoxVar4.get() == '' or entry2.get().strip() == '': + pass + else: + string += self.CheckBoxVar4.get()+'="'+entry2.get().strip()+'"' + if entry3.get().strip() == '': + pass + else: + string += ' "'+entry3.get()+'"' + if self.CheckBoxVar5.get() == '' or entry4.get().strip() == '': + pass + else: + string += self.CheckBoxVar5.get()+' "'+entry4.get()+'"' + + entry5.delete(0, tk.END) + entry5.insert(tk.END, string) + + def RunBuild(): + if entry3.get().strip() == '': + pass + else: + os.system(str(entry5.get().strip())) + self.ComboBoxVar1.set(' --console') + self.CheckBoxVar1.set('') + entry1.delete(0, tk.END) + self.CheckBoxVar2.set('') + self.CheckBoxVar3.set(' --noupx') + self.CheckBoxVar4.set('') + entry2.delete(0, tk.END) + entry3.delete(0, tk.END) + self.CheckBoxVar5.set('') + entry4.delete(0, tk.END) + BuildCommand('') + + def dnd_handle(event): + event.widget.delete(0, tk.END) + event.widget.insert(tk.END, event.data.strip('{').strip('}')) + BuildCommand('') + + def CopyToClipboard(): + win32clipboard.OpenClipboard() + win32clipboard.EmptyClipboard() + win32clipboard.SetClipboardData(win32con.CF_TEXT, entry5.get().strip()) + win32clipboard.CloseClipboard() + + menubar = tk.Menu(parent) + filemenu = tk.Menu(menubar, tearoff=0) + filemenu.add_command(label='Exit', command=parent.destroy) + menubar.add_cascade(label='File', menu=filemenu) + + toolsmenu = tk.Menu(menubar, tearoff=0) + toolsmenu.add_command(label='SetVersion', command=CallSetVersion) + toolsmenu.add_command(label='GrabVersion', command=CallGrabVersion) + menubar.add_cascade(label='Tools', menu=toolsmenu) + + helpmenu = tk.Menu(menubar, tearoff=0) + helpmenu.add_command(label='PyInstaller Manual', command=OpenWebsite) + helpmenu.add_command(label='PyInstaller Develop Download', command=DownloadPyInstaller) + helpmenu.add_command(label='UPX Download', command=DownloadUPX) + helpmenu.add_command(label='Check for updates', command=CheckUpdate) + helpmenu.add_command(label='About', command=AboutMe) + menubar.add_cascade(label='Help', menu=helpmenu) + + parent.config(menu=menubar) + + self.logoImage = ImageTk.PhotoImage(Image.open('images/logo.png')) + label1 = tk.Label(parent, image=self.logoImage); label1.pack(side=tk.TOP) + + self.ComboBoxVar1 = tk.StringVar() + self.ComboBoxVar1.set(' --console') + ComboBox1 = ttk.Combobox(parent, values=[' --console',' --windowed'], textvariable=self.ComboBoxVar1, state='readonly') + ComboBox1.place(width=143, height=21, x=10, y=124) + ComboBox1.bind('<>', BuildCommand) + + button1 = ttk.Button(parent, text='Info', width=5, command=lambda: CommandInfo('subsystem')); button1.place(width=40, height=25, x=163, y=124) + + self.CheckBoxVar1 = tk.StringVar() + self.CheckBoxVar1.set('') + CheckBox1 = ttk.Checkbutton(parent, text=('--name') + ,variable=self.CheckBoxVar1, onvalue=' --name', offvalue='', command=lambda: BuildCommand('')); CheckBox1.place(width=63, height=21, x=245, y=124) + entry1 = ttk.Entry(parent); entry1.place(width=126, height=21, x=318, y=124) + + button2 = ttk.Button(parent, text='Info', width=5, command=lambda: CommandInfo('name')); button2.place(width=40, height=25, x=454, y=124) + + self.CheckBoxVar2 = tk.StringVar() + self.CheckBoxVar2.set('') + CheckBox2 = ttk.Checkbutton(parent, text='--onefile', + variable=self.CheckBoxVar2, onvalue=' --onefile', offvalue='', command=lambda: BuildCommand('')); CheckBox2.place(width=69, height=21, x=10, y=159) + button3 = ttk.Button(parent, text='Info', width=5, command=lambda: CommandInfo('onefile')); button3.place(width=40, height=25, x=89, y=159) + + self.CheckBoxVar3 = tk.StringVar() + self.CheckBoxVar3.set(' --noupx') + CheckBox3 = ttk.Checkbutton(parent, text=('--noupx') + ,variable=self.CheckBoxVar3, onvalue=' --noupx', offvalue='', command=lambda: BuildCommand('')); CheckBox3.place(width=66, height=21, x=164, y=159) + + button4 = ttk.Button(parent, text='Info', width=5, command=lambda: CommandInfo('noupx')); button4.place(width=40, height=25, x=240, y=159) + + self.CheckBoxVar4 = tk.StringVar() + self.CheckBoxVar4.set('') + CheckBox4 = ttk.Checkbutton(parent, text='--version-file', + variable=self.CheckBoxVar4, onvalue=' --version-file', offvalue='', command=lambda: BuildCommand('')); CheckBox4.place(width=92, height=21, x=10, y=194) + + button5 = ttk.Button(parent, text='Browse', command=lambda: GetDirectoryString('versionfile')); button5.place(width=76, height=25, x=112, y=194) + + entry2 = ttk.Entry(parent); entry2.place(width=248, height=21, x=198, y=197) + dnd.bindtarget(entry2, dnd_handle, 'text/uri-list') + + button6 = ttk.Button(parent, text='Info', width=5, command=lambda: CommandInfo('versionfile')); button6.place(width=40, height=25, x=456, y=194) + + label2 = tk.Label(parent, text='Script', bg=COLOR); label2.place(width=36, height=21, x=10, y=229) + button7 = ttk.Button(parent, text='Browse', command=lambda: GetDirectoryString('script')); button7.place(width=76, height=25, x=56, y=229) + entry3 = ttk.Entry(parent); entry3.place(width=354, height=21, x=142, y=229) + dnd.bindtarget(entry3, dnd_handle, 'text/uri-list') + + self.CheckBoxVar5 = tk.StringVar() + self.CheckBoxVar5.set('') + CheckBox5 = ttk.Checkbutton(parent, text='--icon', + variable=self.CheckBoxVar5, onvalue=' --icon', offvalue='', command=lambda: BuildCommand('')); CheckBox5.place(width=56, height=21, x=10, y=264) + button8 = ttk.Button(parent, text='Browse', command=lambda: GetDirectoryString('icon')); button8.place(width=76, height=25, x=76, y=264) + entry4 = ttk.Entry(parent); entry4.place(width=284, height=21, x=162, y=264) + dnd.bindtarget(entry4, dnd_handle, 'text/uri-list') + button9 = ttk.Button(parent, text='Info', width=5, command=lambda: CommandInfo('icon')); button9.place(width=40, height=25, x=456, y=264) + + label3 = tk.Label(parent, text='Command', bg=COLOR); label3.place(width=63, height=21, x=10, y=299) + entry5 = ttk.Entry(parent); entry5.place(width=363, height=21, x=83, y=299) + button6 = ttk.Button(parent, text='Copy', width=5, command=CopyToClipboard); button6.place(width=40, height=25, x=456, y=299) + BuildCommand('') + + button10 = ttk.Button(parent, text='Build', command=RunBuild); button10.place(width=76, height=25, x=(506/2)-86, y=340) + button11 = ttk.Button(parent, text='Close', command=parent.destroy); button11.place(width=76, height=25, x=(506/2)+10, y=340) + + ttk.Style().configure('TCheckbutton', background=COLOR) + +class DisplayAboutMe(tk.Toplevel): + def __init__(self, parent): + tk.Toplevel.__init__(self, parent) + + self.transient(parent) + self.result = None + self.grab_set() + wFilter = 300; hFilter = 310 + w = wFilter - 15; h = hFilter - 37 + sw = self.winfo_screenwidth() + sh = self.winfo_screenheight() + x = (sw - w)/2 + y = (sh - h)/2 + self.geometry('{0}x{1}+{2}+{3}'.format(w, h, int(x), int(y))) + self.resizable(width=False, height=False) + self.title('About') + self.wm_iconbitmap('images/python.ico') + + self.image = Image.open('images/vs.png') + self.size = (100, 100) + self.thumb = ImageOps.fit(self.image, self.size, Image.ANTIALIAS) + self.photo = ImageTk.PhotoImage(self.thumb) + logoLabel = tk.Label(self, image=self.photo); logoLabel.pack(side=tk.TOP, pady=10) + + f1 = tk.Frame(self); f1.pack() + f2 = tk.Frame(self); f2.pack(pady=10) + f3 = tk.Frame(f2); f3.pack() + + def CallHyperLink(EventArgs): + webbrowser.get('windows-default').open_new_tab('www.vs113dev.com') + + tk.Label(f1, text='PyInstaller GUI '+str(__version__)).pack() + tk.Label(f1, text='Copyright (C) 2014 Victor Santiago').pack() + tk.Label(f1, text='All rights reserved').pack() + + f = font.Font(size=10, slant='italic', underline=True) + label1 = tk.Label(f3, text='www.vs113dev.com', font = f, cursor='hand2') + label1['foreground'] = 'blue' + label1.pack(side=tk.LEFT) + label1.bind('', CallHyperLink) + ttk.Button(self, text='OK', command=self.destroy).pack(pady=5) + +class SetVersionFile(tk.Toplevel): + def __init__(self, parent, dnd): + tk.Toplevel.__init__(self, parent) + + self.transient(parent) + self.result = None + self.grab_set() + w = 506; h = 300 + sw = self.winfo_screenwidth() + sh = self.winfo_screenheight() + x = (sw - w)/2 + y = (sh - h)/2 + self.geometry('{0}x{1}+{2}+{3}'.format(w, h, int(x), int(y))) + self.resizable(width=False, height=False) + self.configure(background=COLOR) + self.title('Set Version File') + self.wm_iconbitmap('images/python.ico') + + def dnd_handle(event): + event.widget.delete(0, tk.END) + event.widget.insert(tk.END, event.data.strip('{').strip('}')) + GetDirectoryString('') + + def GetDirectoryString(string): + if string == 'fileversion': + filename = tkFileDialog.askopenfilename(filetypes = [('Version File', '*.txt')]) + entry1.delete(0, tk.END) + if filename == '': + pass + else: + entry1.insert(tk.END, str(filename)) + elif string == 'executable': + filename = tkFileDialog.askopenfilename(filetypes = [('Executable', '*.exe')]) + entry2.delete(0, tk.END) + if filename == '': + pass + else: + entry2.insert(tk.END, str(filename)) + + entry3.delete(0, tk.END) + string = r'PyInstaller\utils\set_version.py' + if str(entry1.get().strip()) == '': + pass + else: + string += ' "'+str(entry1.get())+'"' + if str(entry2.get().strip()) == '': + pass + else: + string += ' "'+str(entry2.get())+'"' + entry3.insert(tk.END, string) + + self.logoImage = ImageTk.PhotoImage(Image.open('images/logo.png')) + label1 = tk.Label(self, image=self.logoImage); label1.pack(side=tk.TOP) + + def SetVersion(): + os.system(r'PyInstaller\utils\set_version.py "'+str(entry1.get().strip())+'" "'+str(entry2.get().strip())+'"') + entry1.delete(0, tk.END) + entry2.delete(0, tk.END) + entry3.delete(0, tk.END) + entry3.insert(tk.END, r'PyInstaller\utils\set_version.py') + + def CopyToClipboard(): + win32clipboard.OpenClipboard() + win32clipboard.EmptyClipboard() + win32clipboard.SetClipboardData(win32con.CF_TEXT, entry3.get().strip()) + win32clipboard.CloseClipboard() + + label2 = tk.Label(self, text='File Version', bg=COLOR); label2.place(x=10, y=120) + button1 = ttk.Button(self, text='Browse', command=lambda: GetDirectoryString('fileversion')) + button1.place(x=80, y=120) + entry1 = ttk.Entry(self); entry1.place(width=506-76-100, height=21, x=165, y=122) + dnd.bindtarget(entry1, dnd_handle, 'text/uri-list') + + label3 = tk.Label(self, text='Executable', bg=COLOR); label3.place(x=10, y=155) + button2 = ttk.Button(self, text='Browse', command=lambda: GetDirectoryString('executable')) + button2.place(x=80, y=155) + entry2 = ttk.Entry(self); entry2.place(width=330, height=21, x=165, y=157) + dnd.bindtarget(entry2, dnd_handle, 'text/uri-list') + + label4 = tk.Label(self, text='Command', bg=COLOR); label4.place(x=10, y=192) + entry3 = ttk.Entry(self); entry3.place(width=365, height=21, x=80, y=192) + entry3.insert(tk.END, r'PyInstaller\utils\set_version.py') + button3 = ttk.Button(self, text='Copy', width=5, command=CopyToClipboard); button3.place(width=40, height=25, x=456, y=192) + + button4 = ttk.Button(self, text='Set Version', command=SetVersion); button4.place(width=76, height=25, x=(506/2)-86, y=235) + button5 = ttk.Button(self, text='Close', command=self.destroy); button5.place(width=76, height=25, x=(506/2)+10, y=235) + +class GrabVersionFile(tk.Toplevel): + def __init__(self, parent, dnd): + tk.Toplevel.__init__(self, parent) + + self.transient(parent) + self.result = None + self.grab_set() + w = 506; h = 230 + sw = self.winfo_screenwidth() + sh = self.winfo_screenheight() + x = (sw - w)/2 + y = (sh - h)/2 + self.geometry('{0}x{1}+{2}+{3}'.format(w, h, int(x), int(y))) + self.resizable(width=False, height=False) + self.configure(background=COLOR) + self.title('Set Version File') + self.wm_iconbitmap('images/python.ico') + + def dnd_handle(event): + event.widget.delete(0, tk.END) + event.widget.insert(tk.END, event.data.strip('{').strip('}')) + GetDirectoryString('') + + def GetDirectoryString(string): + if string == 'executable': + filename = tkFileDialog.askopenfilename(filetypes = [('Executable', '*.exe')]) + entry1.delete(0, tk.END) + if filename == '': + pass + else: + entry1.insert(tk.END, str(filename)) + + entry2.delete(0, tk.END) + string = r'PyInstaller\utils\grab_version.py' + if str(entry1.get().strip()) == '': + pass + else: + string += ' "'+str(entry1.get())+'"' + entry2.insert(tk.END, string) + + self.logoImage = ImageTk.PhotoImage(Image.open('images/logo.png')) + label1 = tk.Label(self, image=self.logoImage); label1.pack(side=tk.TOP) + + def GrabVersion(): + string = r'PyInstaller\utils\grab_version.py "'+str(entry1.get().strip())+'"' + os.system(string) + entry1.delete(0, tk.END) + entry2.delete(0, tk.END) + entry2.insert(tk.END, r'PyInstaller\utils\grab_version.py') + + def CopyToClipboard(): + win32clipboard.OpenClipboard() + win32clipboard.EmptyClipboard() + win32clipboard.SetClipboardData(win32con.CF_TEXT, entry2.get().strip()) + win32clipboard.CloseClipboard() + + label2 = tk.Label(self, text='Executable', bg=COLOR); label2.place(x=10, y=120) + button1 = ttk.Button(self, text='Browse', command=lambda: GetDirectoryString('executable')) + button1.place(x=80, y=120) + entry1 = ttk.Entry(self); entry1.place(width=506-76-100, height=21, x=165, y=122) + dnd.bindtarget(entry1, dnd_handle, 'text/uri-list') + + label3 = tk.Label(self, text='Command', bg=COLOR); label3.place(x=10, y=155) + entry2 = ttk.Entry(self); entry2.place(width=365, height=21, x=80, y=155) + entry2.insert(tk.END, r'PyInstaller\utils\grab_version.py') + button2 = ttk.Button(self, text='Copy', width=5, command=CopyToClipboard); button2.place(width=40, height=25, x=456, y=155) + + button3 = ttk.Button(self, text='Grab Version', command=GrabVersion); button3.place(width=76, height=25, x=(506/2)-86, y=190) + button4 = ttk.Button(self, text='Close', command=self.destroy); button4.place(width=76, height=25, x=(506/2)+10, y=190) + + +def main(): + root = tk.Tk() + root.geometry('506x400') + root.resizable(False, False) + root.title('PyInstaller GUI Version: '+str(__version__)) + root.wm_iconbitmap('images/python.ico') + root.configure(background=COLOR) + dnd = TkDND(root) + CallMainApp = MainApp(root, dnd) + root.mainloop() + +if __name__ == '__main__': + main() diff --git a/images/logo.png b/images/logo.png new file mode 100644 index 0000000..1eb7e2e Binary files /dev/null and b/images/logo.png differ diff --git a/images/python.ico b/images/python.ico new file mode 100644 index 0000000..4d63d0f Binary files /dev/null and b/images/python.ico differ diff --git a/images/vs.png b/images/vs.png new file mode 100644 index 0000000..267b088 Binary files /dev/null and b/images/vs.png differ diff --git a/modules/__init__.py b/modules/__init__.py new file mode 100644 index 0000000..e69de29 diff --git a/modules/tkdnd2.6/pkgIndex.tcl b/modules/tkdnd2.6/pkgIndex.tcl new file mode 100644 index 0000000..b5047b0 --- /dev/null +++ b/modules/tkdnd2.6/pkgIndex.tcl @@ -0,0 +1,6 @@ +# +# Tcl package index file +# +package ifneeded tkdnd 2.6 \ + "source \{$dir/tkdnd.tcl\} ; \ + tkdnd::initialise \{$dir\} tkdnd26.dll tkdnd" diff --git a/modules/tkdnd2.6/tkdnd.tcl b/modules/tkdnd2.6/tkdnd.tcl new file mode 100644 index 0000000..5d64dc7 --- /dev/null +++ b/modules/tkdnd2.6/tkdnd.tcl @@ -0,0 +1,418 @@ +# +# tkdnd.tcl -- +# +# This file implements some utility procedures that are used by the TkDND +# package. +# +# This software is copyrighted by: +# George Petasis, National Centre for Scientific Research "Demokritos", +# Aghia Paraskevi, Athens, Greece. +# e-mail: petasis@iit.demokritos.gr +# +# The following terms apply to all files associated +# with the software unless explicitly disclaimed in individual files. +# +# The authors hereby grant permission to use, copy, modify, distribute, +# and license this software and its documentation for any purpose, provided +# that existing copyright notices are retained in all copies and that this +# notice is included verbatim in any distributions. No written agreement, +# license, or royalty fee is required for any of the authorized uses. +# Modifications to this software may be copyrighted by their authors +# and need not follow the licensing terms described here, provided that +# the new terms are clearly indicated on the first page of each file where +# they apply. +# +# IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY +# FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES +# ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY +# DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE +# POSSIBILITY OF SUCH DAMAGE. +# +# THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, +# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, +# FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE +# IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE +# NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR +# MODIFICATIONS. +# + +package require Tk + +namespace eval tkdnd { + variable _topw ".drag" + variable _tabops + variable _state + variable _x0 + variable _y0 + variable _platform_namespace + variable _drop_file_temp_dir + variable _auto_update 1 + + variable _windowingsystem + + bind TkDND_Drag1 {tkdnd::_begin_drag press 1 %W %s %X %Y} + bind TkDND_Drag1 {tkdnd::_begin_drag motion 1 %W %s %X %Y} + bind TkDND_Drag2 {tkdnd::_begin_drag press 2 %W %s %X %Y} + bind TkDND_Drag2 {tkdnd::_begin_drag motion 2 %W %s %X %Y} + bind TkDND_Drag3 {tkdnd::_begin_drag press 3 %W %s %X %Y} + bind TkDND_Drag3 {tkdnd::_begin_drag motion 3 %W %s %X %Y} + + # ---------------------------------------------------------------------------- + # Command tkdnd::initialise: Initialise the TkDND package. + # ---------------------------------------------------------------------------- + proc initialise { dir PKG_LIB_FILE PACKAGE_NAME} { + variable _platform_namespace + variable _drop_file_temp_dir + variable _windowingsystem + global env + + switch [tk windowingsystem] { + x11 { + set _windowingsystem x11 + } + win32 - + windows { + set _windowingsystem windows + } + aqua { + set _windowingsystem aqua + } + default { + error "unknown Tk windowing system" + } + } + + ## Get User's home directory: We try to locate the proper path from a set of + ## environmental variables... + foreach var {HOME HOMEPATH USERPROFILE ALLUSERSPROFILE APPDATA} { + if {[info exists env($var)]} { + if {[file isdirectory $env($var)]} { + set UserHomeDir $env($var) + break + } + } + } + + ## Should use [tk windowingsystem] instead of tcl platform array: + ## OS X returns "unix," but that's not useful because it has its own + ## windowing system, aqua + ## Under windows we have to also combine HOMEDRIVE & HOMEPATH... + if {![info exists UserHomeDir] && + [string equal $_windowingsystem windows] && + [info exists env(HOMEDRIVE)] && [info exists env(HOMEPATH)]} { + if {[file isdirectory $env(HOMEDRIVE)$env(HOMEPATH)]} { + set UserHomeDir $env(HOMEDRIVE)$env(HOMEPATH) + } + } + ## Have we located the needed path? + if {![info exists UserHomeDir]} { + set UserHomeDir [pwd] + } + set UserHomeDir [file normalize $UserHomeDir] + + ## Try to locate a temporary directory... + foreach var {TKDND_TEMP_DIR TEMP TMP} { + if {[info exists env($var)]} { + if {[file isdirectory $env($var)] && [file writable $env($var)]} { + set _drop_file_temp_dir $env($var) + break + } + } + } + if {![info exists _drop_file_temp_dir]} { + foreach _dir [list "$UserHomeDir/Local Settings/Temp" \ + "$UserHomeDir/AppData/Local/Temp" \ + /tmp \ + C:/WINDOWS/Temp C:/Temp C:/tmp \ + D:/WINDOWS/Temp D:/Temp D:/tmp] { + if {[file isdirectory $_dir] && [file writable $_dir]} { + set _drop_file_temp_dir $_dir + break + } + } + } + if {![info exists _drop_file_temp_dir]} { + set _drop_file_temp_dir $UserHomeDir + } + set _drop_file_temp_dir [file native $_drop_file_temp_dir] + + switch $_windowingsystem { + x11 { + source $dir/tkdnd_unix.tcl + set _platform_namespace xdnd + } + win32 - + windows { + source $dir/tkdnd_windows.tcl + set _platform_namespace olednd + } + aqua { + source $dir/tkdnd_unix.tcl + source $dir/tkdnd_macosx.tcl + set _platform_namespace macdnd + } + default { + error "unknown Tk windowing system" + } + } + load $dir/$PKG_LIB_FILE $PACKAGE_NAME + source $dir/tkdnd_compat.tcl + };# initialise + + proc GetDropFileTempDirectory { } { + variable _drop_file_temp_dir + return $_drop_file_temp_dir + } + proc SetDropFileTempDirectory { dir } { + variable _drop_file_temp_dir + set _drop_file_temp_dir $dir + } + +};# namespace tkdnd + +# ---------------------------------------------------------------------------- +# Command tkdnd::drag_source +# ---------------------------------------------------------------------------- +proc tkdnd::drag_source { mode path { types {} } { event 1 } } { + set tags [bindtags $path] + set idx [lsearch $tags "TkDND_Drag*"] + switch -- $mode { + register { + if { $idx != -1 } { + bindtags $path [lreplace $tags $idx $idx TkDND_Drag$event] + } else { + bindtags $path [concat $tags TkDND_Drag$event] + } + set types [platform_specific_types $types] + set old_types [bind $path <>] + foreach type $types { + if {[lsearch $old_types $type] < 0} {lappend old_types $type} + } + bind $path <> $old_types + } + unregister { + if { $idx != -1 } { + bindtags $path [lreplace $tags $idx $idx] + } + } + } +};# tkdnd::drag_source + +# ---------------------------------------------------------------------------- +# Command tkdnd::drop_target +# ---------------------------------------------------------------------------- +proc tkdnd::drop_target { mode path { types {} } } { + variable _windowingsystem + set types [platform_specific_types $types] + switch -- $mode { + register { + switch $_windowingsystem { + x11 { + _register_types $path [winfo toplevel $path] $types + } + win32 - + windows { + _RegisterDragDrop $path + bind $path {+ tkdnd::_RevokeDragDrop %W} + } + aqua { + macdnd::registerdragwidget [winfo toplevel $path] $types + } + default { + error "unknown Tk windowing system" + } + } + set old_types [bind $path <>] + set new_types {} + foreach type $types { + if {[lsearch -exact $old_types $type] < 0} {lappend new_types $type} + } + if {[llength $new_types]} { + bind $path <> [concat $old_types $new_types] + } + } + unregister { + switch $_windowingsystem { + x11 { + } + win32 - + windows { + _RevokeDragDrop $path + } + aqua { + error todo + } + default { + error "unknown Tk windowing system" + } + } + bind $path <> {} + } + } +};# tkdnd::drop_target + +# ---------------------------------------------------------------------------- +# Command tkdnd::_begin_drag +# ---------------------------------------------------------------------------- +proc tkdnd::_begin_drag { event button source state X Y } { + variable _x0 + variable _y0 + variable _state + + switch -- $event { + press { + set _x0 $X + set _y0 $Y + set _state "press" + } + motion { + if { ![info exists _state] } { + # This is just extra protection. There seem to be + # rare cases where the motion comes before the press. + return + } + if { [string equal $_state "press"] } { + if { abs($_x0-$X) > 3 || abs($_y0-$Y) > 3 } { + set _state "done" + _init_drag $button $source $state $X $Y + } + } + } + } +};# tkdnd::_begin_drag + +# ---------------------------------------------------------------------------- +# Command tkdnd::_init_drag +# ---------------------------------------------------------------------------- +proc tkdnd::_init_drag { button source state rootX rootY } { + # Call the <> binding. + set cmd [bind $source <>] + if {[string length $cmd]} { + set cmd [string map [list %W $source %X $rootX %Y $rootY \ + %S $state %e <> %A \{\} \ + %t [bind $source <>]] $cmd] + set info [uplevel \#0 $cmd] + if { $info != "" } { + variable _windowingsystem + foreach { actions types data } $info { break } + set types [platform_specific_types $types] + set action refuse_drop + switch $_windowingsystem { + x11 { + set action [xdnd::_dodragdrop $source $actions $types $data $button] + } + win32 - + windows { + set action [_DoDragDrop $source $actions $types $data $button] + } + aqua { + set action [macdnd::dodragdrop $source $actions $types $data] + } + default { + error "unknown Tk windowing system" + } + } + ## Call _end_drag to notify the widget of the result of the drag + ## operation... + _end_drag $button $source {} $action {} $data {} $state $rootX $rootY + } + } +};# tkdnd::_init_drag + +# ---------------------------------------------------------------------------- +# Command tkdnd::_end_drag +# ---------------------------------------------------------------------------- +proc tkdnd::_end_drag { button source target action type data result + state rootX rootY } { + set rootX 0 + set rootY 0 + # Call the <> binding. + set cmd [bind $source <>] + if {[string length $cmd]} { + set cmd [string map [list %W $source %X $rootX %Y $rootY \ + %S $state %e <> %A \{$action\}] $cmd] + set info [uplevel \#0 $cmd] + if { $info != "" } { + variable _windowingsystem + foreach { actions types data } $info { break } + set types [platform_specific_types $types] + switch $_windowingsystem { + x11 { + error "dragging from Tk widgets not yet supported" + } + win32 - + windows { + set action [_DoDragDrop $source $actions $types $data $button] + } + aqua { + macdnd::dodragdrop $source $actions $types $data + } + default { + error "unknown Tk windowing system" + } + } + ## Call _end_drag to notify the widget of the result of the drag + ## operation... + _end_drag $button $source {} $action {} $data {} $state $rootX $rootY + } + } +};# tkdnd::_end_drag + +# ---------------------------------------------------------------------------- +# Command tkdnd::platform_specific_types +# ---------------------------------------------------------------------------- +proc tkdnd::platform_specific_types { types } { + variable _platform_namespace + return [${_platform_namespace}::_platform_specific_types $types] +}; # tkdnd::platform_specific_types + +# ---------------------------------------------------------------------------- +# Command tkdnd::platform_independent_types +# ---------------------------------------------------------------------------- +proc tkdnd::platform_independent_types { types } { + variable _platform_namespace + return [${_platform_namespace}::_platform_independent_types $types] +}; # tkdnd::platform_independent_types + +# ---------------------------------------------------------------------------- +# Command tkdnd::platform_specific_type +# ---------------------------------------------------------------------------- +proc tkdnd::platform_specific_type { type } { + variable _platform_namespace + return [${_platform_namespace}::_platform_specific_type $type] +}; # tkdnd::platform_specific_type + +# ---------------------------------------------------------------------------- +# Command tkdnd::platform_independent_type +# ---------------------------------------------------------------------------- +proc tkdnd::platform_independent_type { type } { + variable _platform_namespace + return [${_platform_namespace}::_platform_independent_type $type] +}; # tkdnd::platform_independent_type + +# ---------------------------------------------------------------------------- +# Command tkdnd::bytes_to_string +# ---------------------------------------------------------------------------- +proc tkdnd::bytes_to_string { bytes } { + set string {} + foreach byte $bytes { + append string [binary format c $byte] + } + return $string +};# tkdnd::bytes_to_string + +# ---------------------------------------------------------------------------- +# Command tkdnd::urn_unquote +# ---------------------------------------------------------------------------- +proc tkdnd::urn_unquote {url} { + set result "" + set start 0 + while {[regexp -start $start -indices {%[0-9a-fA-F]{2}} $url match]} { + foreach {first last} $match break + append result [string range $url $start [expr {$first - 1}]] + append result [format %c 0x[string range $url [incr first] $last]] + set start [incr last] + } + append result [string range $url $start end] + return $result +};# tkdnd::urn_unquote diff --git a/modules/tkdnd2.6/tkdnd_compat.tcl b/modules/tkdnd2.6/tkdnd_compat.tcl new file mode 100644 index 0000000..791eb68 --- /dev/null +++ b/modules/tkdnd2.6/tkdnd_compat.tcl @@ -0,0 +1,159 @@ +# +# tkdnd_compat.tcl -- +# +# This file implements some utility procedures, to support older versions +# of the TkDND package. +# +# This software is copyrighted by: +# George Petasis, National Centre for Scientific Research "Demokritos", +# Aghia Paraskevi, Athens, Greece. +# e-mail: petasis@iit.demokritos.gr +# +# The following terms apply to all files associated +# with the software unless explicitly disclaimed in individual files. +# +# The authors hereby grant permission to use, copy, modify, distribute, +# and license this software and its documentation for any purpose, provided +# that existing copyright notices are retained in all copies and that this +# notice is included verbatim in any distributions. No written agreement, +# license, or royalty fee is required for any of the authorized uses. +# Modifications to this software may be copyrighted by their authors +# and need not follow the licensing terms described here, provided that +# the new terms are clearly indicated on the first page of each file where +# they apply. +# +# IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY +# FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES +# ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY +# DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE +# POSSIBILITY OF SUCH DAMAGE. +# +# THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, +# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, +# FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE +# IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE +# NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR +# MODIFICATIONS. +# + +namespace eval compat { + +};# namespace compat + +# ---------------------------------------------------------------------------- +# Command ::dnd +# ---------------------------------------------------------------------------- +proc ::dnd {method window args} { + switch $method { + bindtarget { + switch [llength $args] { + 0 {return [tkdnd::compat::bindtarget0 $window]} + 1 {return [tkdnd::compat::bindtarget1 $window [lindex $args 0]]} + 2 {return [tkdnd::compat::bindtarget2 $window [lindex $args 0] \ + [lindex $args 1]]} + 3 {return [tkdnd::compat::bindtarget3 $window [lindex $args 0] \ + [lindex $args 1] [lindex $args 2]]} + 4 {return [tkdnd::compat::bindtarget4 $window [lindex $args 0] \ + [lindex $args 1] [lindex $args 2] [lindex $args 3]]} + } + } + cleartarget { + return [tkdnd::compat::cleartarget $window] + } + bindsource { + switch [llength $args] { + 0 {return [tkdnd::compat::bindsource0 $window]} + 1 {return [tkdnd::compat::bindsource1 $window [lindex $args 0]]} + 2 {return [tkdnd::compat::bindsource2 $window [lindex $args 0] \ + [lindex $args 1]]} + 3 {return [tkdnd::compat::bindsource3 $window [lindex $args 0] \ + [lindex $args 1] [lindex $args 2]]} + } + } + clearsource { + return [tkdnd::compat::clearsource $window] + } + drag { + return [tkdnd::_init_drag $window "press" 0 0] + } + } + error "invalid number of arguments!" +};# ::dnd + +# ---------------------------------------------------------------------------- +# Command compat::bindtarget +# ---------------------------------------------------------------------------- +proc compat::bindtarget0 {window} { + return [bind $window <>] +};# compat::bindtarget0 + +proc compat::bindtarget1 {window type} { + return [bindtarget2 $window $type ] +};# compat::bindtarget1 + +proc compat::bindtarget2 {window type event} { + switch $event { + {return [bind $window <>]} + {return [bind $window <>]} + {return [bind $window <>]} + {return [bind $window <>]} + } +};# compat::bindtarget2 + +proc compat::bindtarget3 {window type event script} { + set type [normalise_type $type] + ::tkdnd::drop_target register $window [list $type] + switch $event { + {return [bind $window <> $script]} + {return [bind $window <> $script]} + {return [bind $window <> $script]} + {return [bind $window <> $script]} + } +};# compat::bindtarget3 + +proc compat::bindtarget4 {window type event script priority} { + return [bindtarget3 $window $type $event $script] +};# compat::bindtarget4 + +proc compat::normalise_type { type } { + switch $type { + text/plain - + {text/plain;charset=UTF-8} - + Text {return DND_Text} + text/uri-list - + Files {return DND_Files} + default {return $type} + } +};# compat::normalise_type + +# ---------------------------------------------------------------------------- +# Command compat::bindsource +# ---------------------------------------------------------------------------- +proc compat::bindsource0 {window} { + return [bind $window <>] +};# compat::bindsource0 + +proc compat::bindsource1 {window type} { + return [bindsource2 $window $type ] +};# compat::bindsource1 + +proc compat::bindsource2 {window type script} { + ::tkdnd::drag_source register $window $type 2 + bind $window <> "list {copy} %t \[$script\]" +};# compat::bindsource2 + +proc compat::bindsource3 {window type script priority} { + return [bindsource2 $window $type $script] +};# compat::bindsource3 + +# ---------------------------------------------------------------------------- +# Command compat::cleartarget +# ---------------------------------------------------------------------------- +proc compat::cleartarget {window} { +};# compat::cleartarget + +# ---------------------------------------------------------------------------- +# Command compat::clearsource +# ---------------------------------------------------------------------------- +proc compat::clearsource {window} { +};# compat::clearsource diff --git a/modules/tkdnd2.6/tkdnd_macosx.tcl b/modules/tkdnd2.6/tkdnd_macosx.tcl new file mode 100644 index 0000000..a610d05 --- /dev/null +++ b/modules/tkdnd2.6/tkdnd_macosx.tcl @@ -0,0 +1,170 @@ +# +# tkdnd_macosx.tcl -- +# +# This file implements some utility procedures that are used by the TkDND +# package. + +# This software is copyrighted by: +# Georgios Petasis, Athens, Greece. +# e-mail: petasisg@yahoo.gr, petasis@iit.demokritos.gr +# +# Mac portions (c) 2009 Kevin Walzer/WordTech Communications LLC, +# kw@codebykevin.com +# +# +# The following terms apply to all files associated +# with the software unless explicitly disclaimed in individual files. +# +# The authors hereby grant permission to use, copy, modify, distribute, +# and license this software and its documentation for any purpose, provided +# that existing copyright notices are retained in all copies and that this +# notice is included verbatim in any distributions. No written agreement, +# license, or royalty fee is required for any of the authorized uses. +# Modifications to this software may be copyrighted by their authors +# and need not follow the licensing terms described here, provided that +# the new terms are clearly indicated on the first page of each file where +# they apply. +# +# IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY +# FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES +# ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY +# DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE +# POSSIBILITY OF SUCH DAMAGE. +# +# THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, +# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, +# FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE +# IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE +# NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR +# MODIFICATIONS. +# + +#basic API for Mac Drag and Drop + +#two data types supported: strings and file paths + +#two commands at C level: ::tkdnd::macdnd::registerdragwidget, ::tkdnd::macdnd::unregisterdragwidget + +#data retrieval mechanism: text or file paths are copied from drag clipboard to system clipboard and retrieved via [clipboard get]; array of file paths is converted to single tab-separated string, can be split into Tcl list + +if {[tk windowingsystem] eq "aqua" && "AppKit" ni [winfo server .]} { + error {TkAqua Cocoa required} +} + +namespace eval macdnd { + variable _dropped_data +};# namespace macdnd + +# ---------------------------------------------------------------------------- +# Command macdnd::_HandleEnter +# ---------------------------------------------------------------------------- +proc macdnd::_HandleEnter { path drag_source typelist } { + return [::tkdnd::xdnd::_HandleXdndEnter $path $drag_source $typelist] +};# macdnd::_HandleEnter + +# ---------------------------------------------------------------------------- +# Command macdnd::_HandlePosition +# ---------------------------------------------------------------------------- +proc macdnd::_HandlePosition { drop_target rootX rootY } { + return [::tkdnd::xdnd::_HandleXdndPosition $drop_target $rootX $rootY] +};# macdnd::_HandlePosition + +# ---------------------------------------------------------------------------- +# Command macdnd::_HandleLeave +# ---------------------------------------------------------------------------- +proc macdnd::_HandleLeave { args } { + return [::tkdnd::xdnd::_HandleXdndLeave] +};# macdnd::_HandleLeave + +# ---------------------------------------------------------------------------- +# Command macdnd::_HandleDrop +# ---------------------------------------------------------------------------- +proc macdnd::_HandleDrop { drop_target data args } { + variable _dropped_data + set _dropped_data $data + return [::tkdnd::xdnd::_HandleXdndDrop 0] +};# macdnd::_HandleDrop + +# ---------------------------------------------------------------------------- +# Command macdnd::_GetDroppedData +# ---------------------------------------------------------------------------- +proc macdnd::_GetDroppedData { time } { + variable _dropped_data + return $_dropped_data +};# macdnd::_GetDroppedData +proc xdnd::_GetDroppedData { time } { + return [::tkdnd::macdnd::_GetDroppedData $time] +};# xdnd::_GetDroppedData + +# ---------------------------------------------------------------------------- +# Command macdnd::_GetDragSource +# ---------------------------------------------------------------------------- +proc macdnd::_GetDragSource { } { + return [::tkdnd::xdnd::_GetDragSource] +};# macdnd::_GetDragSource + +# ---------------------------------------------------------------------------- +# Command macdnd::_GetDropTarget +# ---------------------------------------------------------------------------- +proc macdnd::_GetDropTarget { } { + return [::tkdnd::xdnd::_GetDropTarget] +};# macdnd::_GetDropTarget + +# ---------------------------------------------------------------------------- +# Command macdnd::_supported_types +# ---------------------------------------------------------------------------- +proc macdnd::_supported_types { types } { + return [::tkdnd::xdnd::_supported_types $types] +}; # macdnd::_supported_types + +# ---------------------------------------------------------------------------- +# Command macdnd::_platform_specific_types +# ---------------------------------------------------------------------------- +proc macdnd::_platform_specific_types { types } { + return [::tkdnd::xdnd::_platform_specific_types $types] +}; # macdnd::_platform_specific_types + +# ---------------------------------------------------------------------------- +# Command macdnd::_normalise_data +# ---------------------------------------------------------------------------- +proc macdnd::_normalise_data { type data } { + return [::tkdnd::xdnd::_normalise_data $type $data] +}; # macdnd::_normalise_data + +# ---------------------------------------------------------------------------- +# Command macdnd::_platform_specific_type +# ---------------------------------------------------------------------------- +proc macdnd::_platform_specific_type { type } { + switch $type { + DND_Text {return [list NSStringPboardType]} + DND_Files {return [list NSFilenamesPboardType]} + default {return [list $type]} + } +}; # macdnd::_platform_specific_type +proc xdnd::_platform_specific_type { type } { + return [::tkdnd::macdnd::_platform_specific_type $type] +}; # xdnd::_platform_specific_type + +# ---------------------------------------------------------------------------- +# Command macdnd::_platform_independent_type +# ---------------------------------------------------------------------------- +proc macdnd::_platform_independent_type { type } { + switch $type { + NSStringPboardType {return DND_Text} + NSFilenamesPboardType {return DND_Files} + default {return [list $type]} + } +}; # macdnd::_platform_independent_type +proc xdnd::_platform_independent_type { type } { + return [::tkdnd::macdnd::_platform_independent_type $type] +}; # xdnd::_platform_independent_type + +# ---------------------------------------------------------------------------- +# Command macdnd::_supported_type +# ---------------------------------------------------------------------------- +proc macdnd::_supported_type { type } { + return 1 +}; # macdnd::_supported_type +proc xdnd::_supported_type { type } { + return [::tkdnd::macdnd::_supported_type $type] +}; # xdnd::_supported_type diff --git a/modules/tkdnd2.6/tkdnd_unix.tcl b/modules/tkdnd2.6/tkdnd_unix.tcl new file mode 100644 index 0000000..811fa88 --- /dev/null +++ b/modules/tkdnd2.6/tkdnd_unix.tcl @@ -0,0 +1,1015 @@ +# +# tkdnd_unix.tcl -- +# +# This file implements some utility procedures that are used by the TkDND +# package. +# +# This software is copyrighted by: +# George Petasis, National Centre for Scientific Research "Demokritos", +# Aghia Paraskevi, Athens, Greece. +# e-mail: petasis@iit.demokritos.gr +# +# The following terms apply to all files associated +# with the software unless explicitly disclaimed in individual files. +# +# The authors hereby grant permission to use, copy, modify, distribute, +# and license this software and its documentation for any purpose, provided +# that existing copyright notices are retained in all copies and that this +# notice is included verbatim in any distributions. No written agreement, +# license, or royalty fee is required for any of the authorized uses. +# Modifications to this software may be copyrighted by their authors +# and need not follow the licensing terms described here, provided that +# the new terms are clearly indicated on the first page of each file where +# they apply. +# +# IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY +# FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES +# ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY +# DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE +# POSSIBILITY OF SUCH DAMAGE. +# +# THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, +# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, +# FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE +# IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE +# NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR +# MODIFICATIONS. +# + +namespace eval xdnd { + variable _types {} + variable _typelist {} + variable _codelist {} + variable _actionlist {} + variable _pressedkeys {} + variable _action {} + variable _common_drag_source_types {} + variable _common_drop_target_types {} + variable _drag_source {} + variable _drop_target {} + + variable _dragging 0 + + proc debug {msg} { + puts $msg + };# debug +};# namespace xdnd + +# ---------------------------------------------------------------------------- +# Command xdnd::_HandleXdndEnter +# ---------------------------------------------------------------------------- +proc xdnd::_HandleXdndEnter { path drag_source typelist } { + variable _typelist; set _typelist $typelist + variable _pressedkeys; set _pressedkeys 1 + variable _action; set _action {} + variable _common_drag_source_types; set _common_drag_source_types {} + variable _common_drop_target_types; set _common_drop_target_types {} + variable _actionlist + variable _drag_source; set _drag_source $drag_source + variable _drop_target; set _drop_target {} + variable _actionlist; set _actionlist \ + {copy move link ask private} + # debug "\n===============================================================" + # debug "xdnd::_HandleXdndEnter: path=$path, drag_source=$drag_source,\ + # typelist=$typelist" + # debug "xdnd::_HandleXdndEnter: ACTION: default" + return default +};# xdnd::_HandleXdndEnter + +# ---------------------------------------------------------------------------- +# Command xdnd::_HandleXdndPosition +# ---------------------------------------------------------------------------- +proc xdnd::_HandleXdndPosition { drop_target rootX rootY {drag_source {}} } { + variable _types + variable _typelist + variable _actionlist + variable _pressedkeys + variable _action + variable _common_drag_source_types + variable _common_drop_target_types + variable _drag_source + variable _drop_target + # debug "xdnd::_HandleXdndPosition: drop_target=$drop_target,\ + # _drop_target=$_drop_target, rootX=$rootX, rootY=$rootY" + + if {![info exists _drag_source] && ![string length $_drag_source]} { + # debug "xdnd::_HandleXdndPosition: no or empty _drag_source:\ + # return refuse_drop" + return refuse_drop + } + + if {$drag_source ne "" && $drag_source ne $_drag_source} { + debug "XDND position event from unexpected source: $_drag_source\ + != $drag_source" + return refuse_drop + } + + ## Does the new drop target support any of our new types? + set _types [bind $drop_target <>] + # debug ">> Accepted types: $drop_target $_types" + if {[llength $_types]} { + ## Examine the drop target types, to find at least one match with the drag + ## source types... + set supported_types [_supported_types $_typelist] + foreach type $_types { + foreach matched [lsearch -glob -all -inline $supported_types $type] { + ## Drop target supports this type. + lappend common_drag_source_types $matched + lappend common_drop_target_types $type + } + } + } + + # debug "\t($_drop_target) -> ($drop_target)" + if {$drop_target != $_drop_target} { + if {[string length $_drop_target]} { + ## Call the <> event. + # debug "\t<> on $_drop_target" + set cmd [bind $_drop_target <>] + if {[string length $cmd]} { + set _codelist $_typelist + set cmd [string map [list %W $_drop_target %X $rootX %Y $rootY \ + %CST \{$_common_drag_source_types\} \ + %CTT \{$_common_drop_target_types\} \ + %ST \{$_typelist\} %TT \{$_types\} \ + %A \{$_action\} %a \{$_actionlist\} \ + %b \{$_pressedkeys\} %m \{$_pressedkeys\} \ + %D \{\} %e <> \ + %L \{$_typelist\} %% % \ + %t \{$_typelist\} %T \{[lindex $_common_drag_source_types 0]\} \ + %c \{$_codelist\} %C \{[lindex $_codelist 0]\} \ + ] $cmd] + uplevel \#0 $cmd + } + } + set _drop_target {} + + if {[info exists common_drag_source_types]} { + set _action copy + set _common_drag_source_types $common_drag_source_types + set _common_drop_target_types $common_drop_target_types + set _drop_target $drop_target + ## Drop target supports at least one type. Send a <>. + # puts "<> -> $drop_target" + set cmd [bind $drop_target <>] + if {[string length $cmd]} { + focus $drop_target + set _codelist $_typelist + set cmd [string map [list %W $drop_target %X $rootX %Y $rootY \ + %CST \{$_common_drag_source_types\} \ + %CTT \{$_common_drop_target_types\} \ + %ST \{$_typelist\} %TT \{$_types\} \ + %A $_action %a \{$_actionlist\} \ + %b \{$_pressedkeys\} %m \{$_pressedkeys\} \ + %D \{\} %e <> \ + %L \{$_typelist\} %% % \ + %t \{$_typelist\} %T \{[lindex $_common_drag_source_types 0]\} \ + %c \{$_codelist\} %C \{[lindex $_codelist 0]\} \ + ] $cmd] + set _action [uplevel \#0 $cmd] + } + } + set _drop_target $drop_target + } + + set _action refuse_drop + set _drop_target {} + if {[info exists common_drag_source_types]} { + set _action copy + set _common_drag_source_types $common_drag_source_types + set _common_drop_target_types $common_drop_target_types + set _drop_target $drop_target + ## Drop target supports at least one type. Send a <>. + set cmd [bind $drop_target <>] + if {[string length $cmd]} { + set _codelist $_typelist + set cmd [string map [list %W $drop_target %X $rootX %Y $rootY \ + %CST \{$_common_drag_source_types\} \ + %CTT \{$_common_drop_target_types\} \ + %ST \{$_typelist\} %TT \{$_types\} \ + %A $_action %a \{$_actionlist\} \ + %b \{$_pressedkeys\} %m \{$_pressedkeys\} \ + %D \{\} %e <> \ + %L \{$_typelist\} %% % \ + %t \{$_typelist\} %T \{[lindex $_common_drag_source_types 0]\} \ + %c \{$_codelist\} %C \{[lindex $_codelist 0]\} \ + ] $cmd] + set _action [uplevel \#0 $cmd] + } + } + # Return values: copy, move, link, ask, private, refuse_drop, default + # debug "xdnd::_HandleXdndPosition: ACTION: $_action" + return $_action +};# xdnd::_HandleXdndPosition + +# ---------------------------------------------------------------------------- +# Command xdnd::_HandleXdndLeave +# ---------------------------------------------------------------------------- +proc xdnd::_HandleXdndLeave { } { + variable _types + variable _typelist + variable _actionlist + variable _pressedkeys + variable _action + variable _common_drag_source_types + variable _common_drop_target_types + variable _drag_source + variable _drop_target + if {![info exists _drop_target]} {set _drop_target {}} + # debug "xdnd::_HandleXdndLeave: _drop_target=$_drop_target" + if {[info exists _drop_target] && [string length $_drop_target]} { + set cmd [bind $_drop_target <>] + if {[string length $cmd]} { + set _codelist $_typelist + set cmd [string map [list %W $_drop_target %X 0 %Y 0 \ + %CST \{$_common_drag_source_types\} \ + %CTT \{$_common_drop_target_types\} \ + %ST \{$_typelist\} %TT \{$_types\} \ + %A \{$_action\} %a \{$_actionlist\} \ + %b \{$_pressedkeys\} %m \{$_pressedkeys\} \ + %D \{\} %e <> \ + %L \{$_typelist\} %% % \ + %t \{$_typelist\} %T \{[lindex $_common_drag_source_types 0]\} \ + %c \{$_codelist\} %C \{[lindex $_codelist 0]\} \ + ] $cmd] + set _action [uplevel \#0 $cmd] + } + } + foreach var {_types _typelist _actionlist _pressedkeys _action + _common_drag_source_types _common_drop_target_types + _drag_source _drop_target} { + set $var {} + } +};# xdnd::_HandleXdndLeave + +# ---------------------------------------------------------------------------- +# Command xdnd::_HandleXdndDrop +# ---------------------------------------------------------------------------- +proc xdnd::_HandleXdndDrop { time } { + variable _types + variable _typelist + variable _actionlist + variable _pressedkeys + variable _action + variable _common_drag_source_types + variable _common_drop_target_types + variable _drag_source + variable _drop_target + set rootX 0 + set rootY 0 + + # puts "xdnd::_HandleXdndDrop: $time" + + if {![info exists _drag_source] && ![string length $_drag_source]} { + return refuse_drop + } + if {![info exists _drop_target] && ![string length $_drop_target]} { + return refuse_drop + } + if {![llength $_common_drag_source_types]} {return refuse_drop} + ## Get the dropped data. + set data [_GetDroppedData $time] + ## Try to select the most specific <> event. + foreach type [concat $_common_drag_source_types $_common_drop_target_types] { + set type [_platform_independent_type $type] + set cmd [bind $_drop_target <>] + if {[string length $cmd]} { + set _codelist $_typelist + set cmd [string map [list %W $_drop_target %X $rootX %Y $rootY \ + %CST \{$_common_drag_source_types\} \ + %CTT \{$_common_drop_target_types\} \ + %ST \{$_typelist\} %TT \{$_types\} \ + %A $_action %a \{$_actionlist\} \ + %b \{$_pressedkeys\} %m \{$_pressedkeys\} \ + %D [list $data] %e <> \ + %L \{$_typelist\} %% % \ + %t \{$_typelist\} %T \{[lindex $_common_drag_source_types 0]\} \ + %c \{$_codelist\} %C \{[lindex $_codelist 0]\} \ + ] $cmd] + return [uplevel \#0 $cmd] + } + } + set cmd [bind $_drop_target <>] + if {[string length $cmd]} { + set _codelist $_typelist + set cmd [string map [list %W $_drop_target %X $rootX %Y $rootY \ + %CST \{$_common_drag_source_types\} \ + %CTT \{$_common_drop_target_types\} \ + %ST \{$_typelist\} %TT \{$_types\} \ + %A $_action %a \{$_actionlist\} \ + %b \{$_pressedkeys\} %m \{$_pressedkeys\} \ + %D [list $data] %e <> \ + %L \{$_typelist\} %% % \ + %t \{$_typelist\} %T \{[lindex $_common_drag_source_types 0]\} \ + %c \{$_codelist\} %C \{[lindex $_codelist 0]\} \ + ] $cmd] + set _action [uplevel \#0 $cmd] + } + # Return values: XdndActionCopy, XdndActionMove, XdndActionLink, + # XdndActionAsk, XdndActionPrivate, refuse_drop + return $_action +};# xdnd::_HandleXdndDrop + +# ---------------------------------------------------------------------------- +# Command xdnd::_GetDroppedData +# ---------------------------------------------------------------------------- +proc xdnd::_GetDroppedData { time } { + variable _drag_source + variable _drop_target + variable _common_drag_source_types + variable _use_tk_selection + if {![llength $_common_drag_source_types]} { + error "no common data types between the drag source and drop target widgets" + } + ## Is drag source in this application? + if {[catch {winfo pathname -displayof $_drop_target $_drag_source} p]} { + set _use_tk_selection 0 + } else { + set _use_tk_selection 1 + } + #set _use_tk_selection 1 + foreach type $_common_drag_source_types { + # puts "TYPE: $type ($_drop_target)" + # _get_selection $_drop_target $time $type + if {$_use_tk_selection} { + if {![catch { + selection get -displayof $_drop_target -selection XdndSelection \ + -type $type + } result options]} { + return [_normalise_data $type $result] + } + } else { + # puts "_selection_get -displayof $_drop_target -selection XdndSelection \ + # -type $type -time $time" + #after 100 [list focus -force $_drop_target] + #after 50 [list raise [winfo toplevel $_drop_target]] + if {![catch { + _selection_get -displayof $_drop_target -selection XdndSelection \ + -type $type -time $time + } result options]} { + return [_normalise_data $type $result] + } + } + } + return -options $options $result +};# xdnd::_GetDroppedData + +# ---------------------------------------------------------------------------- +# Command xdnd::_GetDragSource +# ---------------------------------------------------------------------------- +proc xdnd::_GetDragSource { } { + variable _drag_source + return $_drag_source +};# xdnd::_GetDragSource + +# ---------------------------------------------------------------------------- +# Command xdnd::_GetDropTarget +# ---------------------------------------------------------------------------- +proc xdnd::_GetDropTarget { } { + variable _drop_target + if {[string length $_drop_target]} { + return [winfo id $_drop_target] + } + return 0 +};# xdnd::_GetDropTarget + +# ---------------------------------------------------------------------------- +# Command xdnd::_supported_types +# ---------------------------------------------------------------------------- +proc xdnd::_supported_types { types } { + set new_types {} + foreach type $types { + if {[_supported_type $type]} {lappend new_types $type} + } + return $new_types +}; # xdnd::_supported_types + +# ---------------------------------------------------------------------------- +# Command xdnd::_platform_specific_types +# ---------------------------------------------------------------------------- +proc xdnd::_platform_specific_types { types } { + set new_types {} + foreach type $types { + set new_types [concat $new_types [_platform_specific_type $type]] + } + return $new_types +}; # xdnd::_platform_specific_types + +# ---------------------------------------------------------------------------- +# Command xdnd::_normalise_data +# ---------------------------------------------------------------------------- +proc xdnd::_normalise_data { type data } { + # Tk knows how to interpret the following types: + # STRING, TEXT, COMPOUND_TEXT + # UTF8_STRING + # Else, it returns a list of 8 or 32 bit numbers... + switch -glob $type { + STRING - UTF8_STRING - TEXT - COMPOUND_TEXT {return $data} + text/html - + text/plain { + if {[catch { + encoding convertfrom utf-8 [tkdnd::bytes_to_string $data] + } string]} { + set string $data + } + return [string map {\r\n \n} $string] + } + text/uri-list* { + if {[catch { + encoding convertfrom utf-8 [tkdnd::bytes_to_string $data + } string]} { + set string $data + } + ## Get rid of \r\n + set string [string trim [string map {\r\n \n} $string]] + set files {} + foreach quoted_file [split $string] { + set file [tkdnd::urn_unquote $quoted_file] + switch -glob $file { + file://* {lappend files [string range $file 7 end]} + ftp://* - + https://* - + http://* {lappend files $quoted_file} + default {lappend files $file} + } + } + return $files + } + application/x-color { + return $data + } + text/x-moz-url - + application/q-iconlist - + default {return $data} + } +}; # xdnd::_normalise_data + +# ---------------------------------------------------------------------------- +# Command xdnd::_platform_specific_type +# ---------------------------------------------------------------------------- +proc xdnd::_platform_specific_type { type } { + switch $type { + DND_Text {return [list text/plain\;charset=utf-8 UTF8_STRING \ + text/plain STRING TEXT COMPOUND_TEXT]} + DND_Files {return [list text/uri-list]} + DND_Color {return [list application/x-color]} + default {return [list $type]} + } +}; # xdnd::_platform_specific_type + +# ---------------------------------------------------------------------------- +# Command xdnd::_platform_independent_type +# ---------------------------------------------------------------------------- +proc xdnd::_platform_independent_type { type } { + switch -glob $type { + UTF8_STRING - + STRING - + TEXT - + COMPOUND_TEXT - + text/plain* {return DND_Text} + text/uri-list* {return DND_Files} + application/x-color {return DND_Color} + default {return [list $type]} + } +}; # xdnd::_platform_independent_type + +# ---------------------------------------------------------------------------- +# Command xdnd::_supported_type +# ---------------------------------------------------------------------------- +proc xdnd::_supported_type { type } { + switch -glob [string tolower $type] { + {text/plain;charset=utf-8} - text/plain - + utf8_string - string - text - compound_text - + text/uri-list* - + application/x-color {return 1} + } + return 0 +}; # xdnd::_supported_type + +############################################################################# +## +## XDND drag implementation +## +############################################################################# + +# ---------------------------------------------------------------------------- +# Command xdnd::_selection_ownership_lost +# ---------------------------------------------------------------------------- +proc xdnd::_selection_ownership_lost {} { + variable _dragging + set _dragging 0 +};# _selection_ownership_lost + +# ---------------------------------------------------------------------------- +# Command xdnd::_dodragdrop +# ---------------------------------------------------------------------------- +proc xdnd::_dodragdrop { source actions types data button } { + variable _dragging + + # puts "xdnd::_dodragdrop: source: $source, actions: $actions, types: $types,\ + # data: \"$data\", button: $button" + if {$_dragging} { + ## We are in the middle of another drag operation... + error "another drag operation in progress" + } + + variable _dodragdrop_drag_source $source + variable _dodragdrop_drop_target 0 + variable _dodragdrop_drop_target_proxy 0 + variable _dodragdrop_actions $actions + variable _dodragdrop_action_descriptions $actions + variable _dodragdrop_actions_len [llength $actions] + variable _dodragdrop_types $types + variable _dodragdrop_types_len [llength $types] + variable _dodragdrop_data $data + variable _dodragdrop_transfer_data {} + variable _dodragdrop_button $button + variable _dodragdrop_time 0 + variable _dodragdrop_default_action refuse_drop + variable _dodragdrop_waiting_status 0 + variable _dodragdrop_drop_target_accepts_drop 0 + variable _dodragdrop_drop_target_accepts_action refuse_drop + variable _dodragdrop_current_cursor $_dodragdrop_default_action + variable _dodragdrop_drop_occured 0 + variable _dodragdrop_selection_requestor 0 + + ## + ## If we have more than 3 types, the property XdndTypeList must be set on + ## the drag source widget... + ## + if {$_dodragdrop_types_len > 3} { + _announce_type_list $_dodragdrop_drag_source $_dodragdrop_types + } + + ## + ## Announce the actions & their descriptions on the XdndActionList & + ## XdndActionDescription properties... + ## + _announce_action_list $_dodragdrop_drag_source $_dodragdrop_actions \ + $_dodragdrop_action_descriptions + + ## + ## Arrange selection handlers for our drag source, and all the supported types + ## + registerSelectionHandler $source $types + + ## + ## Step 1: When a drag begins, the source takes ownership of XdndSelection. + ## + selection own -command ::tkdnd::xdnd::_selection_ownership_lost \ + -selection XdndSelection $source + set _dragging 1 + + ## Grab the mouse pointer... + _grab_pointer $source $_dodragdrop_default_action + + ## Register our generic event handler... + # The generic event callback will report events by modifying variable + # ::xdnd::_dodragdrop_event: a dict with event information will be set as + # the value of the variable... + _register_generic_event_handler + + ## Set a timeout for debugging purposes... + # after 60000 {set ::tkdnd::xdnd::_dragging 0} + + tkwait variable ::tkdnd::xdnd::_dragging + _SendXdndLeave + + set _dragging 0 + _ungrab_pointer $source + _unregister_generic_event_handler + catch {selection clear -selection XdndSelection} + unregisterSelectionHandler $source $types +};# xdnd::_dodragdrop + +# ---------------------------------------------------------------------------- +# Command xdnd::_process_drag_events +# ---------------------------------------------------------------------------- +proc xdnd::_process_drag_events {event} { + # The return value from proc is normally 0. A non-zero return value indicates + # that the event is not to be handled further; that is, proc has done all + # processing that is to be allowed for the event + variable _dragging + if {!$_dragging} {return 0} + # puts $event + + variable _dodragdrop_time + set time [dict get $event time] + set type [dict get $event type] + if {$time < $_dodragdrop_time && ![string equal $type SelectionRequest]} { + return 0 + } + set _dodragdrop_time $time + + variable _dodragdrop_drag_source + variable _dodragdrop_drop_target + variable _dodragdrop_drop_target_proxy + variable _dodragdrop_default_action + switch $type { + MotionNotify { + set rootx [dict get $event x_root] + set rooty [dict get $event y_root] + set window [_find_drop_target_window $_dodragdrop_drag_source \ + $rootx $rooty] + if {[string length $window]} { + ## Examine the modifiers to suggest an action... + set _dodragdrop_default_action [_default_action $event] + ## Is it a Tk widget? + # set path [winfo containing $rootx $rooty] + # puts "Window under mouse: $window ($path)" + if {$_dodragdrop_drop_target != $window} { + ## Send XdndLeave to $_dodragdrop_drop_target + _SendXdndLeave + ## Is there a proxy? If not, _find_drop_target_proxy returns the + ## target window, so we always get a valid "proxy". + set proxy [_find_drop_target_proxy $_dodragdrop_drag_source $window] + ## Send XdndEnter to $window + _SendXdndEnter $window $proxy + ## Send XdndPosition to $_dodragdrop_drop_target + _SendXdndPosition $rootx $rooty $_dodragdrop_default_action + } else { + ## Send XdndPosition to $_dodragdrop_drop_target + _SendXdndPosition $rootx $rooty $_dodragdrop_default_action + } + } else { + ## No window under the mouse. Send XdndLeave to $_dodragdrop_drop_target + _SendXdndLeave + } + } + ButtonPress { + } + ButtonRelease { + variable _dodragdrop_button + set button [dict get $event button] + if {$button == $_dodragdrop_button} { + ## The button that initiated the drag was released. Trigger drop... + _SendXdndDrop + } + return 1 + } + KeyPress { + } + KeyRelease { + set keysym [dict get $event keysym] + switch $keysym { + Escape { + ## The user has pressed escape. Abort... + if {$_dragging} {set _dragging 0} + } + } + } + SelectionRequest { + variable _dodragdrop_selection_requestor + variable _dodragdrop_selection_property + variable _dodragdrop_selection_selection + variable _dodragdrop_selection_target + variable _dodragdrop_selection_time + set _dodragdrop_selection_requestor [dict get $event requestor] + set _dodragdrop_selection_property [dict get $event property] + set _dodragdrop_selection_selection [dict get $event selection] + set _dodragdrop_selection_target [dict get $event target] + set _dodragdrop_selection_time $time + return 0 + } + default { + return 0 + } + } + return 0 +};# _process_drag_events + +# ---------------------------------------------------------------------------- +# Command xdnd::_SendXdndEnter +# ---------------------------------------------------------------------------- +proc xdnd::_SendXdndEnter {window proxy} { + variable _dodragdrop_drag_source + variable _dodragdrop_drop_target + variable _dodragdrop_drop_target_proxy + variable _dodragdrop_types + variable _dodragdrop_waiting_status + variable _dodragdrop_drop_occured + if {$_dodragdrop_drop_target > 0} _SendXdndLeave + if {$_dodragdrop_drop_occured} return + set _dodragdrop_drop_target $window + set _dodragdrop_drop_target_proxy $proxy + set _dodragdrop_waiting_status 0 + if {$_dodragdrop_drop_target < 1} return + # puts "XdndEnter: $_dodragdrop_drop_target $_dodragdrop_drop_target_proxy" + _send_XdndEnter $_dodragdrop_drag_source $_dodragdrop_drop_target \ + $_dodragdrop_drop_target_proxy $_dodragdrop_types +};# xdnd::_SendXdndEnter + +# ---------------------------------------------------------------------------- +# Command xdnd::_SendXdndPosition +# ---------------------------------------------------------------------------- +proc xdnd::_SendXdndPosition {rootx rooty action} { + variable _dodragdrop_drag_source + variable _dodragdrop_drop_target + if {$_dodragdrop_drop_target < 1} return + variable _dodragdrop_drop_occured + if {$_dodragdrop_drop_occured} return + variable _dodragdrop_drop_target_proxy + variable _dodragdrop_waiting_status + ## Arrange a new XdndPosition, to be send periodically... + variable _dodragdrop_xdnd_position_heartbeat + catch {after cancel $_dodragdrop_xdnd_position_heartbeat} + set _dodragdrop_xdnd_position_heartbeat [after 200 \ + [list ::tkdnd::xdnd::_SendXdndPosition $rootx $rooty $action]] + if {$_dodragdrop_waiting_status} {return} + # puts "XdndPosition: $_dodragdrop_drop_target $rootx $rooty $action" + _send_XdndPosition $_dodragdrop_drag_source $_dodragdrop_drop_target \ + $_dodragdrop_drop_target_proxy $rootx $rooty $action + set _dodragdrop_waiting_status 1 +};# xdnd::_SendXdndPosition + +# ---------------------------------------------------------------------------- +# Command xdnd::_HandleXdndStatus +# ---------------------------------------------------------------------------- +proc xdnd::_HandleXdndStatus {event} { + variable _dodragdrop_drop_target + variable _dodragdrop_waiting_status + + variable _dodragdrop_drop_target_accepts_drop + variable _dodragdrop_drop_target_accepts_action + set _dodragdrop_waiting_status 0 + foreach key {target accept want_position action x y w h} { + set $key [dict get $event $key] + } + set _dodragdrop_drop_target_accepts_drop $accept + set _dodragdrop_drop_target_accepts_action $action + if {$_dodragdrop_drop_target < 1} return + variable _dodragdrop_drop_occured + if {$_dodragdrop_drop_occured} return + _update_cursor + # puts "XdndStatus: $event" +};# xdnd::_HandleXdndStatus + +# ---------------------------------------------------------------------------- +# Command xdnd::_HandleXdndFinished +# ---------------------------------------------------------------------------- +proc xdnd::_HandleXdndFinished {event} { + variable _dodragdrop_drop_target + set _dodragdrop_drop_target 0 + variable _dragging + if {$_dragging} {set _dragging 0} + # puts "XdndFinished: $event" +};# xdnd::_HandleXdndFinished + +# ---------------------------------------------------------------------------- +# Command xdnd::_SendXdndLeave +# ---------------------------------------------------------------------------- +proc xdnd::_SendXdndLeave {} { + variable _dodragdrop_drag_source + variable _dodragdrop_drop_target + if {$_dodragdrop_drop_target < 1} return + variable _dodragdrop_drop_target_proxy + # puts "XdndLeave: $_dodragdrop_drop_target" + _send_XdndLeave $_dodragdrop_drag_source $_dodragdrop_drop_target \ + $_dodragdrop_drop_target_proxy + set _dodragdrop_drop_target 0 + variable _dodragdrop_drop_target_accepts_drop + variable _dodragdrop_drop_target_accepts_action + set _dodragdrop_drop_target_accepts_drop 0 + set _dodragdrop_drop_target_accepts_action refuse_drop + variable _dodragdrop_drop_occured + if {$_dodragdrop_drop_occured} return + _update_cursor +};# xdnd::_SendXdndLeave + +# ---------------------------------------------------------------------------- +# Command xdnd::_SendXdndDrop +# ---------------------------------------------------------------------------- +proc xdnd::_SendXdndDrop {} { + variable _dodragdrop_drag_source + variable _dodragdrop_drop_target + if {$_dodragdrop_drop_target < 1} { + ## The mouse has been released over a widget that does not accept drops. + _HandleXdndFinished {} + return + } + variable _dodragdrop_drop_occured + if {$_dodragdrop_drop_occured} {return} + variable _dodragdrop_drop_target_proxy + variable _dodragdrop_drop_target_accepts_drop + variable _dodragdrop_drop_target_accepts_action + + set _dodragdrop_drop_occured 1 + _update_cursor clock + + if {!$_dodragdrop_drop_target_accepts_drop} { + _SendXdndLeave + _HandleXdndFinished {} + return + } + # puts "XdndDrop: $_dodragdrop_drop_target" + variable _dodragdrop_drop_timestamp + set _dodragdrop_drop_timestamp [_send_XdndDrop \ + $_dodragdrop_drag_source $_dodragdrop_drop_target \ + $_dodragdrop_drop_target_proxy] + set _dodragdrop_drop_target 0 + # puts "XdndDrop: $_dodragdrop_drop_target" + ## Arrange a timeout for receiving XdndFinished... + after 10000 [list ::tkdnd::xdnd::_HandleXdndFinished {}] +};# xdnd::_SendXdndDrop + +# ---------------------------------------------------------------------------- +# Command xdnd::_update_cursor +# ---------------------------------------------------------------------------- +proc xdnd::_update_cursor { {cursor {}}} { + # puts "_update_cursor $cursor" + variable _dodragdrop_current_cursor + variable _dodragdrop_drag_source + variable _dodragdrop_drop_target_accepts_drop + variable _dodragdrop_drop_target_accepts_action + + if {![string length $cursor]} { + set cursor refuse_drop + if {$_dodragdrop_drop_target_accepts_drop} { + set cursor $_dodragdrop_drop_target_accepts_action + } + } + if {![string equal $cursor $_dodragdrop_current_cursor]} { + _set_pointer_cursor $_dodragdrop_drag_source $cursor + set _dodragdrop_current_cursor $cursor + } +};# xdnd::_update_cursor + +# ---------------------------------------------------------------------------- +# Command xdnd::_default_action +# ---------------------------------------------------------------------------- +proc xdnd::_default_action {event} { + variable _dodragdrop_actions + variable _dodragdrop_actions_len + if {$_dodragdrop_actions_len == 1} {return [lindex $_dodragdrop_actions 0]} + + set alt [dict get $event Alt] + set shift [dict get $event Shift] + set control [dict get $event Control] + + if {$shift && $control && [lsearch $_dodragdrop_actions link] != -1} { + return link + } elseif {$control && [lsearch $_dodragdrop_actions copy] != -1} { + return copy + } elseif {$shift && [lsearch $_dodragdrop_actions move] != -1} { + return move + } elseif {$alt && [lsearch $_dodragdrop_actions link] != -1} { + return link + } + return default +};# xdnd::_default_action + +# ---------------------------------------------------------------------------- +# Command xdnd::getFormatForType +# ---------------------------------------------------------------------------- +proc xdnd::getFormatForType {type} { + switch -glob [string tolower $type] { + text/plain\;charset=utf-8 - + utf8_string {set format UTF8_STRING} + text/plain - + string - + text - + compound_text {set format STRING} + text/uri-list* {set format UTF8_STRING} + application/x-color {set format $type} + default {set format $type} + } + return $format +};# xdnd::getFormatForType + +# ---------------------------------------------------------------------------- +# Command xdnd::registerSelectionHandler +# ---------------------------------------------------------------------------- +proc xdnd::registerSelectionHandler {source types} { + foreach type $types { + selection handle -selection XdndSelection \ + -type $type \ + -format [getFormatForType $type] \ + $source [list ::tkdnd::xdnd::_SendData $type] + } +};# xdnd::registerSelectionHandler + +# ---------------------------------------------------------------------------- +# Command xdnd::unregisterSelectionHandler +# ---------------------------------------------------------------------------- +proc xdnd::unregisterSelectionHandler {source types} { + foreach type $types { + catch { + selection handle -selection XdndSelection \ + -type $type \ + -format [getFormatForType $type] \ + $source {} + } + } +};# xdnd::unregisterSelectionHandler + +# ---------------------------------------------------------------------------- +# Command xdnd::_convert_to_unsigned +# ---------------------------------------------------------------------------- +proc xdnd::_convert_to_unsigned {data format} { + switch $format { + 8 { set mask 0xff } + 16 { set mask 0xffff } + 32 { set mask 0xffffff } + default {error "unsupported format $format"} + } + ## Convert signed integer into unsigned... + set d [list] + foreach num $data { + lappend d [expr { $num & $mask }] + } + return $d +};# xdnd::_convert_to_unsigned + +# ---------------------------------------------------------------------------- +# Command xdnd::_SendData +# ---------------------------------------------------------------------------- +proc xdnd::_SendData {type offset bytes args} { + variable _dodragdrop_drag_source + variable _dodragdrop_data + variable _dodragdrop_transfer_data + set format 8 + if {$offset == 0} { + ## Prepare the data to be transfered... + switch -glob $type { + text/plain* - UTF8_STRING - STRING - TEXT - COMPOUND_TEXT { + binary scan [encoding convertto utf-8 $_dodragdrop_data] \ + c* _dodragdrop_transfer_data + set _dodragdrop_transfer_data \ + [_convert_to_unsigned $_dodragdrop_transfer_data $format] + } + text/uri-list* { + set files [list] + foreach file $_dodragdrop_data { + switch -glob $file { + *://* {lappend files $file} + default {lappend files file://$file} + } + } + binary scan [encoding convertto utf-8 "[join $files \r\n]\r\n"] \ + c* _dodragdrop_transfer_data + set _dodragdrop_transfer_data \ + [_convert_to_unsigned $_dodragdrop_transfer_data $format] + } + application/x-color { + set format 16 + ## Try to understand the provided data: we accept a standard Tk colour, + ## or a list of 3 values (red green blue) or a list of 4 values + ## (red green blue opacity). + switch [llength $_dodragdrop_data] { + 1 { set color [winfo rgb $_dodragdrop_drag_source $_dodragdrop_data] + lappend color 65535 } + 3 { set color $_dodragdrop_data; lappend color 65535 } + 4 { set color $_dodragdrop_data } + default {error "unknown color data: \"$_dodragdrop_data\""} + } + ## Convert the 4 elements into 16 bit values... + set _dodragdrop_transfer_data [list] + foreach c $color { + lappend _dodragdrop_transfer_data [format 0x%04X $c] + } + } + default { + set format 32 + binary scan $_dodragdrop_data c* _dodragdrop_transfer_data + } + } + } + + ## + ## Data has been split into bytes. Count the bytes requested, and return them + ## + set data [lrange $_dodragdrop_transfer_data $offset [expr {$offset+$bytes-1}]] + switch $format { + 8 { + set data [encoding convertfrom utf-8 [binary format c* $data]] + } + 16 { + variable _dodragdrop_selection_requestor + if {$_dodragdrop_selection_requestor} { + ## Tk selection cannot process this format (only 8 & 32 supported). + ## Call our XChangeProperty... + set numItems [llength $data] + variable _dodragdrop_selection_property + variable _dodragdrop_selection_selection + variable _dodragdrop_selection_target + variable _dodragdrop_selection_time + XChangeProperty $_dodragdrop_drag_source \ + $_dodragdrop_selection_requestor \ + $_dodragdrop_selection_property \ + $_dodragdrop_selection_target \ + $format \ + $_dodragdrop_selection_time \ + $data $numItems + return -code break + } + } + 32 { + } + default { + error "unsupported format $format" + } + } + # puts "SendData: $type $offset $bytes $args ($_dodragdrop_data)" + # puts " $data" + return $data +};# xdnd::_SendData diff --git a/modules/tkdnd2.6/tkdnd_windows.tcl b/modules/tkdnd2.6/tkdnd_windows.tcl new file mode 100644 index 0000000..32b0187 --- /dev/null +++ b/modules/tkdnd2.6/tkdnd_windows.tcl @@ -0,0 +1,360 @@ +# +# tkdnd_windows.tcl -- +# +# This file implements some utility procedures that are used by the TkDND +# package. +# +# This software is copyrighted by: +# George Petasis, National Centre for Scientific Research "Demokritos", +# Aghia Paraskevi, Athens, Greece. +# e-mail: petasis@iit.demokritos.gr +# +# The following terms apply to all files associated +# with the software unless explicitly disclaimed in individual files. +# +# The authors hereby grant permission to use, copy, modify, distribute, +# and license this software and its documentation for any purpose, provided +# that existing copyright notices are retained in all copies and that this +# notice is included verbatim in any distributions. No written agreement, +# license, or royalty fee is required for any of the authorized uses. +# Modifications to this software may be copyrighted by their authors +# and need not follow the licensing terms described here, provided that +# the new terms are clearly indicated on the first page of each file where +# they apply. +# +# IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY +# FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES +# ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY +# DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE +# POSSIBILITY OF SUCH DAMAGE. +# +# THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, +# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, +# FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE +# IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE +# NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR +# MODIFICATIONS. +# + +namespace eval olednd { + variable _types {} + variable _typelist {} + variable _codelist {} + variable _actionlist {} + variable _pressedkeys {} + variable _action {} + variable _common_drag_source_types {} + variable _common_drop_target_types {} + variable _unhandled_types {} +};# namespace olednd + +# ---------------------------------------------------------------------------- +# Command olednd::_HandleDragEnter +# ---------------------------------------------------------------------------- +proc olednd::_HandleDragEnter { drop_target typelist actionlist pressedkeys + rootX rootY codelist } { + variable _typelist; set _typelist $typelist + variable _codelist; set _codelist $codelist + variable _actionlist; set _actionlist $actionlist + variable _pressedkeys; set _pressedkeys $pressedkeys + variable _action; set _action {} + variable _common_drag_source_types; set _common_drag_source_types {} + variable _common_drop_target_types; set _common_drop_target_types {} + # puts "olednd::_HandleDragEnter: drop_target=$drop_target,\ + # typelist=$typelist, actionlist=$actionlist,\ + # pressedkeys=$pressedkeys, rootX=$rootX, rootY=$rootY" + focus $drop_target + + ## Does the new drop target support any of our new types? + variable _types; set _types [bind $drop_target <>] + if {[llength $_types]} { + ## Examine the drop target types, to find at least one match with the drag + ## source types... + set supported_types [_supported_types $_typelist] + foreach type $_types { + foreach matched [lsearch -glob -all -inline $supported_types $type] { + ## Drop target supports this type. + lappend common_drag_source_types $matched + lappend common_drop_target_types $type + } + } + } + + set _action refuse_drop + if {[info exists common_drag_source_types]} { + set _action copy + set _common_drag_source_types $common_drag_source_types + set _common_drop_target_types $common_drop_target_types + ## Drop target supports at least one type. Send a <>. + set cmd [bind $drop_target <>] + if {[string length $cmd]} { + set cmd [string map [list %W $drop_target %X $rootX %Y $rootY \ + %CST \{$_common_drag_source_types\} \ + %CTT \{$_common_drop_target_types\} \ + %ST \{$_typelist\} %TT \{$_types\} \ + %A $_action %a \{$_actionlist\} \ + %b \{$_pressedkeys\} %m \{$_pressedkeys\} \ + %D \{\} %e <> \ + %L \{$_typelist\} %% % \ + %t \{$_typelist\} %T \{[lindex $_common_drag_source_types 0]\} \ + %c \{$_codelist\} %C \{[lindex $_codelist 0]\} \ + ] $cmd] + set _action [uplevel \#0 $cmd] + } + } + if {$::tkdnd::_auto_update} {update} + # Return values: copy, move, link, ask, private, refuse_drop, default + return $_action +};# olednd::_HandleDragEnter + +# ---------------------------------------------------------------------------- +# Command olednd::_HandleDragOver +# ---------------------------------------------------------------------------- +proc olednd::_HandleDragOver { drop_target pressedkeys rootX rootY } { + variable _types + variable _typelist + variable _codelist + variable _actionlist + variable _pressedkeys + variable _action + variable _common_drag_source_types + variable _common_drop_target_types + # puts "olednd::_HandleDragOver: drop_target=$drop_target,\ + # pressedkeys=$pressedkeys, rootX=$rootX, rootY=$rootY" + + if {![llength $_common_drag_source_types]} {return refuse_drop} + set _pressedkeys $pressedkeys + set cmd [bind $drop_target <>] + if {[string length $cmd]} { + set cmd [string map [list %W $drop_target %X $rootX %Y $rootY \ + %CST \{$_common_drag_source_types\} \ + %CTT \{$_common_drop_target_types\} \ + %ST \{$_typelist\} %TT \{$_types\} \ + %A $_action %a \{$_actionlist\} \ + %b \{$_pressedkeys\} %m \{$_pressedkeys\} \ + %D \{\} %e <> \ + %L \{$_typelist\} %% % \ + %t \{$_typelist\} %T \{[lindex $_common_drag_source_types 0]\} \ + %c \{$_codelist\} %C \{[lindex $_codelist 0]\} \ + ] $cmd] + set _action [uplevel \#0 $cmd] + } + if {$::tkdnd::_auto_update} {update} + # Return values: copy, move, link, ask, private, refuse_drop, default + return $_action +};# olednd::_HandleDragOver + +# ---------------------------------------------------------------------------- +# Command olednd::_HandleDragLeave +# ---------------------------------------------------------------------------- +proc olednd::_HandleDragLeave { drop_target } { + variable _types + variable _typelist + variable _codelist + variable _actionlist + variable _pressedkeys + variable _action + variable _common_drag_source_types + variable _common_drop_target_types + if {![llength $_common_drag_source_types]} {return} + foreach var {_types _typelist _actionlist _pressedkeys _action + _common_drag_source_types _common_drop_target_types} { + set $var {} + } + + set cmd [bind $drop_target <>] + if {[string length $cmd]} { + set cmd [string map [list %W $drop_target %X 0 %Y 0 \ + %CST \{$_common_drag_source_types\} \ + %CTT \{$_common_drop_target_types\} \ + %ST \{$_typelist\} %TT \{$_types\} \ + %A \{$_action\} %a \{$_actionlist\} \ + %b \{$_pressedkeys\} %m \{$_pressedkeys\} \ + %D \{\} %e <> \ + %L \{$_typelist\} %% % \ + %t \{$_typelist\} %T \{[lindex $_common_drag_source_types 0]\} \ + %u \{$_codelist\} %C \{[lindex $_codelist 0]\} \ + ] $cmd] + set _action [uplevel \#0 $cmd] + } + if {$::tkdnd::_auto_update} {update} +};# olednd::_HandleDragLeave + +# ---------------------------------------------------------------------------- +# Command olednd::_HandleXdndDrop +# ---------------------------------------------------------------------------- +proc olednd::_HandleDrop { drop_target pressedkeys rootX rootY _type data } { + variable _types + variable _typelist + variable _codelist + variable _actionlist + variable _pressedkeys + variable _action + variable _common_drag_source_types + variable _common_drop_target_types + set data [_normalise_data $_type $data] + # puts "olednd::_HandleDrop: drop_target=$drop_target,\ + # pressedkeys=$pressedkeys, rootX=$rootX, rootY=$rootY,\ + # data=\"$data\"" + + if {![llength $_common_drag_source_types]} {return refuse_drop} + set _pressedkeys $pressedkeys + ## Try to select the most specific <> event. + foreach type [concat $_common_drag_source_types $_common_drop_target_types] { + set type [_platform_independent_type $type] + set cmd [bind $drop_target <>] + if {[string length $cmd]} { + set cmd [string map [list %W $drop_target %X $rootX %Y $rootY \ + %CST \{$_common_drag_source_types\} \ + %CTT \{$_common_drop_target_types\} \ + %ST \{$_typelist\} %TT \{$_types\} \ + %A $_action %a \{$_actionlist\} \ + %b \{$_pressedkeys\} %m \{$_pressedkeys\} \ + %D [list $data] %e <> \ + %L \{$_typelist\} %% % \ + %t \{$_typelist\} %T \{[lindex $_common_drag_source_types 0]\} \ + %c \{$_codelist\} %C \{[lindex $_codelist 0]\} \ + ] $cmd] + return [uplevel \#0 $cmd] + } + } + set cmd [bind $drop_target <>] + if {[string length $cmd]} { + set cmd [string map [list %W $drop_target %X $rootX %Y $rootY \ + %CST \{$_common_drag_source_types\} \ + %CTT \{$_common_drop_target_types\} \ + %ST \{$_typelist\} %TT \{$_types\} \ + %A $_action %a \{$_actionlist\} \ + %b \{$_pressedkeys\} %m \{$_pressedkeys\} \ + %D [list $data] %e <> \ + %L \{$_typelist\} %% % \ + %t \{$_typelist\} %T \{[lindex $_common_drag_source_types 0]\} \ + %c \{$_codelist\} %C \{[lindex $_codelist 0]\} \ + ] $cmd] + set _action [uplevel \#0 $cmd] + } + if {$::tkdnd::_auto_update} {update} + # Return values: copy, move, link, ask, private, refuse_drop + return $_action +};# olednd::_HandleXdndDrop + +# ---------------------------------------------------------------------------- +# Command olednd::_GetDropTypes +# ---------------------------------------------------------------------------- +proc olednd::_GetDropTypes { drop_target } { + variable _common_drag_source_types + return $_common_drag_source_types +};# olednd::_GetDropTypes + +# ---------------------------------------------------------------------------- +# Command olednd::_GetDroppedData +# ---------------------------------------------------------------------------- +proc olednd::_GetDroppedData { } { + variable _drop_target + return [selection get -displayof $_drop_target \ + -selection XdndSelection -type STRING] +};# olednd::_GetDroppedData + +# ---------------------------------------------------------------------------- +# Command olednd::_GetDragSource +# ---------------------------------------------------------------------------- +proc olednd::_GetDragSource { } { + variable _drag_source + return $_drag_source +};# olednd::_GetDragSource + +# ---------------------------------------------------------------------------- +# Command olednd::_GetDropTarget +# ---------------------------------------------------------------------------- +proc olednd::_GetDropTarget { } { + variable _drop_target + return [winfo id $_drop_target] +};# olednd::_GetDropTarget + +# ---------------------------------------------------------------------------- +# Command olednd::_supported_types +# ---------------------------------------------------------------------------- +proc olednd::_supported_types { types } { + set new_types {} + foreach type $types { + if {[_supported_type $type]} {lappend new_types $type} + } + return $new_types +}; # olednd::_supported_types + +# ---------------------------------------------------------------------------- +# Command olednd::_platform_specific_types +# ---------------------------------------------------------------------------- +proc olednd::_platform_specific_types { types } { + set new_types {} + foreach type $types { + set new_types [concat $new_types [_platform_specific_type $type]] + } + return $new_types +}; # olednd::_platform_specific_types + +# ---------------------------------------------------------------------------- +# Command olednd::_platform_independent_types +# ---------------------------------------------------------------------------- +proc olednd::_platform_independent_types { types } { + set new_types {} + foreach type $types { + set new_types [concat $new_types [_platform_independent_type $type]] + } + return $new_types +}; # olednd::_platform_independent_types + +# ---------------------------------------------------------------------------- +# Command olednd::_normalise_data +# ---------------------------------------------------------------------------- +proc olednd::_normalise_data { type data } { + switch $type { + CF_HDROP {return $data} + DND_Text {return [list CF_UNICODETEXT CF_TEXT]} + DND_Files {return [list CF_HDROP]} + default {return $data} + } +}; # olednd::_normalise_data + +# ---------------------------------------------------------------------------- +# Command olednd::_platform_specific_type +# ---------------------------------------------------------------------------- +proc olednd::_platform_specific_type { type } { + switch $type { + DND_Text {return [list CF_UNICODETEXT CF_TEXT]} + DND_Files {return [list CF_HDROP]} + default { + # variable _unhandled_types + # if {[lsearch -exact $_unhandled_types $type] == -1} { + # lappend _unhandled_types $type + # } + return [list $type]} + } +}; # olednd::_platform_specific_type + +# ---------------------------------------------------------------------------- +# Command olednd::_platform_independent_type +# ---------------------------------------------------------------------------- +proc olednd::_platform_independent_type { type } { + switch $type { + CF_UNICODETEXT - CF_TEXT {return DND_Text} + CF_HDROP {return DND_Files} + default {return [list $type]} + } +}; # olednd::_platform_independent_type + +# ---------------------------------------------------------------------------- +# Command olednd::_supported_type +# ---------------------------------------------------------------------------- +proc olednd::_supported_type { type } { + # return 1; + switch $type { + CF_UNICODETEXT - CF_TEXT - + FileGroupDescriptor - FileGroupDescriptorW - + CF_HDROP {return 1} + } + # Is the type in our known, but unhandled types? + variable _unhandled_types + if {[lsearch -exact $_unhandled_types $type] != -1} {return 1} + return 0 +}; # olednd::_supported_type diff --git a/modules/untested_tkdnd_wrapper.py b/modules/untested_tkdnd_wrapper.py new file mode 100644 index 0000000..b2f12ef --- /dev/null +++ b/modules/untested_tkdnd_wrapper.py @@ -0,0 +1,97 @@ +import os +import Tkinter + +def _load_tkdnd(master): + tkdndlib = os.environ.get('TKDND_LIBRARY') + if tkdndlib: + master.tk.eval('global auto_path; lappend auto_path {%s}' % tkdndlib) + master.tk.eval('package require tkdnd') + master._tkdnd_loaded = True + + +class TkDND(object): + def __init__(self, master): + if not getattr(master, '_tkdnd_loaded', False): + _load_tkdnd(master) + self.master = master + self.tk = master.tk + + # Available pre-defined values for the 'dndtype' parameter: + # text/plain + # text/plain;charset=UTF-8 + # text/uri-list + + def bindtarget(self, window, callback, dndtype, event='', priority=50): + cmd = self._prepare_tkdnd_func(callback) + return self.tk.call('dnd', 'bindtarget', window, dndtype, event, + cmd, priority) + + def bindtarget_query(self, window, dndtype=None, event=''): + return self.tk.call('dnd', 'bindtarget', window, dndtype, event) + + def cleartarget(self, window): + self.tk.call('dnd', 'cleartarget', window) + + + def bindsource(self, window, callback, dndtype, priority=50): + cmd = self._prepare_tkdnd_func(callback) + self.tk.call('dnd', 'bindsource', window, dndtype, cmd, priority) + + def bindsource_query(self, window, dndtype=None): + return self.tk.call('dnd', 'bindsource', window, dndtype) + + def clearsource(self, window): + self.tk.call('dnd', 'clearsource', window) + + + def drag(self, window, actions=None, descriptions=None, + cursorwin=None, callback=None): + cmd = None + if cursorwin is not None: + if callback is not None: + cmd = self._prepare_tkdnd_func(callback) + self.tk.call('dnd', 'drag', window, actions, descriptions, + cursorwin, cmd) + + + _subst_format = ('%A', '%a', '%b', '%D', '%d', '%m', '%T', + '%W', '%X', '%Y', '%x', '%y') + _subst_format_str = " ".join(_subst_format) + + def _prepare_tkdnd_func(self, callback): + funcid = self.master.register(callback, self._dndsubstitute) + cmd = ('%s %s' % (funcid, self._subst_format_str)) + return cmd + + def _dndsubstitute(self, *args): + if len(args) != len(self._subst_format): + return args + + def try_int(x): + x = str(x) + try: + return int(x) + except ValueError: + return x + + A, a, b, D, d, m, T, W, X, Y, x, y = args + + event = Tkinter.Event() + event.action = A # Current action of the drag and drop operation. + event.action_list = a # Action list supported by the drag source. + event.mouse_button = b # Mouse button pressed during the drag and drop. + event.data = D # The data that has been dropped. + event.descr = d # The list of descriptions. + event.modifier = m # The list of modifier keyboard keys pressed. + event.dndtype = T + event.widget = self.master.nametowidget(W) + event.x_root = X # Mouse pointer x coord, relative to the root win. + event.y_root = Y + event.x = x # Mouse pointer x coord, relative to the widget. + event.y = y + + event.action_list = str(event.action_list).split() + for name in ('mouse_button', 'x', 'y', 'x_root', 'y_root'): + setattr(event, name, try_int(getattr(event, name))) + + return (event, )