Merge pull request #25 from Anjok07/beta

v4.0.0 Release
This commit is contained in:
Dilan Boskan 2020-11-13 12:55:34 +01:00 committed by GitHub
commit 9eb6ed6c13
54 changed files with 10355 additions and 471 deletions

Binary file not shown.

Before

Width:  |  Height:  |  Size: 84 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 100 KiB

201
README.md
View File

@ -1,56 +1,185 @@
# Ultimate Vocal Remover GUI
# Ultimate Vocal Remover GUI v4.0.0
<img src="https://raw.githubusercontent.com/Anjok07/ultimatevocalremovergui/beta/img/UVRVP4.png" />
***NEW VERSION WITH BRAND NEW MODELS COMING 11/14/2020! SEE THE BETA BRANCH FOR MORE DETAILS!***
[![Release](https://img.shields.io/github/release/anjok07/ultimatevocalremovergui.svg)](https://github.com/anjok07/ultimatevocalremovergui/releases/latest)
[![Downloads](https://img.shields.io/github/downloads/anjok07/ultimatevocalremovergui/total.svg)](https://github.com/anjok07/ultimatevocalremovergui/releases)
![alt text](https://raw.githubusercontent.com/Anjok07/ultimatevocalremovergui/master/Images/UVR-App.jpg)
## About
This project is a GUI version of the vocal remover created and posted by tsurumeso. This is a deep-learning-based tool that extracts the instrumental from a track containing vocals. This would not have been possible without tsurumeso's hard work and dedication! You can find tsurumeso's original command line version [here](https://github.com/tsurumeso/vocal-remover)
This application is a GUI version of the vocal remover AI created and posted by GitHub user [tsurumeso](https://github.com/tsurumeso). You can find tsurumeso's original command line version [here](https://github.com/tsurumeso/vocal-remover).
- **Special Thanks**
- [tsurumeso](https://github.com/tsurumeso) - The engineer who authored the AI code. Thank you for the hard work and dedication you put into the AI application this GUI is built around!
- [DilanBoskan](https://github.com/DilanBoskan) - The main GUI code contributor. Thank you for helping bring this GUI to life! Your hard work and continued support is greatly appreciated.
## Installation
The application was made with Tkinter for cross platform compatibility, so this should work with Windows, Mac, and Linux systems. I've only personally tested this on Windows 10 & Linux Ubuntu.
The application was made with Tkinter for cross-platform compatibility, so it should work with Windows, Mac, and Linux systems. However, this application has only been tested on Windows 10 & Linux Ubuntu.
### Install Required Applications & Packages
1. Download & install Python 3.7 (Make sure to check the box that says "Add Python 3.7 to PATH" if you're on Windows)
2. Once Python has installed, open the Windows Command Prompt and run the following installs -
- If you plan on doing conversions with your Nvidia GPU, please install the following -
1. Download & install Python 3.7 [here](https://www.python.org/ftp/python/3.7.0/python-3.7.0-amd64.exe) (Windows link)
- **Note:** Ensure the *"Add Python 3.7 to PATH"* box is checked
2. Once Python has installed, download **Ultimate Vocal Remover GUI Version 4.0.0** [here](https://github.com/Anjok07/ultimatevocalremovergui/releases/download/v4.0.0/UVR-V4GUI.zip)
3. Place the UVR-V4GUI folder contained within the *.zip* file where ever you wish.
- Your documents folder or home directory is recommended for easy access.
4. From the UVR-V4GUI directory, open the Windows Command Prompt and run the following installs -
```
pip install --no-cache-dir -r requirements.txt
pip install torch==1.6.0+cu101 torchvision==0.7.0+cu101 -f https://download.pytorch.org/whl/torch_stable.html
```
- If you don't have a compatible Nvidia GPU and plan on only using the CPU version please do not check the "GPU Conversion" option in the GUI and install the following -
### FFmpeg
FFmpeg must be installed and configured in order for the application to be able to process any track that isn't a *.wav* file. Instructions for installing FFmpeg can be found on YouTube, WikiHow, Reddit, GitHub, and many other sources around the web.
- **Note:** If you are experiencing any errors when attempting to process any media files that are not in the *.wav* format, please ensure FFmpeg is installed & configured correctly.
### Running the Vocal Remover GUI & Models
- Open the file labeled *'VocalRemover.py'*.
- It's recommended that you create a shortcut for the file labeled *'VocalRemover.py'* to your desktop for easy access.
- **Note:** If you are unable to open the *'VocalRemover.py'* file, please go to the [**troubleshooting**](https://github.com/Anjok07/ultimatevocalremovergui/tree/beta#troubleshooting) section below.
- **Note:** All output audio files will be in the *'.wav'* format.
## Option Guide
### Choose AI Engine:
- This option allows you to toggle between tsurumeso's v2 & v4 AI engines.
- **Note:** Each engine comes with it's own set of models.
- **Note:** The TTA option and the ability to set the N_FFT value is limited to the v4 engine only.
### Model Selections:
The v2 & v4 AI engines use different sets of models. When selected, the models available for v2 or v4 will automatically populate within the model selection dropdowns.
- **Choose Main Model** - Here is where you choose the main model to perform a deep vocal removal.
- Each of the models provided were trained on different parameters, though they can convert tracks of all genres.
- Each model differs in the way they process given tracks.
- The [*'Model Test Mode'*](https://github.com/Anjok07/ultimatevocalremovergui/tree/beta#checkboxes) option makes it easier for the user to test different models on given tracks.
- **Choose Stacked Model** - These models are meant to clean up vocal artifacts from instrumental outputs.
- The stacked models provided are only meant to process instrumental outputs created by a main model.
- Selecting the [*'Stack Passes'*](https://github.com/Anjok07/ultimatevocalremovergui/tree/beta#checkboxes) option will enable you to select a stacked model to run with a main model.
- If you wish to only run a stacked model on a track, make sure the [*'Stack Conversion Only'*](https://github.com/Anjok07/ultimatevocalremovergui/tree/beta#checkboxes) option is checked.
- The wide range of main model/stacked model combinations gives the user more flexibility in discovering what model blend works best for the track(s) they are proessing.
- To reiterate, the [*'Model Test Mode'*](https://github.com/Anjok07/ultimatevocalremovergui/tree/beta#checkboxes) option streamlines the process of testing different main model/stacked model combinations on a given track. More information on this option can be found in the next section.
### Checkboxes
- **GPU Conversion** - Selecting this option ensures the GPU is used to process conversions.
- **Note:** This option will not work if you don't have a Cuda compatible GPU.
- Nividia GPU's are most compatible with Cuda.
- **Note:** CPU conversions are much slower compared to those processed through the GPU.
- **Post-process** - This option can potentially identify leftover instrumental artifacts within the vocal outputs. This option may improve the separation on *some* songs.
- **Note:** Having this option selected can potentially have an adverse effect on the conversion process, depending on the track. Because of this, it's only recommended as a last resort.
- **TTA** - This option performs Test-Time-Augmentation to improve the separation quality.
- **Note:** Having this selected will increase the time it takes to complete a conversion.
- **Note:** This option is ***not*** compatible with the *v2* AI engine.
- **Output Image** - Selecting this option will include the spectrograms in *.jpg* format for the instrumental & vocal audio outputs.
- **Stack Passes** - This option activates the stacked model conversion process and allows the user to set the number of times a track runs through a stacked model.
- **Note:** Unless you have the *'Save All Stacked Outputs'* option selected, the following outputs will be saved -
- Instrumental generated after the last stack pass &
- The vocal track generated by the main model
- **Note:** The best range is 3-7 passes. 8 or more passes can result in degraded sound quality for the track.
- **Stack Conversion Only** - Selecting this option allows the user to bypass the main model and run a track through a stacked model only.
- **Save All Stacked Outputs** - Having this option selected will auto-generate a new folder named after the track being processed to your *'Save to'* path. The new folder will contain all of the outputs that were generated after each stack pass. The amount of audio outputs will depend on the number of stack passes chosen.
- **Note:** Each output audio file will be appended with the number of passes it has had.
- **Example:** If 5 stack passes are chosen, the application will provide you with all 5 pairs of audio outputs generated after each pass, if this option is enabled.
- This option can be very useful in determining the optimal number of passes needed to clean a track.
- The *'stacked vocal'* tracks will contain the audio of the vocal artifacts that were removed from the instrumental.
- These files can be used to verify artifact removal.
- **Model Test Mode** - This option makes it easier for users to test the results of different models, and model combinations, by eliminating the hassel of having to manually change the filenames and/or create new folders when processing the same track through multiple models. This option structures the model testing process.
- When *'Model Test Mode'* is selected, the application will auto-generate a new folder in the *'Save to'* path you have chosen.
- The new auto-generated folder will be named after the model(s) selected.
- The output audio files will be saved to the auto-generated directory.
- The filenames for the instrumental & vocal outputs will have the selected model(s) name(s) appended to them.
### Parameter Values
All models released here will have the values they were trained with appended to the end of their filenames like so, **'MGM-HIGHEND_sr44100_hl512_w512_nf2048.pth'**. The *'_sr44100_hl512_w512_nf2048'* portion automatically sets the *SR*, *HOP LENGNTH*, *WINDOW SIZE*, & *N_FFT* values within the application. If there are no values appended to the end of a selected model filename, the *SR*, *HOP LENGNTH*, *WINDOW SIZE*, & *N_FFT* fields will be editable and auto-populate with default values.
- **Default Values:**
- **SR** - 44100
- **HOP LENGTH** - 1024
- **WINDOW SIZE** - 512
- **N_FFT** - 2048
### Other Buttons:
- **Add New Model** - This button will automatically open the models folder.
- **Note:** If you are adding a new model, make sure to add it accordingly based on the AI engine it was trained on.
- **Example:** If you wish to add a model trained on the v4 engine, add it to the correct folder located in the 'models/v4/' directory.
- **Note:** The application will automatically detect any models added the correct directories without needing a restart.
- **Restart Button** - If the application hangs for any reason, you can hit the circular arrow button immediately to the right of the *'Start Conversion'* button.
## Models Included
All of the models included in the release were trained on large datasets containing diverse sets of music genres.
**PLEASE NOTE:** Do not change the name of the models provided! The required parameters are specified and appended to the end of the filenames.
Here's a list of the models included within the package -
- **v4 AI Engine**
- **Main Models**
- **MGM_MAIN_v4_sr44100_hl512_w512_nf2048.pth** - This is the main model that does an excellent job removing vocals from most tracks.
- **MGM_LOWEND_A_v4_sr32000_hl512_w512_nf2048.pth** - This model focuses a bit more on removing vocals from lower frequencies.
- **MGM_LOWEND_B_v4_sr33075_hl384_w512_nf2048.pth** - This is also a model that focuses on lower end frequencies, but trained with different parameters.
- **MGM_HIGHEND_v4_sr44100_hl1024_nf2048.pth** - This model slightly focuses a bit more on higher end frequencies.
- **MODEL_BVKARAOKE_by_aufr33_v4_sr33075_hl384_w512_nf1536.pth** - This is a beta model that removes main vocals while leaving background vocals intact.
- **Stacked Models**
- **StackedMGM_MM_v4_sr44100_hl512_w512_nf2048.pth** - This is a strong vocal artifact removal model. This model was made to run with *'MGM_MAIN_v4_sr44100_hl512_w512_nf2048.pth'*. However, any combination may yield the desired results.
- **StackedMGM_MLA_v4_sr32000_hl512_w512_nf2048.pth** - This is a strong vocal artifact removal model. This model was made to run with *'MGM_MAIN_v4_sr44100_hl512_w512_nf2048.pth'*. However, any combination may yield a desired results.
- **StackedMGM_LL_v4_sr32000_hl512_w512_nf2048.pth** - This is a strong vocal artifact removal model. This model was made to run with *'MGM_LOWEND_A_v4_sr32000_hl512_w512_nf2048.pth'*. However, any combination may yield a desired results.
- **v2 AI Engine**
- **Main Models**
- **Multi_Genre_Model_v2_sr44100_hl1024_w512.pth** - This model yields excellent results for most tracks processed through it.
- **Stacked Models**
- **StackedRegA_v2_sr44100_hl1024_w512.pth** - This is a standard vocal artifact removal model.
- **StackedRegB_v2_sr44100_hl1024_w512.pth** - This is a standard vocal artifact removal model.
- **StackedArg_v2_sr44100_hl1024_w512.pth** - This model removes vocal artifacts a bit more aggressively, but may greatly degrade the audio quality of the output audio.
A special thank you to aufr33 for helping me expand the dataset used to train some of these models and for the helpful training tips.
## Other GUI Notes
- The application will automatically remember your *'save to'* path upon closing and reopening until it's changed.
- **Note:** The last directory accessed within the application will also be remembered.
- Multiple conversions are supported.
- The ability to drag & drop audio files to convert has also been added.
- Conversion times will greatly depend on your hardware.
- **Note:** This application will *not* be friendly to older or budget hardware. Please proceed with caution! Pay attention to your PC and make sure it doesn't overheat. ***We are not responsible for any hardware damage.***
## Troubleshooting
### Common Issues
- This application is not compatible with 32-bit versions of Python. Please make sure your version of Python is 64-bit.
- If FFmpeg is not installed, the application will throw an error if the user attempts to convert a non-WAV file.
### Issue Reporting
Please be as detailed as possible when posting a new issue. Make sure to provide any error outputs and/or screenshots/gif's to give us a clearer understanding of the issue you are experiencing.
If the *'VocalRemover.py'* file won't open *under any circumstances* and all other resources have been exhausted, please do the following -
1. Open the cmd prompt from the UVR-V4GUI directory
2. Run the following command -
```
pip install torch==1.6.0+cpu torchvision==0.7.0+cpu -f https://download.pytorch.org/whl/torch_stable.html
python VocalRemover.py
```
- The rest need to be installed as well -
3. Copy and paste the error output in the cmd prompt to the issues center on the GitHub repository.
```
pip install Pillow
pip install tqdm==4.30.0
pip install librosa==0.6.3
pip install opencv-python
pip install numba==0.48.0
pip install SoundFile
pip install soundstretch
```
3. For the ability to convert mp3, mp4, m4a, flac, along with other media formats, you'll need ffmpeg installed and configured!
## License
### Getting the Vocal Remover GUI & Models
Download the latest version from [here](https://github.com/Anjok07/ultimatevocalremovergui/releases/tag/v2.2.0-GUI).
The **Ultimate Vocal Remover GUI** code is [MIT-licensed](LICENSE).
## Running the Vocal Remover Application GUI
1. Extract the contents where ever you wish (I put mine in my documents folder) and open the file labeled "VocalRemover.py" (I recommend you create a shortcut for the file labeled "VocalRemover.py" to your desktop).
2. Open the application.
## Contributing
### Notes Regarding the GUI
- For anyone interested in the ongoing development of **Ultimate Vocal Remover GUI** please send us a pull request and we will review it. This project is 100% open-source and free for anyone to use and/or modify as they wish.
- Please note that we do not maintain or directly support any of tsurumesos AI application code. We only maintain the development and support for the **Ultimate Vocal Remover GUI**.
 - The application will automatically remember your "save to" path upon closing and re-opening until you change it
 - You can select as many files as you like. Multiple conversions are supported!
 - Conversions on wav files should always work with no issue. However, you will need to install and configure ffmpeg in order for conversions on any other media file to work. If you select non-wav music files without having ffmpeg configured and attempt a conversion it will freeze and you will have to restart the application.
 - Only check the GPU box if you have the Cuda driver installed for your Nvidia GPU. Most Nvidia GPU's released prior to 2015 or with less than 4GB's of V-RAM might not be compatible.
- The dropdown model menu consists of the models that I trained with roughly 700 pairs. I included the option to add your own model as well if you've trained your own. Alternatively, you can also simply add a model to the models directory and restart the application, as it will automatically show there.
- The SR, N FFT, HOP LENGTH, and WINDOW SIZE parameters are set to the defaults. Those were the parameters used in training, so changing them may result in poor conversion performance unless the model is compatible with the changes made. Those are essentially advanced settings, so I recommend you leave them as is unless you know exactly what you're doing.
- The Stacked Model is meant to clean up vocal residue left over in the form of vocal pinches and static. This model is only meant for instrumentals created via converted tracks that ran through one of the main models!
- The "Stack Passes" option should only be used with the Stacked Model. This option allows you to set the amount of times you want a track to run through a model. The amount of times you need to run it through will vary greatly by track. Most tracks won't require any more than 2-5 passes. If you do 5 or more passes on a track you risk quality degradation. When doing stack passes the first and last "vocal" track will give you an idea of how much static was removed.
- Conversion times will greatly depend on your hardware. This application will NOT be friendly to older or budget hardware. Please proceed with caution! Pay attention to your PC and make sure it doesn't overheat.
## References
- [1] Takahashi et al., "Multi-scale Multi-band DenseNets for Audio Source Separation", https://arxiv.org/pdf/1706.09588.pdf

File diff suppressed because it is too large Load Diff

BIN
img/UVR-banner.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 20 KiB

BIN
img/UVRVP4.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 56 KiB

BIN
img/refresh.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.6 KiB

View File

@ -1,200 +0,0 @@
import argparse
import os
import cv2
import librosa
import numpy as np
import soundfile as sf
from tqdm import tqdm
from lib import dataset
from lib import nets
from lib import spec_utils
# Variable manipulation and command line text parsing
import torch
import tkinter as tk
import traceback # Error Message Recent Calls
class Namespace:
"""
Replaces ArgumentParser
"""
def __init__(self, **kwargs):
self.__dict__.update(kwargs)
def main(window: tk.Wm, input_paths: list, gpu: bool = -1,
model: str = 'models/baseline.pth', sr: int = 44100, hop_length: int = 1024,
window_size: int = 512, out_mask: bool = False, postprocess: bool = False,
export_path: str = '', loops: int = 1,
# Other Variables (Tkinter)
progress_var: tk.Variable = None, button_widget: tk.Button = None, command_widget: tk.Text = None,
):
def load_model():
args.command_widget.write('Loading model...\n') # nopep8 Write Command Text
device = torch.device('cpu')
model = nets.CascadedASPPNet()
model.load_state_dict(torch.load(args.model, map_location=device))
if torch.cuda.is_available() and args.gpu >= 0:
device = torch.device('cuda:{}'.format(args.gpu))
model.to(device)
args.command_widget.write('Done!\n') # nopep8 Write Command Text
return model, device
def load_wave_source():
args.command_widget.write(base_text + 'Loading wave source...\n') # nopep8 Write Command Text
X, sr = librosa.load(music_file,
args.sr,
False,
dtype=np.float32,
res_type='kaiser_fast')
args.command_widget.write(base_text + 'Done!\n') # nopep8 Write Command Text
return X, sr
def stft_wave_source(X):
args.command_widget.write(base_text + 'Stft of wave source...\n') # nopep8 Write Command Text
X = spec_utils.calc_spec(X, args.hop_length)
X, phase = np.abs(X), np.exp(1.j * np.angle(X))
coeff = X.max()
X /= coeff
offset = model.offset
l, r, roi_size = dataset.make_padding(
X.shape[2], args.window_size, offset)
X_pad = np.pad(X, ((0, 0), (0, 0), (l, r)), mode='constant')
X_roll = np.roll(X_pad, roi_size // 2, axis=2)
model.eval()
with torch.no_grad():
masks = []
masks_roll = []
length = int(np.ceil(X.shape[2] / roi_size))
for i in tqdm(range(length)):
progress_var.set(base_progress + max_progress * (0.1 + (0.6/length * i))) # nopep8 Update Progress
start = i * roi_size
X_window = torch.from_numpy(np.asarray([
X_pad[:, :, start:start + args.window_size],
X_roll[:, :, start:start + args.window_size]
])).to(device)
pred = model.predict(X_window)
pred = pred.detach().cpu().numpy()
masks.append(pred[0])
masks_roll.append(pred[1])
mask = np.concatenate(masks, axis=2)[:, :, :X.shape[2]]
mask_roll = np.concatenate(masks_roll, axis=2)[
:, :, :X.shape[2]]
mask = (mask + np.roll(mask_roll, -roi_size // 2, axis=2)) / 2
if args.postprocess:
vocal = X * (1 - mask) * coeff
mask = spec_utils.mask_uninformative(mask, vocal)
args.command_widget.write(base_text + 'Done!\n') # nopep8 Write Command Text
inst = X * mask * coeff
vocal = X * (1 - mask) * coeff
return inst, vocal, phase, mask
def invert_instrum_vocal(inst, vocal, phase):
args.command_widget.write(base_text + 'Inverse stft of instruments and vocals...\n') # nopep8 Write Command Text
wav_instrument = spec_utils.spec_to_wav(inst, phase, args.hop_length) # nopep8
wav_vocals = spec_utils.spec_to_wav(vocal, phase, args.hop_length) # nopep8
args.command_widget.write(base_text + 'Done!\n') # nopep8 Write Command Text
return wav_instrument, wav_vocals
def save_files(wav_instrument, wav_vocals):
args.command_widget.write(base_text + 'Saving Files...\n') # nopep8 Write Command Text
sf.write(f'{export_path}/{base_name}_(Instrumental).wav',
wav_instrument.T, sr)
if cur_loop == 0:
sf.write(f'{export_path}/{base_name}_(Vocals).wav',
wav_vocals.T, sr)
if (cur_loop == (args.loops - 1) and
args.loops > 1):
sf.write(f'{export_path}/{base_name}_(Last_Vocals).wav',
wav_vocals.T, sr)
args.command_widget.write(base_text + 'Done!\n') # nopep8 Write Command Text
def create_mask():
args.command_widget.write(base_text + 'Creating Mask...\n') # nopep8 Write Command Text
norm_mask = np.uint8((1 - mask) * 255).transpose(1, 2, 0)
norm_mask = np.concatenate([
np.max(norm_mask, axis=2, keepdims=True),
norm_mask], axis=2)[::-1]
_, bin_mask = cv2.imencode('.png', norm_mask)
args.command_widget.write(base_text + 'Saving Mask...\n') # nopep8 Write Command Text
with open(f'{export_path}/{base_name}_(Mask).png', mode='wb') as f:
bin_mask.tofile(f)
args.command_widget.write(base_text + 'Done!\n') # nopep8 Write Command Text
args = Namespace(input=input_paths, gpu=gpu, model=model,
sr=sr, hop_length=hop_length, window_size=window_size,
out_mask=out_mask, postprocess=postprocess, export=export_path,
loops=loops,
# Other Variables (Tkinter)
window=window, progress_var=progress_var,
button_widget=button_widget, command_widget=command_widget,
)
args.command_widget.clear() # Clear Command Text
args.button_widget.configure(state=tk.DISABLED) # Disable Button
total_files = len(args.input) # Used to calculate progress
model, device = load_model()
for file_num, music_file in enumerate(args.input, start=1):
try:
base_name = f'{file_num}_{os.path.splitext(os.path.basename(music_file))[0]}'
for cur_loop in range(args.loops):
if cur_loop > 0:
args.command_widget.write(f'File {file_num}/{total_files}: ' + 'Next Pass!\n') # nopep8 Write Command Text
music_file = f'{export_path}/{base_name}_(Instrumental).wav'
base_progress = 100 / \
(total_files*args.loops) * \
((file_num*args.loops)-((args.loops-1) - cur_loop)-1)
base_text = 'File {file_num}/{total_files}:{loop} '.format(
file_num=file_num,
total_files=total_files,
loop='' if args.loops <= 1 else f' ({cur_loop+1}/{args.loops})')
max_progress = 100 / (total_files*args.loops)
progress_var.set(base_progress + max_progress * 0.05) # nopep8 Update Progress
X, sr = load_wave_source()
progress_var.set(base_progress + max_progress * 0.1) # nopep8 Update Progress
inst, vocal, phase, mask = stft_wave_source(X)
progress_var.set(base_progress + max_progress * 0.7) # nopep8 Update Progress
wav_instrument, wav_vocals = invert_instrum_vocal(inst, vocal, phase) # nopep8
progress_var.set(base_progress + max_progress * 0.8) # nopep8 Update Progress
save_files(wav_instrument, wav_vocals)
progress_var.set(base_progress + max_progress * 0.9) # nopep8 Update Progress
if args.out_mask:
create_mask()
progress_var.set(base_progress + max_progress * 1) # nopep8 Update Progress
args.command_widget.write(base_text + 'Completed Seperation!\n\n') # nopep8 Write Command Text
except Exception as e:
traceback_text = ''.join(traceback.format_tb(e.__traceback__))
print(traceback_text)
print(type(e).__name__, e)
tk.messagebox.showerror(master=args.window,
title='Untracked Error',
message=f'Traceback Error: "{traceback_text}"\n{type(e).__name__}: "{e}"\nFile: {music_file}\n\nPlease contact the creator and attach a screenshot of this error with the file which caused it!')
args.button_widget.configure(state=tk.NORMAL) # Enable Button
return
progress_var.set(100) # Update Progress
args.command_widget.write(f'Conversion(s) Completed and Saving all Files!') # nopep8 Write Command Text
args.button_widget.configure(state=tk.NORMAL) # Enable Button

485
inference_v2.py Normal file
View File

@ -0,0 +1,485 @@
import argparse
import os
import cv2
import librosa
import numpy as np
import soundfile as sf
from tqdm import tqdm
from lib_v2 import dataset
from lib_v2 import nets
from lib_v2 import spec_utils
import torch
# Variable manipulation and command line text parsing
from collections import defaultdict
import tkinter as tk
import time # Timer
import traceback # Error Message Recent Calls
class Namespace:
"""
Replaces ArgumentParser
"""
def __init__(self, **kwargs):
self.__dict__.update(kwargs)
data = {
# Paths
'input_paths': None,
'export_path': None,
# Processing Options
'gpu': -1,
'postprocess': True,
'tta': True,
'output_image': True,
# Models
'instrumentalModel': None,
'vocalModel': None,
'stackModel': None,
'useModel': None,
# Stack Options
'stackPasses': 0,
'stackOnly': False,
'saveAllStacked': False,
# Model Folder
'modelFolder': False,
# Constants
'sr': 44_100,
'hop_length': 1_024,
'window_size': 512,
'n_fft': 2_048,
}
default_sr = data['sr']
default_hop_length = data['hop_length']
default_window_size = data['window_size']
default_n_fft = data['n_fft']
def update_progress(progress_var, total_files, total_loops, file_num, loop_num, step: float = 1):
"""Calculate the progress for the progress widget in the GUI"""
base = (100 / total_files)
progress = base * (file_num - 1)
progress += (base / total_loops) * (loop_num + step)
progress_var.set(progress)
def get_baseText(total_files, total_loops, file_num, loop_num):
"""Create the base text for the command widget"""
text = 'File {file_num}/{total_files}:{loop} '.format(file_num=file_num,
total_files=total_files,
loop='' if total_loops <= 1 else f' ({loop_num+1}/{total_loops})')
return text
def update_constants(model_name):
"""
Decode the conversion settings from the model's name
"""
global data
text = model_name.replace('.pth', '')
text_parts = text.split('_')[1:]
# First set everything to default ->
# If file name is not decodeable (invalid or no text_parts), constants stay at default
data['sr'] = default_sr
data['hop_length'] = default_hop_length
data['window_size'] = default_window_size
data['n_fft'] = default_n_fft
for text_part in text_parts:
if 'sr' in text_part:
text_part = text_part.replace('sr', '')
if text_part.isdecimal():
try:
data['sr'] = int(text_part)
continue
except ValueError:
# Cannot convert string to int
pass
if 'hl' in text_part:
text_part = text_part.replace('hl', '')
if text_part.isdecimal():
try:
data['hop_length'] = int(text_part)
continue
except ValueError:
# Cannot convert string to int
pass
if 'w' in text_part:
text_part = text_part.replace('w', '')
if text_part.isdecimal():
try:
data['window_size'] = int(text_part)
continue
except ValueError:
# Cannot convert string to int
pass
if 'nf' in text_part:
text_part = text_part.replace('nf', '')
if text_part.isdecimal():
try:
data['n_fft'] = int(text_part)
continue
except ValueError:
# Cannot convert string to int
pass
def determineModelFolderName():
"""
Determine the name that is used for the folder and appended
to the back of the music files
"""
modelFolderName = ''
if not data['modelFolder']:
# Model Test Mode not selected
return modelFolderName
# -Instrumental-
if os.path.isfile(data['instrumentalModel']):
modelFolderName += os.path.splitext(os.path.basename(data['instrumentalModel']))[0] + '-'
# -Vocal-
elif os.path.isfile(data['vocalModel']):
modelFolderName += os.path.splitext(os.path.basename(data['vocalModel']))[0] + '-'
# -Stack-
if os.path.isfile(data['stackModel']):
modelFolderName += os.path.splitext(os.path.basename(data['stackModel']))[0]
else:
modelFolderName = modelFolderName[:-1]
if modelFolderName:
modelFolderName = '/' + modelFolderName
return modelFolderName
def main(window: tk.Wm, text_widget: tk.Text, button_widget: tk.Button, progress_var: tk.Variable,
**kwargs: dict):
def load_models():
text_widget.write('Loading models...\n') # nopep8 Write Command Text
models = defaultdict(lambda: None)
devices = defaultdict(lambda: None)
# -Instrumental-
if os.path.isfile(data['instrumentalModel']):
device = torch.device('cpu')
model = nets.CascadedASPPNet()
model.load_state_dict(torch.load(data['instrumentalModel'],
map_location=device))
if torch.cuda.is_available() and data['gpu'] >= 0:
device = torch.device('cuda:{}'.format(data['gpu']))
model.to(device)
models['instrumental'] = model
devices['instrumental'] = device
# -Vocal-
elif os.path.isfile(data['vocalModel']):
device = torch.device('cpu')
model = nets.CascadedASPPNet()
model.load_state_dict(torch.load(data['vocalModel'],
map_location=device))
if torch.cuda.is_available() and data['gpu'] >= 0:
device = torch.device('cuda:{}'.format(data['gpu']))
model.to(device)
models['vocal'] = model
devices['vocal'] = device
# -Stack-
if os.path.isfile(data['stackModel']):
device = torch.device('cpu')
model = nets.CascadedASPPNet()
model.load_state_dict(torch.load(data['stackModel'],
map_location=device))
if torch.cuda.is_available() and data['gpu'] >= 0:
device = torch.device('cuda:{}'.format(data['gpu']))
model.to(device)
models['stack'] = model
devices['stack'] = device
text_widget.write('Done!\n')
return models, devices
def load_wave_source():
X, sr = librosa.load(music_file,
data['sr'],
False,
dtype=np.float32,
res_type='kaiser_fast')
return X, sr
def stft_wave_source(X, model, device):
X = spec_utils.calc_spec(X, data['hop_length'])
X, phase = np.abs(X), np.exp(1.j * np.angle(X))
coeff = X.max()
X /= coeff
offset = model.offset
l, r, roi_size = dataset.make_padding(
X.shape[2], data['window_size'], offset)
X_pad = np.pad(X, ((0, 0), (0, 0), (l, r)), mode='constant')
X_roll = np.roll(X_pad, roi_size // 2, axis=2)
model.eval()
with torch.no_grad():
masks = []
masks_roll = []
length = int(np.ceil(X.shape[2] / roi_size))
for i in tqdm(range(length)):
update_progress(**progress_kwargs,
step=0.1 + 0.5*(i/(length - 1)))
start = i * roi_size
X_window = torch.from_numpy(np.asarray([
X_pad[:, :, start:start + data['window_size']],
X_roll[:, :, start:start + data['window_size']]
])).to(device)
pred = model.predict(X_window)
pred = pred.detach().cpu().numpy()
masks.append(pred[0])
masks_roll.append(pred[1])
mask = np.concatenate(masks, axis=2)[:, :, :X.shape[2]]
mask_roll = np.concatenate(masks_roll, axis=2)[
:, :, :X.shape[2]]
mask = (mask + np.roll(mask_roll, -roi_size // 2, axis=2)) / 2
if data['postprocess']:
vocal = X * (1 - mask) * coeff
mask = spec_utils.mask_uninformative(mask, vocal)
inst = X * mask * coeff
vocal = X * (1 - mask) * coeff
return inst, vocal, phase, mask
def invert_instrum_vocal(inst, vocal, phase):
wav_instrument = spec_utils.spec_to_wav(inst, phase, data['hop_length']) # nopep8
wav_vocals = spec_utils.spec_to_wav(vocal, phase, data['hop_length']) # nopep8
return wav_instrument, wav_vocals
def save_files(wav_instrument, wav_vocals):
"""Save output music files"""
vocal_name = None
instrumental_name = None
save_path = os.path.dirname(base_name)
# Get the Suffix Name
if (not loop_num or
loop_num == (total_loops - 1)): # First or Last Loop
if data['stackOnly']:
if loop_num == (total_loops - 1): # Last Loop
if not (total_loops - 1): # Only 1 Loop
vocal_name = '(Vocals)'
instrumental_name = '(Instrumental)'
else:
vocal_name = '(Vocal_Final_Stacked_Output)'
instrumental_name = '(Instrumental_Final_Stacked_Output)'
elif data['useModel'] == 'instrumental':
if not loop_num: # First Loop
vocal_name = '(Vocals)'
if loop_num == (total_loops - 1): # Last Loop
if not (total_loops - 1): # Only 1 Loop
instrumental_name = '(Instrumental)'
else:
instrumental_name = '(Instrumental_Final_Stacked_Output)'
elif data['useModel'] == 'vocal':
if not loop_num: # First Loop
instrumental_name = '(Instrumental)'
if loop_num == (total_loops - 1): # Last Loop
if not (total_loops - 1): # Only 1 Loop
vocal_name = '(Vocals)'
else:
vocal_name = '(Vocals_Final_Stacked_Output)'
if data['useModel'] == 'vocal':
# Reverse names
vocal_name, instrumental_name = instrumental_name, vocal_name
elif data['saveAllStacked']:
folder_name = os.path.basename(base_name) + ' Stacked Outputs' # nopep8
save_path = os.path.join(save_path, folder_name)
if not os.path.isdir(save_path):
os.mkdir(save_path)
if data['stackOnly']:
vocal_name = f'(Vocal_{loop_num}_Stacked_Output)'
instrumental_name = f'(Instrumental_{loop_num}_Stacked_Output)'
elif (data['useModel'] == 'vocal' or
data['useModel'] == 'instrumental'):
vocal_name = f'(Vocals_{loop_num}_Stacked_Output)'
instrumental_name = f'(Instrumental_{loop_num}_Stacked_Output)'
if data['useModel'] == 'vocal':
# Reverse names
vocal_name, instrumental_name = instrumental_name, vocal_name
# Save Temp File
# For instrumental the instrumental is the temp file
# and for vocal the instrumental is the temp file due
# to reversement
sf.write(f'temp.wav',
wav_instrument.T, sr)
appendModelFolderName = modelFolderName.replace('/', '_')
# -Save files-
# Instrumental
if instrumental_name is not None:
instrumental_path = '{save_path}/{file_name}.wav'.format(
save_path=save_path,
file_name=f'{os.path.basename(base_name)}_{instrumental_name}{appendModelFolderName}',
)
sf.write(instrumental_path,
wav_instrument.T, sr)
# Vocal
if vocal_name is not None:
vocal_path = '{save_path}/{file_name}.wav'.format(
save_path=save_path,
file_name=f'{os.path.basename(base_name)}_{vocal_name}{appendModelFolderName}',
)
sf.write(vocal_path,
wav_vocals.T, sr)
def output_image():
norm_mask = np.uint8((1 - mask) * 255).transpose(1, 2, 0)
norm_mask = np.concatenate([
np.max(norm_mask, axis=2, keepdims=True),
norm_mask], axis=2)[::-1]
_, bin_mask = cv2.imencode('.png', norm_mask)
text_widget.write(base_text + 'Saving Mask...\n') # nopep8 Write Command Text
with open(f'{base_name}_(Mask).png', mode='wb') as f:
bin_mask.tofile(f)
data.update(kwargs)
# Update default settings
global default_sr
global default_hop_length
global default_window_size
global default_n_fft
default_sr = data['sr']
default_hop_length = data['hop_length']
default_window_size = data['window_size']
default_n_fft = data['n_fft']
stime = time.perf_counter()
progress_var.set(0)
text_widget.clear()
button_widget.configure(state=tk.DISABLED) # Disable Button
models, devices = load_models()
modelFolderName = determineModelFolderName()
if modelFolderName:
folder_path = f'{data["export_path"]}{modelFolderName}'
if not os.path.isdir(folder_path):
os.mkdir(folder_path)
# Determine Loops
total_loops = data['stackPasses']
if not data['stackOnly']:
total_loops += 1
for file_num, music_file in enumerate(data['input_paths'], start=1):
try:
# Determine File Name
base_name = f'{data["export_path"]}{modelFolderName}/{file_num}_{os.path.splitext(os.path.basename(music_file))[0]}'
for loop_num in range(total_loops):
# -Determine which model will be used-
if not loop_num:
# First Iteration
if data['stackOnly']:
if os.path.isfile(data['stackModel']):
model_name = os.path.basename(data['stackModel'])
model = models['stack']
device = devices['stack']
else:
raise ValueError(f'Selected stack only model, however, stack model path file cannot be found\nPath: "{data["stackModel"]}"') # nopep8
else:
model_name = os.path.basename(data[f'{data["useModel"]}Model'])
model = models[data['useModel']]
device = devices[data['useModel']]
else:
model_name = os.path.basename(data['stackModel'])
# Every other iteration
model = models['stack']
device = devices['stack']
# Reference new music file
music_file = 'temp.wav'
# -Get text and update progress-
base_text = get_baseText(total_files=len(data['input_paths']),
total_loops=total_loops,
file_num=file_num,
loop_num=loop_num)
progress_kwargs = {'progress_var': progress_var,
'total_files': len(data['input_paths']),
'total_loops': total_loops,
'file_num': file_num,
'loop_num': loop_num}
update_progress(**progress_kwargs,
step=0)
update_constants(model_name)
# -Go through the different steps of seperation-
# Wave source
text_widget.write(base_text + 'Loading wave source...\n') # nopep8 Write Command Text
X, sr = load_wave_source()
text_widget.write(base_text + 'Done!\n') # nopep8 Write Command Text
update_progress(**progress_kwargs,
step=0.1)
# Stft of wave source
text_widget.write(base_text + 'Stft of wave source...\n') # nopep8 Write Command Text
inst, vocal, phase, mask = stft_wave_source(X, model, device)
text_widget.write(base_text + 'Done!\n') # nopep8 Write Command Text
update_progress(**progress_kwargs,
step=0.6)
# Inverse stft
text_widget.write(base_text + 'Inverse stft of instruments and vocals...\n') # nopep8 Write Command Text
wav_instrument, wav_vocals = invert_instrum_vocal(inst, vocal, phase) # nopep8
text_widget.write(base_text + 'Done!\n') # nopep8 Write Command Text
update_progress(**progress_kwargs,
step=0.7)
# Save Files
text_widget.write(base_text + 'Saving Files...\n') # nopep8 Write Command Text
save_files(wav_instrument, wav_vocals)
text_widget.write(base_text + 'Done!\n') # nopep8 Write Command Text
update_progress(**progress_kwargs,
step=0.8)
else:
# Save Output Image (Mask)
if data['output_image']:
text_widget.write(base_text + 'Creating Mask...\n') # nopep8 Write Command Text
output_image()
text_widget.write(base_text + 'Done!\n') # nopep8 Write Command Text
text_widget.write(base_text + 'Completed Seperation!\n\n') # nopep8 Write Command Text
except Exception as e:
traceback_text = ''.join(traceback.format_tb(e.__traceback__))
message = f'Traceback Error: "{traceback_text}"\n{type(e).__name__}: "{e}"\nFile: {music_file}\nLoop: {loop_num}\nPlease contact the creator and attach a screenshot of this error with the file and settings that caused it!'
tk.messagebox.showerror(master=window,
title='Untracked Error',
message=message)
print(traceback_text)
print(type(e).__name__, e)
print(message)
progress_var.set(0)
button_widget.configure(state=tk.NORMAL) # Enable Button
return
os.remove('temp.wav')
progress_var.set(0) # Update Progress
text_widget.write(f'Conversion(s) Completed and Saving all Files!\n') # nopep8 Write Command Text
text_widget.write(f'Time Elapsed: {time.strftime("%H:%M:%S", time.gmtime(int(time.perf_counter() - stime)))}') # nopep8
button_widget.configure(state=tk.NORMAL) # Enable Button

521
inference_v4.py Normal file
View File

@ -0,0 +1,521 @@
import pprint
import argparse
import os
import cv2
import librosa
import numpy as np
import soundfile as sf
from tqdm import tqdm
from lib_v4 import dataset
from lib_v4 import nets
from lib_v4 import spec_utils
import torch
# Command line text parsing and widget manipulation
from collections import defaultdict
import tkinter as tk
import traceback # Error Message Recent Calls
import time # Timer
class VocalRemover(object):
def __init__(self, data, text_widget: tk.Text):
self.data = data
self.text_widget = text_widget
self.models = defaultdict(lambda: None)
self.devices = defaultdict(lambda: None)
self._load_models()
# self.offset = model.offset
def _load_models(self):
self.text_widget.write('Loading models...\n') # nopep8 Write Command Text
# -Instrumental-
if os.path.isfile(data['instrumentalModel']):
device = torch.device('cpu')
model = nets.CascadedASPPNet(self.data['n_fft'])
model.load_state_dict(torch.load(self.data['instrumentalModel'],
map_location=device))
if torch.cuda.is_available() and self.data['gpu'] >= 0:
device = torch.device('cuda:{}'.format(self.data['gpu']))
model.to(device)
self.models['instrumental'] = model
self.devices['instrumental'] = device
# -Vocal-
elif os.path.isfile(data['vocalModel']):
device = torch.device('cpu')
model = nets.CascadedASPPNet(self.data['n_fft'])
model.load_state_dict(torch.load(self.data['vocalModel'],
map_location=device))
if torch.cuda.is_available() and self.data['gpu'] >= 0:
device = torch.device('cuda:{}'.format(self.data['gpu']))
model.to(device)
self.models['vocal'] = model
self.devices['vocal'] = device
# -Stack-
if os.path.isfile(self.data['stackModel']):
device = torch.device('cpu')
model = nets.CascadedASPPNet(self.data['n_fft'])
model.load_state_dict(torch.load(self.data['stackModel'],
map_location=device))
if torch.cuda.is_available() and self.data['gpu'] >= 0:
device = torch.device('cuda:{}'.format(self.data['gpu']))
model.to(device)
self.models['stack'] = model
self.devices['stack'] = device
self.text_widget.write('Done!\n')
def _execute(self, X_mag_pad, roi_size, n_window, device, model):
model.eval()
with torch.no_grad():
preds = []
for i in tqdm(range(n_window)):
start = i * roi_size
X_mag_window = X_mag_pad[None, :, :,
start:start + self.data['window_size']]
X_mag_window = torch.from_numpy(X_mag_window).to(device)
pred = model.predict(X_mag_window)
pred = pred.detach().cpu().numpy()
preds.append(pred[0])
pred = np.concatenate(preds, axis=2)
return pred
def preprocess(self, X_spec):
X_mag = np.abs(X_spec)
X_phase = np.angle(X_spec)
return X_mag, X_phase
def inference(self, X_spec, device, model):
X_mag, X_phase = self.preprocess(X_spec)
coef = X_mag.max()
X_mag_pre = X_mag / coef
n_frame = X_mag_pre.shape[2]
pad_l, pad_r, roi_size = dataset.make_padding(n_frame,
self.data['window_size'], model.offset)
n_window = int(np.ceil(n_frame / roi_size))
X_mag_pad = np.pad(
X_mag_pre, ((0, 0), (0, 0), (pad_l, pad_r)), mode='constant')
pred = self._execute(X_mag_pad, roi_size, n_window,
device, model)
pred = pred[:, :, :n_frame]
return pred * coef, X_mag, np.exp(1.j * X_phase)
def inference_tta(self, X_spec, device, model):
X_mag, X_phase = self.preprocess(X_spec)
coef = X_mag.max()
X_mag_pre = X_mag / coef
n_frame = X_mag_pre.shape[2]
pad_l, pad_r, roi_size = dataset.make_padding(n_frame,
self.data['window_size'], model.offset)
n_window = int(np.ceil(n_frame / roi_size))
X_mag_pad = np.pad(
X_mag_pre, ((0, 0), (0, 0), (pad_l, pad_r)), mode='constant')
pred = self._execute(X_mag_pad, roi_size, n_window,
device, model)
pred = pred[:, :, :n_frame]
pad_l += roi_size // 2
pad_r += roi_size // 2
n_window += 1
X_mag_pad = np.pad(
X_mag_pre, ((0, 0), (0, 0), (pad_l, pad_r)), mode='constant')
pred_tta = self._execute(X_mag_pad, roi_size, n_window,
device, model)
pred_tta = pred_tta[:, :, roi_size // 2:]
pred_tta = pred_tta[:, :, :n_frame]
return (pred + pred_tta) * 0.5 * coef, X_mag, np.exp(1.j * X_phase)
data = {
# Paths
'input_paths': None,
'export_path': None,
# Processing Options
'gpu': -1,
'postprocess': True,
'tta': True,
'output_image': True,
# Models
'instrumentalModel': None,
'vocalModel': None,
'stackModel': None,
'useModel': None,
# Stack Options
'stackPasses': 0,
'stackOnly': False,
'saveAllStacked': False,
# Constants
'sr': 44_100,
'hop_length': 1_024,
'window_size': 512,
'n_fft': 2_048,
}
default_sr = data['sr']
default_hop_length = data['hop_length']
default_window_size = data['window_size']
default_n_fft = data['n_fft']
def update_progress(progress_var, total_files, total_loops, file_num, loop_num, step: float = 1):
"""Calculate the progress for the progress widget in the GUI"""
base = (100 / total_files)
progress = base * (file_num - 1)
progress += (base / total_loops) * (loop_num + step)
progress_var.set(progress)
def get_baseText(total_files, total_loops, file_num, loop_num):
"""Create the base text for the command widget"""
text = 'File {file_num}/{total_files}:{loop} '.format(file_num=file_num,
total_files=total_files,
loop='' if total_loops <= 1 else f' ({loop_num+1}/{total_loops})')
return text
def update_constants(model_name):
"""
Decode the conversion settings from the model's name
"""
global data
text = model_name.replace('.pth', '')
text_parts = text.split('_')[1:]
data['sr'] = default_sr
data['hop_length'] = default_hop_length
data['window_size'] = default_window_size
data['n_fft'] = default_n_fft
for text_part in text_parts:
if 'sr' in text_part:
text_part = text_part.replace('sr', '')
if text_part.isdecimal():
try:
data['sr'] = int(text_part)
continue
except ValueError:
# Cannot convert string to int
pass
if 'hl' in text_part:
text_part = text_part.replace('hl', '')
if text_part.isdecimal():
try:
data['hop_length'] = int(text_part)
continue
except ValueError:
# Cannot convert string to int
pass
if 'w' in text_part:
text_part = text_part.replace('w', '')
if text_part.isdecimal():
try:
data['window_size'] = int(text_part)
continue
except ValueError:
# Cannot convert string to int
pass
if 'nf' in text_part:
text_part = text_part.replace('nf', '')
if text_part.isdecimal():
try:
data['n_fft'] = int(text_part)
continue
except ValueError:
# Cannot convert string to int
pass
def determineModelFolderName():
"""
Determine the name that is used for the folder and appended
to the back of the music files
"""
modelFolderName = ''
if not data['modelFolder']:
# Model Test Mode not selected
return modelFolderName
# -Instrumental-
if os.path.isfile(data['instrumentalModel']):
modelFolderName += os.path.splitext(os.path.basename(data['instrumentalModel']))[0] + '-'
# -Vocal-
elif os.path.isfile(data['vocalModel']):
modelFolderName += os.path.splitext(os.path.basename(data['vocalModel']))[0] + '-'
# -Stack-
if os.path.isfile(data['stackModel']):
modelFolderName += os.path.splitext(os.path.basename(data['stackModel']))[0]
else:
modelFolderName = modelFolderName[:-1]
if modelFolderName:
modelFolderName = '/' + modelFolderName
return modelFolderName
def main(window: tk.Wm, text_widget: tk.Text, button_widget: tk.Button, progress_var: tk.Variable,
**kwargs: dict):
def save_files(wav_instrument, wav_vocals):
"""Save output music files"""
vocal_name = None
instrumental_name = None
save_path = os.path.dirname(base_name)
# Get the Suffix Name
if (not loop_num or
loop_num == (total_loops - 1)): # First or Last Loop
if data['stackOnly']:
if loop_num == (total_loops - 1): # Last Loop
if not (total_loops - 1): # Only 1 Loop
vocal_name = '(Vocals)'
instrumental_name = '(Instrumental)'
else:
vocal_name = '(Vocal_Final_Stacked_Output)'
instrumental_name = '(Instrumental_Final_Stacked_Output)'
elif data['useModel'] == 'instrumental':
if not loop_num: # First Loop
vocal_name = '(Vocals)'
if loop_num == (total_loops - 1): # Last Loop
if not (total_loops - 1): # Only 1 Loop
instrumental_name = '(Instrumental)'
else:
instrumental_name = '(Instrumental_Final_Stacked_Output)'
elif data['useModel'] == 'vocal':
if not loop_num: # First Loop
instrumental_name = '(Instrumental)'
if loop_num == (total_loops - 1): # Last Loop
if not (total_loops - 1): # Only 1 Loop
vocal_name = '(Vocals)'
else:
vocal_name = '(Vocals_Final_Stacked_Output)'
if data['useModel'] == 'vocal':
# Reverse names
vocal_name, instrumental_name = instrumental_name, vocal_name
elif data['saveAllStacked']:
folder_name = os.path.basename(base_name) + ' Stacked Outputs' # nopep8
save_path = os.path.join(save_path, folder_name)
if not os.path.isdir(save_path):
os.mkdir(save_path)
if data['stackOnly']:
vocal_name = f'(Vocal_{loop_num}_Stacked_Output)'
instrumental_name = f'(Instrumental_{loop_num}_Stacked_Output)'
elif (data['useModel'] == 'vocal' or
data['useModel'] == 'instrumental'):
vocal_name = f'(Vocals_{loop_num}_Stacked_Output)'
instrumental_name = f'(Instrumental_{loop_num}_Stacked_Output)'
if data['useModel'] == 'vocal':
# Reverse names
vocal_name, instrumental_name = instrumental_name, vocal_name
# Save Temp File
# For instrumental the instrumental is the temp file
# and for vocal the instrumental is the temp file due
# to reversement
sf.write(f'temp.wav',
wav_instrument.T, sr)
appendModelFolderName = modelFolderName.replace('/', '_')
# -Save files-
# Instrumental
if instrumental_name is not None:
instrumental_path = '{save_path}/{file_name}.wav'.format(
save_path=save_path,
file_name=f'{os.path.basename(base_name)}_{instrumental_name}{appendModelFolderName}',
)
sf.write(instrumental_path,
wav_instrument.T, sr)
# Vocal
if vocal_name is not None:
vocal_path = '{save_path}/{file_name}.wav'.format(
save_path=save_path,
file_name=f'{os.path.basename(base_name)}_{vocal_name}{appendModelFolderName}',
)
sf.write(vocal_path,
wav_vocals.T, sr)
data.update(kwargs)
# Update default settings
global default_sr
global default_hop_length
global default_window_size
global default_n_fft
default_sr = data['sr']
default_hop_length = data['hop_length']
default_window_size = data['window_size']
default_n_fft = data['n_fft']
stime = time.perf_counter()
progress_var.set(0)
text_widget.clear()
button_widget.configure(state=tk.DISABLED) # Disable Button
vocal_remover = VocalRemover(data, text_widget)
modelFolderName = determineModelFolderName()
if modelFolderName:
folder_path = f'{data["export_path"]}{modelFolderName}'
if not os.path.isdir(folder_path):
os.mkdir(folder_path)
# Determine Loops
total_loops = data['stackPasses']
if not data['stackOnly']:
total_loops += 1
for file_num, music_file in enumerate(data['input_paths'], start=1):
try:
# Determine File Name
base_name = f'{data["export_path"]}{modelFolderName}/{file_num}_{os.path.splitext(os.path.basename(music_file))[0]}'
# --Seperate Music Files--
for loop_num in range(total_loops):
# -Determine which model will be used-
if not loop_num:
# First Iteration
if data['stackOnly']:
if os.path.isfile(data['stackModel']):
model_name = os.path.basename(data['stackModel'])
model = vocal_remover.models['stack']
device = vocal_remover.devices['stack']
else:
raise ValueError(f'Selected stack only model, however, stack model path file cannot be found\nPath: "{data["stackModel"]}"') # nopep8
else:
model_name = os.path.basename(data[f'{data["useModel"]}Model'])
model = vocal_remover.models[data['useModel']]
device = vocal_remover.devices[data['useModel']]
else:
model_name = os.path.basename(data['stackModel'])
# Every other iteration
model = vocal_remover.models['stack']
device = vocal_remover.devices['stack']
# Reference new music file
music_file = 'temp.wav'
# -Get text and update progress-
base_text = get_baseText(total_files=len(data['input_paths']),
total_loops=total_loops,
file_num=file_num,
loop_num=loop_num)
progress_kwargs = {'progress_var': progress_var,
'total_files': len(data['input_paths']),
'total_loops': total_loops,
'file_num': file_num,
'loop_num': loop_num}
update_progress(**progress_kwargs,
step=0)
update_constants(model_name)
# -Go through the different steps of seperation-
# Wave source
text_widget.write(base_text + 'Loading wave source...\n')
X, sr = librosa.load(music_file, data['sr'], False,
dtype=np.float32, res_type='kaiser_fast')
if X.ndim == 1:
X = np.asarray([X, X])
text_widget.write(base_text + 'Done!\n')
update_progress(**progress_kwargs,
step=0.1)
# Stft of wave source
text_widget.write(base_text + 'Stft of wave source...\n')
X = spec_utils.wave_to_spectrogram(X,
data['hop_length'], data['n_fft'])
if data['tta']:
pred, X_mag, X_phase = vocal_remover.inference_tta(X,
device=device,
model=model)
else:
pred, X_mag, X_phase = vocal_remover.inference(X,
device=device,
model=model)
text_widget.write(base_text + 'Done!\n')
update_progress(**progress_kwargs,
step=0.6)
# Postprocess
if data['postprocess']:
text_widget.write(base_text + 'Post processing...\n')
pred_inv = np.clip(X_mag - pred, 0, np.inf)
pred = spec_utils.mask_silence(pred, pred_inv)
text_widget.write(base_text + 'Done!\n')
update_progress(**progress_kwargs,
step=0.65)
# Inverse stft
text_widget.write(base_text + 'Inverse stft of instruments and vocals...\n') # nopep8
y_spec = pred * X_phase
wav_instrument = spec_utils.spectrogram_to_wave(y_spec,
hop_length=data['hop_length'])
v_spec = np.clip(X_mag - pred, 0, np.inf) * X_phase
wav_vocals = spec_utils.spectrogram_to_wave(v_spec,
hop_length=data['hop_length'])
text_widget.write(base_text + 'Done!\n')
update_progress(**progress_kwargs,
step=0.7)
# Save output music files
text_widget.write(base_text + 'Saving Files...\n')
save_files(wav_instrument, wav_vocals)
text_widget.write(base_text + 'Done!\n')
update_progress(**progress_kwargs,
step=0.8)
else:
# Save output image
if data['output_image']:
with open('{}_Instruments.jpg'.format(base_name), mode='wb') as f:
image = spec_utils.spectrogram_to_image(y_spec)
_, bin_image = cv2.imencode('.jpg', image)
bin_image.tofile(f)
with open('{}_Vocals.jpg'.format(base_name), mode='wb') as f:
image = spec_utils.spectrogram_to_image(v_spec)
_, bin_image = cv2.imencode('.jpg', image)
bin_image.tofile(f)
text_widget.write(base_text + 'Completed Seperation!\n\n')
except Exception as e:
traceback_text = ''.join(traceback.format_tb(e.__traceback__))
message = f'Traceback Error: "{traceback_text}"\n{type(e).__name__}: "{e}"\nFile: {music_file}\nLoop: {loop_num}\nPlease contact the creator and attach a screenshot of this error with the file and settings that caused it!'
tk.messagebox.showerror(master=window,
title='Untracked Error',
message=message)
print(traceback_text)
print(type(e).__name__, e)
print(message)
progress_var.set(0)
button_widget.configure(state=tk.NORMAL) # Enable Button
return
os.remove('temp.wav')
progress_var.set(0)
text_widget.write(f'Conversion(s) Completed and Saving all Files!\n')
text_widget.write(f'Time Elapsed: {time.strftime("%H:%M:%S", time.gmtime(int(time.perf_counter() - stime)))}') # nopep8
button_widget.configure(state=tk.NORMAL) # Enable Button

View File

@ -4,7 +4,7 @@ import numpy as np
import torch
from tqdm import tqdm
from lib import spec_utils
from lib_v2 import spec_utils
class VocalRemoverValidationSet(torch.utils.data.Dataset):

View File

@ -2,7 +2,7 @@ import torch
from torch import nn
import torch.nn.functional as F
from lib import spec_utils
from lib_v2 import spec_utils
class Conv2DBNActiv(nn.Module):

View File

@ -1,7 +1,7 @@
import torch
from torch import nn
from lib import layers
from lib_v2 import layers
class BaseASPPNet(nn.Module):

170
lib_v4/dataset.py Normal file
View File

@ -0,0 +1,170 @@
import os
import random
import numpy as np
import torch
import torch.utils.data
from tqdm import tqdm
from lib_v4 import spec_utils
class VocalRemoverValidationSet(torch.utils.data.Dataset):
def __init__(self, patch_list):
self.patch_list = patch_list
def __len__(self):
return len(self.patch_list)
def __getitem__(self, idx):
path = self.patch_list[idx]
data = np.load(path)
X, y = data['X'], data['y']
X_mag = np.abs(X)
y_mag = np.abs(y)
return X_mag, y_mag
def make_pair(mix_dir, inst_dir):
input_exts = ['.wav', '.m4a', '.mp3', '.mp4', '.flac']
X_list = sorted([
os.path.join(mix_dir, fname)
for fname in os.listdir(mix_dir)
if os.path.splitext(fname)[1] in input_exts])
y_list = sorted([
os.path.join(inst_dir, fname)
for fname in os.listdir(inst_dir)
if os.path.splitext(fname)[1] in input_exts])
filelist = list(zip(X_list, y_list))
return filelist
def train_val_split(dataset_dir, split_mode, val_rate, val_filelist):
if split_mode == 'random':
filelist = make_pair(
os.path.join(dataset_dir, 'mixtures'),
os.path.join(dataset_dir, 'instruments'))
random.shuffle(filelist)
if len(val_filelist) == 0:
val_size = int(len(filelist) * val_rate)
train_filelist = filelist[:-val_size]
val_filelist = filelist[-val_size:]
else:
train_filelist = [
pair for pair in filelist
if list(pair) not in val_filelist]
elif split_mode == 'subdirs':
if len(val_filelist) != 0:
raise ValueError('The `val_filelist` option is not available in `subdirs` mode')
train_filelist = make_pair(
os.path.join(dataset_dir, 'training/mixtures'),
os.path.join(dataset_dir, 'training/instruments'))
val_filelist = make_pair(
os.path.join(dataset_dir, 'validation/mixtures'),
os.path.join(dataset_dir, 'validation/instruments'))
return train_filelist, val_filelist
def augment(X, y, reduction_rate, reduction_mask, mixup_rate, mixup_alpha):
perm = np.random.permutation(len(X))
for i, idx in enumerate(tqdm(perm)):
if np.random.uniform() < reduction_rate:
y[idx] = spec_utils.reduce_vocal_aggressively(X[idx], y[idx], reduction_mask)
if np.random.uniform() < 0.5:
# swap channel
X[idx] = X[idx, ::-1]
y[idx] = y[idx, ::-1]
if np.random.uniform() < 0.02:
# mono
X[idx] = X[idx].mean(axis=0, keepdims=True)
y[idx] = y[idx].mean(axis=0, keepdims=True)
if np.random.uniform() < 0.02:
# inst
X[idx] = y[idx]
if np.random.uniform() < mixup_rate and i < len(perm) - 1:
lam = np.random.beta(mixup_alpha, mixup_alpha)
X[idx] = lam * X[idx] + (1 - lam) * X[perm[i + 1]]
y[idx] = lam * y[idx] + (1 - lam) * y[perm[i + 1]]
return X, y
def make_padding(width, cropsize, offset):
left = offset
roi_size = cropsize - left * 2
if roi_size == 0:
roi_size = cropsize
right = roi_size - (width % roi_size) + left
return left, right, roi_size
def make_training_set(filelist, cropsize, patches, sr, hop_length, n_fft, offset):
len_dataset = patches * len(filelist)
X_dataset = np.zeros(
(len_dataset, 2, n_fft // 2 + 1, cropsize), dtype=np.complex64)
y_dataset = np.zeros(
(len_dataset, 2, n_fft // 2 + 1, cropsize), dtype=np.complex64)
for i, (X_path, y_path) in enumerate(tqdm(filelist)):
X, y = spec_utils.cache_or_load(X_path, y_path, sr, hop_length, n_fft)
coef = np.max([np.abs(X).max(), np.abs(y).max()])
X, y = X / coef, y / coef
l, r, roi_size = make_padding(X.shape[2], cropsize, offset)
X_pad = np.pad(X, ((0, 0), (0, 0), (l, r)), mode='constant')
y_pad = np.pad(y, ((0, 0), (0, 0), (l, r)), mode='constant')
starts = np.random.randint(0, X_pad.shape[2] - cropsize, patches)
ends = starts + cropsize
for j in range(patches):
idx = i * patches + j
X_dataset[idx] = X_pad[:, :, starts[j]:ends[j]]
y_dataset[idx] = y_pad[:, :, starts[j]:ends[j]]
return X_dataset, y_dataset
def make_validation_set(filelist, cropsize, sr, hop_length, n_fft, offset):
patch_list = []
patch_dir = 'cs{}_sr{}_hl{}_nf{}_of{}'.format(cropsize, sr, hop_length, n_fft, offset)
os.makedirs(patch_dir, exist_ok=True)
for i, (X_path, y_path) in enumerate(tqdm(filelist)):
basename = os.path.splitext(os.path.basename(X_path))[0]
X, y = spec_utils.cache_or_load(X_path, y_path, sr, hop_length, n_fft)
coef = np.max([np.abs(X).max(), np.abs(y).max()])
X, y = X / coef, y / coef
l, r, roi_size = make_padding(X.shape[2], cropsize, offset)
X_pad = np.pad(X, ((0, 0), (0, 0), (l, r)), mode='constant')
y_pad = np.pad(y, ((0, 0), (0, 0), (l, r)), mode='constant')
len_dataset = int(np.ceil(X.shape[2] / roi_size))
for j in range(len_dataset):
outpath = os.path.join(patch_dir, '{}_p{}.npz'.format(basename, j))
start = j * roi_size
if not os.path.exists(outpath):
np.savez(
outpath,
X=X_pad[:, :, start:start + cropsize],
y=y_pad[:, :, start:start + cropsize])
patch_list.append(outpath)
return VocalRemoverValidationSet(patch_list)

116
lib_v4/layers.py Normal file
View File

@ -0,0 +1,116 @@
import torch
from torch import nn
import torch.nn.functional as F
from lib_v4 import spec_utils
class Conv2DBNActiv(nn.Module):
def __init__(self, nin, nout, ksize=3, stride=1, pad=1, dilation=1, activ=nn.ReLU):
super(Conv2DBNActiv, self).__init__()
self.conv = nn.Sequential(
nn.Conv2d(
nin, nout,
kernel_size=ksize,
stride=stride,
padding=pad,
dilation=dilation,
bias=False),
nn.BatchNorm2d(nout),
activ()
)
def __call__(self, x):
return self.conv(x)
class SeperableConv2DBNActiv(nn.Module):
def __init__(self, nin, nout, ksize=3, stride=1, pad=1, dilation=1, activ=nn.ReLU):
super(SeperableConv2DBNActiv, self).__init__()
self.conv = nn.Sequential(
nn.Conv2d(
nin, nin,
kernel_size=ksize,
stride=stride,
padding=pad,
dilation=dilation,
groups=nin,
bias=False),
nn.Conv2d(
nin, nout,
kernel_size=1,
bias=False),
nn.BatchNorm2d(nout),
activ()
)
def __call__(self, x):
return self.conv(x)
class Encoder(nn.Module):
def __init__(self, nin, nout, ksize=3, stride=1, pad=1, activ=nn.LeakyReLU):
super(Encoder, self).__init__()
self.conv1 = Conv2DBNActiv(nin, nout, ksize, 1, pad, activ=activ)
self.conv2 = Conv2DBNActiv(nout, nout, ksize, stride, pad, activ=activ)
def __call__(self, x):
skip = self.conv1(x)
h = self.conv2(skip)
return h, skip
class Decoder(nn.Module):
def __init__(self, nin, nout, ksize=3, stride=1, pad=1, activ=nn.ReLU, dropout=False):
super(Decoder, self).__init__()
self.conv = Conv2DBNActiv(nin, nout, ksize, 1, pad, activ=activ)
self.dropout = nn.Dropout2d(0.1) if dropout else None
def __call__(self, x, skip=None):
x = F.interpolate(x, scale_factor=2, mode='bilinear', align_corners=True)
if skip is not None:
skip = spec_utils.crop_center(skip, x)
x = torch.cat([x, skip], dim=1)
h = self.conv(x)
if self.dropout is not None:
h = self.dropout(h)
return h
class ASPPModule(nn.Module):
def __init__(self, nin, nout, dilations=(4, 8, 16), activ=nn.ReLU):
super(ASPPModule, self).__init__()
self.conv1 = nn.Sequential(
nn.AdaptiveAvgPool2d((1, None)),
Conv2DBNActiv(nin, nin, 1, 1, 0, activ=activ)
)
self.conv2 = Conv2DBNActiv(nin, nin, 1, 1, 0, activ=activ)
self.conv3 = SeperableConv2DBNActiv(
nin, nin, 3, 1, dilations[0], dilations[0], activ=activ)
self.conv4 = SeperableConv2DBNActiv(
nin, nin, 3, 1, dilations[1], dilations[1], activ=activ)
self.conv5 = SeperableConv2DBNActiv(
nin, nin, 3, 1, dilations[2], dilations[2], activ=activ)
self.bottleneck = nn.Sequential(
Conv2DBNActiv(nin * 5, nout, 1, 1, 0, activ=activ),
nn.Dropout2d(0.1)
)
def forward(self, x):
_, _, h, w = x.size()
feat1 = F.interpolate(self.conv1(x), size=(h, w), mode='bilinear', align_corners=True)
feat2 = self.conv2(x)
feat3 = self.conv3(x)
feat4 = self.conv4(x)
feat5 = self.conv5(x)
out = torch.cat((feat1, feat2, feat3, feat4, feat5), dim=1)
bottle = self.bottleneck(out)
return bottle

108
lib_v4/nets.py Normal file
View File

@ -0,0 +1,108 @@
import torch
from torch import nn
import torch.nn.functional as F
from lib_v4 import layers
class BaseASPPNet(nn.Module):
def __init__(self, nin, ch, dilations=(4, 8, 16)):
super(BaseASPPNet, self).__init__()
self.enc1 = layers.Encoder(nin, ch, 3, 2, 1)
self.enc2 = layers.Encoder(ch, ch * 2, 3, 2, 1)
self.enc3 = layers.Encoder(ch * 2, ch * 4, 3, 2, 1)
self.enc4 = layers.Encoder(ch * 4, ch * 8, 3, 2, 1)
self.aspp = layers.ASPPModule(ch * 8, ch * 16, dilations)
self.dec4 = layers.Decoder(ch * (8 + 16), ch * 8, 3, 1, 1)
self.dec3 = layers.Decoder(ch * (4 + 8), ch * 4, 3, 1, 1)
self.dec2 = layers.Decoder(ch * (2 + 4), ch * 2, 3, 1, 1)
self.dec1 = layers.Decoder(ch * (1 + 2), ch, 3, 1, 1)
def __call__(self, x):
h, e1 = self.enc1(x)
h, e2 = self.enc2(h)
h, e3 = self.enc3(h)
h, e4 = self.enc4(h)
h = self.aspp(h)
h = self.dec4(h, e4)
h = self.dec3(h, e3)
h = self.dec2(h, e2)
h = self.dec1(h, e1)
return h
class CascadedASPPNet(nn.Module):
def __init__(self, n_fft):
super(CascadedASPPNet, self).__init__()
self.stg1_low_band_net = BaseASPPNet(2, 16)
self.stg1_high_band_net = BaseASPPNet(2, 16)
self.stg2_bridge = layers.Conv2DBNActiv(18, 8, 1, 1, 0)
self.stg2_full_band_net = BaseASPPNet(8, 16)
self.stg3_bridge = layers.Conv2DBNActiv(34, 16, 1, 1, 0)
self.stg3_full_band_net = BaseASPPNet(16, 32)
self.out = nn.Conv2d(32, 2, 1, bias=False)
self.aux1_out = nn.Conv2d(16, 2, 1, bias=False)
self.aux2_out = nn.Conv2d(16, 2, 1, bias=False)
self.max_bin = n_fft // 2
self.output_bin = n_fft // 2 + 1
self.offset = 128
def forward(self, x):
mix = x.detach()
x = x.clone()
x = x[:, :, :self.max_bin]
bandw = x.size()[2] // 2
aux1 = torch.cat([
self.stg1_low_band_net(x[:, :, :bandw]),
self.stg1_high_band_net(x[:, :, bandw:])
], dim=2)
h = torch.cat([x, aux1], dim=1)
aux2 = self.stg2_full_band_net(self.stg2_bridge(h))
h = torch.cat([x, aux1, aux2], dim=1)
h = self.stg3_full_band_net(self.stg3_bridge(h))
mask = torch.sigmoid(self.out(h))
mask = F.pad(
input=mask,
pad=(0, 0, 0, self.output_bin - mask.size()[2]),
mode='replicate')
if self.training:
aux1 = torch.sigmoid(self.aux1_out(aux1))
aux1 = F.pad(
input=aux1,
pad=(0, 0, 0, self.output_bin - aux1.size()[2]),
mode='replicate')
aux2 = torch.sigmoid(self.aux2_out(aux2))
aux2 = F.pad(
input=aux2,
pad=(0, 0, 0, self.output_bin - aux2.size()[2]),
mode='replicate')
return mask * mix, aux1 * mix, aux2 * mix
else:
return mask * mix
def predict(self, x_mag):
h = self.forward(x_mag)
if self.offset > 0:
h = h[:, :, :, self.offset:-self.offset]
assert h.size()[3] > 0
return h

216
lib_v4/spec_utils.py Normal file
View File

@ -0,0 +1,216 @@
import os
import librosa
import numpy as np
import soundfile as sf
def crop_center(h1, h2):
h1_shape = h1.size()
h2_shape = h2.size()
if h1_shape[3] == h2_shape[3]:
return h1
elif h1_shape[3] < h2_shape[3]:
raise ValueError('h1_shape[3] must be greater than h2_shape[3]')
# s_freq = (h2_shape[2] - h1_shape[2]) // 2
# e_freq = s_freq + h1_shape[2]
s_time = (h1_shape[3] - h2_shape[3]) // 2
e_time = s_time + h2_shape[3]
h1 = h1[:, :, :, s_time:e_time]
return h1
def wave_to_spectrogram(wave, hop_length, n_fft):
wave_left = np.asfortranarray(wave[0])
wave_right = np.asfortranarray(wave[1])
spec_left = librosa.stft(wave_left, n_fft, hop_length=hop_length)
spec_right = librosa.stft(wave_right, n_fft, hop_length=hop_length)
spec = np.asfortranarray([spec_left, spec_right])
return spec
def spectrogram_to_image(spec, mode='magnitude'):
if mode == 'magnitude':
if np.iscomplexobj(spec):
y = np.abs(spec)
else:
y = spec
y = np.log10(y ** 2 + 1e-8)
elif mode == 'phase':
if np.iscomplexobj(spec):
y = np.angle(spec)
else:
y = spec
y -= y.min()
y *= 255 / y.max()
img = np.uint8(y)
if y.ndim == 3:
img = img.transpose(1, 2, 0)
img = np.concatenate([
np.max(img, axis=2, keepdims=True), img
], axis=2)
return img
def reduce_vocal_aggressively(X, y, softmask):
v = X - y
y_mag_tmp = np.abs(y)
v_mag_tmp = np.abs(v)
v_mask = v_mag_tmp > y_mag_tmp
y_mag = np.clip(y_mag_tmp - v_mag_tmp * v_mask * softmask, 0, np.inf)
return y_mag * np.exp(1.j * np.angle(y))
def mask_silence(mag, ref, thres=0.2, min_range=64, fade_size=32):
if min_range < fade_size * 2:
raise ValueError('min_range must be >= fade_area * 2')
mag = mag.copy()
idx = np.where(ref.mean(axis=(0, 1)) < thres)[0]
starts = np.insert(idx[np.where(np.diff(idx) != 1)[0] + 1], 0, idx[0])
ends = np.append(idx[np.where(np.diff(idx) != 1)[0]], idx[-1])
uninformative = np.where(ends - starts > min_range)[0]
if len(uninformative) > 0:
starts = starts[uninformative]
ends = ends[uninformative]
old_e = None
for s, e in zip(starts, ends):
if old_e is not None and s - old_e < fade_size:
s = old_e - fade_size * 2
if s != 0:
weight = np.linspace(0, 1, fade_size)
mag[:, :, s:s + fade_size] += weight * ref[:, :, s:s + fade_size]
else:
s -= fade_size
if e != mag.shape[2]:
weight = np.linspace(1, 0, fade_size)
mag[:, :, e - fade_size:e] += weight * ref[:, :, e - fade_size:e]
else:
e += fade_size
mag[:, :, s + fade_size:e - fade_size] += ref[:, :, s + fade_size:e - fade_size]
old_e = e
return mag
def align_wave_head_and_tail(a, b, sr):
a, _ = librosa.effects.trim(a)
b, _ = librosa.effects.trim(b)
a_mono = a[:, :sr * 4].sum(axis=0)
b_mono = b[:, :sr * 4].sum(axis=0)
a_mono -= a_mono.mean()
b_mono -= b_mono.mean()
offset = len(a_mono) - 1
delay = np.argmax(np.correlate(a_mono, b_mono, 'full')) - offset
if delay > 0:
a = a[:, delay:]
else:
b = b[:, np.abs(delay):]
if a.shape[1] < b.shape[1]:
b = b[:, :a.shape[1]]
else:
a = a[:, :b.shape[1]]
return a, b
def cache_or_load(mix_path, inst_path, sr, hop_length, n_fft):
mix_basename = os.path.splitext(os.path.basename(mix_path))[0]
inst_basename = os.path.splitext(os.path.basename(inst_path))[0]
cache_dir = 'sr{}_hl{}_nf{}'.format(sr, hop_length, n_fft)
mix_cache_dir = os.path.join(os.path.dirname(mix_path), cache_dir)
inst_cache_dir = os.path.join(os.path.dirname(inst_path), cache_dir)
os.makedirs(mix_cache_dir, exist_ok=True)
os.makedirs(inst_cache_dir, exist_ok=True)
mix_cache_path = os.path.join(mix_cache_dir, mix_basename + '.npy')
inst_cache_path = os.path.join(inst_cache_dir, inst_basename + '.npy')
if os.path.exists(mix_cache_path) and os.path.exists(inst_cache_path):
X = np.load(mix_cache_path)
y = np.load(inst_cache_path)
else:
X, _ = librosa.load(
mix_path, sr, False, dtype=np.float32, res_type='kaiser_fast')
y, _ = librosa.load(
inst_path, sr, False, dtype=np.float32, res_type='kaiser_fast')
X, y = align_wave_head_and_tail(X, y, sr)
X = wave_to_spectrogram(X, hop_length, n_fft)
y = wave_to_spectrogram(y, hop_length, n_fft)
_, ext = os.path.splitext(mix_path)
np.save(mix_cache_path, X)
np.save(inst_cache_path, y)
return X, y
def spectrogram_to_wave(spec, hop_length=1024):
spec_left = np.asfortranarray(spec[0])
spec_right = np.asfortranarray(spec[1])
wave_left = librosa.istft(spec_left, hop_length=hop_length)
wave_right = librosa.istft(spec_right, hop_length=hop_length)
wave = np.asfortranarray([wave_left, wave_right])
return wave
if __name__ == "__main__":
import cv2
import sys
X, _ = librosa.load(
sys.argv[1], 44100, False, dtype=np.float32, res_type='kaiser_fast')
y, _ = librosa.load(
sys.argv[2], 44100, False, dtype=np.float32, res_type='kaiser_fast')
X, y = align_wave_head_and_tail(X, y, 44100)
X_spec = wave_to_spectrogram(X, 1024, 2048)
y_spec = wave_to_spectrogram(y, 1024, 2048)
y_spec = reduce_vocal_aggressively(X_spec, y_spec, 0.2)
v_spec = X_spec - y_spec
# v_mask = np.abs(v_spec) > np.abs(y_spec)
# y_spec = X_spec - v_spec * v_mask
# v_spec = X_spec - y_spec
X_mag = np.abs(X_spec)
y_mag = np.abs(y_spec)
v_mag = np.abs(v_spec)
X_image = spectrogram_to_image(X_mag)
y_image = spectrogram_to_image(y_mag)
v_image = spectrogram_to_image(v_mag)
cv2.imwrite('test_X.jpg', X_image)
cv2.imwrite('test_y.jpg', y_image)
cv2.imwrite('test_v.jpg', v_image)
sf.write('test_X.wav', spectrogram_to_wave(X_spec).T, 44100)
sf.write('test_y.wav', spectrogram_to_wave(y_spec).T, 44100)
sf.write('test_v.wav', spectrogram_to_wave(v_spec).T, 44100)

View File

@ -1 +0,0 @@
Model Goes Here

View File

@ -0,0 +1 @@
Models Go Here

View File

@ -0,0 +1 @@
Models Go Here

View File

@ -0,0 +1 @@
Models Go Here

View File

@ -0,0 +1 @@
Models Go Here

7
requirements.txt Normal file
View File

@ -0,0 +1,7 @@
Pillow
tqdm==4.45.0
librosa==0.7.2
opencv-python
numba==0.48.0
SoundFile
soundstretch

292
tkinterdnd2/TkinterDnD.py Normal file
View File

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

25
tkinterdnd2/__init__.py Normal file
View File

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

Binary file not shown.

View File

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

View File

@ -0,0 +1,469 @@
#
# tkdnd.tcl --
#
# This file implements some utility procedures that are used by the TkDND
# package.
#
# This software is copyrighted by:
# George Petasis, National Centre for Scientific Research "Demokritos",
# Aghia Paraskevi, Athens, Greece.
# e-mail: petasis@iit.demokritos.gr
#
# The following terms apply to all files associated
# with the software unless explicitly disclaimed in individual files.
#
# The authors hereby grant permission to use, copy, modify, distribute,
# and license this software and its documentation for any purpose, provided
# that existing copyright notices are retained in all copies and that this
# notice is included verbatim in any distributions. No written agreement,
# license, or royalty fee is required for any of the authorized uses.
# Modifications to this software may be copyrighted by their authors
# and need not follow the licensing terms described here, provided that
# the new terms are clearly indicated on the first page of each file where
# they apply.
#
# IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
# FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
# ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
# DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
#
# THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE
# IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
# NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
# MODIFICATIONS.
#
package require Tk
namespace eval ::tkdnd {
variable _topw ".drag"
variable _tabops
variable _state
variable _x0
variable _y0
variable _platform_namespace
variable _drop_file_temp_dir
variable _auto_update 1
variable _dx 3 ;# The difference in pixels before a drag is initiated.
variable _dy 3 ;# The difference in pixels before a drag is initiated.
variable _windowingsystem
bind TkDND_Drag1 <ButtonPress-1> {tkdnd::_begin_drag press 1 %W %s %X %Y %x %y}
bind TkDND_Drag1 <B1-Motion> {tkdnd::_begin_drag motion 1 %W %s %X %Y %x %y}
bind TkDND_Drag2 <ButtonPress-2> {tkdnd::_begin_drag press 2 %W %s %X %Y %x %y}
bind TkDND_Drag2 <B2-Motion> {tkdnd::_begin_drag motion 2 %W %s %X %Y %x %y}
bind TkDND_Drag3 <ButtonPress-3> {tkdnd::_begin_drag press 3 %W %s %X %Y %x %y}
bind TkDND_Drag3 <B3-Motion> {tkdnd::_begin_drag motion 3 %W %s %X %Y %x %y}
# ----------------------------------------------------------------------------
# Command tkdnd::initialise: Initialise the TkDND package.
# ----------------------------------------------------------------------------
proc initialise { dir PKG_LIB_FILE PACKAGE_NAME} {
variable _platform_namespace
variable _drop_file_temp_dir
variable _windowingsystem
global env
switch [tk windowingsystem] {
x11 {
set _windowingsystem x11
}
win32 -
windows {
set _windowingsystem windows
}
aqua {
set _windowingsystem aqua
}
default {
error "unknown Tk windowing system"
}
}
## Get User's home directory: We try to locate the proper path from a set of
## environmental variables...
foreach var {HOME HOMEPATH USERPROFILE ALLUSERSPROFILE APPDATA} {
if {[info exists env($var)]} {
if {[file isdirectory $env($var)]} {
set UserHomeDir $env($var)
break
}
}
}
## Should use [tk windowingsystem] instead of tcl platform array:
## OS X returns "unix," but that's not useful because it has its own
## windowing system, aqua
## Under windows we have to also combine HOMEDRIVE & HOMEPATH...
if {![info exists UserHomeDir] &&
[string equal $_windowingsystem windows] &&
[info exists env(HOMEDRIVE)] && [info exists env(HOMEPATH)]} {
if {[file isdirectory $env(HOMEDRIVE)$env(HOMEPATH)]} {
set UserHomeDir $env(HOMEDRIVE)$env(HOMEPATH)
}
}
## Have we located the needed path?
if {![info exists UserHomeDir]} {
set UserHomeDir [pwd]
}
set UserHomeDir [file normalize $UserHomeDir]
## Try to locate a temporary directory...
foreach var {TKDND_TEMP_DIR TEMP TMP} {
if {[info exists env($var)]} {
if {[file isdirectory $env($var)] && [file writable $env($var)]} {
set _drop_file_temp_dir $env($var)
break
}
}
}
if {![info exists _drop_file_temp_dir]} {
foreach _dir [list "$UserHomeDir/Local Settings/Temp" \
"$UserHomeDir/AppData/Local/Temp" \
/tmp \
C:/WINDOWS/Temp C:/Temp C:/tmp \
D:/WINDOWS/Temp D:/Temp D:/tmp] {
if {[file isdirectory $_dir] && [file writable $_dir]} {
set _drop_file_temp_dir $_dir
break
}
}
}
if {![info exists _drop_file_temp_dir]} {
set _drop_file_temp_dir $UserHomeDir
}
set _drop_file_temp_dir [file native $_drop_file_temp_dir]
source $dir/tkdnd_generic.tcl
switch $_windowingsystem {
x11 {
source $dir/tkdnd_unix.tcl
set _platform_namespace xdnd
}
win32 -
windows {
source $dir/tkdnd_windows.tcl
set _platform_namespace olednd
}
aqua {
source $dir/tkdnd_macosx.tcl
set _platform_namespace macdnd
}
default {
error "unknown Tk windowing system"
}
}
load $dir/$PKG_LIB_FILE $PACKAGE_NAME
source $dir/tkdnd_compat.tcl
${_platform_namespace}::initialise
};# initialise
proc GetDropFileTempDirectory { } {
variable _drop_file_temp_dir
return $_drop_file_temp_dir
}
proc SetDropFileTempDirectory { dir } {
variable _drop_file_temp_dir
set _drop_file_temp_dir $dir
}
};# namespace ::tkdnd
# ----------------------------------------------------------------------------
# Command tkdnd::drag_source
# ----------------------------------------------------------------------------
proc ::tkdnd::drag_source { mode path { types {} } { event 1 }
{ tagprefix TkDND_Drag } } {
set tags [bindtags $path]
set idx [lsearch $tags ${tagprefix}$event]
switch -- $mode {
register {
if { $idx != -1 } {
## No need to do anything!
# bindtags $path [lreplace $tags $idx $idx ${tagprefix}$event]
} else {
bindtags $path [linsert $tags 1 ${tagprefix}$event]
}
_drag_source_update_types $path $types
}
unregister {
if { $idx != -1 } {
bindtags $path [lreplace $tags $idx $idx]
}
}
}
};# tkdnd::drag_source
proc ::tkdnd::_drag_source_update_types { path types } {
set types [platform_specific_types $types]
set old_types [bind $path <<DragSourceTypes>>]
foreach type $types {
if {[lsearch $old_types $type] < 0} {lappend old_types $type}
}
bind $path <<DragSourceTypes>> $old_types
};# ::tkdnd::_drag_source_update_types
# ----------------------------------------------------------------------------
# Command tkdnd::drop_target
# ----------------------------------------------------------------------------
proc ::tkdnd::drop_target { mode path { types {} } } {
variable _windowingsystem
set types [platform_specific_types $types]
switch -- $mode {
register {
switch $_windowingsystem {
x11 {
_register_types $path [winfo toplevel $path] $types
}
win32 -
windows {
_RegisterDragDrop $path
bind <Destroy> $path {+ tkdnd::_RevokeDragDrop %W}
}
aqua {
macdnd::registerdragwidget [winfo toplevel $path] $types
}
default {
error "unknown Tk windowing system"
}
}
set old_types [bind $path <<DropTargetTypes>>]
set new_types {}
foreach type $types {
if {[lsearch -exact $old_types $type] < 0} {lappend new_types $type}
}
if {[llength $new_types]} {
bind $path <<DropTargetTypes>> [concat $old_types $new_types]
}
}
unregister {
switch $_windowingsystem {
x11 {
}
win32 -
windows {
_RevokeDragDrop $path
}
aqua {
error todo
}
default {
error "unknown Tk windowing system"
}
}
bind $path <<DropTargetTypes>> {}
}
}
};# tkdnd::drop_target
# ----------------------------------------------------------------------------
# Command tkdnd::_begin_drag
# ----------------------------------------------------------------------------
proc ::tkdnd::_begin_drag { event button source state X Y x y } {
variable _x0
variable _y0
variable _state
switch -- $event {
press {
set _x0 $X
set _y0 $Y
set _state "press"
}
motion {
if { ![info exists _state] } {
# This is just extra protection. There seem to be
# rare cases where the motion comes before the press.
return
}
if { [string equal $_state "press"] } {
variable _dx
variable _dy
if { abs($_x0-$X) > ${_dx} || abs($_y0-$Y) > ${_dy} } {
set _state "done"
_init_drag $button $source $state $X $Y $x $y
}
}
}
}
};# tkdnd::_begin_drag
# ----------------------------------------------------------------------------
# Command tkdnd::_init_drag
# ----------------------------------------------------------------------------
proc ::tkdnd::_init_drag { button source state rootX rootY X Y } {
# Call the <<DragInitCmd>> binding.
set cmd [bind $source <<DragInitCmd>>]
# puts "CMD: $cmd"
if {[string length $cmd]} {
set cmd [string map [list %W $source %X $rootX %Y $rootY %x $X %y $Y \
%S $state %e <<DragInitCmd>> %A \{\} %% % \
%t [bind $source <<DragSourceTypes>>]] $cmd]
set code [catch {uplevel \#0 $cmd} info options]
# puts "CODE: $code ---- $info"
switch -exact -- $code {
0 {}
3 - 4 {
# FRINK: nocheck
return
}
default {
return -options $options $info
}
}
set len [llength $info]
if {$len == 3} {
foreach { actions types _data } $info { break }
set types [platform_specific_types $types]
set data [list]
foreach type $types {
lappend data $_data
}
unset _data
} elseif {$len == 2} {
foreach { actions _data } $info { break }
set data [list]; set types [list]
foreach {t d} $_data {
foreach t [platform_specific_types $t] {
lappend types $t; lappend data $d
}
}
unset _data t d
} else {
if {$len == 1 && [string equal [lindex $actions 0] "refuse_drop"]} {
return
}
error "not enough items in the result of the <<DragInitCmd>>\
event binding. Either 2 or 3 items are expected. The command
executed was: \"$cmd\"\nResult was: \"$info\""
}
set action refuse_drop
variable _windowingsystem
# puts "Source: \"$source\""
# puts "Types: \"[join $types {", "}]\""
# puts "Actions: \"[join $actions {", "}]\""
# puts "Button: \"$button\""
# puts "Data: \"[string range $data 0 100]\""
switch $_windowingsystem {
x11 {
set action [xdnd::_dodragdrop $source $actions $types $data $button]
}
win32 -
windows {
set action [_DoDragDrop $source $actions $types $data $button]
}
aqua {
set action [macdnd::dodragdrop $source $actions $types $data $button]
}
default {
error "unknown Tk windowing system"
}
}
## Call _end_drag to notify the widget of the result of the drag
## operation...
_end_drag $button $source {} $action {} $data {} $state $rootX $rootY $X $Y
}
};# tkdnd::_init_drag
# ----------------------------------------------------------------------------
# Command tkdnd::_end_drag
# ----------------------------------------------------------------------------
proc ::tkdnd::_end_drag { button source target action type data result
state rootX rootY X Y } {
set rootX 0
set rootY 0
# Call the <<DragEndCmd>> binding.
set cmd [bind $source <<DragEndCmd>>]
if {[string length $cmd]} {
set cmd [string map [list %W $source %X $rootX %Y $rootY %x $X %y $Y %% % \
%S $state %e <<DragEndCmd>> %A \{$action\}] $cmd]
set info [uplevel \#0 $cmd]
# if { $info != "" } {
# variable _windowingsystem
# foreach { actions types data } $info { break }
# set types [platform_specific_types $types]
# switch $_windowingsystem {
# x11 {
# error "dragging from Tk widgets not yet supported"
# }
# win32 -
# windows {
# set action [_DoDragDrop $source $actions $types $data $button]
# }
# aqua {
# macdnd::dodragdrop $source $actions $types $data
# }
# default {
# error "unknown Tk windowing system"
# }
# }
# ## Call _end_drag to notify the widget of the result of the drag
# ## operation...
# _end_drag $button $source {} $action {} $data {} $state $rootX $rootY
# }
}
};# tkdnd::_end_drag
# ----------------------------------------------------------------------------
# Command tkdnd::platform_specific_types
# ----------------------------------------------------------------------------
proc ::tkdnd::platform_specific_types { types } {
variable _platform_namespace
${_platform_namespace}::platform_specific_types $types
}; # tkdnd::platform_specific_types
# ----------------------------------------------------------------------------
# Command tkdnd::platform_independent_types
# ----------------------------------------------------------------------------
proc ::tkdnd::platform_independent_types { types } {
variable _platform_namespace
${_platform_namespace}::platform_independent_types $types
}; # tkdnd::platform_independent_types
# ----------------------------------------------------------------------------
# Command tkdnd::platform_specific_type
# ----------------------------------------------------------------------------
proc ::tkdnd::platform_specific_type { type } {
variable _platform_namespace
${_platform_namespace}::platform_specific_type $type
}; # tkdnd::platform_specific_type
# ----------------------------------------------------------------------------
# Command tkdnd::platform_independent_type
# ----------------------------------------------------------------------------
proc ::tkdnd::platform_independent_type { type } {
variable _platform_namespace
${_platform_namespace}::platform_independent_type $type
}; # tkdnd::platform_independent_type
# ----------------------------------------------------------------------------
# Command tkdnd::bytes_to_string
# ----------------------------------------------------------------------------
proc ::tkdnd::bytes_to_string { bytes } {
set string {}
foreach byte $bytes {
append string [binary format c $byte]
}
return $string
};# tkdnd::bytes_to_string
# ----------------------------------------------------------------------------
# Command tkdnd::urn_unquote
# ----------------------------------------------------------------------------
proc ::tkdnd::urn_unquote {url} {
set result ""
set start 0
while {[regexp -start $start -indices {%[0-9a-fA-F]{2}} $url match]} {
foreach {first last} $match break
append result [string range $url $start [expr {$first - 1}]]
append result [format %c 0x[string range $url [incr first] $last]]
set start [incr last]
}
append result [string range $url $start end]
return [encoding convertfrom utf-8 $result]
};# tkdnd::urn_unquote

View File

@ -0,0 +1,160 @@
#
# tkdnd_compat.tcl --
#
# This file implements some utility procedures, to support older versions
# of the TkDND package.
#
# This software is copyrighted by:
# George Petasis, National Centre for Scientific Research "Demokritos",
# Aghia Paraskevi, Athens, Greece.
# e-mail: petasis@iit.demokritos.gr
#
# The following terms apply to all files associated
# with the software unless explicitly disclaimed in individual files.
#
# The authors hereby grant permission to use, copy, modify, distribute,
# and license this software and its documentation for any purpose, provided
# that existing copyright notices are retained in all copies and that this
# notice is included verbatim in any distributions. No written agreement,
# license, or royalty fee is required for any of the authorized uses.
# Modifications to this software may be copyrighted by their authors
# and need not follow the licensing terms described here, provided that
# the new terms are clearly indicated on the first page of each file where
# they apply.
#
# IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
# FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
# ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
# DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
#
# THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE
# IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
# NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
# MODIFICATIONS.
#
namespace eval compat {
};# namespace compat
# ----------------------------------------------------------------------------
# Command ::dnd
# ----------------------------------------------------------------------------
proc ::dnd {method window args} {
switch $method {
bindtarget {
switch [llength $args] {
0 {return [tkdnd::compat::bindtarget0 $window]}
1 {return [tkdnd::compat::bindtarget1 $window [lindex $args 0]]}
2 {return [tkdnd::compat::bindtarget2 $window [lindex $args 0] \
[lindex $args 1]]}
3 {return [tkdnd::compat::bindtarget3 $window [lindex $args 0] \
[lindex $args 1] [lindex $args 2]]}
4 {return [tkdnd::compat::bindtarget4 $window [lindex $args 0] \
[lindex $args 1] [lindex $args 2] [lindex $args 3]]}
}
}
cleartarget {
return [tkdnd::compat::cleartarget $window]
}
bindsource {
switch [llength $args] {
0 {return [tkdnd::compat::bindsource0 $window]}
1 {return [tkdnd::compat::bindsource1 $window [lindex $args 0]]}
2 {return [tkdnd::compat::bindsource2 $window [lindex $args 0] \
[lindex $args 1]]}
3 {return [tkdnd::compat::bindsource3 $window [lindex $args 0] \
[lindex $args 1] [lindex $args 2]]}
}
}
clearsource {
return [tkdnd::compat::clearsource $window]
}
drag {
return [tkdnd::_init_drag 1 $window "press" 0 0 0 0]
}
}
error "invalid number of arguments!"
};# ::dnd
# ----------------------------------------------------------------------------
# Command compat::bindtarget
# ----------------------------------------------------------------------------
proc compat::bindtarget0 {window} {
return [bind $window <<DropTargetTypes>>]
};# compat::bindtarget0
proc compat::bindtarget1 {window type} {
return [bindtarget2 $window $type <Drop>]
};# compat::bindtarget1
proc compat::bindtarget2 {window type event} {
switch $event {
<DragEnter> {return [bind $window <<DropEnter>>]}
<Drag> {return [bind $window <<DropPosition>>]}
<DragLeave> {return [bind $window <<DropLeave>>]}
<Drop> {return [bind $window <<Drop>>]}
}
};# compat::bindtarget2
proc compat::bindtarget3 {window type event script} {
set type [normalise_type $type]
::tkdnd::drop_target register $window [list $type]
switch $event {
<DragEnter> {return [bind $window <<DropEnter>> $script]}
<Drag> {return [bind $window <<DropPosition>> $script]}
<DragLeave> {return [bind $window <<DropLeave>> $script]}
<Drop> {return [bind $window <<Drop>> $script]}
}
};# compat::bindtarget3
proc compat::bindtarget4 {window type event script priority} {
return [bindtarget3 $window $type $event $script]
};# compat::bindtarget4
proc compat::normalise_type { type } {
switch $type {
text/plain -
{text/plain;charset=UTF-8} -
Text {return DND_Text}
text/uri-list -
Files {return DND_Files}
default {return $type}
}
};# compat::normalise_type
# ----------------------------------------------------------------------------
# Command compat::bindsource
# ----------------------------------------------------------------------------
proc compat::bindsource0 {window} {
return [bind $window <<DropTargetTypes>>]
};# compat::bindsource0
proc compat::bindsource1 {window type} {
return [bindsource2 $window $type <Drop>]
};# compat::bindsource1
proc compat::bindsource2 {window type script} {
set type [normalise_type $type]
::tkdnd::drag_source register $window $type
bind $window <<DragInitCmd>> "list {copy} {%t} \[$script\]"
};# compat::bindsource2
proc compat::bindsource3 {window type script priority} {
return [bindsource2 $window $type $script]
};# compat::bindsource3
# ----------------------------------------------------------------------------
# Command compat::cleartarget
# ----------------------------------------------------------------------------
proc compat::cleartarget {window} {
};# compat::cleartarget
# ----------------------------------------------------------------------------
# Command compat::clearsource
# ----------------------------------------------------------------------------
proc compat::clearsource {window} {
};# compat::clearsource

View File

@ -0,0 +1,520 @@
#
# tkdnd_generic.tcl --
#
# This file implements some utility procedures that are used by the TkDND
# package.
#
# This software is copyrighted by:
# George Petasis, National Centre for Scientific Research "Demokritos",
# Aghia Paraskevi, Athens, Greece.
# e-mail: petasis@iit.demokritos.gr
#
# The following terms apply to all files associated
# with the software unless explicitly disclaimed in individual files.
#
# The authors hereby grant permission to use, copy, modify, distribute,
# and license this software and its documentation for any purpose, provided
# that existing copyright notices are retained in all copies and that this
# notice is included verbatim in any distributions. No written agreement,
# license, or royalty fee is required for any of the authorized uses.
# Modifications to this software may be copyrighted by their authors
# and need not follow the licensing terms described here, provided that
# the new terms are clearly indicated on the first page of each file where
# they apply.
#
# IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
# FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
# ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
# DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
#
# THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE
# IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
# NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
# MODIFICATIONS.
#
namespace eval generic {
variable _types {}
variable _typelist {}
variable _codelist {}
variable _actionlist {}
variable _pressedkeys {}
variable _action {}
variable _common_drag_source_types {}
variable _common_drop_target_types {}
variable _drag_source {}
variable _drop_target {}
variable _last_mouse_root_x 0
variable _last_mouse_root_y 0
variable _tkdnd2platform
variable _platform2tkdnd
proc debug {msg} {
puts $msg
};# debug
proc initialise { } {
};# initialise
proc initialise_platform_to_tkdnd_types { types } {
variable _platform2tkdnd
variable _tkdnd2platform
set _platform2tkdnd [dict create {*}$types]
set _tkdnd2platform [dict create]
foreach type [dict keys $_platform2tkdnd] {
dict lappend _tkdnd2platform [dict get $_platform2tkdnd $type] $type
}
};# initialise_platform_to_tkdnd_types
proc initialise_tkdnd_to_platform_types { types } {
variable _tkdnd2platform
set _tkdnd2platform [dict create {*}$types]
};# initialise_tkdnd_to_platform_types
};# namespace generic
# ----------------------------------------------------------------------------
# Command generic::HandleEnter
# ----------------------------------------------------------------------------
proc generic::HandleEnter { drop_target drag_source typelist codelist
actionlist pressedkeys } {
variable _typelist; set _typelist $typelist
variable _pressedkeys; set _pressedkeys $pressedkeys
variable _action; set _action refuse_drop
variable _common_drag_source_types; set _common_drag_source_types {}
variable _common_drop_target_types; set _common_drop_target_types {}
variable _actionlist
variable _drag_source; set _drag_source $drag_source
variable _drop_target; set _drop_target {}
variable _actionlist; set _actionlist $actionlist
variable _codelist set _codelist $codelist
variable _last_mouse_root_x; set _last_mouse_root_x 0
variable _last_mouse_root_y; set _last_mouse_root_y 0
# debug "\n==============================================================="
# debug "generic::HandleEnter: drop_target=$drop_target,\
# drag_source=$drag_source,\
# typelist=$typelist"
# debug "generic::HandleEnter: ACTION: default"
return default
};# generic::HandleEnter
# ----------------------------------------------------------------------------
# Command generic::HandlePosition
# ----------------------------------------------------------------------------
proc generic::HandlePosition { drop_target drag_source pressedkeys
rootX rootY { time 0 } } {
variable _types
variable _typelist
variable _codelist
variable _actionlist
variable _pressedkeys
variable _action
variable _common_drag_source_types
variable _common_drop_target_types
variable _drag_source
variable _drop_target
variable _last_mouse_root_x; set _last_mouse_root_x $rootX
variable _last_mouse_root_y; set _last_mouse_root_y $rootY
# debug "generic::HandlePosition: drop_target=$drop_target,\
# _drop_target=$_drop_target, rootX=$rootX, rootY=$rootY"
if {![info exists _drag_source] && ![string length $_drag_source]} {
# debug "generic::HandlePosition: no or empty _drag_source:\
# return refuse_drop"
return refuse_drop
}
if {$drag_source ne "" && $drag_source ne $_drag_source} {
debug "generic position event from unexpected source: $_drag_source\
!= $drag_source"
return refuse_drop
}
set _pressedkeys $pressedkeys
## Does the new drop target support any of our new types?
# foreach {common_drag_source_types common_drop_target_types} \
# [GetWindowCommonTypes $drop_target $_typelist] {break}
foreach {drop_target common_drag_source_types common_drop_target_types} \
[FindWindowWithCommonTypes $drop_target $_typelist] {break}
set data [GetDroppedData $time]
# debug "\t($_drop_target) -> ($drop_target)"
if {$drop_target != $_drop_target} {
if {[string length $_drop_target]} {
## Call the <<DropLeave>> event.
# debug "\t<<DropLeave>> on $_drop_target"
set cmd [bind $_drop_target <<DropLeave>>]
if {[string length $cmd]} {
set cmd [string map [list %W $_drop_target %X $rootX %Y $rootY \
%CST \{$_common_drag_source_types\} \
%CTT \{$_common_drop_target_types\} \
%CPT \{[lindex [platform_independent_type [lindex $_common_drag_source_types 0]] 0]\} \
%ST \{$_typelist\} %TT \{$_types\} \
%A \{$_action\} %a \{$_actionlist\} \
%b \{$_pressedkeys\} %m \{$_pressedkeys\} \
%D \{\} %e <<DropLeave>> \
%L \{$_typelist\} %% % \
%t \{$_typelist\} %T \{[lindex $_common_drag_source_types 0]\} \
%c \{$_codelist\} %C \{[lindex $_codelist 0]\} \
] $cmd]
uplevel \#0 $cmd
}
}
set _drop_target $drop_target
set _action refuse_drop
if {[llength $common_drag_source_types]} {
set _action [lindex $_actionlist 0]
set _common_drag_source_types $common_drag_source_types
set _common_drop_target_types $common_drop_target_types
## Drop target supports at least one type. Send a <<DropEnter>>.
# puts "<<DropEnter>> -> $drop_target"
set cmd [bind $drop_target <<DropEnter>>]
if {[string length $cmd]} {
focus $drop_target
set cmd [string map [list %W $drop_target %X $rootX %Y $rootY \
%CST \{$_common_drag_source_types\} \
%CTT \{$_common_drop_target_types\} \
%CPT \{[lindex [platform_independent_type [lindex $_common_drag_source_types 0]] 0]\} \
%ST \{$_typelist\} %TT \{$_types\} \
%A $_action %a \{$_actionlist\} \
%b \{$_pressedkeys\} %m \{$_pressedkeys\} \
%D [list $data] %e <<DropEnter>> \
%L \{$_typelist\} %% % \
%t \{$_typelist\} %T \{[lindex $_common_drag_source_types 0]\} \
%c \{$_codelist\} %C \{[lindex $_codelist 0]\} \
] $cmd]
set _action [uplevel \#0 $cmd]
switch -exact -- $_action {
copy - move - link - ask - private - refuse_drop - default {}
default {set _action copy}
}
}
}
}
set _drop_target {}
if {[llength $common_drag_source_types]} {
set _common_drag_source_types $common_drag_source_types
set _common_drop_target_types $common_drop_target_types
set _drop_target $drop_target
## Drop target supports at least one type. Send a <<DropPosition>>.
set cmd [bind $drop_target <<DropPosition>>]
if {[string length $cmd]} {
set cmd [string map [list %W $drop_target %X $rootX %Y $rootY \
%CST \{$_common_drag_source_types\} \
%CTT \{$_common_drop_target_types\} \
%CPT \{[lindex [platform_independent_type [lindex $_common_drag_source_types 0]] 0]\} \
%ST \{$_typelist\} %TT \{$_types\} \
%A $_action %a \{$_actionlist\} \
%b \{$_pressedkeys\} %m \{$_pressedkeys\} \
%D [list $data] %e <<DropPosition>> \
%L \{$_typelist\} %% % \
%t \{$_typelist\} %T \{[lindex $_common_drag_source_types 0]\} \
%c \{$_codelist\} %C \{[lindex $_codelist 0]\} \
] $cmd]
set _action [uplevel \#0 $cmd]
}
}
# Return values: copy, move, link, ask, private, refuse_drop, default
# debug "generic::HandlePosition: ACTION: $_action"
switch -exact -- $_action {
copy - move - link - ask - private - refuse_drop - default {}
default {set _action copy}
}
return $_action
};# generic::HandlePosition
# ----------------------------------------------------------------------------
# Command generic::HandleLeave
# ----------------------------------------------------------------------------
proc generic::HandleLeave { } {
variable _types
variable _typelist
variable _codelist
variable _actionlist
variable _pressedkeys
variable _action
variable _common_drag_source_types
variable _common_drop_target_types
variable _drag_source
variable _drop_target
variable _last_mouse_root_x
variable _last_mouse_root_y
if {![info exists _drop_target]} {set _drop_target {}}
# debug "generic::HandleLeave: _drop_target=$_drop_target"
if {[info exists _drop_target] && [string length $_drop_target]} {
set cmd [bind $_drop_target <<DropLeave>>]
if {[string length $cmd]} {
set cmd [string map [list %W $_drop_target \
%X $_last_mouse_root_x %Y $_last_mouse_root_y \
%CST \{$_common_drag_source_types\} \
%CTT \{$_common_drop_target_types\} \
%CPT \{[lindex [platform_independent_type [lindex $_common_drag_source_types 0]] 0]\} \
%ST \{$_typelist\} %TT \{$_types\} \
%A \{$_action\} %a \{$_actionlist\} \
%b \{$_pressedkeys\} %m \{$_pressedkeys\} \
%D \{\} %e <<DropLeave>> \
%L \{$_typelist\} %% % \
%t \{$_typelist\} %T \{[lindex $_common_drag_source_types 0]\} \
%c \{$_codelist\} %C \{[lindex $_codelist 0]\} \
] $cmd]
set _action [uplevel \#0 $cmd]
}
}
foreach var {_types _typelist _actionlist _pressedkeys _action
_common_drag_source_types _common_drop_target_types
_drag_source _drop_target} {
set $var {}
}
};# generic::HandleLeave
# ----------------------------------------------------------------------------
# Command generic::HandleDrop
# ----------------------------------------------------------------------------
proc generic::HandleDrop {drop_target drag_source pressedkeys rootX rootY time } {
variable _types
variable _typelist
variable _codelist
variable _actionlist
variable _pressedkeys
variable _action
variable _common_drag_source_types
variable _common_drop_target_types
variable _drag_source
variable _drop_target
variable _last_mouse_root_x
variable _last_mouse_root_y
variable _last_mouse_root_x; set _last_mouse_root_x $rootX
variable _last_mouse_root_y; set _last_mouse_root_y $rootY
set _pressedkeys $pressedkeys
# puts "generic::HandleDrop: $time"
if {![info exists _drag_source] && ![string length $_drag_source]} {
return refuse_drop
}
if {![info exists _drop_target] && ![string length $_drop_target]} {
return refuse_drop
}
if {![llength $_common_drag_source_types]} {return refuse_drop}
## Get the dropped data.
set data [GetDroppedData $time]
## Try to select the most specific <<Drop>> event.
foreach type [concat $_common_drag_source_types $_common_drop_target_types] {
set type [platform_independent_type $type]
set cmd [bind $_drop_target <<Drop:$type>>]
if {[string length $cmd]} {
set cmd [string map [list %W $_drop_target %X $rootX %Y $rootY \
%CST \{$_common_drag_source_types\} \
%CTT \{$_common_drop_target_types\} \
%CPT \{[lindex [platform_independent_type [lindex $_common_drag_source_types 0]] 0]\} \
%ST \{$_typelist\} %TT \{$_types\} \
%A $_action %a \{$_actionlist\} \
%b \{$_pressedkeys\} %m \{$_pressedkeys\} \
%D [list $data] %e <<Drop:$type>> \
%L \{$_typelist\} %% % \
%t \{$_typelist\} %T \{[lindex $_common_drag_source_types 0]\} \
%c \{$_codelist\} %C \{[lindex $_codelist 0]\} \
] $cmd]
set _action [uplevel \#0 $cmd]
# Return values: copy, move, link, ask, private, refuse_drop
switch -exact -- $_action {
copy - move - link - ask - private - refuse_drop - default {}
default {set _action copy}
}
return $_action
}
}
set cmd [bind $_drop_target <<Drop>>]
if {[string length $cmd]} {
set cmd [string map [list %W $_drop_target %X $rootX %Y $rootY \
%CST \{$_common_drag_source_types\} \
%CTT \{$_common_drop_target_types\} \
%CPT \{[lindex [platform_independent_type [lindex $_common_drag_source_types 0]] 0]\} \
%ST \{$_typelist\} %TT \{$_types\} \
%A $_action %a \{$_actionlist\} \
%b \{$_pressedkeys\} %m \{$_pressedkeys\} \
%D [list $data] %e <<Drop>> \
%L \{$_typelist\} %% % \
%t \{$_typelist\} %T \{[lindex $_common_drag_source_types 0]\} \
%c \{$_codelist\} %C \{[lindex $_codelist 0]\} \
] $cmd]
set _action [uplevel \#0 $cmd]
}
# Return values: copy, move, link, ask, private, refuse_drop
switch -exact -- $_action {
copy - move - link - ask - private - refuse_drop - default {}
default {set _action copy}
}
return $_action
};# generic::HandleDrop
# ----------------------------------------------------------------------------
# Command generic::GetWindowCommonTypes
# ----------------------------------------------------------------------------
proc generic::GetWindowCommonTypes { win typelist } {
set types [bind $win <<DropTargetTypes>>]
# debug ">> Accepted types: $win $_types"
set common_drag_source_types {}
set common_drop_target_types {}
if {[llength $types]} {
## Examine the drop target types, to find at least one match with the drag
## source types...
set supported_types [supported_types $typelist]
foreach type $types {
foreach matched [lsearch -glob -all -inline $supported_types $type] {
## Drop target supports this type.
lappend common_drag_source_types $matched
lappend common_drop_target_types $type
}
}
}
list $common_drag_source_types $common_drop_target_types
};# generic::GetWindowCommonTypes
# ----------------------------------------------------------------------------
# Command generic::FindWindowWithCommonTypes
# ----------------------------------------------------------------------------
proc generic::FindWindowWithCommonTypes { win typelist } {
set toplevel [winfo toplevel $win]
while {![string equal $win $toplevel]} {
foreach {common_drag_source_types common_drop_target_types} \
[GetWindowCommonTypes $win $typelist] {break}
if {[llength $common_drag_source_types]} {
return [list $win $common_drag_source_types $common_drop_target_types]
}
set win [winfo parent $win]
}
## We have reached the toplevel, which may be also a target (SF Bug #30)
foreach {common_drag_source_types common_drop_target_types} \
[GetWindowCommonTypes $win $typelist] {break}
if {[llength $common_drag_source_types]} {
return [list $win $common_drag_source_types $common_drop_target_types]
}
return { {} {} {} }
};# generic::FindWindowWithCommonTypes
# ----------------------------------------------------------------------------
# Command generic::GetDroppedData
# ----------------------------------------------------------------------------
proc generic::GetDroppedData { time } {
variable _dropped_data
return $_dropped_data
};# generic::GetDroppedData
# ----------------------------------------------------------------------------
# Command generic::SetDroppedData
# ----------------------------------------------------------------------------
proc generic::SetDroppedData { data } {
variable _dropped_data
set _dropped_data $data
};# generic::SetDroppedData
# ----------------------------------------------------------------------------
# Command generic::GetDragSource
# ----------------------------------------------------------------------------
proc generic::GetDragSource { } {
variable _drag_source
return $_drag_source
};# generic::GetDragSource
# ----------------------------------------------------------------------------
# Command generic::GetDropTarget
# ----------------------------------------------------------------------------
proc generic::GetDropTarget { } {
variable _drop_target
return $_drop_target
};# generic::GetDropTarget
# ----------------------------------------------------------------------------
# Command generic::GetDragSourceCommonTypes
# ----------------------------------------------------------------------------
proc generic::GetDragSourceCommonTypes { } {
variable _common_drag_source_types
return $_common_drag_source_types
};# generic::GetDragSourceCommonTypes
# ----------------------------------------------------------------------------
# Command generic::GetDropTargetCommonTypes
# ----------------------------------------------------------------------------
proc generic::GetDropTargetCommonTypes { } {
variable _common_drag_source_types
return $_common_drag_source_types
};# generic::GetDropTargetCommonTypes
# ----------------------------------------------------------------------------
# Command generic::platform_specific_types
# ----------------------------------------------------------------------------
proc generic::platform_specific_types { types } {
set new_types {}
foreach type $types {
set new_types [concat $new_types [platform_specific_type $type]]
}
return $new_types
}; # generic::platform_specific_types
# ----------------------------------------------------------------------------
# Command generic::platform_specific_type
# ----------------------------------------------------------------------------
proc generic::platform_specific_type { type } {
variable _tkdnd2platform
if {[dict exists $_tkdnd2platform $type]} {
return [dict get $_tkdnd2platform $type]
}
list $type
}; # generic::platform_specific_type
# ----------------------------------------------------------------------------
# Command tkdnd::platform_independent_types
# ----------------------------------------------------------------------------
proc ::tkdnd::platform_independent_types { types } {
set new_types {}
foreach type $types {
set new_types [concat $new_types [platform_independent_type $type]]
}
return $new_types
}; # tkdnd::platform_independent_types
# ----------------------------------------------------------------------------
# Command generic::platform_independent_type
# ----------------------------------------------------------------------------
proc generic::platform_independent_type { type } {
variable _platform2tkdnd
if {[dict exists $_platform2tkdnd $type]} {
return [dict get $_platform2tkdnd $type]
}
return $type
}; # generic::platform_independent_type
# ----------------------------------------------------------------------------
# Command generic::supported_types
# ----------------------------------------------------------------------------
proc generic::supported_types { types } {
set new_types {}
foreach type $types {
if {[supported_type $type]} {lappend new_types $type}
}
return $new_types
}; # generic::supported_types
# ----------------------------------------------------------------------------
# Command generic::supported_type
# ----------------------------------------------------------------------------
proc generic::supported_type { type } {
variable _platform2tkdnd
if {[dict exists $_platform2tkdnd $type]} {
return 1
}
return 0
}; # generic::supported_type

View File

@ -0,0 +1,144 @@
#
# tkdnd_macosx.tcl --
#
# This file implements some utility procedures that are used by the TkDND
# package.
# This software is copyrighted by:
# Georgios Petasis, Athens, Greece.
# e-mail: petasisg@yahoo.gr, petasis@iit.demokritos.gr
#
# Mac portions (c) 2009 Kevin Walzer/WordTech Communications LLC,
# kw@codebykevin.com
#
#
# The following terms apply to all files associated
# with the software unless explicitly disclaimed in individual files.
#
# The authors hereby grant permission to use, copy, modify, distribute,
# and license this software and its documentation for any purpose, provided
# that existing copyright notices are retained in all copies and that this
# notice is included verbatim in any distributions. No written agreement,
# license, or royalty fee is required for any of the authorized uses.
# Modifications to this software may be copyrighted by their authors
# and need not follow the licensing terms described here, provided that
# the new terms are clearly indicated on the first page of each file where
# they apply.
#
# IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
# FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
# ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
# DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
#
# THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE
# IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
# NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
# MODIFICATIONS.
#
#basic API for Mac Drag and Drop
#two data types supported: strings and file paths
#two commands at C level: ::tkdnd::macdnd::registerdragwidget, ::tkdnd::macdnd::unregisterdragwidget
#data retrieval mechanism: text or file paths are copied from drag clipboard to system clipboard and retrieved via [clipboard get]; array of file paths is converted to single tab-separated string, can be split into Tcl list
if {[tk windowingsystem] eq "aqua" && "AppKit" ni [winfo server .]} {
error {TkAqua Cocoa required}
}
namespace eval macdnd {
proc initialise { } {
## Mapping from platform types to TkDND types...
::tkdnd::generic::initialise_platform_to_tkdnd_types [list \
NSPasteboardTypeString DND_Text \
NSFilenamesPboardType DND_Files \
NSPasteboardTypeHTML DND_HTML \
]
};# initialise
};# namespace macdnd
# ----------------------------------------------------------------------------
# Command macdnd::HandleEnter
# ----------------------------------------------------------------------------
proc macdnd::HandleEnter { path drag_source typelist { data {} } } {
variable _pressedkeys
variable _actionlist
set _pressedkeys 1
set _actionlist { copy move link ask private }
::tkdnd::generic::SetDroppedData $data
::tkdnd::generic::HandleEnter $path $drag_source $typelist $typelist \
$_actionlist $_pressedkeys
};# macdnd::HandleEnter
# ----------------------------------------------------------------------------
# Command macdnd::HandlePosition
# ----------------------------------------------------------------------------
proc macdnd::HandlePosition { drop_target rootX rootY {drag_source {}} } {
variable _pressedkeys
variable _last_mouse_root_x; set _last_mouse_root_x $rootX
variable _last_mouse_root_y; set _last_mouse_root_y $rootY
::tkdnd::generic::HandlePosition $drop_target $drag_source \
$_pressedkeys $rootX $rootY
};# macdnd::HandlePosition
# ----------------------------------------------------------------------------
# Command macdnd::HandleLeave
# ----------------------------------------------------------------------------
proc macdnd::HandleLeave { args } {
::tkdnd::generic::HandleLeave
};# macdnd::HandleLeave
# ----------------------------------------------------------------------------
# Command macdnd::HandleDrop
# ----------------------------------------------------------------------------
proc macdnd::HandleDrop { drop_target data args } {
variable _pressedkeys
variable _last_mouse_root_x
variable _last_mouse_root_y
## Get the dropped data...
::tkdnd::generic::SetDroppedData $data
::tkdnd::generic::HandleDrop {} {} $_pressedkeys \
$_last_mouse_root_x $_last_mouse_root_y 0
};# macdnd::HandleDrop
# ----------------------------------------------------------------------------
# Command macdnd::GetDragSourceCommonTypes
# ----------------------------------------------------------------------------
proc macdnd::GetDragSourceCommonTypes { } {
::tkdnd::generic::GetDragSourceCommonTypes
};# macdnd::GetDragSourceCommonTypes
# ----------------------------------------------------------------------------
# Command macdnd::platform_specific_types
# ----------------------------------------------------------------------------
proc macdnd::platform_specific_types { types } {
::tkdnd::generic::platform_specific_types $types
}; # macdnd::platform_specific_types
# ----------------------------------------------------------------------------
# Command macdnd::platform_specific_type
# ----------------------------------------------------------------------------
proc macdnd::platform_specific_type { type } {
::tkdnd::generic::platform_specific_type $type
}; # macdnd::platform_specific_type
# ----------------------------------------------------------------------------
# Command tkdnd::platform_independent_types
# ----------------------------------------------------------------------------
proc ::tkdnd::platform_independent_types { types } {
::tkdnd::generic::platform_independent_types $types
}; # tkdnd::platform_independent_types
# ----------------------------------------------------------------------------
# Command macdnd::platform_independent_type
# ----------------------------------------------------------------------------
proc macdnd::platform_independent_type { type } {
::tkdnd::generic::platform_independent_type $type
}; # macdnd::platform_independent_type

View File

@ -0,0 +1,810 @@
#
# tkdnd_unix.tcl --
#
# This file implements some utility procedures that are used by the TkDND
# package.
#
# This software is copyrighted by:
# George Petasis, National Centre for Scientific Research "Demokritos",
# Aghia Paraskevi, Athens, Greece.
# e-mail: petasis@iit.demokritos.gr
#
# The following terms apply to all files associated
# with the software unless explicitly disclaimed in individual files.
#
# The authors hereby grant permission to use, copy, modify, distribute,
# and license this software and its documentation for any purpose, provided
# that existing copyright notices are retained in all copies and that this
# notice is included verbatim in any distributions. No written agreement,
# license, or royalty fee is required for any of the authorized uses.
# Modifications to this software may be copyrighted by their authors
# and need not follow the licensing terms described here, provided that
# the new terms are clearly indicated on the first page of each file where
# they apply.
#
# IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
# FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
# ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
# DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
#
# THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE
# IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
# NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
# MODIFICATIONS.
#
namespace eval xdnd {
variable _dragging 0
proc initialise { } {
## Mapping from platform types to TkDND types...
::tkdnd::generic::initialise_platform_to_tkdnd_types [list \
text/plain\;charset=utf-8 DND_Text \
UTF8_STRING DND_Text \
text/plain DND_Text \
STRING DND_Text \
TEXT DND_Text \
COMPOUND_TEXT DND_Text \
text/uri-list DND_Files \
text/html\;charset=utf-8 DND_HTML \
text/html DND_HTML \
application/x-color DND_Color \
]
};# initialise
};# namespace xdnd
# ----------------------------------------------------------------------------
# Command xdnd::HandleXdndEnter
# ----------------------------------------------------------------------------
proc xdnd::HandleXdndEnter { path drag_source typelist time { data {} } } {
variable _pressedkeys
variable _actionlist
variable _typelist
set _pressedkeys 1
set _actionlist { copy move link ask private }
set _typelist $typelist
# puts "xdnd::HandleXdndEnter: $time"
::tkdnd::generic::SetDroppedData $data
::tkdnd::generic::HandleEnter $path $drag_source $typelist $typelist \
$_actionlist $_pressedkeys
};# xdnd::HandleXdndEnter
# ----------------------------------------------------------------------------
# Command xdnd::HandleXdndPosition
# ----------------------------------------------------------------------------
proc xdnd::HandleXdndPosition { drop_target rootX rootY time {drag_source {}} } {
variable _pressedkeys
variable _typelist
variable _last_mouse_root_x; set _last_mouse_root_x $rootX
variable _last_mouse_root_y; set _last_mouse_root_y $rootY
# puts "xdnd::HandleXdndPosition: $time"
## Get the dropped data...
catch {
::tkdnd::generic::SetDroppedData [GetPositionData $drop_target $_typelist $time]
}
::tkdnd::generic::HandlePosition $drop_target $drag_source \
$_pressedkeys $rootX $rootY
};# xdnd::HandleXdndPosition
# ----------------------------------------------------------------------------
# Command xdnd::HandleXdndLeave
# ----------------------------------------------------------------------------
proc xdnd::HandleXdndLeave { } {
::tkdnd::generic::HandleLeave
};# xdnd::HandleXdndLeave
# ----------------------------------------------------------------------------
# Command xdnd::_HandleXdndDrop
# ----------------------------------------------------------------------------
proc xdnd::HandleXdndDrop { time } {
variable _pressedkeys
variable _last_mouse_root_x
variable _last_mouse_root_y
## Get the dropped data...
::tkdnd::generic::SetDroppedData [GetDroppedData \
[::tkdnd::generic::GetDragSource] [::tkdnd::generic::GetDropTarget] \
[::tkdnd::generic::GetDragSourceCommonTypes] $time]
::tkdnd::generic::HandleDrop {} {} $_pressedkeys \
$_last_mouse_root_x $_last_mouse_root_y $time
};# xdnd::HandleXdndDrop
# ----------------------------------------------------------------------------
# Command xdnd::GetPositionData
# ----------------------------------------------------------------------------
proc xdnd::GetPositionData { drop_target typelist time } {
foreach {drop_target common_drag_source_types common_drop_target_types} \
[::tkdnd::generic::FindWindowWithCommonTypes $drop_target $typelist] {break}
GetDroppedData [::tkdnd::generic::GetDragSource] $drop_target \
$common_drag_source_types $time
};# xdnd::GetPositionData
# ----------------------------------------------------------------------------
# Command xdnd::GetDroppedData
# ----------------------------------------------------------------------------
proc xdnd::GetDroppedData { _drag_source _drop_target _common_drag_source_types time } {
if {![llength $_common_drag_source_types]} {
error "no common data types between the drag source and drop target widgets"
}
## Is drag source in this application?
if {[catch {winfo pathname -displayof $_drop_target $_drag_source} p]} {
set _use_tk_selection 0
} else {
set _use_tk_selection 1
}
foreach type $_common_drag_source_types {
# puts "TYPE: $type ($_drop_target)"
# _get_selection $_drop_target $time $type
if {$_use_tk_selection} {
if {![catch {
selection get -displayof $_drop_target -selection XdndSelection \
-type $type
} result options]} {
return [normalise_data $type $result]
}
} else {
# puts "_selection_get -displayof $_drop_target -selection XdndSelection \
# -type $type -time $time"
#after 100 [list focus -force $_drop_target]
#after 50 [list raise [winfo toplevel $_drop_target]]
if {![catch {
_selection_get -displayof $_drop_target -selection XdndSelection \
-type $type -time $time
} result options]} {
return [normalise_data $type $result]
}
}
}
return -options $options $result
};# xdnd::GetDroppedData
# ----------------------------------------------------------------------------
# Command xdnd::platform_specific_types
# ----------------------------------------------------------------------------
proc xdnd::platform_specific_types { types } {
::tkdnd::generic::platform_specific_types $types
}; # xdnd::platform_specific_types
# ----------------------------------------------------------------------------
# Command xdnd::platform_specific_type
# ----------------------------------------------------------------------------
proc xdnd::platform_specific_type { type } {
::tkdnd::generic::platform_specific_type $type
}; # xdnd::platform_specific_type
# ----------------------------------------------------------------------------
# Command tkdnd::platform_independent_types
# ----------------------------------------------------------------------------
proc ::tkdnd::platform_independent_types { types } {
::tkdnd::generic::platform_independent_types $types
}; # tkdnd::platform_independent_types
# ----------------------------------------------------------------------------
# Command xdnd::platform_independent_type
# ----------------------------------------------------------------------------
proc xdnd::platform_independent_type { type } {
::tkdnd::generic::platform_independent_type $type
}; # xdnd::platform_independent_type
# ----------------------------------------------------------------------------
# Command xdnd::_normalise_data
# ----------------------------------------------------------------------------
proc xdnd::normalise_data { type data } {
# Tk knows how to interpret the following types:
# STRING, TEXT, COMPOUND_TEXT
# UTF8_STRING
# Else, it returns a list of 8 or 32 bit numbers...
switch -glob $type {
STRING - UTF8_STRING - TEXT - COMPOUND_TEXT {return $data}
text/html {
if {[catch {
encoding convertfrom unicode $data
} string]} {
set string $data
}
return [string map {\r\n \n} $string]
}
text/html\;charset=utf-8 -
text/plain\;charset=utf-8 -
text/plain {
if {[catch {
encoding convertfrom utf-8 [tkdnd::bytes_to_string $data]
} string]} {
set string $data
}
return [string map {\r\n \n} $string]
}
text/uri-list* {
if {[catch {
encoding convertfrom utf-8 [tkdnd::bytes_to_string $data]
} string]} {
set string $data
}
## Get rid of \r\n
set string [string trim [string map {\r\n \n} $string]]
set files {}
foreach quoted_file [split $string] {
set file [tkdnd::urn_unquote $quoted_file]
switch -glob $file {
\#* {}
file://* {lappend files [string range $file 7 end]}
ftp://* -
https://* -
http://* {lappend files $quoted_file}
default {lappend files $file}
}
}
return $files
}
application/x-color {
return $data
}
text/x-moz-url -
application/q-iconlist -
default {return $data}
}
}; # xdnd::normalise_data
#############################################################################
##
## XDND drag implementation
##
#############################################################################
# ----------------------------------------------------------------------------
# Command xdnd::_selection_ownership_lost
# ----------------------------------------------------------------------------
proc xdnd::_selection_ownership_lost {} {
variable _dragging
set _dragging 0
};# _selection_ownership_lost
# ----------------------------------------------------------------------------
# Command xdnd::_dodragdrop
# ----------------------------------------------------------------------------
proc xdnd::_dodragdrop { source actions types data button } {
variable _dragging
# puts "xdnd::_dodragdrop: source: $source, actions: $actions, types: $types,\
# data: \"$data\", button: $button"
if {$_dragging} {
## We are in the middle of another drag operation...
error "another drag operation in progress"
}
variable _dodragdrop_drag_source $source
variable _dodragdrop_drop_target 0
variable _dodragdrop_drop_target_proxy 0
variable _dodragdrop_actions $actions
variable _dodragdrop_action_descriptions $actions
variable _dodragdrop_actions_len [llength $actions]
variable _dodragdrop_types $types
variable _dodragdrop_types_len [llength $types]
variable _dodragdrop_data $data
variable _dodragdrop_transfer_data {}
variable _dodragdrop_button $button
variable _dodragdrop_time 0
variable _dodragdrop_default_action refuse_drop
variable _dodragdrop_waiting_status 0
variable _dodragdrop_drop_target_accepts_drop 0
variable _dodragdrop_drop_target_accepts_action refuse_drop
variable _dodragdrop_current_cursor $_dodragdrop_default_action
variable _dodragdrop_drop_occured 0
variable _dodragdrop_selection_requestor 0
##
## If we have more than 3 types, the property XdndTypeList must be set on
## the drag source widget...
##
if {$_dodragdrop_types_len > 3} {
_announce_type_list $_dodragdrop_drag_source $_dodragdrop_types
}
##
## Announce the actions & their descriptions on the XdndActionList &
## XdndActionDescription properties...
##
_announce_action_list $_dodragdrop_drag_source $_dodragdrop_actions \
$_dodragdrop_action_descriptions
##
## Arrange selection handlers for our drag source, and all the supported types
##
registerSelectionHandler $source $types
##
## Step 1: When a drag begins, the source takes ownership of XdndSelection.
##
selection own -command ::tkdnd::xdnd::_selection_ownership_lost \
-selection XdndSelection $source
set _dragging 1
## Grab the mouse pointer...
_grab_pointer $source $_dodragdrop_default_action
## Register our generic event handler...
# The generic event callback will report events by modifying variable
# ::xdnd::_dodragdrop_event: a dict with event information will be set as
# the value of the variable...
_register_generic_event_handler
## Set a timeout for debugging purposes...
# after 60000 {set ::tkdnd::xdnd::_dragging 0}
tkwait variable ::tkdnd::xdnd::_dragging
_SendXdndLeave
set _dragging 0
_ungrab_pointer $source
_unregister_generic_event_handler
catch {selection clear -selection XdndSelection}
unregisterSelectionHandler $source $types
return $_dodragdrop_drop_target_accepts_action
};# xdnd::_dodragdrop
# ----------------------------------------------------------------------------
# Command xdnd::_process_drag_events
# ----------------------------------------------------------------------------
proc xdnd::_process_drag_events {event} {
# The return value from proc is normally 0. A non-zero return value indicates
# that the event is not to be handled further; that is, proc has done all
# processing that is to be allowed for the event
variable _dragging
if {!$_dragging} {return 0}
# puts $event
variable _dodragdrop_time
set time [dict get $event time]
set type [dict get $event type]
if {$time < $_dodragdrop_time && ![string equal $type SelectionRequest]} {
return 0
}
set _dodragdrop_time $time
variable _dodragdrop_drag_source
variable _dodragdrop_drop_target
variable _dodragdrop_drop_target_proxy
variable _dodragdrop_default_action
switch $type {
MotionNotify {
set rootx [dict get $event x_root]
set rooty [dict get $event y_root]
set window [_find_drop_target_window $_dodragdrop_drag_source \
$rootx $rooty]
if {[string length $window]} {
## Examine the modifiers to suggest an action...
set _dodragdrop_default_action [_default_action $event]
## Is it a Tk widget?
# set path [winfo containing $rootx $rooty]
# puts "Window under mouse: $window ($path)"
if {$_dodragdrop_drop_target != $window} {
## Send XdndLeave to $_dodragdrop_drop_target
_SendXdndLeave
## Is there a proxy? If not, _find_drop_target_proxy returns the
## target window, so we always get a valid "proxy".
set proxy [_find_drop_target_proxy $_dodragdrop_drag_source $window]
## Send XdndEnter to $window
_SendXdndEnter $window $proxy
## Send XdndPosition to $_dodragdrop_drop_target
_SendXdndPosition $rootx $rooty $_dodragdrop_default_action
} else {
## Send XdndPosition to $_dodragdrop_drop_target
_SendXdndPosition $rootx $rooty $_dodragdrop_default_action
}
} else {
## No window under the mouse. Send XdndLeave to $_dodragdrop_drop_target
_SendXdndLeave
}
}
ButtonPress {
}
ButtonRelease {
variable _dodragdrop_button
set button [dict get $event button]
if {$button == $_dodragdrop_button} {
## The button that initiated the drag was released. Trigger drop...
_SendXdndDrop
}
return 1
}
KeyPress {
}
KeyRelease {
set keysym [dict get $event keysym]
switch $keysym {
Escape {
## The user has pressed escape. Abort...
if {$_dragging} {set _dragging 0}
}
}
}
SelectionRequest {
variable _dodragdrop_selection_requestor
variable _dodragdrop_selection_property
variable _dodragdrop_selection_selection
variable _dodragdrop_selection_target
variable _dodragdrop_selection_time
set _dodragdrop_selection_requestor [dict get $event requestor]
set _dodragdrop_selection_property [dict get $event property]
set _dodragdrop_selection_selection [dict get $event selection]
set _dodragdrop_selection_target [dict get $event target]
set _dodragdrop_selection_time $time
return 0
}
default {
return 0
}
}
return 0
};# _process_drag_events
# ----------------------------------------------------------------------------
# Command xdnd::_SendXdndEnter
# ----------------------------------------------------------------------------
proc xdnd::_SendXdndEnter {window proxy} {
variable _dodragdrop_drag_source
variable _dodragdrop_drop_target
variable _dodragdrop_drop_target_proxy
variable _dodragdrop_types
variable _dodragdrop_waiting_status
variable _dodragdrop_drop_occured
if {$_dodragdrop_drop_target > 0} _SendXdndLeave
if {$_dodragdrop_drop_occured} return
set _dodragdrop_drop_target $window
set _dodragdrop_drop_target_proxy $proxy
set _dodragdrop_waiting_status 0
if {$_dodragdrop_drop_target < 1} return
# puts "XdndEnter: $_dodragdrop_drop_target $_dodragdrop_drop_target_proxy"
_send_XdndEnter $_dodragdrop_drag_source $_dodragdrop_drop_target \
$_dodragdrop_drop_target_proxy $_dodragdrop_types
};# xdnd::_SendXdndEnter
# ----------------------------------------------------------------------------
# Command xdnd::_SendXdndPosition
# ----------------------------------------------------------------------------
proc xdnd::_SendXdndPosition {rootx rooty action} {
variable _dodragdrop_drag_source
variable _dodragdrop_drop_target
if {$_dodragdrop_drop_target < 1} return
variable _dodragdrop_drop_occured
if {$_dodragdrop_drop_occured} return
variable _dodragdrop_drop_target_proxy
variable _dodragdrop_waiting_status
## Arrange a new XdndPosition, to be send periodically...
variable _dodragdrop_xdnd_position_heartbeat
catch {after cancel $_dodragdrop_xdnd_position_heartbeat}
set _dodragdrop_xdnd_position_heartbeat [after 200 \
[list ::tkdnd::xdnd::_SendXdndPosition $rootx $rooty $action]]
if {$_dodragdrop_waiting_status} {return}
# puts "XdndPosition: $_dodragdrop_drop_target $rootx $rooty $action"
_send_XdndPosition $_dodragdrop_drag_source $_dodragdrop_drop_target \
$_dodragdrop_drop_target_proxy $rootx $rooty $action
set _dodragdrop_waiting_status 1
};# xdnd::_SendXdndPosition
# ----------------------------------------------------------------------------
# Command xdnd::_HandleXdndStatus
# ----------------------------------------------------------------------------
proc xdnd::_HandleXdndStatus {event} {
variable _dodragdrop_drop_target
variable _dodragdrop_waiting_status
variable _dodragdrop_drop_target_accepts_drop
variable _dodragdrop_drop_target_accepts_action
set _dodragdrop_waiting_status 0
foreach key {target accept want_position action x y w h} {
set $key [dict get $event $key]
}
set _dodragdrop_drop_target_accepts_drop $accept
set _dodragdrop_drop_target_accepts_action $action
if {$_dodragdrop_drop_target < 1} return
variable _dodragdrop_drop_occured
if {$_dodragdrop_drop_occured} return
_update_cursor
# puts "XdndStatus: $event"
};# xdnd::_HandleXdndStatus
# ----------------------------------------------------------------------------
# Command xdnd::_HandleXdndFinished
# ----------------------------------------------------------------------------
proc xdnd::_HandleXdndFinished {event} {
variable _dodragdrop_xdnd_finished_event_after_id
catch {after cancel $_dodragdrop_xdnd_finished_event_after_id}
set _dodragdrop_xdnd_finished_event_after_id {}
variable _dodragdrop_drop_target
set _dodragdrop_drop_target 0
variable _dragging
if {$_dragging} {set _dragging 0}
variable _dodragdrop_drop_target_accepts_drop
variable _dodragdrop_drop_target_accepts_action
if {[dict size $event]} {
foreach key {target accept action} {
set $key [dict get $event $key]
}
set _dodragdrop_drop_target_accepts_drop $accept
set _dodragdrop_drop_target_accepts_action $action
} else {
set _dodragdrop_drop_target_accepts_drop 0
}
if {!$_dodragdrop_drop_target_accepts_drop} {
set _dodragdrop_drop_target_accepts_action refuse_drop
}
# puts "XdndFinished: $event"
};# xdnd::_HandleXdndFinished
# ----------------------------------------------------------------------------
# Command xdnd::_SendXdndLeave
# ----------------------------------------------------------------------------
proc xdnd::_SendXdndLeave {} {
variable _dodragdrop_drag_source
variable _dodragdrop_drop_target
if {$_dodragdrop_drop_target < 1} return
variable _dodragdrop_drop_target_proxy
# puts "XdndLeave: $_dodragdrop_drop_target"
_send_XdndLeave $_dodragdrop_drag_source $_dodragdrop_drop_target \
$_dodragdrop_drop_target_proxy
set _dodragdrop_drop_target 0
variable _dodragdrop_drop_target_accepts_drop
variable _dodragdrop_drop_target_accepts_action
set _dodragdrop_drop_target_accepts_drop 0
set _dodragdrop_drop_target_accepts_action refuse_drop
variable _dodragdrop_drop_occured
if {$_dodragdrop_drop_occured} return
_update_cursor
};# xdnd::_SendXdndLeave
# ----------------------------------------------------------------------------
# Command xdnd::_SendXdndDrop
# ----------------------------------------------------------------------------
proc xdnd::_SendXdndDrop {} {
variable _dodragdrop_drag_source
variable _dodragdrop_drop_target
if {$_dodragdrop_drop_target < 1} {
## The mouse has been released over a widget that does not accept drops.
_HandleXdndFinished {}
return
}
variable _dodragdrop_drop_occured
if {$_dodragdrop_drop_occured} {return}
variable _dodragdrop_drop_target_proxy
variable _dodragdrop_drop_target_accepts_drop
variable _dodragdrop_drop_target_accepts_action
set _dodragdrop_drop_occured 1
_update_cursor clock
if {!$_dodragdrop_drop_target_accepts_drop} {
_SendXdndLeave
_HandleXdndFinished {}
return
}
# puts "XdndDrop: $_dodragdrop_drop_target"
variable _dodragdrop_drop_timestamp
set _dodragdrop_drop_timestamp [_send_XdndDrop \
$_dodragdrop_drag_source $_dodragdrop_drop_target \
$_dodragdrop_drop_target_proxy]
set _dodragdrop_drop_target 0
# puts "XdndDrop: $_dodragdrop_drop_target"
## Arrange a timeout for receiving XdndFinished...
variable _dodragdrop_xdnd_finished_event_after_id
set _dodragdrop_xdnd_finished_event_after_id \
[after 10000 [list ::tkdnd::xdnd::_HandleXdndFinished {}]]
};# xdnd::_SendXdndDrop
# ----------------------------------------------------------------------------
# Command xdnd::_update_cursor
# ----------------------------------------------------------------------------
proc xdnd::_update_cursor { {cursor {}}} {
# puts "_update_cursor $cursor"
variable _dodragdrop_current_cursor
variable _dodragdrop_drag_source
variable _dodragdrop_drop_target_accepts_drop
variable _dodragdrop_drop_target_accepts_action
if {![string length $cursor]} {
set cursor refuse_drop
if {$_dodragdrop_drop_target_accepts_drop} {
set cursor $_dodragdrop_drop_target_accepts_action
}
}
if {![string equal $cursor $_dodragdrop_current_cursor]} {
_set_pointer_cursor $_dodragdrop_drag_source $cursor
set _dodragdrop_current_cursor $cursor
}
};# xdnd::_update_cursor
# ----------------------------------------------------------------------------
# Command xdnd::_default_action
# ----------------------------------------------------------------------------
proc xdnd::_default_action {event} {
variable _dodragdrop_actions
variable _dodragdrop_actions_len
if {$_dodragdrop_actions_len == 1} {return [lindex $_dodragdrop_actions 0]}
set alt [dict get $event Alt]
set shift [dict get $event Shift]
set control [dict get $event Control]
if {$shift && $control && [lsearch $_dodragdrop_actions link] != -1} {
return link
} elseif {$control && [lsearch $_dodragdrop_actions copy] != -1} {
return copy
} elseif {$shift && [lsearch $_dodragdrop_actions move] != -1} {
return move
} elseif {$alt && [lsearch $_dodragdrop_actions link] != -1} {
return link
}
return default
};# xdnd::_default_action
# ----------------------------------------------------------------------------
# Command xdnd::getFormatForType
# ----------------------------------------------------------------------------
proc xdnd::getFormatForType {type} {
switch -glob [string tolower $type] {
text/plain\;charset=utf-8 -
text/html\;charset=utf-8 -
utf8_string {set format UTF8_STRING}
text/html -
text/plain -
string -
text -
compound_text {set format STRING}
text/uri-list* {set format UTF8_STRING}
application/x-color {set format $type}
default {set format $type}
}
return $format
};# xdnd::getFormatForType
# ----------------------------------------------------------------------------
# Command xdnd::registerSelectionHandler
# ----------------------------------------------------------------------------
proc xdnd::registerSelectionHandler {source types} {
foreach type $types {
selection handle -selection XdndSelection \
-type $type \
-format [getFormatForType $type] \
$source [list ::tkdnd::xdnd::_SendData $type]
}
};# xdnd::registerSelectionHandler
# ----------------------------------------------------------------------------
# Command xdnd::unregisterSelectionHandler
# ----------------------------------------------------------------------------
proc xdnd::unregisterSelectionHandler {source types} {
foreach type $types {
catch {
selection handle -selection XdndSelection \
-type $type \
-format [getFormatForType $type] \
$source {}
}
}
};# xdnd::unregisterSelectionHandler
# ----------------------------------------------------------------------------
# Command xdnd::_convert_to_unsigned
# ----------------------------------------------------------------------------
proc xdnd::_convert_to_unsigned {data format} {
switch $format {
8 { set mask 0xff }
16 { set mask 0xffff }
32 { set mask 0xffffff }
default {error "unsupported format $format"}
}
## Convert signed integer into unsigned...
set d [list]
foreach num $data {
lappend d [expr { $num & $mask }]
}
return $d
};# xdnd::_convert_to_unsigned
# ----------------------------------------------------------------------------
# Command xdnd::_SendData
# ----------------------------------------------------------------------------
proc xdnd::_SendData {type offset bytes args} {
variable _dodragdrop_drag_source
variable _dodragdrop_types
variable _dodragdrop_data
variable _dodragdrop_transfer_data
## The variable _dodragdrop_data contains a list of data, one for each
## type in the _dodragdrop_types variable. We have to search types, and find
## the corresponding entry in the _dodragdrop_data list.
set index [lsearch $_dodragdrop_types $type]
if {$index < 0} {
error "unable to locate data suitable for type \"$type\""
}
set typed_data [lindex $_dodragdrop_data $index]
set format 8
if {$offset == 0} {
## Prepare the data to be transferred...
switch -glob $type {
text/plain* - UTF8_STRING - STRING - TEXT - COMPOUND_TEXT {
binary scan [encoding convertto utf-8 $typed_data] \
c* _dodragdrop_transfer_data
set _dodragdrop_transfer_data \
[_convert_to_unsigned $_dodragdrop_transfer_data $format]
}
text/uri-list* {
set files [list]
foreach file $typed_data {
switch -glob $file {
*://* {lappend files $file}
default {lappend files file://$file}
}
}
binary scan [encoding convertto utf-8 "[join $files \r\n]\r\n"] \
c* _dodragdrop_transfer_data
set _dodragdrop_transfer_data \
[_convert_to_unsigned $_dodragdrop_transfer_data $format]
}
application/x-color {
set format 16
## Try to understand the provided data: we accept a standard Tk colour,
## or a list of 3 values (red green blue) or a list of 4 values
## (red green blue opacity).
switch [llength $typed_data] {
1 { set color [winfo rgb $_dodragdrop_drag_source $typed_data]
lappend color 65535 }
3 { set color $typed_data; lappend color 65535 }
4 { set color $typed_data }
default {error "unknown color data: \"$typed_data\""}
}
## Convert the 4 elements into 16 bit values...
set _dodragdrop_transfer_data [list]
foreach c $color {
lappend _dodragdrop_transfer_data [format 0x%04X $c]
}
}
default {
set format 32
binary scan $typed_data c* _dodragdrop_transfer_data
}
}
}
##
## Data has been split into bytes. Count the bytes requested, and return them
##
set data [lrange $_dodragdrop_transfer_data $offset [expr {$offset+$bytes-1}]]
switch $format {
8 {
set data [encoding convertfrom utf-8 [binary format c* $data]]
}
16 {
variable _dodragdrop_selection_requestor
if {$_dodragdrop_selection_requestor} {
## Tk selection cannot process this format (only 8 & 32 supported).
## Call our XChangeProperty...
set numItems [llength $data]
variable _dodragdrop_selection_property
variable _dodragdrop_selection_selection
variable _dodragdrop_selection_target
variable _dodragdrop_selection_time
XChangeProperty $_dodragdrop_drag_source \
$_dodragdrop_selection_requestor \
$_dodragdrop_selection_property \
$_dodragdrop_selection_target \
$format \
$_dodragdrop_selection_time \
$data $numItems
return -code break
}
}
32 {
}
default {
error "unsupported format $format"
}
}
# puts "SendData: $type $offset $bytes $args ($typed_data)"
# puts " $data"
return $data
};# xdnd::_SendData

View File

@ -0,0 +1,252 @@
#
# tkdnd_utils.tcl --
#
# This file implements some utility procedures that are used by the TkDND
# package.
#
# This software is copyrighted by:
# George Petasis, National Centre for Scientific Research "Demokritos",
# Aghia Paraskevi, Athens, Greece.
# e-mail: petasis@iit.demokritos.gr
#
# The following terms apply to all files associated
# with the software unless explicitly disclaimed in individual files.
#
# The authors hereby grant permission to use, copy, modify, distribute,
# and license this software and its documentation for any purpose, provided
# that existing copyright notices are retained in all copies and that this
# notice is included verbatim in any distributions. No written agreement,
# license, or royalty fee is required for any of the authorized uses.
# Modifications to this software may be copyrighted by their authors
# and need not follow the licensing terms described here, provided that
# the new terms are clearly indicated on the first page of each file where
# they apply.
#
# IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
# FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
# ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
# DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
#
# THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE
# IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
# NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
# MODIFICATIONS.
#
package require tkdnd
namespace eval ::tkdnd {
namespace eval utils {
};# namespace ::tkdnd::utils
namespace eval text {
variable _drag_tag tkdnd::drag::selection::tag
variable _state {}
variable _drag_source_widget {}
variable _drop_target_widget {}
variable _now_dragging 0
};# namespace ::tkdnd::text
};# namespace ::tkdnd
bind TkDND_Drag_Text1 <ButtonPress-1> {tkdnd::text::_begin_drag clear 1 %W %s %X %Y %x %y}
bind TkDND_Drag_Text1 <B1-Motion> {tkdnd::text::_begin_drag motion 1 %W %s %X %Y %x %y}
bind TkDND_Drag_Text1 <B1-Leave> {tkdnd::text::_TextAutoScan %W %x %y}
bind TkDND_Drag_Text1 <ButtonRelease-1> {tkdnd::text::_begin_drag reset 1 %W %s %X %Y %x %y}
bind TkDND_Drag_Text2 <ButtonPress-2> {tkdnd::text::_begin_drag clear 2 %W %s %X %Y %x %y}
bind TkDND_Drag_Text2 <B2-Motion> {tkdnd::text::_begin_drag motion 2 %W %s %X %Y %x %y}
bind TkDND_Drag_Text2 <ButtonRelease-2> {tkdnd::text::_begin_drag reset 2 %W %s %X %Y %x %y}
bind TkDND_Drag_Text3 <ButtonPress-3> {tkdnd::text::_begin_drag clear 3 %W %s %X %Y %x %y}
bind TkDND_Drag_Text3 <B3-Motion> {tkdnd::text::_begin_drag motion 3 %W %s %X %Y %x %y}
bind TkDND_Drag_Text3 <ButtonRelease-3> {tkdnd::text::_begin_drag reset 3 %W %s %X %Y %x %y}
# ----------------------------------------------------------------------------
# Command tkdnd::text::drag_source
# ----------------------------------------------------------------------------
proc ::tkdnd::text::drag_source { mode path { types DND_Text } { event 1 } { tagprefix TkDND_Drag_Text } { tag sel } } {
switch -exact -- $mode {
register {
$path tag bind $tag <ButtonPress-${event}> \
"tkdnd::text::_begin_drag press ${event} %W %s %X %Y %x %y"
## Set a binding to the widget, to put selection as data...
bind $path <<DragInitCmd>> "::tkdnd::text::DragInitCmd $path {%t} $tag"
## Set a binding to the widget, to remove selection if action is move...
bind $path <<DragEndCmd>> "::tkdnd::text::DragEndCmd $path %A $tag"
}
unregister {
$path tag bind $tag <ButtonPress-${event}> {}
bind $path <<DragInitCmd>> {}
bind $path <<DragEndCmd>> {}
}
}
::tkdnd::drag_source $mode $path $types $event $tagprefix
};# ::tkdnd::text::drag_source
# ----------------------------------------------------------------------------
# Command tkdnd::text::drop_target
# ----------------------------------------------------------------------------
proc ::tkdnd::text::drop_target { mode path { types DND_Text } } {
switch -exact -- $mode {
register {
bind $path <<DropPosition>> "::tkdnd::text::DropPosition $path %X %Y %A %a %m"
bind $path <<Drop>> "::tkdnd::text::Drop $path %D %X %Y %A %a %m"
}
unregister {
bind $path <<DropEnter>> {}
bind $path <<DropPosition>> {}
bind $path <<DropLeave>> {}
bind $path <<Drop>> {}
}
}
::tkdnd::drop_target $mode $path $types
};# ::tkdnd::text::drop_target
# ----------------------------------------------------------------------------
# Command tkdnd::text::DragInitCmd
# ----------------------------------------------------------------------------
proc ::tkdnd::text::DragInitCmd { path { types DND_Text } { tag sel } { actions { copy move } } } {
## Save the selection indices...
variable _drag_source_widget
variable _drop_target_widget
set _drag_source_widget $path
set _drop_target_widget {}
_save_selection $path $tag
list $actions $types [$path get $tag.first $tag.last]
};# ::tkdnd::text::DragInitCmd
# ----------------------------------------------------------------------------
# Command tkdnd::text::DragEndCmd
# ----------------------------------------------------------------------------
proc ::tkdnd::text::DragEndCmd { path action { tag sel } } {
variable _drag_source_widget
variable _drop_target_widget
set _drag_source_widget {}
set _drop_target_widget {}
_restore_selection $path $tag
switch -exact -- $action {
move {
## Delete the original selected text...
variable _selection_first
variable _selection_last
$path delete $_selection_first $_selection_last
}
}
};# ::tkdnd::text::DragEndCmd
# ----------------------------------------------------------------------------
# Command tkdnd::text::DropPosition
# ----------------------------------------------------------------------------
proc ::tkdnd::text::DropPosition { path X Y action actions keys} {
variable _drag_source_widget
variable _drop_target_widget
set _drop_target_widget $path
## This check is primitive, a more accurate one is needed!
if {$path eq $_drag_source_widget} {
## This is a drag within the same widget! Set action to move...
if {"move" in $actions} {set action move}
}
incr X -[winfo rootx $path]
incr Y -[winfo rooty $path]
$path mark set insert @$X,$Y; update
return $action
};# ::tkdnd::text::DropPosition
# ----------------------------------------------------------------------------
# Command tkdnd::text::Drop
# ----------------------------------------------------------------------------
proc ::tkdnd::text::Drop { path data X Y action actions keys } {
incr X -[winfo rootx $path]
incr Y -[winfo rooty $path]
$path mark set insert @$X,$Y
$path insert [$path index insert] $data
return $action
};# ::tkdnd::text::Drop
# ----------------------------------------------------------------------------
# Command tkdnd::text::_save_selection
# ----------------------------------------------------------------------------
proc ::tkdnd::text::_save_selection { path tag} {
variable _drag_tag
variable _selection_first
variable _selection_last
variable _selection_tag $tag
set _selection_first [$path index $tag.first]
set _selection_last [$path index $tag.last]
$path tag add $_drag_tag $_selection_first $_selection_last
$path tag configure $_drag_tag \
-background [$path tag cget $tag -background] \
-foreground [$path tag cget $tag -foreground]
};# tkdnd::text::_save_selection
# ----------------------------------------------------------------------------
# Command tkdnd::text::_restore_selection
# ----------------------------------------------------------------------------
proc ::tkdnd::text::_restore_selection { path tag} {
variable _drag_tag
variable _selection_first
variable _selection_last
$path tag delete $_drag_tag
$path tag remove $tag 0.0 end
#$path tag add $tag $_selection_first $_selection_last
};# tkdnd::text::_restore_selection
# ----------------------------------------------------------------------------
# Command tkdnd::text::_begin_drag
# ----------------------------------------------------------------------------
proc ::tkdnd::text::_begin_drag { event button source state X Y x y } {
variable _drop_target_widget
variable _state
# puts "::tkdnd::text::_begin_drag $event $button $source $state $X $Y $x $y"
switch -exact -- $event {
clear {
switch -exact -- $_state {
press {
## Do not execute other bindings, as they will erase selection...
return -code break
}
}
set _state clear
}
motion {
variable _now_dragging
if {$_now_dragging} {return -code break}
if { [string equal $_state "press"] } {
variable _x0; variable _y0
if { abs($_x0-$X) > ${::tkdnd::_dx} || abs($_y0-$Y) > ${::tkdnd::_dy} } {
set _state "done"
set _drop_target_widget {}
set _now_dragging 1
set code [catch {
::tkdnd::_init_drag $button $source $state $X $Y $x $y
} info options]
set _drop_target_widget {}
set _now_dragging 0
if {$code != 0} {
## Something strange occurred...
return -options $options $info
}
}
return -code break
}
set _state clear
}
press {
variable _x0; variable _y0
set _x0 $X
set _y0 $Y
set _state "press"
}
reset {
set _state {}
}
}
if {$source eq $_drop_target_widget} {return -code break}
return -code continue
};# tkdnd::text::_begin_drag
proc tkdnd::text::_TextAutoScan {w x y} {
variable _now_dragging
if {$_now_dragging} {return -code break}
return -code continue
};# tkdnd::text::_TextAutoScan

View File

@ -0,0 +1,167 @@
#
# tkdnd_windows.tcl --
#
# This file implements some utility procedures that are used by the TkDND
# package.
#
# This software is copyrighted by:
# George Petasis, National Centre for Scientific Research "Demokritos",
# Aghia Paraskevi, Athens, Greece.
# e-mail: petasis@iit.demokritos.gr
#
# The following terms apply to all files associated
# with the software unless explicitly disclaimed in individual files.
#
# The authors hereby grant permission to use, copy, modify, distribute,
# and license this software and its documentation for any purpose, provided
# that existing copyright notices are retained in all copies and that this
# notice is included verbatim in any distributions. No written agreement,
# license, or royalty fee is required for any of the authorized uses.
# Modifications to this software may be copyrighted by their authors
# and need not follow the licensing terms described here, provided that
# the new terms are clearly indicated on the first page of each file where
# they apply.
#
# IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
# FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
# ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
# DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
#
# THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE
# IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
# NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
# MODIFICATIONS.
#
namespace eval olednd {
proc initialise { } {
## Mapping from platform types to TkDND types...
::tkdnd::generic::initialise_platform_to_tkdnd_types [list \
CF_UNICODETEXT DND_Text \
CF_TEXT DND_Text \
CF_HDROP DND_Files \
UniformResourceLocator DND_URL \
CF_HTML DND_HTML \
{HTML Format} DND_HTML \
CF_RTF DND_RTF \
CF_RTFTEXT DND_RTF \
{Rich Text Format} DND_RTF \
]
# FileGroupDescriptorW DND_Files \
# FileGroupDescriptor DND_Files \
## Mapping from TkDND types to platform types...
::tkdnd::generic::initialise_tkdnd_to_platform_types [list \
DND_Text {CF_UNICODETEXT CF_TEXT} \
DND_Files {CF_HDROP} \
DND_URL {UniformResourceLocator UniformResourceLocatorW} \
DND_HTML {CF_HTML {HTML Format}} \
DND_RTF {CF_RTF CF_RTFTEXT {Rich Text Format}} \
]
};# initialise
};# namespace olednd
# ----------------------------------------------------------------------------
# Command olednd::HandleDragEnter
# ----------------------------------------------------------------------------
proc olednd::HandleDragEnter { drop_target typelist actionlist pressedkeys
rootX rootY codelist { data {} } } {
::tkdnd::generic::SetDroppedData $data
focus $drop_target
::tkdnd::generic::HandleEnter $drop_target 0 $typelist \
$codelist $actionlist $pressedkeys
set action [::tkdnd::generic::HandlePosition $drop_target {} \
$pressedkeys $rootX $rootY]
if {$::tkdnd::_auto_update} {update idletasks}
return $action
};# olednd::HandleDragEnter
# ----------------------------------------------------------------------------
# Command olednd::HandleDragOver
# ----------------------------------------------------------------------------
proc olednd::HandleDragOver { drop_target pressedkeys rootX rootY } {
set action [::tkdnd::generic::HandlePosition $drop_target {} \
$pressedkeys $rootX $rootY]
if {$::tkdnd::_auto_update} {update idletasks}
return $action
};# olednd::HandleDragOver
# ----------------------------------------------------------------------------
# Command olednd::HandleDragLeave
# ----------------------------------------------------------------------------
proc olednd::HandleDragLeave { drop_target } {
::tkdnd::generic::HandleLeave
if {$::tkdnd::_auto_update} {update idletasks}
};# olednd::HandleDragLeave
# ----------------------------------------------------------------------------
# Command olednd::HandleDrop
# ----------------------------------------------------------------------------
proc olednd::HandleDrop { drop_target pressedkeys rootX rootY type data } {
::tkdnd::generic::SetDroppedData [normalise_data $type $data]
set action [::tkdnd::generic::HandleDrop $drop_target {} \
$pressedkeys $rootX $rootY 0]
if {$::tkdnd::_auto_update} {update idletasks}
return $action
};# olednd::HandleDrop
# ----------------------------------------------------------------------------
# Command olednd::GetDataType
# ----------------------------------------------------------------------------
proc olednd::GetDataType { drop_target typelist } {
foreach {drop_target common_drag_source_types common_drop_target_types} \
[::tkdnd::generic::FindWindowWithCommonTypes $drop_target $typelist] {break}
lindex $common_drag_source_types 0
};# olednd::GetDataType
# ----------------------------------------------------------------------------
# Command olednd::GetDragSourceCommonTypes
# ----------------------------------------------------------------------------
proc olednd::GetDragSourceCommonTypes { drop_target } {
::tkdnd::generic::GetDragSourceCommonTypes
};# olednd::GetDragSourceCommonTypes
# ----------------------------------------------------------------------------
# Command olednd::platform_specific_types
# ----------------------------------------------------------------------------
proc olednd::platform_specific_types { types } {
::tkdnd::generic::platform_specific_types $types
}; # olednd::platform_specific_types
# ----------------------------------------------------------------------------
# Command olednd::platform_specific_type
# ----------------------------------------------------------------------------
proc olednd::platform_specific_type { type } {
::tkdnd::generic::platform_specific_type $type
}; # olednd::platform_specific_type
# ----------------------------------------------------------------------------
# Command tkdnd::platform_independent_types
# ----------------------------------------------------------------------------
proc ::tkdnd::platform_independent_types { types } {
::tkdnd::generic::platform_independent_types $types
}; # tkdnd::platform_independent_types
# ----------------------------------------------------------------------------
# Command olednd::platform_independent_type
# ----------------------------------------------------------------------------
proc olednd::platform_independent_type { type } {
::tkdnd::generic::platform_independent_type $type
}; # olednd::platform_independent_type
# ----------------------------------------------------------------------------
# Command olednd::normalise_data
# ----------------------------------------------------------------------------
proc olednd::normalise_data { type data } {
switch [lindex [::tkdnd::generic::platform_independent_type $type] 0] {
DND_Text {return $data}
DND_Files {return $data}
DND_HTML {return [encoding convertfrom utf-8 $data]}
default {return $data}
}
}; # olednd::normalise_data

Binary file not shown.

View File

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

View File

@ -0,0 +1,469 @@
#
# tkdnd.tcl --
#
# This file implements some utility procedures that are used by the TkDND
# package.
#
# This software is copyrighted by:
# George Petasis, National Centre for Scientific Research "Demokritos",
# Aghia Paraskevi, Athens, Greece.
# e-mail: petasis@iit.demokritos.gr
#
# The following terms apply to all files associated
# with the software unless explicitly disclaimed in individual files.
#
# The authors hereby grant permission to use, copy, modify, distribute,
# and license this software and its documentation for any purpose, provided
# that existing copyright notices are retained in all copies and that this
# notice is included verbatim in any distributions. No written agreement,
# license, or royalty fee is required for any of the authorized uses.
# Modifications to this software may be copyrighted by their authors
# and need not follow the licensing terms described here, provided that
# the new terms are clearly indicated on the first page of each file where
# they apply.
#
# IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
# FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
# ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
# DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
#
# THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE
# IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
# NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
# MODIFICATIONS.
#
package require Tk
namespace eval ::tkdnd {
variable _topw ".drag"
variable _tabops
variable _state
variable _x0
variable _y0
variable _platform_namespace
variable _drop_file_temp_dir
variable _auto_update 1
variable _dx 3 ;# The difference in pixels before a drag is initiated.
variable _dy 3 ;# The difference in pixels before a drag is initiated.
variable _windowingsystem
bind TkDND_Drag1 <ButtonPress-1> {tkdnd::_begin_drag press 1 %W %s %X %Y %x %y}
bind TkDND_Drag1 <B1-Motion> {tkdnd::_begin_drag motion 1 %W %s %X %Y %x %y}
bind TkDND_Drag2 <ButtonPress-2> {tkdnd::_begin_drag press 2 %W %s %X %Y %x %y}
bind TkDND_Drag2 <B2-Motion> {tkdnd::_begin_drag motion 2 %W %s %X %Y %x %y}
bind TkDND_Drag3 <ButtonPress-3> {tkdnd::_begin_drag press 3 %W %s %X %Y %x %y}
bind TkDND_Drag3 <B3-Motion> {tkdnd::_begin_drag motion 3 %W %s %X %Y %x %y}
# ----------------------------------------------------------------------------
# Command tkdnd::initialise: Initialise the TkDND package.
# ----------------------------------------------------------------------------
proc initialise { dir PKG_LIB_FILE PACKAGE_NAME} {
variable _platform_namespace
variable _drop_file_temp_dir
variable _windowingsystem
global env
switch [tk windowingsystem] {
x11 {
set _windowingsystem x11
}
win32 -
windows {
set _windowingsystem windows
}
aqua {
set _windowingsystem aqua
}
default {
error "unknown Tk windowing system"
}
}
## Get User's home directory: We try to locate the proper path from a set of
## environmental variables...
foreach var {HOME HOMEPATH USERPROFILE ALLUSERSPROFILE APPDATA} {
if {[info exists env($var)]} {
if {[file isdirectory $env($var)]} {
set UserHomeDir $env($var)
break
}
}
}
## Should use [tk windowingsystem] instead of tcl platform array:
## OS X returns "unix," but that's not useful because it has its own
## windowing system, aqua
## Under windows we have to also combine HOMEDRIVE & HOMEPATH...
if {![info exists UserHomeDir] &&
[string equal $_windowingsystem windows] &&
[info exists env(HOMEDRIVE)] && [info exists env(HOMEPATH)]} {
if {[file isdirectory $env(HOMEDRIVE)$env(HOMEPATH)]} {
set UserHomeDir $env(HOMEDRIVE)$env(HOMEPATH)
}
}
## Have we located the needed path?
if {![info exists UserHomeDir]} {
set UserHomeDir [pwd]
}
set UserHomeDir [file normalize $UserHomeDir]
## Try to locate a temporary directory...
foreach var {TKDND_TEMP_DIR TEMP TMP} {
if {[info exists env($var)]} {
if {[file isdirectory $env($var)] && [file writable $env($var)]} {
set _drop_file_temp_dir $env($var)
break
}
}
}
if {![info exists _drop_file_temp_dir]} {
foreach _dir [list "$UserHomeDir/Local Settings/Temp" \
"$UserHomeDir/AppData/Local/Temp" \
/tmp \
C:/WINDOWS/Temp C:/Temp C:/tmp \
D:/WINDOWS/Temp D:/Temp D:/tmp] {
if {[file isdirectory $_dir] && [file writable $_dir]} {
set _drop_file_temp_dir $_dir
break
}
}
}
if {![info exists _drop_file_temp_dir]} {
set _drop_file_temp_dir $UserHomeDir
}
set _drop_file_temp_dir [file native $_drop_file_temp_dir]
source $dir/tkdnd_generic.tcl
switch $_windowingsystem {
x11 {
source $dir/tkdnd_unix.tcl
set _platform_namespace xdnd
}
win32 -
windows {
source $dir/tkdnd_windows.tcl
set _platform_namespace olednd
}
aqua {
source $dir/tkdnd_macosx.tcl
set _platform_namespace macdnd
}
default {
error "unknown Tk windowing system"
}
}
load $dir/$PKG_LIB_FILE $PACKAGE_NAME
source $dir/tkdnd_compat.tcl
${_platform_namespace}::initialise
};# initialise
proc GetDropFileTempDirectory { } {
variable _drop_file_temp_dir
return $_drop_file_temp_dir
}
proc SetDropFileTempDirectory { dir } {
variable _drop_file_temp_dir
set _drop_file_temp_dir $dir
}
};# namespace ::tkdnd
# ----------------------------------------------------------------------------
# Command tkdnd::drag_source
# ----------------------------------------------------------------------------
proc ::tkdnd::drag_source { mode path { types {} } { event 1 }
{ tagprefix TkDND_Drag } } {
set tags [bindtags $path]
set idx [lsearch $tags ${tagprefix}$event]
switch -- $mode {
register {
if { $idx != -1 } {
## No need to do anything!
# bindtags $path [lreplace $tags $idx $idx ${tagprefix}$event]
} else {
bindtags $path [linsert $tags 1 ${tagprefix}$event]
}
_drag_source_update_types $path $types
}
unregister {
if { $idx != -1 } {
bindtags $path [lreplace $tags $idx $idx]
}
}
}
};# tkdnd::drag_source
proc ::tkdnd::_drag_source_update_types { path types } {
set types [platform_specific_types $types]
set old_types [bind $path <<DragSourceTypes>>]
foreach type $types {
if {[lsearch $old_types $type] < 0} {lappend old_types $type}
}
bind $path <<DragSourceTypes>> $old_types
};# ::tkdnd::_drag_source_update_types
# ----------------------------------------------------------------------------
# Command tkdnd::drop_target
# ----------------------------------------------------------------------------
proc ::tkdnd::drop_target { mode path { types {} } } {
variable _windowingsystem
set types [platform_specific_types $types]
switch -- $mode {
register {
switch $_windowingsystem {
x11 {
_register_types $path [winfo toplevel $path] $types
}
win32 -
windows {
_RegisterDragDrop $path
bind <Destroy> $path {+ tkdnd::_RevokeDragDrop %W}
}
aqua {
macdnd::registerdragwidget [winfo toplevel $path] $types
}
default {
error "unknown Tk windowing system"
}
}
set old_types [bind $path <<DropTargetTypes>>]
set new_types {}
foreach type $types {
if {[lsearch -exact $old_types $type] < 0} {lappend new_types $type}
}
if {[llength $new_types]} {
bind $path <<DropTargetTypes>> [concat $old_types $new_types]
}
}
unregister {
switch $_windowingsystem {
x11 {
}
win32 -
windows {
_RevokeDragDrop $path
}
aqua {
error todo
}
default {
error "unknown Tk windowing system"
}
}
bind $path <<DropTargetTypes>> {}
}
}
};# tkdnd::drop_target
# ----------------------------------------------------------------------------
# Command tkdnd::_begin_drag
# ----------------------------------------------------------------------------
proc ::tkdnd::_begin_drag { event button source state X Y x y } {
variable _x0
variable _y0
variable _state
switch -- $event {
press {
set _x0 $X
set _y0 $Y
set _state "press"
}
motion {
if { ![info exists _state] } {
# This is just extra protection. There seem to be
# rare cases where the motion comes before the press.
return
}
if { [string equal $_state "press"] } {
variable _dx
variable _dy
if { abs($_x0-$X) > ${_dx} || abs($_y0-$Y) > ${_dy} } {
set _state "done"
_init_drag $button $source $state $X $Y $x $y
}
}
}
}
};# tkdnd::_begin_drag
# ----------------------------------------------------------------------------
# Command tkdnd::_init_drag
# ----------------------------------------------------------------------------
proc ::tkdnd::_init_drag { button source state rootX rootY X Y } {
# Call the <<DragInitCmd>> binding.
set cmd [bind $source <<DragInitCmd>>]
# puts "CMD: $cmd"
if {[string length $cmd]} {
set cmd [string map [list %W $source %X $rootX %Y $rootY %x $X %y $Y \
%S $state %e <<DragInitCmd>> %A \{\} %% % \
%t [bind $source <<DragSourceTypes>>]] $cmd]
set code [catch {uplevel \#0 $cmd} info options]
# puts "CODE: $code ---- $info"
switch -exact -- $code {
0 {}
3 - 4 {
# FRINK: nocheck
return
}
default {
return -options $options $info
}
}
set len [llength $info]
if {$len == 3} {
foreach { actions types _data } $info { break }
set types [platform_specific_types $types]
set data [list]
foreach type $types {
lappend data $_data
}
unset _data
} elseif {$len == 2} {
foreach { actions _data } $info { break }
set data [list]; set types [list]
foreach {t d} $_data {
foreach t [platform_specific_types $t] {
lappend types $t; lappend data $d
}
}
unset _data t d
} else {
if {$len == 1 && [string equal [lindex $actions 0] "refuse_drop"]} {
return
}
error "not enough items in the result of the <<DragInitCmd>>\
event binding. Either 2 or 3 items are expected. The command
executed was: \"$cmd\"\nResult was: \"$info\""
}
set action refuse_drop
variable _windowingsystem
# puts "Source: \"$source\""
# puts "Types: \"[join $types {", "}]\""
# puts "Actions: \"[join $actions {", "}]\""
# puts "Button: \"$button\""
# puts "Data: \"[string range $data 0 100]\""
switch $_windowingsystem {
x11 {
set action [xdnd::_dodragdrop $source $actions $types $data $button]
}
win32 -
windows {
set action [_DoDragDrop $source $actions $types $data $button]
}
aqua {
set action [macdnd::dodragdrop $source $actions $types $data $button]
}
default {
error "unknown Tk windowing system"
}
}
## Call _end_drag to notify the widget of the result of the drag
## operation...
_end_drag $button $source {} $action {} $data {} $state $rootX $rootY $X $Y
}
};# tkdnd::_init_drag
# ----------------------------------------------------------------------------
# Command tkdnd::_end_drag
# ----------------------------------------------------------------------------
proc ::tkdnd::_end_drag { button source target action type data result
state rootX rootY X Y } {
set rootX 0
set rootY 0
# Call the <<DragEndCmd>> binding.
set cmd [bind $source <<DragEndCmd>>]
if {[string length $cmd]} {
set cmd [string map [list %W $source %X $rootX %Y $rootY %x $X %y $Y %% % \
%S $state %e <<DragEndCmd>> %A \{$action\}] $cmd]
set info [uplevel \#0 $cmd]
# if { $info != "" } {
# variable _windowingsystem
# foreach { actions types data } $info { break }
# set types [platform_specific_types $types]
# switch $_windowingsystem {
# x11 {
# error "dragging from Tk widgets not yet supported"
# }
# win32 -
# windows {
# set action [_DoDragDrop $source $actions $types $data $button]
# }
# aqua {
# macdnd::dodragdrop $source $actions $types $data
# }
# default {
# error "unknown Tk windowing system"
# }
# }
# ## Call _end_drag to notify the widget of the result of the drag
# ## operation...
# _end_drag $button $source {} $action {} $data {} $state $rootX $rootY
# }
}
};# tkdnd::_end_drag
# ----------------------------------------------------------------------------
# Command tkdnd::platform_specific_types
# ----------------------------------------------------------------------------
proc ::tkdnd::platform_specific_types { types } {
variable _platform_namespace
${_platform_namespace}::platform_specific_types $types
}; # tkdnd::platform_specific_types
# ----------------------------------------------------------------------------
# Command tkdnd::platform_independent_types
# ----------------------------------------------------------------------------
proc ::tkdnd::platform_independent_types { types } {
variable _platform_namespace
${_platform_namespace}::platform_independent_types $types
}; # tkdnd::platform_independent_types
# ----------------------------------------------------------------------------
# Command tkdnd::platform_specific_type
# ----------------------------------------------------------------------------
proc ::tkdnd::platform_specific_type { type } {
variable _platform_namespace
${_platform_namespace}::platform_specific_type $type
}; # tkdnd::platform_specific_type
# ----------------------------------------------------------------------------
# Command tkdnd::platform_independent_type
# ----------------------------------------------------------------------------
proc ::tkdnd::platform_independent_type { type } {
variable _platform_namespace
${_platform_namespace}::platform_independent_type $type
}; # tkdnd::platform_independent_type
# ----------------------------------------------------------------------------
# Command tkdnd::bytes_to_string
# ----------------------------------------------------------------------------
proc ::tkdnd::bytes_to_string { bytes } {
set string {}
foreach byte $bytes {
append string [binary format c $byte]
}
return $string
};# tkdnd::bytes_to_string
# ----------------------------------------------------------------------------
# Command tkdnd::urn_unquote
# ----------------------------------------------------------------------------
proc ::tkdnd::urn_unquote {url} {
set result ""
set start 0
while {[regexp -start $start -indices {%[0-9a-fA-F]{2}} $url match]} {
foreach {first last} $match break
append result [string range $url $start [expr {$first - 1}]]
append result [format %c 0x[string range $url [incr first] $last]]
set start [incr last]
}
append result [string range $url $start end]
return [encoding convertfrom utf-8 $result]
};# tkdnd::urn_unquote

View File

@ -0,0 +1,160 @@
#
# tkdnd_compat.tcl --
#
# This file implements some utility procedures, to support older versions
# of the TkDND package.
#
# This software is copyrighted by:
# George Petasis, National Centre for Scientific Research "Demokritos",
# Aghia Paraskevi, Athens, Greece.
# e-mail: petasis@iit.demokritos.gr
#
# The following terms apply to all files associated
# with the software unless explicitly disclaimed in individual files.
#
# The authors hereby grant permission to use, copy, modify, distribute,
# and license this software and its documentation for any purpose, provided
# that existing copyright notices are retained in all copies and that this
# notice is included verbatim in any distributions. No written agreement,
# license, or royalty fee is required for any of the authorized uses.
# Modifications to this software may be copyrighted by their authors
# and need not follow the licensing terms described here, provided that
# the new terms are clearly indicated on the first page of each file where
# they apply.
#
# IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
# FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
# ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
# DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
#
# THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE
# IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
# NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
# MODIFICATIONS.
#
namespace eval compat {
};# namespace compat
# ----------------------------------------------------------------------------
# Command ::dnd
# ----------------------------------------------------------------------------
proc ::dnd {method window args} {
switch $method {
bindtarget {
switch [llength $args] {
0 {return [tkdnd::compat::bindtarget0 $window]}
1 {return [tkdnd::compat::bindtarget1 $window [lindex $args 0]]}
2 {return [tkdnd::compat::bindtarget2 $window [lindex $args 0] \
[lindex $args 1]]}
3 {return [tkdnd::compat::bindtarget3 $window [lindex $args 0] \
[lindex $args 1] [lindex $args 2]]}
4 {return [tkdnd::compat::bindtarget4 $window [lindex $args 0] \
[lindex $args 1] [lindex $args 2] [lindex $args 3]]}
}
}
cleartarget {
return [tkdnd::compat::cleartarget $window]
}
bindsource {
switch [llength $args] {
0 {return [tkdnd::compat::bindsource0 $window]}
1 {return [tkdnd::compat::bindsource1 $window [lindex $args 0]]}
2 {return [tkdnd::compat::bindsource2 $window [lindex $args 0] \
[lindex $args 1]]}
3 {return [tkdnd::compat::bindsource3 $window [lindex $args 0] \
[lindex $args 1] [lindex $args 2]]}
}
}
clearsource {
return [tkdnd::compat::clearsource $window]
}
drag {
return [tkdnd::_init_drag 1 $window "press" 0 0 0 0]
}
}
error "invalid number of arguments!"
};# ::dnd
# ----------------------------------------------------------------------------
# Command compat::bindtarget
# ----------------------------------------------------------------------------
proc compat::bindtarget0 {window} {
return [bind $window <<DropTargetTypes>>]
};# compat::bindtarget0
proc compat::bindtarget1 {window type} {
return [bindtarget2 $window $type <Drop>]
};# compat::bindtarget1
proc compat::bindtarget2 {window type event} {
switch $event {
<DragEnter> {return [bind $window <<DropEnter>>]}
<Drag> {return [bind $window <<DropPosition>>]}
<DragLeave> {return [bind $window <<DropLeave>>]}
<Drop> {return [bind $window <<Drop>>]}
}
};# compat::bindtarget2
proc compat::bindtarget3 {window type event script} {
set type [normalise_type $type]
::tkdnd::drop_target register $window [list $type]
switch $event {
<DragEnter> {return [bind $window <<DropEnter>> $script]}
<Drag> {return [bind $window <<DropPosition>> $script]}
<DragLeave> {return [bind $window <<DropLeave>> $script]}
<Drop> {return [bind $window <<Drop>> $script]}
}
};# compat::bindtarget3
proc compat::bindtarget4 {window type event script priority} {
return [bindtarget3 $window $type $event $script]
};# compat::bindtarget4
proc compat::normalise_type { type } {
switch $type {
text/plain -
{text/plain;charset=UTF-8} -
Text {return DND_Text}
text/uri-list -
Files {return DND_Files}
default {return $type}
}
};# compat::normalise_type
# ----------------------------------------------------------------------------
# Command compat::bindsource
# ----------------------------------------------------------------------------
proc compat::bindsource0 {window} {
return [bind $window <<DropTargetTypes>>]
};# compat::bindsource0
proc compat::bindsource1 {window type} {
return [bindsource2 $window $type <Drop>]
};# compat::bindsource1
proc compat::bindsource2 {window type script} {
set type [normalise_type $type]
::tkdnd::drag_source register $window $type
bind $window <<DragInitCmd>> "list {copy} {%t} \[$script\]"
};# compat::bindsource2
proc compat::bindsource3 {window type script priority} {
return [bindsource2 $window $type $script]
};# compat::bindsource3
# ----------------------------------------------------------------------------
# Command compat::cleartarget
# ----------------------------------------------------------------------------
proc compat::cleartarget {window} {
};# compat::cleartarget
# ----------------------------------------------------------------------------
# Command compat::clearsource
# ----------------------------------------------------------------------------
proc compat::clearsource {window} {
};# compat::clearsource

View File

@ -0,0 +1,520 @@
#
# tkdnd_generic.tcl --
#
# This file implements some utility procedures that are used by the TkDND
# package.
#
# This software is copyrighted by:
# George Petasis, National Centre for Scientific Research "Demokritos",
# Aghia Paraskevi, Athens, Greece.
# e-mail: petasis@iit.demokritos.gr
#
# The following terms apply to all files associated
# with the software unless explicitly disclaimed in individual files.
#
# The authors hereby grant permission to use, copy, modify, distribute,
# and license this software and its documentation for any purpose, provided
# that existing copyright notices are retained in all copies and that this
# notice is included verbatim in any distributions. No written agreement,
# license, or royalty fee is required for any of the authorized uses.
# Modifications to this software may be copyrighted by their authors
# and need not follow the licensing terms described here, provided that
# the new terms are clearly indicated on the first page of each file where
# they apply.
#
# IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
# FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
# ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
# DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
#
# THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE
# IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
# NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
# MODIFICATIONS.
#
namespace eval generic {
variable _types {}
variable _typelist {}
variable _codelist {}
variable _actionlist {}
variable _pressedkeys {}
variable _action {}
variable _common_drag_source_types {}
variable _common_drop_target_types {}
variable _drag_source {}
variable _drop_target {}
variable _last_mouse_root_x 0
variable _last_mouse_root_y 0
variable _tkdnd2platform
variable _platform2tkdnd
proc debug {msg} {
puts $msg
};# debug
proc initialise { } {
};# initialise
proc initialise_platform_to_tkdnd_types { types } {
variable _platform2tkdnd
variable _tkdnd2platform
set _platform2tkdnd [dict create {*}$types]
set _tkdnd2platform [dict create]
foreach type [dict keys $_platform2tkdnd] {
dict lappend _tkdnd2platform [dict get $_platform2tkdnd $type] $type
}
};# initialise_platform_to_tkdnd_types
proc initialise_tkdnd_to_platform_types { types } {
variable _tkdnd2platform
set _tkdnd2platform [dict create {*}$types]
};# initialise_tkdnd_to_platform_types
};# namespace generic
# ----------------------------------------------------------------------------
# Command generic::HandleEnter
# ----------------------------------------------------------------------------
proc generic::HandleEnter { drop_target drag_source typelist codelist
actionlist pressedkeys } {
variable _typelist; set _typelist $typelist
variable _pressedkeys; set _pressedkeys $pressedkeys
variable _action; set _action refuse_drop
variable _common_drag_source_types; set _common_drag_source_types {}
variable _common_drop_target_types; set _common_drop_target_types {}
variable _actionlist
variable _drag_source; set _drag_source $drag_source
variable _drop_target; set _drop_target {}
variable _actionlist; set _actionlist $actionlist
variable _codelist set _codelist $codelist
variable _last_mouse_root_x; set _last_mouse_root_x 0
variable _last_mouse_root_y; set _last_mouse_root_y 0
# debug "\n==============================================================="
# debug "generic::HandleEnter: drop_target=$drop_target,\
# drag_source=$drag_source,\
# typelist=$typelist"
# debug "generic::HandleEnter: ACTION: default"
return default
};# generic::HandleEnter
# ----------------------------------------------------------------------------
# Command generic::HandlePosition
# ----------------------------------------------------------------------------
proc generic::HandlePosition { drop_target drag_source pressedkeys
rootX rootY { time 0 } } {
variable _types
variable _typelist
variable _codelist
variable _actionlist
variable _pressedkeys
variable _action
variable _common_drag_source_types
variable _common_drop_target_types
variable _drag_source
variable _drop_target
variable _last_mouse_root_x; set _last_mouse_root_x $rootX
variable _last_mouse_root_y; set _last_mouse_root_y $rootY
# debug "generic::HandlePosition: drop_target=$drop_target,\
# _drop_target=$_drop_target, rootX=$rootX, rootY=$rootY"
if {![info exists _drag_source] && ![string length $_drag_source]} {
# debug "generic::HandlePosition: no or empty _drag_source:\
# return refuse_drop"
return refuse_drop
}
if {$drag_source ne "" && $drag_source ne $_drag_source} {
debug "generic position event from unexpected source: $_drag_source\
!= $drag_source"
return refuse_drop
}
set _pressedkeys $pressedkeys
## Does the new drop target support any of our new types?
# foreach {common_drag_source_types common_drop_target_types} \
# [GetWindowCommonTypes $drop_target $_typelist] {break}
foreach {drop_target common_drag_source_types common_drop_target_types} \
[FindWindowWithCommonTypes $drop_target $_typelist] {break}
set data [GetDroppedData $time]
# debug "\t($_drop_target) -> ($drop_target)"
if {$drop_target != $_drop_target} {
if {[string length $_drop_target]} {
## Call the <<DropLeave>> event.
# debug "\t<<DropLeave>> on $_drop_target"
set cmd [bind $_drop_target <<DropLeave>>]
if {[string length $cmd]} {
set cmd [string map [list %W $_drop_target %X $rootX %Y $rootY \
%CST \{$_common_drag_source_types\} \
%CTT \{$_common_drop_target_types\} \
%CPT \{[lindex [platform_independent_type [lindex $_common_drag_source_types 0]] 0]\} \
%ST \{$_typelist\} %TT \{$_types\} \
%A \{$_action\} %a \{$_actionlist\} \
%b \{$_pressedkeys\} %m \{$_pressedkeys\} \
%D \{\} %e <<DropLeave>> \
%L \{$_typelist\} %% % \
%t \{$_typelist\} %T \{[lindex $_common_drag_source_types 0]\} \
%c \{$_codelist\} %C \{[lindex $_codelist 0]\} \
] $cmd]
uplevel \#0 $cmd
}
}
set _drop_target $drop_target
set _action refuse_drop
if {[llength $common_drag_source_types]} {
set _action [lindex $_actionlist 0]
set _common_drag_source_types $common_drag_source_types
set _common_drop_target_types $common_drop_target_types
## Drop target supports at least one type. Send a <<DropEnter>>.
# puts "<<DropEnter>> -> $drop_target"
set cmd [bind $drop_target <<DropEnter>>]
if {[string length $cmd]} {
focus $drop_target
set cmd [string map [list %W $drop_target %X $rootX %Y $rootY \
%CST \{$_common_drag_source_types\} \
%CTT \{$_common_drop_target_types\} \
%CPT \{[lindex [platform_independent_type [lindex $_common_drag_source_types 0]] 0]\} \
%ST \{$_typelist\} %TT \{$_types\} \
%A $_action %a \{$_actionlist\} \
%b \{$_pressedkeys\} %m \{$_pressedkeys\} \
%D [list $data] %e <<DropEnter>> \
%L \{$_typelist\} %% % \
%t \{$_typelist\} %T \{[lindex $_common_drag_source_types 0]\} \
%c \{$_codelist\} %C \{[lindex $_codelist 0]\} \
] $cmd]
set _action [uplevel \#0 $cmd]
switch -exact -- $_action {
copy - move - link - ask - private - refuse_drop - default {}
default {set _action copy}
}
}
}
}
set _drop_target {}
if {[llength $common_drag_source_types]} {
set _common_drag_source_types $common_drag_source_types
set _common_drop_target_types $common_drop_target_types
set _drop_target $drop_target
## Drop target supports at least one type. Send a <<DropPosition>>.
set cmd [bind $drop_target <<DropPosition>>]
if {[string length $cmd]} {
set cmd [string map [list %W $drop_target %X $rootX %Y $rootY \
%CST \{$_common_drag_source_types\} \
%CTT \{$_common_drop_target_types\} \
%CPT \{[lindex [platform_independent_type [lindex $_common_drag_source_types 0]] 0]\} \
%ST \{$_typelist\} %TT \{$_types\} \
%A $_action %a \{$_actionlist\} \
%b \{$_pressedkeys\} %m \{$_pressedkeys\} \
%D [list $data] %e <<DropPosition>> \
%L \{$_typelist\} %% % \
%t \{$_typelist\} %T \{[lindex $_common_drag_source_types 0]\} \
%c \{$_codelist\} %C \{[lindex $_codelist 0]\} \
] $cmd]
set _action [uplevel \#0 $cmd]
}
}
# Return values: copy, move, link, ask, private, refuse_drop, default
# debug "generic::HandlePosition: ACTION: $_action"
switch -exact -- $_action {
copy - move - link - ask - private - refuse_drop - default {}
default {set _action copy}
}
return $_action
};# generic::HandlePosition
# ----------------------------------------------------------------------------
# Command generic::HandleLeave
# ----------------------------------------------------------------------------
proc generic::HandleLeave { } {
variable _types
variable _typelist
variable _codelist
variable _actionlist
variable _pressedkeys
variable _action
variable _common_drag_source_types
variable _common_drop_target_types
variable _drag_source
variable _drop_target
variable _last_mouse_root_x
variable _last_mouse_root_y
if {![info exists _drop_target]} {set _drop_target {}}
# debug "generic::HandleLeave: _drop_target=$_drop_target"
if {[info exists _drop_target] && [string length $_drop_target]} {
set cmd [bind $_drop_target <<DropLeave>>]
if {[string length $cmd]} {
set cmd [string map [list %W $_drop_target \
%X $_last_mouse_root_x %Y $_last_mouse_root_y \
%CST \{$_common_drag_source_types\} \
%CTT \{$_common_drop_target_types\} \
%CPT \{[lindex [platform_independent_type [lindex $_common_drag_source_types 0]] 0]\} \
%ST \{$_typelist\} %TT \{$_types\} \
%A \{$_action\} %a \{$_actionlist\} \
%b \{$_pressedkeys\} %m \{$_pressedkeys\} \
%D \{\} %e <<DropLeave>> \
%L \{$_typelist\} %% % \
%t \{$_typelist\} %T \{[lindex $_common_drag_source_types 0]\} \
%c \{$_codelist\} %C \{[lindex $_codelist 0]\} \
] $cmd]
set _action [uplevel \#0 $cmd]
}
}
foreach var {_types _typelist _actionlist _pressedkeys _action
_common_drag_source_types _common_drop_target_types
_drag_source _drop_target} {
set $var {}
}
};# generic::HandleLeave
# ----------------------------------------------------------------------------
# Command generic::HandleDrop
# ----------------------------------------------------------------------------
proc generic::HandleDrop {drop_target drag_source pressedkeys rootX rootY time } {
variable _types
variable _typelist
variable _codelist
variable _actionlist
variable _pressedkeys
variable _action
variable _common_drag_source_types
variable _common_drop_target_types
variable _drag_source
variable _drop_target
variable _last_mouse_root_x
variable _last_mouse_root_y
variable _last_mouse_root_x; set _last_mouse_root_x $rootX
variable _last_mouse_root_y; set _last_mouse_root_y $rootY
set _pressedkeys $pressedkeys
# puts "generic::HandleDrop: $time"
if {![info exists _drag_source] && ![string length $_drag_source]} {
return refuse_drop
}
if {![info exists _drop_target] && ![string length $_drop_target]} {
return refuse_drop
}
if {![llength $_common_drag_source_types]} {return refuse_drop}
## Get the dropped data.
set data [GetDroppedData $time]
## Try to select the most specific <<Drop>> event.
foreach type [concat $_common_drag_source_types $_common_drop_target_types] {
set type [platform_independent_type $type]
set cmd [bind $_drop_target <<Drop:$type>>]
if {[string length $cmd]} {
set cmd [string map [list %W $_drop_target %X $rootX %Y $rootY \
%CST \{$_common_drag_source_types\} \
%CTT \{$_common_drop_target_types\} \
%CPT \{[lindex [platform_independent_type [lindex $_common_drag_source_types 0]] 0]\} \
%ST \{$_typelist\} %TT \{$_types\} \
%A $_action %a \{$_actionlist\} \
%b \{$_pressedkeys\} %m \{$_pressedkeys\} \
%D [list $data] %e <<Drop:$type>> \
%L \{$_typelist\} %% % \
%t \{$_typelist\} %T \{[lindex $_common_drag_source_types 0]\} \
%c \{$_codelist\} %C \{[lindex $_codelist 0]\} \
] $cmd]
set _action [uplevel \#0 $cmd]
# Return values: copy, move, link, ask, private, refuse_drop
switch -exact -- $_action {
copy - move - link - ask - private - refuse_drop - default {}
default {set _action copy}
}
return $_action
}
}
set cmd [bind $_drop_target <<Drop>>]
if {[string length $cmd]} {
set cmd [string map [list %W $_drop_target %X $rootX %Y $rootY \
%CST \{$_common_drag_source_types\} \
%CTT \{$_common_drop_target_types\} \
%CPT \{[lindex [platform_independent_type [lindex $_common_drag_source_types 0]] 0]\} \
%ST \{$_typelist\} %TT \{$_types\} \
%A $_action %a \{$_actionlist\} \
%b \{$_pressedkeys\} %m \{$_pressedkeys\} \
%D [list $data] %e <<Drop>> \
%L \{$_typelist\} %% % \
%t \{$_typelist\} %T \{[lindex $_common_drag_source_types 0]\} \
%c \{$_codelist\} %C \{[lindex $_codelist 0]\} \
] $cmd]
set _action [uplevel \#0 $cmd]
}
# Return values: copy, move, link, ask, private, refuse_drop
switch -exact -- $_action {
copy - move - link - ask - private - refuse_drop - default {}
default {set _action copy}
}
return $_action
};# generic::HandleDrop
# ----------------------------------------------------------------------------
# Command generic::GetWindowCommonTypes
# ----------------------------------------------------------------------------
proc generic::GetWindowCommonTypes { win typelist } {
set types [bind $win <<DropTargetTypes>>]
# debug ">> Accepted types: $win $_types"
set common_drag_source_types {}
set common_drop_target_types {}
if {[llength $types]} {
## Examine the drop target types, to find at least one match with the drag
## source types...
set supported_types [supported_types $typelist]
foreach type $types {
foreach matched [lsearch -glob -all -inline $supported_types $type] {
## Drop target supports this type.
lappend common_drag_source_types $matched
lappend common_drop_target_types $type
}
}
}
list $common_drag_source_types $common_drop_target_types
};# generic::GetWindowCommonTypes
# ----------------------------------------------------------------------------
# Command generic::FindWindowWithCommonTypes
# ----------------------------------------------------------------------------
proc generic::FindWindowWithCommonTypes { win typelist } {
set toplevel [winfo toplevel $win]
while {![string equal $win $toplevel]} {
foreach {common_drag_source_types common_drop_target_types} \
[GetWindowCommonTypes $win $typelist] {break}
if {[llength $common_drag_source_types]} {
return [list $win $common_drag_source_types $common_drop_target_types]
}
set win [winfo parent $win]
}
## We have reached the toplevel, which may be also a target (SF Bug #30)
foreach {common_drag_source_types common_drop_target_types} \
[GetWindowCommonTypes $win $typelist] {break}
if {[llength $common_drag_source_types]} {
return [list $win $common_drag_source_types $common_drop_target_types]
}
return { {} {} {} }
};# generic::FindWindowWithCommonTypes
# ----------------------------------------------------------------------------
# Command generic::GetDroppedData
# ----------------------------------------------------------------------------
proc generic::GetDroppedData { time } {
variable _dropped_data
return $_dropped_data
};# generic::GetDroppedData
# ----------------------------------------------------------------------------
# Command generic::SetDroppedData
# ----------------------------------------------------------------------------
proc generic::SetDroppedData { data } {
variable _dropped_data
set _dropped_data $data
};# generic::SetDroppedData
# ----------------------------------------------------------------------------
# Command generic::GetDragSource
# ----------------------------------------------------------------------------
proc generic::GetDragSource { } {
variable _drag_source
return $_drag_source
};# generic::GetDragSource
# ----------------------------------------------------------------------------
# Command generic::GetDropTarget
# ----------------------------------------------------------------------------
proc generic::GetDropTarget { } {
variable _drop_target
return $_drop_target
};# generic::GetDropTarget
# ----------------------------------------------------------------------------
# Command generic::GetDragSourceCommonTypes
# ----------------------------------------------------------------------------
proc generic::GetDragSourceCommonTypes { } {
variable _common_drag_source_types
return $_common_drag_source_types
};# generic::GetDragSourceCommonTypes
# ----------------------------------------------------------------------------
# Command generic::GetDropTargetCommonTypes
# ----------------------------------------------------------------------------
proc generic::GetDropTargetCommonTypes { } {
variable _common_drag_source_types
return $_common_drag_source_types
};# generic::GetDropTargetCommonTypes
# ----------------------------------------------------------------------------
# Command generic::platform_specific_types
# ----------------------------------------------------------------------------
proc generic::platform_specific_types { types } {
set new_types {}
foreach type $types {
set new_types [concat $new_types [platform_specific_type $type]]
}
return $new_types
}; # generic::platform_specific_types
# ----------------------------------------------------------------------------
# Command generic::platform_specific_type
# ----------------------------------------------------------------------------
proc generic::platform_specific_type { type } {
variable _tkdnd2platform
if {[dict exists $_tkdnd2platform $type]} {
return [dict get $_tkdnd2platform $type]
}
list $type
}; # generic::platform_specific_type
# ----------------------------------------------------------------------------
# Command tkdnd::platform_independent_types
# ----------------------------------------------------------------------------
proc ::tkdnd::platform_independent_types { types } {
set new_types {}
foreach type $types {
set new_types [concat $new_types [platform_independent_type $type]]
}
return $new_types
}; # tkdnd::platform_independent_types
# ----------------------------------------------------------------------------
# Command generic::platform_independent_type
# ----------------------------------------------------------------------------
proc generic::platform_independent_type { type } {
variable _platform2tkdnd
if {[dict exists $_platform2tkdnd $type]} {
return [dict get $_platform2tkdnd $type]
}
return $type
}; # generic::platform_independent_type
# ----------------------------------------------------------------------------
# Command generic::supported_types
# ----------------------------------------------------------------------------
proc generic::supported_types { types } {
set new_types {}
foreach type $types {
if {[supported_type $type]} {lappend new_types $type}
}
return $new_types
}; # generic::supported_types
# ----------------------------------------------------------------------------
# Command generic::supported_type
# ----------------------------------------------------------------------------
proc generic::supported_type { type } {
variable _platform2tkdnd
if {[dict exists $_platform2tkdnd $type]} {
return 1
}
return 0
}; # generic::supported_type

View File

@ -0,0 +1,144 @@
#
# tkdnd_macosx.tcl --
#
# This file implements some utility procedures that are used by the TkDND
# package.
# This software is copyrighted by:
# Georgios Petasis, Athens, Greece.
# e-mail: petasisg@yahoo.gr, petasis@iit.demokritos.gr
#
# Mac portions (c) 2009 Kevin Walzer/WordTech Communications LLC,
# kw@codebykevin.com
#
#
# The following terms apply to all files associated
# with the software unless explicitly disclaimed in individual files.
#
# The authors hereby grant permission to use, copy, modify, distribute,
# and license this software and its documentation for any purpose, provided
# that existing copyright notices are retained in all copies and that this
# notice is included verbatim in any distributions. No written agreement,
# license, or royalty fee is required for any of the authorized uses.
# Modifications to this software may be copyrighted by their authors
# and need not follow the licensing terms described here, provided that
# the new terms are clearly indicated on the first page of each file where
# they apply.
#
# IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
# FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
# ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
# DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
#
# THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE
# IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
# NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
# MODIFICATIONS.
#
#basic API for Mac Drag and Drop
#two data types supported: strings and file paths
#two commands at C level: ::tkdnd::macdnd::registerdragwidget, ::tkdnd::macdnd::unregisterdragwidget
#data retrieval mechanism: text or file paths are copied from drag clipboard to system clipboard and retrieved via [clipboard get]; array of file paths is converted to single tab-separated string, can be split into Tcl list
if {[tk windowingsystem] eq "aqua" && "AppKit" ni [winfo server .]} {
error {TkAqua Cocoa required}
}
namespace eval macdnd {
proc initialise { } {
## Mapping from platform types to TkDND types...
::tkdnd::generic::initialise_platform_to_tkdnd_types [list \
NSPasteboardTypeString DND_Text \
NSFilenamesPboardType DND_Files \
NSPasteboardTypeHTML DND_HTML \
]
};# initialise
};# namespace macdnd
# ----------------------------------------------------------------------------
# Command macdnd::HandleEnter
# ----------------------------------------------------------------------------
proc macdnd::HandleEnter { path drag_source typelist { data {} } } {
variable _pressedkeys
variable _actionlist
set _pressedkeys 1
set _actionlist { copy move link ask private }
::tkdnd::generic::SetDroppedData $data
::tkdnd::generic::HandleEnter $path $drag_source $typelist $typelist \
$_actionlist $_pressedkeys
};# macdnd::HandleEnter
# ----------------------------------------------------------------------------
# Command macdnd::HandlePosition
# ----------------------------------------------------------------------------
proc macdnd::HandlePosition { drop_target rootX rootY {drag_source {}} } {
variable _pressedkeys
variable _last_mouse_root_x; set _last_mouse_root_x $rootX
variable _last_mouse_root_y; set _last_mouse_root_y $rootY
::tkdnd::generic::HandlePosition $drop_target $drag_source \
$_pressedkeys $rootX $rootY
};# macdnd::HandlePosition
# ----------------------------------------------------------------------------
# Command macdnd::HandleLeave
# ----------------------------------------------------------------------------
proc macdnd::HandleLeave { args } {
::tkdnd::generic::HandleLeave
};# macdnd::HandleLeave
# ----------------------------------------------------------------------------
# Command macdnd::HandleDrop
# ----------------------------------------------------------------------------
proc macdnd::HandleDrop { drop_target data args } {
variable _pressedkeys
variable _last_mouse_root_x
variable _last_mouse_root_y
## Get the dropped data...
::tkdnd::generic::SetDroppedData $data
::tkdnd::generic::HandleDrop {} {} $_pressedkeys \
$_last_mouse_root_x $_last_mouse_root_y 0
};# macdnd::HandleDrop
# ----------------------------------------------------------------------------
# Command macdnd::GetDragSourceCommonTypes
# ----------------------------------------------------------------------------
proc macdnd::GetDragSourceCommonTypes { } {
::tkdnd::generic::GetDragSourceCommonTypes
};# macdnd::GetDragSourceCommonTypes
# ----------------------------------------------------------------------------
# Command macdnd::platform_specific_types
# ----------------------------------------------------------------------------
proc macdnd::platform_specific_types { types } {
::tkdnd::generic::platform_specific_types $types
}; # macdnd::platform_specific_types
# ----------------------------------------------------------------------------
# Command macdnd::platform_specific_type
# ----------------------------------------------------------------------------
proc macdnd::platform_specific_type { type } {
::tkdnd::generic::platform_specific_type $type
}; # macdnd::platform_specific_type
# ----------------------------------------------------------------------------
# Command tkdnd::platform_independent_types
# ----------------------------------------------------------------------------
proc ::tkdnd::platform_independent_types { types } {
::tkdnd::generic::platform_independent_types $types
}; # tkdnd::platform_independent_types
# ----------------------------------------------------------------------------
# Command macdnd::platform_independent_type
# ----------------------------------------------------------------------------
proc macdnd::platform_independent_type { type } {
::tkdnd::generic::platform_independent_type $type
}; # macdnd::platform_independent_type

View File

@ -0,0 +1,810 @@
#
# tkdnd_unix.tcl --
#
# This file implements some utility procedures that are used by the TkDND
# package.
#
# This software is copyrighted by:
# George Petasis, National Centre for Scientific Research "Demokritos",
# Aghia Paraskevi, Athens, Greece.
# e-mail: petasis@iit.demokritos.gr
#
# The following terms apply to all files associated
# with the software unless explicitly disclaimed in individual files.
#
# The authors hereby grant permission to use, copy, modify, distribute,
# and license this software and its documentation for any purpose, provided
# that existing copyright notices are retained in all copies and that this
# notice is included verbatim in any distributions. No written agreement,
# license, or royalty fee is required for any of the authorized uses.
# Modifications to this software may be copyrighted by their authors
# and need not follow the licensing terms described here, provided that
# the new terms are clearly indicated on the first page of each file where
# they apply.
#
# IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
# FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
# ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
# DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
#
# THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE
# IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
# NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
# MODIFICATIONS.
#
namespace eval xdnd {
variable _dragging 0
proc initialise { } {
## Mapping from platform types to TkDND types...
::tkdnd::generic::initialise_platform_to_tkdnd_types [list \
text/plain\;charset=utf-8 DND_Text \
UTF8_STRING DND_Text \
text/plain DND_Text \
STRING DND_Text \
TEXT DND_Text \
COMPOUND_TEXT DND_Text \
text/uri-list DND_Files \
text/html\;charset=utf-8 DND_HTML \
text/html DND_HTML \
application/x-color DND_Color \
]
};# initialise
};# namespace xdnd
# ----------------------------------------------------------------------------
# Command xdnd::HandleXdndEnter
# ----------------------------------------------------------------------------
proc xdnd::HandleXdndEnter { path drag_source typelist time { data {} } } {
variable _pressedkeys
variable _actionlist
variable _typelist
set _pressedkeys 1
set _actionlist { copy move link ask private }
set _typelist $typelist
# puts "xdnd::HandleXdndEnter: $time"
::tkdnd::generic::SetDroppedData $data
::tkdnd::generic::HandleEnter $path $drag_source $typelist $typelist \
$_actionlist $_pressedkeys
};# xdnd::HandleXdndEnter
# ----------------------------------------------------------------------------
# Command xdnd::HandleXdndPosition
# ----------------------------------------------------------------------------
proc xdnd::HandleXdndPosition { drop_target rootX rootY time {drag_source {}} } {
variable _pressedkeys
variable _typelist
variable _last_mouse_root_x; set _last_mouse_root_x $rootX
variable _last_mouse_root_y; set _last_mouse_root_y $rootY
# puts "xdnd::HandleXdndPosition: $time"
## Get the dropped data...
catch {
::tkdnd::generic::SetDroppedData [GetPositionData $drop_target $_typelist $time]
}
::tkdnd::generic::HandlePosition $drop_target $drag_source \
$_pressedkeys $rootX $rootY
};# xdnd::HandleXdndPosition
# ----------------------------------------------------------------------------
# Command xdnd::HandleXdndLeave
# ----------------------------------------------------------------------------
proc xdnd::HandleXdndLeave { } {
::tkdnd::generic::HandleLeave
};# xdnd::HandleXdndLeave
# ----------------------------------------------------------------------------
# Command xdnd::_HandleXdndDrop
# ----------------------------------------------------------------------------
proc xdnd::HandleXdndDrop { time } {
variable _pressedkeys
variable _last_mouse_root_x
variable _last_mouse_root_y
## Get the dropped data...
::tkdnd::generic::SetDroppedData [GetDroppedData \
[::tkdnd::generic::GetDragSource] [::tkdnd::generic::GetDropTarget] \
[::tkdnd::generic::GetDragSourceCommonTypes] $time]
::tkdnd::generic::HandleDrop {} {} $_pressedkeys \
$_last_mouse_root_x $_last_mouse_root_y $time
};# xdnd::HandleXdndDrop
# ----------------------------------------------------------------------------
# Command xdnd::GetPositionData
# ----------------------------------------------------------------------------
proc xdnd::GetPositionData { drop_target typelist time } {
foreach {drop_target common_drag_source_types common_drop_target_types} \
[::tkdnd::generic::FindWindowWithCommonTypes $drop_target $typelist] {break}
GetDroppedData [::tkdnd::generic::GetDragSource] $drop_target \
$common_drag_source_types $time
};# xdnd::GetPositionData
# ----------------------------------------------------------------------------
# Command xdnd::GetDroppedData
# ----------------------------------------------------------------------------
proc xdnd::GetDroppedData { _drag_source _drop_target _common_drag_source_types time } {
if {![llength $_common_drag_source_types]} {
error "no common data types between the drag source and drop target widgets"
}
## Is drag source in this application?
if {[catch {winfo pathname -displayof $_drop_target $_drag_source} p]} {
set _use_tk_selection 0
} else {
set _use_tk_selection 1
}
foreach type $_common_drag_source_types {
# puts "TYPE: $type ($_drop_target)"
# _get_selection $_drop_target $time $type
if {$_use_tk_selection} {
if {![catch {
selection get -displayof $_drop_target -selection XdndSelection \
-type $type
} result options]} {
return [normalise_data $type $result]
}
} else {
# puts "_selection_get -displayof $_drop_target -selection XdndSelection \
# -type $type -time $time"
#after 100 [list focus -force $_drop_target]
#after 50 [list raise [winfo toplevel $_drop_target]]
if {![catch {
_selection_get -displayof $_drop_target -selection XdndSelection \
-type $type -time $time
} result options]} {
return [normalise_data $type $result]
}
}
}
return -options $options $result
};# xdnd::GetDroppedData
# ----------------------------------------------------------------------------
# Command xdnd::platform_specific_types
# ----------------------------------------------------------------------------
proc xdnd::platform_specific_types { types } {
::tkdnd::generic::platform_specific_types $types
}; # xdnd::platform_specific_types
# ----------------------------------------------------------------------------
# Command xdnd::platform_specific_type
# ----------------------------------------------------------------------------
proc xdnd::platform_specific_type { type } {
::tkdnd::generic::platform_specific_type $type
}; # xdnd::platform_specific_type
# ----------------------------------------------------------------------------
# Command tkdnd::platform_independent_types
# ----------------------------------------------------------------------------
proc ::tkdnd::platform_independent_types { types } {
::tkdnd::generic::platform_independent_types $types
}; # tkdnd::platform_independent_types
# ----------------------------------------------------------------------------
# Command xdnd::platform_independent_type
# ----------------------------------------------------------------------------
proc xdnd::platform_independent_type { type } {
::tkdnd::generic::platform_independent_type $type
}; # xdnd::platform_independent_type
# ----------------------------------------------------------------------------
# Command xdnd::_normalise_data
# ----------------------------------------------------------------------------
proc xdnd::normalise_data { type data } {
# Tk knows how to interpret the following types:
# STRING, TEXT, COMPOUND_TEXT
# UTF8_STRING
# Else, it returns a list of 8 or 32 bit numbers...
switch -glob $type {
STRING - UTF8_STRING - TEXT - COMPOUND_TEXT {return $data}
text/html {
if {[catch {
encoding convertfrom unicode $data
} string]} {
set string $data
}
return [string map {\r\n \n} $string]
}
text/html\;charset=utf-8 -
text/plain\;charset=utf-8 -
text/plain {
if {[catch {
encoding convertfrom utf-8 [tkdnd::bytes_to_string $data]
} string]} {
set string $data
}
return [string map {\r\n \n} $string]
}
text/uri-list* {
if {[catch {
encoding convertfrom utf-8 [tkdnd::bytes_to_string $data]
} string]} {
set string $data
}
## Get rid of \r\n
set string [string trim [string map {\r\n \n} $string]]
set files {}
foreach quoted_file [split $string] {
set file [tkdnd::urn_unquote $quoted_file]
switch -glob $file {
\#* {}
file://* {lappend files [string range $file 7 end]}
ftp://* -
https://* -
http://* {lappend files $quoted_file}
default {lappend files $file}
}
}
return $files
}
application/x-color {
return $data
}
text/x-moz-url -
application/q-iconlist -
default {return $data}
}
}; # xdnd::normalise_data
#############################################################################
##
## XDND drag implementation
##
#############################################################################
# ----------------------------------------------------------------------------
# Command xdnd::_selection_ownership_lost
# ----------------------------------------------------------------------------
proc xdnd::_selection_ownership_lost {} {
variable _dragging
set _dragging 0
};# _selection_ownership_lost
# ----------------------------------------------------------------------------
# Command xdnd::_dodragdrop
# ----------------------------------------------------------------------------
proc xdnd::_dodragdrop { source actions types data button } {
variable _dragging
# puts "xdnd::_dodragdrop: source: $source, actions: $actions, types: $types,\
# data: \"$data\", button: $button"
if {$_dragging} {
## We are in the middle of another drag operation...
error "another drag operation in progress"
}
variable _dodragdrop_drag_source $source
variable _dodragdrop_drop_target 0
variable _dodragdrop_drop_target_proxy 0
variable _dodragdrop_actions $actions
variable _dodragdrop_action_descriptions $actions
variable _dodragdrop_actions_len [llength $actions]
variable _dodragdrop_types $types
variable _dodragdrop_types_len [llength $types]
variable _dodragdrop_data $data
variable _dodragdrop_transfer_data {}
variable _dodragdrop_button $button
variable _dodragdrop_time 0
variable _dodragdrop_default_action refuse_drop
variable _dodragdrop_waiting_status 0
variable _dodragdrop_drop_target_accepts_drop 0
variable _dodragdrop_drop_target_accepts_action refuse_drop
variable _dodragdrop_current_cursor $_dodragdrop_default_action
variable _dodragdrop_drop_occured 0
variable _dodragdrop_selection_requestor 0
##
## If we have more than 3 types, the property XdndTypeList must be set on
## the drag source widget...
##
if {$_dodragdrop_types_len > 3} {
_announce_type_list $_dodragdrop_drag_source $_dodragdrop_types
}
##
## Announce the actions & their descriptions on the XdndActionList &
## XdndActionDescription properties...
##
_announce_action_list $_dodragdrop_drag_source $_dodragdrop_actions \
$_dodragdrop_action_descriptions
##
## Arrange selection handlers for our drag source, and all the supported types
##
registerSelectionHandler $source $types
##
## Step 1: When a drag begins, the source takes ownership of XdndSelection.
##
selection own -command ::tkdnd::xdnd::_selection_ownership_lost \
-selection XdndSelection $source
set _dragging 1
## Grab the mouse pointer...
_grab_pointer $source $_dodragdrop_default_action
## Register our generic event handler...
# The generic event callback will report events by modifying variable
# ::xdnd::_dodragdrop_event: a dict with event information will be set as
# the value of the variable...
_register_generic_event_handler
## Set a timeout for debugging purposes...
# after 60000 {set ::tkdnd::xdnd::_dragging 0}
tkwait variable ::tkdnd::xdnd::_dragging
_SendXdndLeave
set _dragging 0
_ungrab_pointer $source
_unregister_generic_event_handler
catch {selection clear -selection XdndSelection}
unregisterSelectionHandler $source $types
return $_dodragdrop_drop_target_accepts_action
};# xdnd::_dodragdrop
# ----------------------------------------------------------------------------
# Command xdnd::_process_drag_events
# ----------------------------------------------------------------------------
proc xdnd::_process_drag_events {event} {
# The return value from proc is normally 0. A non-zero return value indicates
# that the event is not to be handled further; that is, proc has done all
# processing that is to be allowed for the event
variable _dragging
if {!$_dragging} {return 0}
# puts $event
variable _dodragdrop_time
set time [dict get $event time]
set type [dict get $event type]
if {$time < $_dodragdrop_time && ![string equal $type SelectionRequest]} {
return 0
}
set _dodragdrop_time $time
variable _dodragdrop_drag_source
variable _dodragdrop_drop_target
variable _dodragdrop_drop_target_proxy
variable _dodragdrop_default_action
switch $type {
MotionNotify {
set rootx [dict get $event x_root]
set rooty [dict get $event y_root]
set window [_find_drop_target_window $_dodragdrop_drag_source \
$rootx $rooty]
if {[string length $window]} {
## Examine the modifiers to suggest an action...
set _dodragdrop_default_action [_default_action $event]
## Is it a Tk widget?
# set path [winfo containing $rootx $rooty]
# puts "Window under mouse: $window ($path)"
if {$_dodragdrop_drop_target != $window} {
## Send XdndLeave to $_dodragdrop_drop_target
_SendXdndLeave
## Is there a proxy? If not, _find_drop_target_proxy returns the
## target window, so we always get a valid "proxy".
set proxy [_find_drop_target_proxy $_dodragdrop_drag_source $window]
## Send XdndEnter to $window
_SendXdndEnter $window $proxy
## Send XdndPosition to $_dodragdrop_drop_target
_SendXdndPosition $rootx $rooty $_dodragdrop_default_action
} else {
## Send XdndPosition to $_dodragdrop_drop_target
_SendXdndPosition $rootx $rooty $_dodragdrop_default_action
}
} else {
## No window under the mouse. Send XdndLeave to $_dodragdrop_drop_target
_SendXdndLeave
}
}
ButtonPress {
}
ButtonRelease {
variable _dodragdrop_button
set button [dict get $event button]
if {$button == $_dodragdrop_button} {
## The button that initiated the drag was released. Trigger drop...
_SendXdndDrop
}
return 1
}
KeyPress {
}
KeyRelease {
set keysym [dict get $event keysym]
switch $keysym {
Escape {
## The user has pressed escape. Abort...
if {$_dragging} {set _dragging 0}
}
}
}
SelectionRequest {
variable _dodragdrop_selection_requestor
variable _dodragdrop_selection_property
variable _dodragdrop_selection_selection
variable _dodragdrop_selection_target
variable _dodragdrop_selection_time
set _dodragdrop_selection_requestor [dict get $event requestor]
set _dodragdrop_selection_property [dict get $event property]
set _dodragdrop_selection_selection [dict get $event selection]
set _dodragdrop_selection_target [dict get $event target]
set _dodragdrop_selection_time $time
return 0
}
default {
return 0
}
}
return 0
};# _process_drag_events
# ----------------------------------------------------------------------------
# Command xdnd::_SendXdndEnter
# ----------------------------------------------------------------------------
proc xdnd::_SendXdndEnter {window proxy} {
variable _dodragdrop_drag_source
variable _dodragdrop_drop_target
variable _dodragdrop_drop_target_proxy
variable _dodragdrop_types
variable _dodragdrop_waiting_status
variable _dodragdrop_drop_occured
if {$_dodragdrop_drop_target > 0} _SendXdndLeave
if {$_dodragdrop_drop_occured} return
set _dodragdrop_drop_target $window
set _dodragdrop_drop_target_proxy $proxy
set _dodragdrop_waiting_status 0
if {$_dodragdrop_drop_target < 1} return
# puts "XdndEnter: $_dodragdrop_drop_target $_dodragdrop_drop_target_proxy"
_send_XdndEnter $_dodragdrop_drag_source $_dodragdrop_drop_target \
$_dodragdrop_drop_target_proxy $_dodragdrop_types
};# xdnd::_SendXdndEnter
# ----------------------------------------------------------------------------
# Command xdnd::_SendXdndPosition
# ----------------------------------------------------------------------------
proc xdnd::_SendXdndPosition {rootx rooty action} {
variable _dodragdrop_drag_source
variable _dodragdrop_drop_target
if {$_dodragdrop_drop_target < 1} return
variable _dodragdrop_drop_occured
if {$_dodragdrop_drop_occured} return
variable _dodragdrop_drop_target_proxy
variable _dodragdrop_waiting_status
## Arrange a new XdndPosition, to be send periodically...
variable _dodragdrop_xdnd_position_heartbeat
catch {after cancel $_dodragdrop_xdnd_position_heartbeat}
set _dodragdrop_xdnd_position_heartbeat [after 200 \
[list ::tkdnd::xdnd::_SendXdndPosition $rootx $rooty $action]]
if {$_dodragdrop_waiting_status} {return}
# puts "XdndPosition: $_dodragdrop_drop_target $rootx $rooty $action"
_send_XdndPosition $_dodragdrop_drag_source $_dodragdrop_drop_target \
$_dodragdrop_drop_target_proxy $rootx $rooty $action
set _dodragdrop_waiting_status 1
};# xdnd::_SendXdndPosition
# ----------------------------------------------------------------------------
# Command xdnd::_HandleXdndStatus
# ----------------------------------------------------------------------------
proc xdnd::_HandleXdndStatus {event} {
variable _dodragdrop_drop_target
variable _dodragdrop_waiting_status
variable _dodragdrop_drop_target_accepts_drop
variable _dodragdrop_drop_target_accepts_action
set _dodragdrop_waiting_status 0
foreach key {target accept want_position action x y w h} {
set $key [dict get $event $key]
}
set _dodragdrop_drop_target_accepts_drop $accept
set _dodragdrop_drop_target_accepts_action $action
if {$_dodragdrop_drop_target < 1} return
variable _dodragdrop_drop_occured
if {$_dodragdrop_drop_occured} return
_update_cursor
# puts "XdndStatus: $event"
};# xdnd::_HandleXdndStatus
# ----------------------------------------------------------------------------
# Command xdnd::_HandleXdndFinished
# ----------------------------------------------------------------------------
proc xdnd::_HandleXdndFinished {event} {
variable _dodragdrop_xdnd_finished_event_after_id
catch {after cancel $_dodragdrop_xdnd_finished_event_after_id}
set _dodragdrop_xdnd_finished_event_after_id {}
variable _dodragdrop_drop_target
set _dodragdrop_drop_target 0
variable _dragging
if {$_dragging} {set _dragging 0}
variable _dodragdrop_drop_target_accepts_drop
variable _dodragdrop_drop_target_accepts_action
if {[dict size $event]} {
foreach key {target accept action} {
set $key [dict get $event $key]
}
set _dodragdrop_drop_target_accepts_drop $accept
set _dodragdrop_drop_target_accepts_action $action
} else {
set _dodragdrop_drop_target_accepts_drop 0
}
if {!$_dodragdrop_drop_target_accepts_drop} {
set _dodragdrop_drop_target_accepts_action refuse_drop
}
# puts "XdndFinished: $event"
};# xdnd::_HandleXdndFinished
# ----------------------------------------------------------------------------
# Command xdnd::_SendXdndLeave
# ----------------------------------------------------------------------------
proc xdnd::_SendXdndLeave {} {
variable _dodragdrop_drag_source
variable _dodragdrop_drop_target
if {$_dodragdrop_drop_target < 1} return
variable _dodragdrop_drop_target_proxy
# puts "XdndLeave: $_dodragdrop_drop_target"
_send_XdndLeave $_dodragdrop_drag_source $_dodragdrop_drop_target \
$_dodragdrop_drop_target_proxy
set _dodragdrop_drop_target 0
variable _dodragdrop_drop_target_accepts_drop
variable _dodragdrop_drop_target_accepts_action
set _dodragdrop_drop_target_accepts_drop 0
set _dodragdrop_drop_target_accepts_action refuse_drop
variable _dodragdrop_drop_occured
if {$_dodragdrop_drop_occured} return
_update_cursor
};# xdnd::_SendXdndLeave
# ----------------------------------------------------------------------------
# Command xdnd::_SendXdndDrop
# ----------------------------------------------------------------------------
proc xdnd::_SendXdndDrop {} {
variable _dodragdrop_drag_source
variable _dodragdrop_drop_target
if {$_dodragdrop_drop_target < 1} {
## The mouse has been released over a widget that does not accept drops.
_HandleXdndFinished {}
return
}
variable _dodragdrop_drop_occured
if {$_dodragdrop_drop_occured} {return}
variable _dodragdrop_drop_target_proxy
variable _dodragdrop_drop_target_accepts_drop
variable _dodragdrop_drop_target_accepts_action
set _dodragdrop_drop_occured 1
_update_cursor clock
if {!$_dodragdrop_drop_target_accepts_drop} {
_SendXdndLeave
_HandleXdndFinished {}
return
}
# puts "XdndDrop: $_dodragdrop_drop_target"
variable _dodragdrop_drop_timestamp
set _dodragdrop_drop_timestamp [_send_XdndDrop \
$_dodragdrop_drag_source $_dodragdrop_drop_target \
$_dodragdrop_drop_target_proxy]
set _dodragdrop_drop_target 0
# puts "XdndDrop: $_dodragdrop_drop_target"
## Arrange a timeout for receiving XdndFinished...
variable _dodragdrop_xdnd_finished_event_after_id
set _dodragdrop_xdnd_finished_event_after_id \
[after 10000 [list ::tkdnd::xdnd::_HandleXdndFinished {}]]
};# xdnd::_SendXdndDrop
# ----------------------------------------------------------------------------
# Command xdnd::_update_cursor
# ----------------------------------------------------------------------------
proc xdnd::_update_cursor { {cursor {}}} {
# puts "_update_cursor $cursor"
variable _dodragdrop_current_cursor
variable _dodragdrop_drag_source
variable _dodragdrop_drop_target_accepts_drop
variable _dodragdrop_drop_target_accepts_action
if {![string length $cursor]} {
set cursor refuse_drop
if {$_dodragdrop_drop_target_accepts_drop} {
set cursor $_dodragdrop_drop_target_accepts_action
}
}
if {![string equal $cursor $_dodragdrop_current_cursor]} {
_set_pointer_cursor $_dodragdrop_drag_source $cursor
set _dodragdrop_current_cursor $cursor
}
};# xdnd::_update_cursor
# ----------------------------------------------------------------------------
# Command xdnd::_default_action
# ----------------------------------------------------------------------------
proc xdnd::_default_action {event} {
variable _dodragdrop_actions
variable _dodragdrop_actions_len
if {$_dodragdrop_actions_len == 1} {return [lindex $_dodragdrop_actions 0]}
set alt [dict get $event Alt]
set shift [dict get $event Shift]
set control [dict get $event Control]
if {$shift && $control && [lsearch $_dodragdrop_actions link] != -1} {
return link
} elseif {$control && [lsearch $_dodragdrop_actions copy] != -1} {
return copy
} elseif {$shift && [lsearch $_dodragdrop_actions move] != -1} {
return move
} elseif {$alt && [lsearch $_dodragdrop_actions link] != -1} {
return link
}
return default
};# xdnd::_default_action
# ----------------------------------------------------------------------------
# Command xdnd::getFormatForType
# ----------------------------------------------------------------------------
proc xdnd::getFormatForType {type} {
switch -glob [string tolower $type] {
text/plain\;charset=utf-8 -
text/html\;charset=utf-8 -
utf8_string {set format UTF8_STRING}
text/html -
text/plain -
string -
text -
compound_text {set format STRING}
text/uri-list* {set format UTF8_STRING}
application/x-color {set format $type}
default {set format $type}
}
return $format
};# xdnd::getFormatForType
# ----------------------------------------------------------------------------
# Command xdnd::registerSelectionHandler
# ----------------------------------------------------------------------------
proc xdnd::registerSelectionHandler {source types} {
foreach type $types {
selection handle -selection XdndSelection \
-type $type \
-format [getFormatForType $type] \
$source [list ::tkdnd::xdnd::_SendData $type]
}
};# xdnd::registerSelectionHandler
# ----------------------------------------------------------------------------
# Command xdnd::unregisterSelectionHandler
# ----------------------------------------------------------------------------
proc xdnd::unregisterSelectionHandler {source types} {
foreach type $types {
catch {
selection handle -selection XdndSelection \
-type $type \
-format [getFormatForType $type] \
$source {}
}
}
};# xdnd::unregisterSelectionHandler
# ----------------------------------------------------------------------------
# Command xdnd::_convert_to_unsigned
# ----------------------------------------------------------------------------
proc xdnd::_convert_to_unsigned {data format} {
switch $format {
8 { set mask 0xff }
16 { set mask 0xffff }
32 { set mask 0xffffff }
default {error "unsupported format $format"}
}
## Convert signed integer into unsigned...
set d [list]
foreach num $data {
lappend d [expr { $num & $mask }]
}
return $d
};# xdnd::_convert_to_unsigned
# ----------------------------------------------------------------------------
# Command xdnd::_SendData
# ----------------------------------------------------------------------------
proc xdnd::_SendData {type offset bytes args} {
variable _dodragdrop_drag_source
variable _dodragdrop_types
variable _dodragdrop_data
variable _dodragdrop_transfer_data
## The variable _dodragdrop_data contains a list of data, one for each
## type in the _dodragdrop_types variable. We have to search types, and find
## the corresponding entry in the _dodragdrop_data list.
set index [lsearch $_dodragdrop_types $type]
if {$index < 0} {
error "unable to locate data suitable for type \"$type\""
}
set typed_data [lindex $_dodragdrop_data $index]
set format 8
if {$offset == 0} {
## Prepare the data to be transferred...
switch -glob $type {
text/plain* - UTF8_STRING - STRING - TEXT - COMPOUND_TEXT {
binary scan [encoding convertto utf-8 $typed_data] \
c* _dodragdrop_transfer_data
set _dodragdrop_transfer_data \
[_convert_to_unsigned $_dodragdrop_transfer_data $format]
}
text/uri-list* {
set files [list]
foreach file $typed_data {
switch -glob $file {
*://* {lappend files $file}
default {lappend files file://$file}
}
}
binary scan [encoding convertto utf-8 "[join $files \r\n]\r\n"] \
c* _dodragdrop_transfer_data
set _dodragdrop_transfer_data \
[_convert_to_unsigned $_dodragdrop_transfer_data $format]
}
application/x-color {
set format 16
## Try to understand the provided data: we accept a standard Tk colour,
## or a list of 3 values (red green blue) or a list of 4 values
## (red green blue opacity).
switch [llength $typed_data] {
1 { set color [winfo rgb $_dodragdrop_drag_source $typed_data]
lappend color 65535 }
3 { set color $typed_data; lappend color 65535 }
4 { set color $typed_data }
default {error "unknown color data: \"$typed_data\""}
}
## Convert the 4 elements into 16 bit values...
set _dodragdrop_transfer_data [list]
foreach c $color {
lappend _dodragdrop_transfer_data [format 0x%04X $c]
}
}
default {
set format 32
binary scan $typed_data c* _dodragdrop_transfer_data
}
}
}
##
## Data has been split into bytes. Count the bytes requested, and return them
##
set data [lrange $_dodragdrop_transfer_data $offset [expr {$offset+$bytes-1}]]
switch $format {
8 {
set data [encoding convertfrom utf-8 [binary format c* $data]]
}
16 {
variable _dodragdrop_selection_requestor
if {$_dodragdrop_selection_requestor} {
## Tk selection cannot process this format (only 8 & 32 supported).
## Call our XChangeProperty...
set numItems [llength $data]
variable _dodragdrop_selection_property
variable _dodragdrop_selection_selection
variable _dodragdrop_selection_target
variable _dodragdrop_selection_time
XChangeProperty $_dodragdrop_drag_source \
$_dodragdrop_selection_requestor \
$_dodragdrop_selection_property \
$_dodragdrop_selection_target \
$format \
$_dodragdrop_selection_time \
$data $numItems
return -code break
}
}
32 {
}
default {
error "unsupported format $format"
}
}
# puts "SendData: $type $offset $bytes $args ($typed_data)"
# puts " $data"
return $data
};# xdnd::_SendData

View File

@ -0,0 +1,252 @@
#
# tkdnd_utils.tcl --
#
# This file implements some utility procedures that are used by the TkDND
# package.
#
# This software is copyrighted by:
# George Petasis, National Centre for Scientific Research "Demokritos",
# Aghia Paraskevi, Athens, Greece.
# e-mail: petasis@iit.demokritos.gr
#
# The following terms apply to all files associated
# with the software unless explicitly disclaimed in individual files.
#
# The authors hereby grant permission to use, copy, modify, distribute,
# and license this software and its documentation for any purpose, provided
# that existing copyright notices are retained in all copies and that this
# notice is included verbatim in any distributions. No written agreement,
# license, or royalty fee is required for any of the authorized uses.
# Modifications to this software may be copyrighted by their authors
# and need not follow the licensing terms described here, provided that
# the new terms are clearly indicated on the first page of each file where
# they apply.
#
# IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
# FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
# ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
# DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
#
# THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE
# IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
# NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
# MODIFICATIONS.
#
package require tkdnd
namespace eval ::tkdnd {
namespace eval utils {
};# namespace ::tkdnd::utils
namespace eval text {
variable _drag_tag tkdnd::drag::selection::tag
variable _state {}
variable _drag_source_widget {}
variable _drop_target_widget {}
variable _now_dragging 0
};# namespace ::tkdnd::text
};# namespace ::tkdnd
bind TkDND_Drag_Text1 <ButtonPress-1> {tkdnd::text::_begin_drag clear 1 %W %s %X %Y %x %y}
bind TkDND_Drag_Text1 <B1-Motion> {tkdnd::text::_begin_drag motion 1 %W %s %X %Y %x %y}
bind TkDND_Drag_Text1 <B1-Leave> {tkdnd::text::_TextAutoScan %W %x %y}
bind TkDND_Drag_Text1 <ButtonRelease-1> {tkdnd::text::_begin_drag reset 1 %W %s %X %Y %x %y}
bind TkDND_Drag_Text2 <ButtonPress-2> {tkdnd::text::_begin_drag clear 2 %W %s %X %Y %x %y}
bind TkDND_Drag_Text2 <B2-Motion> {tkdnd::text::_begin_drag motion 2 %W %s %X %Y %x %y}
bind TkDND_Drag_Text2 <ButtonRelease-2> {tkdnd::text::_begin_drag reset 2 %W %s %X %Y %x %y}
bind TkDND_Drag_Text3 <ButtonPress-3> {tkdnd::text::_begin_drag clear 3 %W %s %X %Y %x %y}
bind TkDND_Drag_Text3 <B3-Motion> {tkdnd::text::_begin_drag motion 3 %W %s %X %Y %x %y}
bind TkDND_Drag_Text3 <ButtonRelease-3> {tkdnd::text::_begin_drag reset 3 %W %s %X %Y %x %y}
# ----------------------------------------------------------------------------
# Command tkdnd::text::drag_source
# ----------------------------------------------------------------------------
proc ::tkdnd::text::drag_source { mode path { types DND_Text } { event 1 } { tagprefix TkDND_Drag_Text } { tag sel } } {
switch -exact -- $mode {
register {
$path tag bind $tag <ButtonPress-${event}> \
"tkdnd::text::_begin_drag press ${event} %W %s %X %Y %x %y"
## Set a binding to the widget, to put selection as data...
bind $path <<DragInitCmd>> "::tkdnd::text::DragInitCmd $path {%t} $tag"
## Set a binding to the widget, to remove selection if action is move...
bind $path <<DragEndCmd>> "::tkdnd::text::DragEndCmd $path %A $tag"
}
unregister {
$path tag bind $tag <ButtonPress-${event}> {}
bind $path <<DragInitCmd>> {}
bind $path <<DragEndCmd>> {}
}
}
::tkdnd::drag_source $mode $path $types $event $tagprefix
};# ::tkdnd::text::drag_source
# ----------------------------------------------------------------------------
# Command tkdnd::text::drop_target
# ----------------------------------------------------------------------------
proc ::tkdnd::text::drop_target { mode path { types DND_Text } } {
switch -exact -- $mode {
register {
bind $path <<DropPosition>> "::tkdnd::text::DropPosition $path %X %Y %A %a %m"
bind $path <<Drop>> "::tkdnd::text::Drop $path %D %X %Y %A %a %m"
}
unregister {
bind $path <<DropEnter>> {}
bind $path <<DropPosition>> {}
bind $path <<DropLeave>> {}
bind $path <<Drop>> {}
}
}
::tkdnd::drop_target $mode $path $types
};# ::tkdnd::text::drop_target
# ----------------------------------------------------------------------------
# Command tkdnd::text::DragInitCmd
# ----------------------------------------------------------------------------
proc ::tkdnd::text::DragInitCmd { path { types DND_Text } { tag sel } { actions { copy move } } } {
## Save the selection indices...
variable _drag_source_widget
variable _drop_target_widget
set _drag_source_widget $path
set _drop_target_widget {}
_save_selection $path $tag
list $actions $types [$path get $tag.first $tag.last]
};# ::tkdnd::text::DragInitCmd
# ----------------------------------------------------------------------------
# Command tkdnd::text::DragEndCmd
# ----------------------------------------------------------------------------
proc ::tkdnd::text::DragEndCmd { path action { tag sel } } {
variable _drag_source_widget
variable _drop_target_widget
set _drag_source_widget {}
set _drop_target_widget {}
_restore_selection $path $tag
switch -exact -- $action {
move {
## Delete the original selected text...
variable _selection_first
variable _selection_last
$path delete $_selection_first $_selection_last
}
}
};# ::tkdnd::text::DragEndCmd
# ----------------------------------------------------------------------------
# Command tkdnd::text::DropPosition
# ----------------------------------------------------------------------------
proc ::tkdnd::text::DropPosition { path X Y action actions keys} {
variable _drag_source_widget
variable _drop_target_widget
set _drop_target_widget $path
## This check is primitive, a more accurate one is needed!
if {$path eq $_drag_source_widget} {
## This is a drag within the same widget! Set action to move...
if {"move" in $actions} {set action move}
}
incr X -[winfo rootx $path]
incr Y -[winfo rooty $path]
$path mark set insert @$X,$Y; update
return $action
};# ::tkdnd::text::DropPosition
# ----------------------------------------------------------------------------
# Command tkdnd::text::Drop
# ----------------------------------------------------------------------------
proc ::tkdnd::text::Drop { path data X Y action actions keys } {
incr X -[winfo rootx $path]
incr Y -[winfo rooty $path]
$path mark set insert @$X,$Y
$path insert [$path index insert] $data
return $action
};# ::tkdnd::text::Drop
# ----------------------------------------------------------------------------
# Command tkdnd::text::_save_selection
# ----------------------------------------------------------------------------
proc ::tkdnd::text::_save_selection { path tag} {
variable _drag_tag
variable _selection_first
variable _selection_last
variable _selection_tag $tag
set _selection_first [$path index $tag.first]
set _selection_last [$path index $tag.last]
$path tag add $_drag_tag $_selection_first $_selection_last
$path tag configure $_drag_tag \
-background [$path tag cget $tag -background] \
-foreground [$path tag cget $tag -foreground]
};# tkdnd::text::_save_selection
# ----------------------------------------------------------------------------
# Command tkdnd::text::_restore_selection
# ----------------------------------------------------------------------------
proc ::tkdnd::text::_restore_selection { path tag} {
variable _drag_tag
variable _selection_first
variable _selection_last
$path tag delete $_drag_tag
$path tag remove $tag 0.0 end
#$path tag add $tag $_selection_first $_selection_last
};# tkdnd::text::_restore_selection
# ----------------------------------------------------------------------------
# Command tkdnd::text::_begin_drag
# ----------------------------------------------------------------------------
proc ::tkdnd::text::_begin_drag { event button source state X Y x y } {
variable _drop_target_widget
variable _state
# puts "::tkdnd::text::_begin_drag $event $button $source $state $X $Y $x $y"
switch -exact -- $event {
clear {
switch -exact -- $_state {
press {
## Do not execute other bindings, as they will erase selection...
return -code break
}
}
set _state clear
}
motion {
variable _now_dragging
if {$_now_dragging} {return -code break}
if { [string equal $_state "press"] } {
variable _x0; variable _y0
if { abs($_x0-$X) > ${::tkdnd::_dx} || abs($_y0-$Y) > ${::tkdnd::_dy} } {
set _state "done"
set _drop_target_widget {}
set _now_dragging 1
set code [catch {
::tkdnd::_init_drag $button $source $state $X $Y $x $y
} info options]
set _drop_target_widget {}
set _now_dragging 0
if {$code != 0} {
## Something strange occurred...
return -options $options $info
}
}
return -code break
}
set _state clear
}
press {
variable _x0; variable _y0
set _x0 $X
set _y0 $Y
set _state "press"
}
reset {
set _state {}
}
}
if {$source eq $_drop_target_widget} {return -code break}
return -code continue
};# tkdnd::text::_begin_drag
proc tkdnd::text::_TextAutoScan {w x y} {
variable _now_dragging
if {$_now_dragging} {return -code break}
return -code continue
};# tkdnd::text::_TextAutoScan

View File

@ -0,0 +1,167 @@
#
# tkdnd_windows.tcl --
#
# This file implements some utility procedures that are used by the TkDND
# package.
#
# This software is copyrighted by:
# George Petasis, National Centre for Scientific Research "Demokritos",
# Aghia Paraskevi, Athens, Greece.
# e-mail: petasis@iit.demokritos.gr
#
# The following terms apply to all files associated
# with the software unless explicitly disclaimed in individual files.
#
# The authors hereby grant permission to use, copy, modify, distribute,
# and license this software and its documentation for any purpose, provided
# that existing copyright notices are retained in all copies and that this
# notice is included verbatim in any distributions. No written agreement,
# license, or royalty fee is required for any of the authorized uses.
# Modifications to this software may be copyrighted by their authors
# and need not follow the licensing terms described here, provided that
# the new terms are clearly indicated on the first page of each file where
# they apply.
#
# IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
# FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
# ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
# DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
#
# THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE
# IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
# NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
# MODIFICATIONS.
#
namespace eval olednd {
proc initialise { } {
## Mapping from platform types to TkDND types...
::tkdnd::generic::initialise_platform_to_tkdnd_types [list \
CF_UNICODETEXT DND_Text \
CF_TEXT DND_Text \
CF_HDROP DND_Files \
UniformResourceLocator DND_URL \
CF_HTML DND_HTML \
{HTML Format} DND_HTML \
CF_RTF DND_RTF \
CF_RTFTEXT DND_RTF \
{Rich Text Format} DND_RTF \
]
# FileGroupDescriptorW DND_Files \
# FileGroupDescriptor DND_Files \
## Mapping from TkDND types to platform types...
::tkdnd::generic::initialise_tkdnd_to_platform_types [list \
DND_Text {CF_UNICODETEXT CF_TEXT} \
DND_Files {CF_HDROP} \
DND_URL {UniformResourceLocator UniformResourceLocatorW} \
DND_HTML {CF_HTML {HTML Format}} \
DND_RTF {CF_RTF CF_RTFTEXT {Rich Text Format}} \
]
};# initialise
};# namespace olednd
# ----------------------------------------------------------------------------
# Command olednd::HandleDragEnter
# ----------------------------------------------------------------------------
proc olednd::HandleDragEnter { drop_target typelist actionlist pressedkeys
rootX rootY codelist { data {} } } {
::tkdnd::generic::SetDroppedData $data
focus $drop_target
::tkdnd::generic::HandleEnter $drop_target 0 $typelist \
$codelist $actionlist $pressedkeys
set action [::tkdnd::generic::HandlePosition $drop_target {} \
$pressedkeys $rootX $rootY]
if {$::tkdnd::_auto_update} {update idletasks}
return $action
};# olednd::HandleDragEnter
# ----------------------------------------------------------------------------
# Command olednd::HandleDragOver
# ----------------------------------------------------------------------------
proc olednd::HandleDragOver { drop_target pressedkeys rootX rootY } {
set action [::tkdnd::generic::HandlePosition $drop_target {} \
$pressedkeys $rootX $rootY]
if {$::tkdnd::_auto_update} {update idletasks}
return $action
};# olednd::HandleDragOver
# ----------------------------------------------------------------------------
# Command olednd::HandleDragLeave
# ----------------------------------------------------------------------------
proc olednd::HandleDragLeave { drop_target } {
::tkdnd::generic::HandleLeave
if {$::tkdnd::_auto_update} {update idletasks}
};# olednd::HandleDragLeave
# ----------------------------------------------------------------------------
# Command olednd::HandleDrop
# ----------------------------------------------------------------------------
proc olednd::HandleDrop { drop_target pressedkeys rootX rootY type data } {
::tkdnd::generic::SetDroppedData [normalise_data $type $data]
set action [::tkdnd::generic::HandleDrop $drop_target {} \
$pressedkeys $rootX $rootY 0]
if {$::tkdnd::_auto_update} {update idletasks}
return $action
};# olednd::HandleDrop
# ----------------------------------------------------------------------------
# Command olednd::GetDataType
# ----------------------------------------------------------------------------
proc olednd::GetDataType { drop_target typelist } {
foreach {drop_target common_drag_source_types common_drop_target_types} \
[::tkdnd::generic::FindWindowWithCommonTypes $drop_target $typelist] {break}
lindex $common_drag_source_types 0
};# olednd::GetDataType
# ----------------------------------------------------------------------------
# Command olednd::GetDragSourceCommonTypes
# ----------------------------------------------------------------------------
proc olednd::GetDragSourceCommonTypes { drop_target } {
::tkdnd::generic::GetDragSourceCommonTypes
};# olednd::GetDragSourceCommonTypes
# ----------------------------------------------------------------------------
# Command olednd::platform_specific_types
# ----------------------------------------------------------------------------
proc olednd::platform_specific_types { types } {
::tkdnd::generic::platform_specific_types $types
}; # olednd::platform_specific_types
# ----------------------------------------------------------------------------
# Command olednd::platform_specific_type
# ----------------------------------------------------------------------------
proc olednd::platform_specific_type { type } {
::tkdnd::generic::platform_specific_type $type
}; # olednd::platform_specific_type
# ----------------------------------------------------------------------------
# Command tkdnd::platform_independent_types
# ----------------------------------------------------------------------------
proc ::tkdnd::platform_independent_types { types } {
::tkdnd::generic::platform_independent_types $types
}; # tkdnd::platform_independent_types
# ----------------------------------------------------------------------------
# Command olednd::platform_independent_type
# ----------------------------------------------------------------------------
proc olednd::platform_independent_type { type } {
::tkdnd::generic::platform_independent_type $type
}; # olednd::platform_independent_type
# ----------------------------------------------------------------------------
# Command olednd::normalise_data
# ----------------------------------------------------------------------------
proc olednd::normalise_data { type data } {
switch [lindex [::tkdnd::generic::platform_independent_type $type] 0] {
DND_Text {return $data}
DND_Files {return $data}
DND_HTML {return [encoding convertfrom utf-8 $data]}
default {return $data}
}
}; # olednd::normalise_data

Binary file not shown.

View File

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

View File

@ -0,0 +1,469 @@
#
# tkdnd.tcl --
#
# This file implements some utility procedures that are used by the TkDND
# package.
#
# This software is copyrighted by:
# George Petasis, National Centre for Scientific Research "Demokritos",
# Aghia Paraskevi, Athens, Greece.
# e-mail: petasis@iit.demokritos.gr
#
# The following terms apply to all files associated
# with the software unless explicitly disclaimed in individual files.
#
# The authors hereby grant permission to use, copy, modify, distribute,
# and license this software and its documentation for any purpose, provided
# that existing copyright notices are retained in all copies and that this
# notice is included verbatim in any distributions. No written agreement,
# license, or royalty fee is required for any of the authorized uses.
# Modifications to this software may be copyrighted by their authors
# and need not follow the licensing terms described here, provided that
# the new terms are clearly indicated on the first page of each file where
# they apply.
#
# IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
# FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
# ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
# DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
#
# THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE
# IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
# NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
# MODIFICATIONS.
#
package require Tk
namespace eval ::tkdnd {
variable _topw ".drag"
variable _tabops
variable _state
variable _x0
variable _y0
variable _platform_namespace
variable _drop_file_temp_dir
variable _auto_update 1
variable _dx 3 ;# The difference in pixels before a drag is initiated.
variable _dy 3 ;# The difference in pixels before a drag is initiated.
variable _windowingsystem
bind TkDND_Drag1 <ButtonPress-1> {tkdnd::_begin_drag press 1 %W %s %X %Y %x %y}
bind TkDND_Drag1 <B1-Motion> {tkdnd::_begin_drag motion 1 %W %s %X %Y %x %y}
bind TkDND_Drag2 <ButtonPress-2> {tkdnd::_begin_drag press 2 %W %s %X %Y %x %y}
bind TkDND_Drag2 <B2-Motion> {tkdnd::_begin_drag motion 2 %W %s %X %Y %x %y}
bind TkDND_Drag3 <ButtonPress-3> {tkdnd::_begin_drag press 3 %W %s %X %Y %x %y}
bind TkDND_Drag3 <B3-Motion> {tkdnd::_begin_drag motion 3 %W %s %X %Y %x %y}
# ----------------------------------------------------------------------------
# Command tkdnd::initialise: Initialise the TkDND package.
# ----------------------------------------------------------------------------
proc initialise { dir PKG_LIB_FILE PACKAGE_NAME} {
variable _platform_namespace
variable _drop_file_temp_dir
variable _windowingsystem
global env
switch [tk windowingsystem] {
x11 {
set _windowingsystem x11
}
win32 -
windows {
set _windowingsystem windows
}
aqua {
set _windowingsystem aqua
}
default {
error "unknown Tk windowing system"
}
}
## Get User's home directory: We try to locate the proper path from a set of
## environmental variables...
foreach var {HOME HOMEPATH USERPROFILE ALLUSERSPROFILE APPDATA} {
if {[info exists env($var)]} {
if {[file isdirectory $env($var)]} {
set UserHomeDir $env($var)
break
}
}
}
## Should use [tk windowingsystem] instead of tcl platform array:
## OS X returns "unix," but that's not useful because it has its own
## windowing system, aqua
## Under windows we have to also combine HOMEDRIVE & HOMEPATH...
if {![info exists UserHomeDir] &&
[string equal $_windowingsystem windows] &&
[info exists env(HOMEDRIVE)] && [info exists env(HOMEPATH)]} {
if {[file isdirectory $env(HOMEDRIVE)$env(HOMEPATH)]} {
set UserHomeDir $env(HOMEDRIVE)$env(HOMEPATH)
}
}
## Have we located the needed path?
if {![info exists UserHomeDir]} {
set UserHomeDir [pwd]
}
set UserHomeDir [file normalize $UserHomeDir]
## Try to locate a temporary directory...
foreach var {TKDND_TEMP_DIR TEMP TMP} {
if {[info exists env($var)]} {
if {[file isdirectory $env($var)] && [file writable $env($var)]} {
set _drop_file_temp_dir $env($var)
break
}
}
}
if {![info exists _drop_file_temp_dir]} {
foreach _dir [list "$UserHomeDir/Local Settings/Temp" \
"$UserHomeDir/AppData/Local/Temp" \
/tmp \
C:/WINDOWS/Temp C:/Temp C:/tmp \
D:/WINDOWS/Temp D:/Temp D:/tmp] {
if {[file isdirectory $_dir] && [file writable $_dir]} {
set _drop_file_temp_dir $_dir
break
}
}
}
if {![info exists _drop_file_temp_dir]} {
set _drop_file_temp_dir $UserHomeDir
}
set _drop_file_temp_dir [file native $_drop_file_temp_dir]
source $dir/tkdnd_generic.tcl
switch $_windowingsystem {
x11 {
source $dir/tkdnd_unix.tcl
set _platform_namespace xdnd
}
win32 -
windows {
source $dir/tkdnd_windows.tcl
set _platform_namespace olednd
}
aqua {
source $dir/tkdnd_macosx.tcl
set _platform_namespace macdnd
}
default {
error "unknown Tk windowing system"
}
}
load $dir/$PKG_LIB_FILE $PACKAGE_NAME
source $dir/tkdnd_compat.tcl
${_platform_namespace}::initialise
};# initialise
proc GetDropFileTempDirectory { } {
variable _drop_file_temp_dir
return $_drop_file_temp_dir
}
proc SetDropFileTempDirectory { dir } {
variable _drop_file_temp_dir
set _drop_file_temp_dir $dir
}
};# namespace ::tkdnd
# ----------------------------------------------------------------------------
# Command tkdnd::drag_source
# ----------------------------------------------------------------------------
proc ::tkdnd::drag_source { mode path { types {} } { event 1 }
{ tagprefix TkDND_Drag } } {
set tags [bindtags $path]
set idx [lsearch $tags ${tagprefix}$event]
switch -- $mode {
register {
if { $idx != -1 } {
## No need to do anything!
# bindtags $path [lreplace $tags $idx $idx ${tagprefix}$event]
} else {
bindtags $path [linsert $tags 1 ${tagprefix}$event]
}
_drag_source_update_types $path $types
}
unregister {
if { $idx != -1 } {
bindtags $path [lreplace $tags $idx $idx]
}
}
}
};# tkdnd::drag_source
proc ::tkdnd::_drag_source_update_types { path types } {
set types [platform_specific_types $types]
set old_types [bind $path <<DragSourceTypes>>]
foreach type $types {
if {[lsearch $old_types $type] < 0} {lappend old_types $type}
}
bind $path <<DragSourceTypes>> $old_types
};# ::tkdnd::_drag_source_update_types
# ----------------------------------------------------------------------------
# Command tkdnd::drop_target
# ----------------------------------------------------------------------------
proc ::tkdnd::drop_target { mode path { types {} } } {
variable _windowingsystem
set types [platform_specific_types $types]
switch -- $mode {
register {
switch $_windowingsystem {
x11 {
_register_types $path [winfo toplevel $path] $types
}
win32 -
windows {
_RegisterDragDrop $path
bind <Destroy> $path {+ tkdnd::_RevokeDragDrop %W}
}
aqua {
macdnd::registerdragwidget [winfo toplevel $path] $types
}
default {
error "unknown Tk windowing system"
}
}
set old_types [bind $path <<DropTargetTypes>>]
set new_types {}
foreach type $types {
if {[lsearch -exact $old_types $type] < 0} {lappend new_types $type}
}
if {[llength $new_types]} {
bind $path <<DropTargetTypes>> [concat $old_types $new_types]
}
}
unregister {
switch $_windowingsystem {
x11 {
}
win32 -
windows {
_RevokeDragDrop $path
}
aqua {
error todo
}
default {
error "unknown Tk windowing system"
}
}
bind $path <<DropTargetTypes>> {}
}
}
};# tkdnd::drop_target
# ----------------------------------------------------------------------------
# Command tkdnd::_begin_drag
# ----------------------------------------------------------------------------
proc ::tkdnd::_begin_drag { event button source state X Y x y } {
variable _x0
variable _y0
variable _state
switch -- $event {
press {
set _x0 $X
set _y0 $Y
set _state "press"
}
motion {
if { ![info exists _state] } {
# This is just extra protection. There seem to be
# rare cases where the motion comes before the press.
return
}
if { [string equal $_state "press"] } {
variable _dx
variable _dy
if { abs($_x0-$X) > ${_dx} || abs($_y0-$Y) > ${_dy} } {
set _state "done"
_init_drag $button $source $state $X $Y $x $y
}
}
}
}
};# tkdnd::_begin_drag
# ----------------------------------------------------------------------------
# Command tkdnd::_init_drag
# ----------------------------------------------------------------------------
proc ::tkdnd::_init_drag { button source state rootX rootY X Y } {
# Call the <<DragInitCmd>> binding.
set cmd [bind $source <<DragInitCmd>>]
# puts "CMD: $cmd"
if {[string length $cmd]} {
set cmd [string map [list %W $source %X $rootX %Y $rootY %x $X %y $Y \
%S $state %e <<DragInitCmd>> %A \{\} %% % \
%t [bind $source <<DragSourceTypes>>]] $cmd]
set code [catch {uplevel \#0 $cmd} info options]
# puts "CODE: $code ---- $info"
switch -exact -- $code {
0 {}
3 - 4 {
# FRINK: nocheck
return
}
default {
return -options $options $info
}
}
set len [llength $info]
if {$len == 3} {
foreach { actions types _data } $info { break }
set types [platform_specific_types $types]
set data [list]
foreach type $types {
lappend data $_data
}
unset _data
} elseif {$len == 2} {
foreach { actions _data } $info { break }
set data [list]; set types [list]
foreach {t d} $_data {
foreach t [platform_specific_types $t] {
lappend types $t; lappend data $d
}
}
unset _data t d
} else {
if {$len == 1 && [string equal [lindex $actions 0] "refuse_drop"]} {
return
}
error "not enough items in the result of the <<DragInitCmd>>\
event binding. Either 2 or 3 items are expected. The command
executed was: \"$cmd\"\nResult was: \"$info\""
}
set action refuse_drop
variable _windowingsystem
# puts "Source: \"$source\""
# puts "Types: \"[join $types {", "}]\""
# puts "Actions: \"[join $actions {", "}]\""
# puts "Button: \"$button\""
# puts "Data: \"[string range $data 0 100]\""
switch $_windowingsystem {
x11 {
set action [xdnd::_dodragdrop $source $actions $types $data $button]
}
win32 -
windows {
set action [_DoDragDrop $source $actions $types $data $button]
}
aqua {
set action [macdnd::dodragdrop $source $actions $types $data $button]
}
default {
error "unknown Tk windowing system"
}
}
## Call _end_drag to notify the widget of the result of the drag
## operation...
_end_drag $button $source {} $action {} $data {} $state $rootX $rootY $X $Y
}
};# tkdnd::_init_drag
# ----------------------------------------------------------------------------
# Command tkdnd::_end_drag
# ----------------------------------------------------------------------------
proc ::tkdnd::_end_drag { button source target action type data result
state rootX rootY X Y } {
set rootX 0
set rootY 0
# Call the <<DragEndCmd>> binding.
set cmd [bind $source <<DragEndCmd>>]
if {[string length $cmd]} {
set cmd [string map [list %W $source %X $rootX %Y $rootY %x $X %y $Y %% % \
%S $state %e <<DragEndCmd>> %A \{$action\}] $cmd]
set info [uplevel \#0 $cmd]
# if { $info != "" } {
# variable _windowingsystem
# foreach { actions types data } $info { break }
# set types [platform_specific_types $types]
# switch $_windowingsystem {
# x11 {
# error "dragging from Tk widgets not yet supported"
# }
# win32 -
# windows {
# set action [_DoDragDrop $source $actions $types $data $button]
# }
# aqua {
# macdnd::dodragdrop $source $actions $types $data
# }
# default {
# error "unknown Tk windowing system"
# }
# }
# ## Call _end_drag to notify the widget of the result of the drag
# ## operation...
# _end_drag $button $source {} $action {} $data {} $state $rootX $rootY
# }
}
};# tkdnd::_end_drag
# ----------------------------------------------------------------------------
# Command tkdnd::platform_specific_types
# ----------------------------------------------------------------------------
proc ::tkdnd::platform_specific_types { types } {
variable _platform_namespace
${_platform_namespace}::platform_specific_types $types
}; # tkdnd::platform_specific_types
# ----------------------------------------------------------------------------
# Command tkdnd::platform_independent_types
# ----------------------------------------------------------------------------
proc ::tkdnd::platform_independent_types { types } {
variable _platform_namespace
${_platform_namespace}::platform_independent_types $types
}; # tkdnd::platform_independent_types
# ----------------------------------------------------------------------------
# Command tkdnd::platform_specific_type
# ----------------------------------------------------------------------------
proc ::tkdnd::platform_specific_type { type } {
variable _platform_namespace
${_platform_namespace}::platform_specific_type $type
}; # tkdnd::platform_specific_type
# ----------------------------------------------------------------------------
# Command tkdnd::platform_independent_type
# ----------------------------------------------------------------------------
proc ::tkdnd::platform_independent_type { type } {
variable _platform_namespace
${_platform_namespace}::platform_independent_type $type
}; # tkdnd::platform_independent_type
# ----------------------------------------------------------------------------
# Command tkdnd::bytes_to_string
# ----------------------------------------------------------------------------
proc ::tkdnd::bytes_to_string { bytes } {
set string {}
foreach byte $bytes {
append string [binary format c $byte]
}
return $string
};# tkdnd::bytes_to_string
# ----------------------------------------------------------------------------
# Command tkdnd::urn_unquote
# ----------------------------------------------------------------------------
proc ::tkdnd::urn_unquote {url} {
set result ""
set start 0
while {[regexp -start $start -indices {%[0-9a-fA-F]{2}} $url match]} {
foreach {first last} $match break
append result [string range $url $start [expr {$first - 1}]]
append result [format %c 0x[string range $url [incr first] $last]]
set start [incr last]
}
append result [string range $url $start end]
return [encoding convertfrom utf-8 $result]
};# tkdnd::urn_unquote

Binary file not shown.

View File

@ -0,0 +1,160 @@
#
# tkdnd_compat.tcl --
#
# This file implements some utility procedures, to support older versions
# of the TkDND package.
#
# This software is copyrighted by:
# George Petasis, National Centre for Scientific Research "Demokritos",
# Aghia Paraskevi, Athens, Greece.
# e-mail: petasis@iit.demokritos.gr
#
# The following terms apply to all files associated
# with the software unless explicitly disclaimed in individual files.
#
# The authors hereby grant permission to use, copy, modify, distribute,
# and license this software and its documentation for any purpose, provided
# that existing copyright notices are retained in all copies and that this
# notice is included verbatim in any distributions. No written agreement,
# license, or royalty fee is required for any of the authorized uses.
# Modifications to this software may be copyrighted by their authors
# and need not follow the licensing terms described here, provided that
# the new terms are clearly indicated on the first page of each file where
# they apply.
#
# IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
# FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
# ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
# DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
#
# THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE
# IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
# NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
# MODIFICATIONS.
#
namespace eval compat {
};# namespace compat
# ----------------------------------------------------------------------------
# Command ::dnd
# ----------------------------------------------------------------------------
proc ::dnd {method window args} {
switch $method {
bindtarget {
switch [llength $args] {
0 {return [tkdnd::compat::bindtarget0 $window]}
1 {return [tkdnd::compat::bindtarget1 $window [lindex $args 0]]}
2 {return [tkdnd::compat::bindtarget2 $window [lindex $args 0] \
[lindex $args 1]]}
3 {return [tkdnd::compat::bindtarget3 $window [lindex $args 0] \
[lindex $args 1] [lindex $args 2]]}
4 {return [tkdnd::compat::bindtarget4 $window [lindex $args 0] \
[lindex $args 1] [lindex $args 2] [lindex $args 3]]}
}
}
cleartarget {
return [tkdnd::compat::cleartarget $window]
}
bindsource {
switch [llength $args] {
0 {return [tkdnd::compat::bindsource0 $window]}
1 {return [tkdnd::compat::bindsource1 $window [lindex $args 0]]}
2 {return [tkdnd::compat::bindsource2 $window [lindex $args 0] \
[lindex $args 1]]}
3 {return [tkdnd::compat::bindsource3 $window [lindex $args 0] \
[lindex $args 1] [lindex $args 2]]}
}
}
clearsource {
return [tkdnd::compat::clearsource $window]
}
drag {
return [tkdnd::_init_drag 1 $window "press" 0 0 0 0]
}
}
error "invalid number of arguments!"
};# ::dnd
# ----------------------------------------------------------------------------
# Command compat::bindtarget
# ----------------------------------------------------------------------------
proc compat::bindtarget0 {window} {
return [bind $window <<DropTargetTypes>>]
};# compat::bindtarget0
proc compat::bindtarget1 {window type} {
return [bindtarget2 $window $type <Drop>]
};# compat::bindtarget1
proc compat::bindtarget2 {window type event} {
switch $event {
<DragEnter> {return [bind $window <<DropEnter>>]}
<Drag> {return [bind $window <<DropPosition>>]}
<DragLeave> {return [bind $window <<DropLeave>>]}
<Drop> {return [bind $window <<Drop>>]}
}
};# compat::bindtarget2
proc compat::bindtarget3 {window type event script} {
set type [normalise_type $type]
::tkdnd::drop_target register $window [list $type]
switch $event {
<DragEnter> {return [bind $window <<DropEnter>> $script]}
<Drag> {return [bind $window <<DropPosition>> $script]}
<DragLeave> {return [bind $window <<DropLeave>> $script]}
<Drop> {return [bind $window <<Drop>> $script]}
}
};# compat::bindtarget3
proc compat::bindtarget4 {window type event script priority} {
return [bindtarget3 $window $type $event $script]
};# compat::bindtarget4
proc compat::normalise_type { type } {
switch $type {
text/plain -
{text/plain;charset=UTF-8} -
Text {return DND_Text}
text/uri-list -
Files {return DND_Files}
default {return $type}
}
};# compat::normalise_type
# ----------------------------------------------------------------------------
# Command compat::bindsource
# ----------------------------------------------------------------------------
proc compat::bindsource0 {window} {
return [bind $window <<DropTargetTypes>>]
};# compat::bindsource0
proc compat::bindsource1 {window type} {
return [bindsource2 $window $type <Drop>]
};# compat::bindsource1
proc compat::bindsource2 {window type script} {
set type [normalise_type $type]
::tkdnd::drag_source register $window $type
bind $window <<DragInitCmd>> "list {copy} {%t} \[$script\]"
};# compat::bindsource2
proc compat::bindsource3 {window type script priority} {
return [bindsource2 $window $type $script]
};# compat::bindsource3
# ----------------------------------------------------------------------------
# Command compat::cleartarget
# ----------------------------------------------------------------------------
proc compat::cleartarget {window} {
};# compat::cleartarget
# ----------------------------------------------------------------------------
# Command compat::clearsource
# ----------------------------------------------------------------------------
proc compat::clearsource {window} {
};# compat::clearsource

View File

@ -0,0 +1,520 @@
#
# tkdnd_generic.tcl --
#
# This file implements some utility procedures that are used by the TkDND
# package.
#
# This software is copyrighted by:
# George Petasis, National Centre for Scientific Research "Demokritos",
# Aghia Paraskevi, Athens, Greece.
# e-mail: petasis@iit.demokritos.gr
#
# The following terms apply to all files associated
# with the software unless explicitly disclaimed in individual files.
#
# The authors hereby grant permission to use, copy, modify, distribute,
# and license this software and its documentation for any purpose, provided
# that existing copyright notices are retained in all copies and that this
# notice is included verbatim in any distributions. No written agreement,
# license, or royalty fee is required for any of the authorized uses.
# Modifications to this software may be copyrighted by their authors
# and need not follow the licensing terms described here, provided that
# the new terms are clearly indicated on the first page of each file where
# they apply.
#
# IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
# FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
# ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
# DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
#
# THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE
# IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
# NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
# MODIFICATIONS.
#
namespace eval generic {
variable _types {}
variable _typelist {}
variable _codelist {}
variable _actionlist {}
variable _pressedkeys {}
variable _action {}
variable _common_drag_source_types {}
variable _common_drop_target_types {}
variable _drag_source {}
variable _drop_target {}
variable _last_mouse_root_x 0
variable _last_mouse_root_y 0
variable _tkdnd2platform
variable _platform2tkdnd
proc debug {msg} {
puts $msg
};# debug
proc initialise { } {
};# initialise
proc initialise_platform_to_tkdnd_types { types } {
variable _platform2tkdnd
variable _tkdnd2platform
set _platform2tkdnd [dict create {*}$types]
set _tkdnd2platform [dict create]
foreach type [dict keys $_platform2tkdnd] {
dict lappend _tkdnd2platform [dict get $_platform2tkdnd $type] $type
}
};# initialise_platform_to_tkdnd_types
proc initialise_tkdnd_to_platform_types { types } {
variable _tkdnd2platform
set _tkdnd2platform [dict create {*}$types]
};# initialise_tkdnd_to_platform_types
};# namespace generic
# ----------------------------------------------------------------------------
# Command generic::HandleEnter
# ----------------------------------------------------------------------------
proc generic::HandleEnter { drop_target drag_source typelist codelist
actionlist pressedkeys } {
variable _typelist; set _typelist $typelist
variable _pressedkeys; set _pressedkeys $pressedkeys
variable _action; set _action refuse_drop
variable _common_drag_source_types; set _common_drag_source_types {}
variable _common_drop_target_types; set _common_drop_target_types {}
variable _actionlist
variable _drag_source; set _drag_source $drag_source
variable _drop_target; set _drop_target {}
variable _actionlist; set _actionlist $actionlist
variable _codelist set _codelist $codelist
variable _last_mouse_root_x; set _last_mouse_root_x 0
variable _last_mouse_root_y; set _last_mouse_root_y 0
# debug "\n==============================================================="
# debug "generic::HandleEnter: drop_target=$drop_target,\
# drag_source=$drag_source,\
# typelist=$typelist"
# debug "generic::HandleEnter: ACTION: default"
return default
};# generic::HandleEnter
# ----------------------------------------------------------------------------
# Command generic::HandlePosition
# ----------------------------------------------------------------------------
proc generic::HandlePosition { drop_target drag_source pressedkeys
rootX rootY { time 0 } } {
variable _types
variable _typelist
variable _codelist
variable _actionlist
variable _pressedkeys
variable _action
variable _common_drag_source_types
variable _common_drop_target_types
variable _drag_source
variable _drop_target
variable _last_mouse_root_x; set _last_mouse_root_x $rootX
variable _last_mouse_root_y; set _last_mouse_root_y $rootY
# debug "generic::HandlePosition: drop_target=$drop_target,\
# _drop_target=$_drop_target, rootX=$rootX, rootY=$rootY"
if {![info exists _drag_source] && ![string length $_drag_source]} {
# debug "generic::HandlePosition: no or empty _drag_source:\
# return refuse_drop"
return refuse_drop
}
if {$drag_source ne "" && $drag_source ne $_drag_source} {
debug "generic position event from unexpected source: $_drag_source\
!= $drag_source"
return refuse_drop
}
set _pressedkeys $pressedkeys
## Does the new drop target support any of our new types?
# foreach {common_drag_source_types common_drop_target_types} \
# [GetWindowCommonTypes $drop_target $_typelist] {break}
foreach {drop_target common_drag_source_types common_drop_target_types} \
[FindWindowWithCommonTypes $drop_target $_typelist] {break}
set data [GetDroppedData $time]
# debug "\t($_drop_target) -> ($drop_target)"
if {$drop_target != $_drop_target} {
if {[string length $_drop_target]} {
## Call the <<DropLeave>> event.
# debug "\t<<DropLeave>> on $_drop_target"
set cmd [bind $_drop_target <<DropLeave>>]
if {[string length $cmd]} {
set cmd [string map [list %W $_drop_target %X $rootX %Y $rootY \
%CST \{$_common_drag_source_types\} \
%CTT \{$_common_drop_target_types\} \
%CPT \{[lindex [platform_independent_type [lindex $_common_drag_source_types 0]] 0]\} \
%ST \{$_typelist\} %TT \{$_types\} \
%A \{$_action\} %a \{$_actionlist\} \
%b \{$_pressedkeys\} %m \{$_pressedkeys\} \
%D \{\} %e <<DropLeave>> \
%L \{$_typelist\} %% % \
%t \{$_typelist\} %T \{[lindex $_common_drag_source_types 0]\} \
%c \{$_codelist\} %C \{[lindex $_codelist 0]\} \
] $cmd]
uplevel \#0 $cmd
}
}
set _drop_target $drop_target
set _action refuse_drop
if {[llength $common_drag_source_types]} {
set _action [lindex $_actionlist 0]
set _common_drag_source_types $common_drag_source_types
set _common_drop_target_types $common_drop_target_types
## Drop target supports at least one type. Send a <<DropEnter>>.
# puts "<<DropEnter>> -> $drop_target"
set cmd [bind $drop_target <<DropEnter>>]
if {[string length $cmd]} {
focus $drop_target
set cmd [string map [list %W $drop_target %X $rootX %Y $rootY \
%CST \{$_common_drag_source_types\} \
%CTT \{$_common_drop_target_types\} \
%CPT \{[lindex [platform_independent_type [lindex $_common_drag_source_types 0]] 0]\} \
%ST \{$_typelist\} %TT \{$_types\} \
%A $_action %a \{$_actionlist\} \
%b \{$_pressedkeys\} %m \{$_pressedkeys\} \
%D [list $data] %e <<DropEnter>> \
%L \{$_typelist\} %% % \
%t \{$_typelist\} %T \{[lindex $_common_drag_source_types 0]\} \
%c \{$_codelist\} %C \{[lindex $_codelist 0]\} \
] $cmd]
set _action [uplevel \#0 $cmd]
switch -exact -- $_action {
copy - move - link - ask - private - refuse_drop - default {}
default {set _action copy}
}
}
}
}
set _drop_target {}
if {[llength $common_drag_source_types]} {
set _common_drag_source_types $common_drag_source_types
set _common_drop_target_types $common_drop_target_types
set _drop_target $drop_target
## Drop target supports at least one type. Send a <<DropPosition>>.
set cmd [bind $drop_target <<DropPosition>>]
if {[string length $cmd]} {
set cmd [string map [list %W $drop_target %X $rootX %Y $rootY \
%CST \{$_common_drag_source_types\} \
%CTT \{$_common_drop_target_types\} \
%CPT \{[lindex [platform_independent_type [lindex $_common_drag_source_types 0]] 0]\} \
%ST \{$_typelist\} %TT \{$_types\} \
%A $_action %a \{$_actionlist\} \
%b \{$_pressedkeys\} %m \{$_pressedkeys\} \
%D [list $data] %e <<DropPosition>> \
%L \{$_typelist\} %% % \
%t \{$_typelist\} %T \{[lindex $_common_drag_source_types 0]\} \
%c \{$_codelist\} %C \{[lindex $_codelist 0]\} \
] $cmd]
set _action [uplevel \#0 $cmd]
}
}
# Return values: copy, move, link, ask, private, refuse_drop, default
# debug "generic::HandlePosition: ACTION: $_action"
switch -exact -- $_action {
copy - move - link - ask - private - refuse_drop - default {}
default {set _action copy}
}
return $_action
};# generic::HandlePosition
# ----------------------------------------------------------------------------
# Command generic::HandleLeave
# ----------------------------------------------------------------------------
proc generic::HandleLeave { } {
variable _types
variable _typelist
variable _codelist
variable _actionlist
variable _pressedkeys
variable _action
variable _common_drag_source_types
variable _common_drop_target_types
variable _drag_source
variable _drop_target
variable _last_mouse_root_x
variable _last_mouse_root_y
if {![info exists _drop_target]} {set _drop_target {}}
# debug "generic::HandleLeave: _drop_target=$_drop_target"
if {[info exists _drop_target] && [string length $_drop_target]} {
set cmd [bind $_drop_target <<DropLeave>>]
if {[string length $cmd]} {
set cmd [string map [list %W $_drop_target \
%X $_last_mouse_root_x %Y $_last_mouse_root_y \
%CST \{$_common_drag_source_types\} \
%CTT \{$_common_drop_target_types\} \
%CPT \{[lindex [platform_independent_type [lindex $_common_drag_source_types 0]] 0]\} \
%ST \{$_typelist\} %TT \{$_types\} \
%A \{$_action\} %a \{$_actionlist\} \
%b \{$_pressedkeys\} %m \{$_pressedkeys\} \
%D \{\} %e <<DropLeave>> \
%L \{$_typelist\} %% % \
%t \{$_typelist\} %T \{[lindex $_common_drag_source_types 0]\} \
%c \{$_codelist\} %C \{[lindex $_codelist 0]\} \
] $cmd]
set _action [uplevel \#0 $cmd]
}
}
foreach var {_types _typelist _actionlist _pressedkeys _action
_common_drag_source_types _common_drop_target_types
_drag_source _drop_target} {
set $var {}
}
};# generic::HandleLeave
# ----------------------------------------------------------------------------
# Command generic::HandleDrop
# ----------------------------------------------------------------------------
proc generic::HandleDrop {drop_target drag_source pressedkeys rootX rootY time } {
variable _types
variable _typelist
variable _codelist
variable _actionlist
variable _pressedkeys
variable _action
variable _common_drag_source_types
variable _common_drop_target_types
variable _drag_source
variable _drop_target
variable _last_mouse_root_x
variable _last_mouse_root_y
variable _last_mouse_root_x; set _last_mouse_root_x $rootX
variable _last_mouse_root_y; set _last_mouse_root_y $rootY
set _pressedkeys $pressedkeys
# puts "generic::HandleDrop: $time"
if {![info exists _drag_source] && ![string length $_drag_source]} {
return refuse_drop
}
if {![info exists _drop_target] && ![string length $_drop_target]} {
return refuse_drop
}
if {![llength $_common_drag_source_types]} {return refuse_drop}
## Get the dropped data.
set data [GetDroppedData $time]
## Try to select the most specific <<Drop>> event.
foreach type [concat $_common_drag_source_types $_common_drop_target_types] {
set type [platform_independent_type $type]
set cmd [bind $_drop_target <<Drop:$type>>]
if {[string length $cmd]} {
set cmd [string map [list %W $_drop_target %X $rootX %Y $rootY \
%CST \{$_common_drag_source_types\} \
%CTT \{$_common_drop_target_types\} \
%CPT \{[lindex [platform_independent_type [lindex $_common_drag_source_types 0]] 0]\} \
%ST \{$_typelist\} %TT \{$_types\} \
%A $_action %a \{$_actionlist\} \
%b \{$_pressedkeys\} %m \{$_pressedkeys\} \
%D [list $data] %e <<Drop:$type>> \
%L \{$_typelist\} %% % \
%t \{$_typelist\} %T \{[lindex $_common_drag_source_types 0]\} \
%c \{$_codelist\} %C \{[lindex $_codelist 0]\} \
] $cmd]
set _action [uplevel \#0 $cmd]
# Return values: copy, move, link, ask, private, refuse_drop
switch -exact -- $_action {
copy - move - link - ask - private - refuse_drop - default {}
default {set _action copy}
}
return $_action
}
}
set cmd [bind $_drop_target <<Drop>>]
if {[string length $cmd]} {
set cmd [string map [list %W $_drop_target %X $rootX %Y $rootY \
%CST \{$_common_drag_source_types\} \
%CTT \{$_common_drop_target_types\} \
%CPT \{[lindex [platform_independent_type [lindex $_common_drag_source_types 0]] 0]\} \
%ST \{$_typelist\} %TT \{$_types\} \
%A $_action %a \{$_actionlist\} \
%b \{$_pressedkeys\} %m \{$_pressedkeys\} \
%D [list $data] %e <<Drop>> \
%L \{$_typelist\} %% % \
%t \{$_typelist\} %T \{[lindex $_common_drag_source_types 0]\} \
%c \{$_codelist\} %C \{[lindex $_codelist 0]\} \
] $cmd]
set _action [uplevel \#0 $cmd]
}
# Return values: copy, move, link, ask, private, refuse_drop
switch -exact -- $_action {
copy - move - link - ask - private - refuse_drop - default {}
default {set _action copy}
}
return $_action
};# generic::HandleDrop
# ----------------------------------------------------------------------------
# Command generic::GetWindowCommonTypes
# ----------------------------------------------------------------------------
proc generic::GetWindowCommonTypes { win typelist } {
set types [bind $win <<DropTargetTypes>>]
# debug ">> Accepted types: $win $_types"
set common_drag_source_types {}
set common_drop_target_types {}
if {[llength $types]} {
## Examine the drop target types, to find at least one match with the drag
## source types...
set supported_types [supported_types $typelist]
foreach type $types {
foreach matched [lsearch -glob -all -inline $supported_types $type] {
## Drop target supports this type.
lappend common_drag_source_types $matched
lappend common_drop_target_types $type
}
}
}
list $common_drag_source_types $common_drop_target_types
};# generic::GetWindowCommonTypes
# ----------------------------------------------------------------------------
# Command generic::FindWindowWithCommonTypes
# ----------------------------------------------------------------------------
proc generic::FindWindowWithCommonTypes { win typelist } {
set toplevel [winfo toplevel $win]
while {![string equal $win $toplevel]} {
foreach {common_drag_source_types common_drop_target_types} \
[GetWindowCommonTypes $win $typelist] {break}
if {[llength $common_drag_source_types]} {
return [list $win $common_drag_source_types $common_drop_target_types]
}
set win [winfo parent $win]
}
## We have reached the toplevel, which may be also a target (SF Bug #30)
foreach {common_drag_source_types common_drop_target_types} \
[GetWindowCommonTypes $win $typelist] {break}
if {[llength $common_drag_source_types]} {
return [list $win $common_drag_source_types $common_drop_target_types]
}
return { {} {} {} }
};# generic::FindWindowWithCommonTypes
# ----------------------------------------------------------------------------
# Command generic::GetDroppedData
# ----------------------------------------------------------------------------
proc generic::GetDroppedData { time } {
variable _dropped_data
return $_dropped_data
};# generic::GetDroppedData
# ----------------------------------------------------------------------------
# Command generic::SetDroppedData
# ----------------------------------------------------------------------------
proc generic::SetDroppedData { data } {
variable _dropped_data
set _dropped_data $data
};# generic::SetDroppedData
# ----------------------------------------------------------------------------
# Command generic::GetDragSource
# ----------------------------------------------------------------------------
proc generic::GetDragSource { } {
variable _drag_source
return $_drag_source
};# generic::GetDragSource
# ----------------------------------------------------------------------------
# Command generic::GetDropTarget
# ----------------------------------------------------------------------------
proc generic::GetDropTarget { } {
variable _drop_target
return $_drop_target
};# generic::GetDropTarget
# ----------------------------------------------------------------------------
# Command generic::GetDragSourceCommonTypes
# ----------------------------------------------------------------------------
proc generic::GetDragSourceCommonTypes { } {
variable _common_drag_source_types
return $_common_drag_source_types
};# generic::GetDragSourceCommonTypes
# ----------------------------------------------------------------------------
# Command generic::GetDropTargetCommonTypes
# ----------------------------------------------------------------------------
proc generic::GetDropTargetCommonTypes { } {
variable _common_drag_source_types
return $_common_drag_source_types
};# generic::GetDropTargetCommonTypes
# ----------------------------------------------------------------------------
# Command generic::platform_specific_types
# ----------------------------------------------------------------------------
proc generic::platform_specific_types { types } {
set new_types {}
foreach type $types {
set new_types [concat $new_types [platform_specific_type $type]]
}
return $new_types
}; # generic::platform_specific_types
# ----------------------------------------------------------------------------
# Command generic::platform_specific_type
# ----------------------------------------------------------------------------
proc generic::platform_specific_type { type } {
variable _tkdnd2platform
if {[dict exists $_tkdnd2platform $type]} {
return [dict get $_tkdnd2platform $type]
}
list $type
}; # generic::platform_specific_type
# ----------------------------------------------------------------------------
# Command tkdnd::platform_independent_types
# ----------------------------------------------------------------------------
proc ::tkdnd::platform_independent_types { types } {
set new_types {}
foreach type $types {
set new_types [concat $new_types [platform_independent_type $type]]
}
return $new_types
}; # tkdnd::platform_independent_types
# ----------------------------------------------------------------------------
# Command generic::platform_independent_type
# ----------------------------------------------------------------------------
proc generic::platform_independent_type { type } {
variable _platform2tkdnd
if {[dict exists $_platform2tkdnd $type]} {
return [dict get $_platform2tkdnd $type]
}
return $type
}; # generic::platform_independent_type
# ----------------------------------------------------------------------------
# Command generic::supported_types
# ----------------------------------------------------------------------------
proc generic::supported_types { types } {
set new_types {}
foreach type $types {
if {[supported_type $type]} {lappend new_types $type}
}
return $new_types
}; # generic::supported_types
# ----------------------------------------------------------------------------
# Command generic::supported_type
# ----------------------------------------------------------------------------
proc generic::supported_type { type } {
variable _platform2tkdnd
if {[dict exists $_platform2tkdnd $type]} {
return 1
}
return 0
}; # generic::supported_type

View File

@ -0,0 +1,144 @@
#
# tkdnd_macosx.tcl --
#
# This file implements some utility procedures that are used by the TkDND
# package.
# This software is copyrighted by:
# Georgios Petasis, Athens, Greece.
# e-mail: petasisg@yahoo.gr, petasis@iit.demokritos.gr
#
# Mac portions (c) 2009 Kevin Walzer/WordTech Communications LLC,
# kw@codebykevin.com
#
#
# The following terms apply to all files associated
# with the software unless explicitly disclaimed in individual files.
#
# The authors hereby grant permission to use, copy, modify, distribute,
# and license this software and its documentation for any purpose, provided
# that existing copyright notices are retained in all copies and that this
# notice is included verbatim in any distributions. No written agreement,
# license, or royalty fee is required for any of the authorized uses.
# Modifications to this software may be copyrighted by their authors
# and need not follow the licensing terms described here, provided that
# the new terms are clearly indicated on the first page of each file where
# they apply.
#
# IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
# FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
# ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
# DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
#
# THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE
# IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
# NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
# MODIFICATIONS.
#
#basic API for Mac Drag and Drop
#two data types supported: strings and file paths
#two commands at C level: ::tkdnd::macdnd::registerdragwidget, ::tkdnd::macdnd::unregisterdragwidget
#data retrieval mechanism: text or file paths are copied from drag clipboard to system clipboard and retrieved via [clipboard get]; array of file paths is converted to single tab-separated string, can be split into Tcl list
if {[tk windowingsystem] eq "aqua" && "AppKit" ni [winfo server .]} {
error {TkAqua Cocoa required}
}
namespace eval macdnd {
proc initialise { } {
## Mapping from platform types to TkDND types...
::tkdnd::generic::initialise_platform_to_tkdnd_types [list \
NSPasteboardTypeString DND_Text \
NSFilenamesPboardType DND_Files \
NSPasteboardTypeHTML DND_HTML \
]
};# initialise
};# namespace macdnd
# ----------------------------------------------------------------------------
# Command macdnd::HandleEnter
# ----------------------------------------------------------------------------
proc macdnd::HandleEnter { path drag_source typelist { data {} } } {
variable _pressedkeys
variable _actionlist
set _pressedkeys 1
set _actionlist { copy move link ask private }
::tkdnd::generic::SetDroppedData $data
::tkdnd::generic::HandleEnter $path $drag_source $typelist $typelist \
$_actionlist $_pressedkeys
};# macdnd::HandleEnter
# ----------------------------------------------------------------------------
# Command macdnd::HandlePosition
# ----------------------------------------------------------------------------
proc macdnd::HandlePosition { drop_target rootX rootY {drag_source {}} } {
variable _pressedkeys
variable _last_mouse_root_x; set _last_mouse_root_x $rootX
variable _last_mouse_root_y; set _last_mouse_root_y $rootY
::tkdnd::generic::HandlePosition $drop_target $drag_source \
$_pressedkeys $rootX $rootY
};# macdnd::HandlePosition
# ----------------------------------------------------------------------------
# Command macdnd::HandleLeave
# ----------------------------------------------------------------------------
proc macdnd::HandleLeave { args } {
::tkdnd::generic::HandleLeave
};# macdnd::HandleLeave
# ----------------------------------------------------------------------------
# Command macdnd::HandleDrop
# ----------------------------------------------------------------------------
proc macdnd::HandleDrop { drop_target data args } {
variable _pressedkeys
variable _last_mouse_root_x
variable _last_mouse_root_y
## Get the dropped data...
::tkdnd::generic::SetDroppedData $data
::tkdnd::generic::HandleDrop {} {} $_pressedkeys \
$_last_mouse_root_x $_last_mouse_root_y 0
};# macdnd::HandleDrop
# ----------------------------------------------------------------------------
# Command macdnd::GetDragSourceCommonTypes
# ----------------------------------------------------------------------------
proc macdnd::GetDragSourceCommonTypes { } {
::tkdnd::generic::GetDragSourceCommonTypes
};# macdnd::GetDragSourceCommonTypes
# ----------------------------------------------------------------------------
# Command macdnd::platform_specific_types
# ----------------------------------------------------------------------------
proc macdnd::platform_specific_types { types } {
::tkdnd::generic::platform_specific_types $types
}; # macdnd::platform_specific_types
# ----------------------------------------------------------------------------
# Command macdnd::platform_specific_type
# ----------------------------------------------------------------------------
proc macdnd::platform_specific_type { type } {
::tkdnd::generic::platform_specific_type $type
}; # macdnd::platform_specific_type
# ----------------------------------------------------------------------------
# Command tkdnd::platform_independent_types
# ----------------------------------------------------------------------------
proc ::tkdnd::platform_independent_types { types } {
::tkdnd::generic::platform_independent_types $types
}; # tkdnd::platform_independent_types
# ----------------------------------------------------------------------------
# Command macdnd::platform_independent_type
# ----------------------------------------------------------------------------
proc macdnd::platform_independent_type { type } {
::tkdnd::generic::platform_independent_type $type
}; # macdnd::platform_independent_type

View File

@ -0,0 +1,810 @@
#
# tkdnd_unix.tcl --
#
# This file implements some utility procedures that are used by the TkDND
# package.
#
# This software is copyrighted by:
# George Petasis, National Centre for Scientific Research "Demokritos",
# Aghia Paraskevi, Athens, Greece.
# e-mail: petasis@iit.demokritos.gr
#
# The following terms apply to all files associated
# with the software unless explicitly disclaimed in individual files.
#
# The authors hereby grant permission to use, copy, modify, distribute,
# and license this software and its documentation for any purpose, provided
# that existing copyright notices are retained in all copies and that this
# notice is included verbatim in any distributions. No written agreement,
# license, or royalty fee is required for any of the authorized uses.
# Modifications to this software may be copyrighted by their authors
# and need not follow the licensing terms described here, provided that
# the new terms are clearly indicated on the first page of each file where
# they apply.
#
# IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
# FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
# ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
# DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
#
# THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE
# IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
# NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
# MODIFICATIONS.
#
namespace eval xdnd {
variable _dragging 0
proc initialise { } {
## Mapping from platform types to TkDND types...
::tkdnd::generic::initialise_platform_to_tkdnd_types [list \
text/plain\;charset=utf-8 DND_Text \
UTF8_STRING DND_Text \
text/plain DND_Text \
STRING DND_Text \
TEXT DND_Text \
COMPOUND_TEXT DND_Text \
text/uri-list DND_Files \
text/html\;charset=utf-8 DND_HTML \
text/html DND_HTML \
application/x-color DND_Color \
]
};# initialise
};# namespace xdnd
# ----------------------------------------------------------------------------
# Command xdnd::HandleXdndEnter
# ----------------------------------------------------------------------------
proc xdnd::HandleXdndEnter { path drag_source typelist time { data {} } } {
variable _pressedkeys
variable _actionlist
variable _typelist
set _pressedkeys 1
set _actionlist { copy move link ask private }
set _typelist $typelist
# puts "xdnd::HandleXdndEnter: $time"
::tkdnd::generic::SetDroppedData $data
::tkdnd::generic::HandleEnter $path $drag_source $typelist $typelist \
$_actionlist $_pressedkeys
};# xdnd::HandleXdndEnter
# ----------------------------------------------------------------------------
# Command xdnd::HandleXdndPosition
# ----------------------------------------------------------------------------
proc xdnd::HandleXdndPosition { drop_target rootX rootY time {drag_source {}} } {
variable _pressedkeys
variable _typelist
variable _last_mouse_root_x; set _last_mouse_root_x $rootX
variable _last_mouse_root_y; set _last_mouse_root_y $rootY
# puts "xdnd::HandleXdndPosition: $time"
## Get the dropped data...
catch {
::tkdnd::generic::SetDroppedData [GetPositionData $drop_target $_typelist $time]
}
::tkdnd::generic::HandlePosition $drop_target $drag_source \
$_pressedkeys $rootX $rootY
};# xdnd::HandleXdndPosition
# ----------------------------------------------------------------------------
# Command xdnd::HandleXdndLeave
# ----------------------------------------------------------------------------
proc xdnd::HandleXdndLeave { } {
::tkdnd::generic::HandleLeave
};# xdnd::HandleXdndLeave
# ----------------------------------------------------------------------------
# Command xdnd::_HandleXdndDrop
# ----------------------------------------------------------------------------
proc xdnd::HandleXdndDrop { time } {
variable _pressedkeys
variable _last_mouse_root_x
variable _last_mouse_root_y
## Get the dropped data...
::tkdnd::generic::SetDroppedData [GetDroppedData \
[::tkdnd::generic::GetDragSource] [::tkdnd::generic::GetDropTarget] \
[::tkdnd::generic::GetDragSourceCommonTypes] $time]
::tkdnd::generic::HandleDrop {} {} $_pressedkeys \
$_last_mouse_root_x $_last_mouse_root_y $time
};# xdnd::HandleXdndDrop
# ----------------------------------------------------------------------------
# Command xdnd::GetPositionData
# ----------------------------------------------------------------------------
proc xdnd::GetPositionData { drop_target typelist time } {
foreach {drop_target common_drag_source_types common_drop_target_types} \
[::tkdnd::generic::FindWindowWithCommonTypes $drop_target $typelist] {break}
GetDroppedData [::tkdnd::generic::GetDragSource] $drop_target \
$common_drag_source_types $time
};# xdnd::GetPositionData
# ----------------------------------------------------------------------------
# Command xdnd::GetDroppedData
# ----------------------------------------------------------------------------
proc xdnd::GetDroppedData { _drag_source _drop_target _common_drag_source_types time } {
if {![llength $_common_drag_source_types]} {
error "no common data types between the drag source and drop target widgets"
}
## Is drag source in this application?
if {[catch {winfo pathname -displayof $_drop_target $_drag_source} p]} {
set _use_tk_selection 0
} else {
set _use_tk_selection 1
}
foreach type $_common_drag_source_types {
# puts "TYPE: $type ($_drop_target)"
# _get_selection $_drop_target $time $type
if {$_use_tk_selection} {
if {![catch {
selection get -displayof $_drop_target -selection XdndSelection \
-type $type
} result options]} {
return [normalise_data $type $result]
}
} else {
# puts "_selection_get -displayof $_drop_target -selection XdndSelection \
# -type $type -time $time"
#after 100 [list focus -force $_drop_target]
#after 50 [list raise [winfo toplevel $_drop_target]]
if {![catch {
_selection_get -displayof $_drop_target -selection XdndSelection \
-type $type -time $time
} result options]} {
return [normalise_data $type $result]
}
}
}
return -options $options $result
};# xdnd::GetDroppedData
# ----------------------------------------------------------------------------
# Command xdnd::platform_specific_types
# ----------------------------------------------------------------------------
proc xdnd::platform_specific_types { types } {
::tkdnd::generic::platform_specific_types $types
}; # xdnd::platform_specific_types
# ----------------------------------------------------------------------------
# Command xdnd::platform_specific_type
# ----------------------------------------------------------------------------
proc xdnd::platform_specific_type { type } {
::tkdnd::generic::platform_specific_type $type
}; # xdnd::platform_specific_type
# ----------------------------------------------------------------------------
# Command tkdnd::platform_independent_types
# ----------------------------------------------------------------------------
proc ::tkdnd::platform_independent_types { types } {
::tkdnd::generic::platform_independent_types $types
}; # tkdnd::platform_independent_types
# ----------------------------------------------------------------------------
# Command xdnd::platform_independent_type
# ----------------------------------------------------------------------------
proc xdnd::platform_independent_type { type } {
::tkdnd::generic::platform_independent_type $type
}; # xdnd::platform_independent_type
# ----------------------------------------------------------------------------
# Command xdnd::_normalise_data
# ----------------------------------------------------------------------------
proc xdnd::normalise_data { type data } {
# Tk knows how to interpret the following types:
# STRING, TEXT, COMPOUND_TEXT
# UTF8_STRING
# Else, it returns a list of 8 or 32 bit numbers...
switch -glob $type {
STRING - UTF8_STRING - TEXT - COMPOUND_TEXT {return $data}
text/html {
if {[catch {
encoding convertfrom unicode $data
} string]} {
set string $data
}
return [string map {\r\n \n} $string]
}
text/html\;charset=utf-8 -
text/plain\;charset=utf-8 -
text/plain {
if {[catch {
encoding convertfrom utf-8 [tkdnd::bytes_to_string $data]
} string]} {
set string $data
}
return [string map {\r\n \n} $string]
}
text/uri-list* {
if {[catch {
encoding convertfrom utf-8 [tkdnd::bytes_to_string $data]
} string]} {
set string $data
}
## Get rid of \r\n
set string [string trim [string map {\r\n \n} $string]]
set files {}
foreach quoted_file [split $string] {
set file [tkdnd::urn_unquote $quoted_file]
switch -glob $file {
\#* {}
file://* {lappend files [string range $file 7 end]}
ftp://* -
https://* -
http://* {lappend files $quoted_file}
default {lappend files $file}
}
}
return $files
}
application/x-color {
return $data
}
text/x-moz-url -
application/q-iconlist -
default {return $data}
}
}; # xdnd::normalise_data
#############################################################################
##
## XDND drag implementation
##
#############################################################################
# ----------------------------------------------------------------------------
# Command xdnd::_selection_ownership_lost
# ----------------------------------------------------------------------------
proc xdnd::_selection_ownership_lost {} {
variable _dragging
set _dragging 0
};# _selection_ownership_lost
# ----------------------------------------------------------------------------
# Command xdnd::_dodragdrop
# ----------------------------------------------------------------------------
proc xdnd::_dodragdrop { source actions types data button } {
variable _dragging
# puts "xdnd::_dodragdrop: source: $source, actions: $actions, types: $types,\
# data: \"$data\", button: $button"
if {$_dragging} {
## We are in the middle of another drag operation...
error "another drag operation in progress"
}
variable _dodragdrop_drag_source $source
variable _dodragdrop_drop_target 0
variable _dodragdrop_drop_target_proxy 0
variable _dodragdrop_actions $actions
variable _dodragdrop_action_descriptions $actions
variable _dodragdrop_actions_len [llength $actions]
variable _dodragdrop_types $types
variable _dodragdrop_types_len [llength $types]
variable _dodragdrop_data $data
variable _dodragdrop_transfer_data {}
variable _dodragdrop_button $button
variable _dodragdrop_time 0
variable _dodragdrop_default_action refuse_drop
variable _dodragdrop_waiting_status 0
variable _dodragdrop_drop_target_accepts_drop 0
variable _dodragdrop_drop_target_accepts_action refuse_drop
variable _dodragdrop_current_cursor $_dodragdrop_default_action
variable _dodragdrop_drop_occured 0
variable _dodragdrop_selection_requestor 0
##
## If we have more than 3 types, the property XdndTypeList must be set on
## the drag source widget...
##
if {$_dodragdrop_types_len > 3} {
_announce_type_list $_dodragdrop_drag_source $_dodragdrop_types
}
##
## Announce the actions & their descriptions on the XdndActionList &
## XdndActionDescription properties...
##
_announce_action_list $_dodragdrop_drag_source $_dodragdrop_actions \
$_dodragdrop_action_descriptions
##
## Arrange selection handlers for our drag source, and all the supported types
##
registerSelectionHandler $source $types
##
## Step 1: When a drag begins, the source takes ownership of XdndSelection.
##
selection own -command ::tkdnd::xdnd::_selection_ownership_lost \
-selection XdndSelection $source
set _dragging 1
## Grab the mouse pointer...
_grab_pointer $source $_dodragdrop_default_action
## Register our generic event handler...
# The generic event callback will report events by modifying variable
# ::xdnd::_dodragdrop_event: a dict with event information will be set as
# the value of the variable...
_register_generic_event_handler
## Set a timeout for debugging purposes...
# after 60000 {set ::tkdnd::xdnd::_dragging 0}
tkwait variable ::tkdnd::xdnd::_dragging
_SendXdndLeave
set _dragging 0
_ungrab_pointer $source
_unregister_generic_event_handler
catch {selection clear -selection XdndSelection}
unregisterSelectionHandler $source $types
return $_dodragdrop_drop_target_accepts_action
};# xdnd::_dodragdrop
# ----------------------------------------------------------------------------
# Command xdnd::_process_drag_events
# ----------------------------------------------------------------------------
proc xdnd::_process_drag_events {event} {
# The return value from proc is normally 0. A non-zero return value indicates
# that the event is not to be handled further; that is, proc has done all
# processing that is to be allowed for the event
variable _dragging
if {!$_dragging} {return 0}
# puts $event
variable _dodragdrop_time
set time [dict get $event time]
set type [dict get $event type]
if {$time < $_dodragdrop_time && ![string equal $type SelectionRequest]} {
return 0
}
set _dodragdrop_time $time
variable _dodragdrop_drag_source
variable _dodragdrop_drop_target
variable _dodragdrop_drop_target_proxy
variable _dodragdrop_default_action
switch $type {
MotionNotify {
set rootx [dict get $event x_root]
set rooty [dict get $event y_root]
set window [_find_drop_target_window $_dodragdrop_drag_source \
$rootx $rooty]
if {[string length $window]} {
## Examine the modifiers to suggest an action...
set _dodragdrop_default_action [_default_action $event]
## Is it a Tk widget?
# set path [winfo containing $rootx $rooty]
# puts "Window under mouse: $window ($path)"
if {$_dodragdrop_drop_target != $window} {
## Send XdndLeave to $_dodragdrop_drop_target
_SendXdndLeave
## Is there a proxy? If not, _find_drop_target_proxy returns the
## target window, so we always get a valid "proxy".
set proxy [_find_drop_target_proxy $_dodragdrop_drag_source $window]
## Send XdndEnter to $window
_SendXdndEnter $window $proxy
## Send XdndPosition to $_dodragdrop_drop_target
_SendXdndPosition $rootx $rooty $_dodragdrop_default_action
} else {
## Send XdndPosition to $_dodragdrop_drop_target
_SendXdndPosition $rootx $rooty $_dodragdrop_default_action
}
} else {
## No window under the mouse. Send XdndLeave to $_dodragdrop_drop_target
_SendXdndLeave
}
}
ButtonPress {
}
ButtonRelease {
variable _dodragdrop_button
set button [dict get $event button]
if {$button == $_dodragdrop_button} {
## The button that initiated the drag was released. Trigger drop...
_SendXdndDrop
}
return 1
}
KeyPress {
}
KeyRelease {
set keysym [dict get $event keysym]
switch $keysym {
Escape {
## The user has pressed escape. Abort...
if {$_dragging} {set _dragging 0}
}
}
}
SelectionRequest {
variable _dodragdrop_selection_requestor
variable _dodragdrop_selection_property
variable _dodragdrop_selection_selection
variable _dodragdrop_selection_target
variable _dodragdrop_selection_time
set _dodragdrop_selection_requestor [dict get $event requestor]
set _dodragdrop_selection_property [dict get $event property]
set _dodragdrop_selection_selection [dict get $event selection]
set _dodragdrop_selection_target [dict get $event target]
set _dodragdrop_selection_time $time
return 0
}
default {
return 0
}
}
return 0
};# _process_drag_events
# ----------------------------------------------------------------------------
# Command xdnd::_SendXdndEnter
# ----------------------------------------------------------------------------
proc xdnd::_SendXdndEnter {window proxy} {
variable _dodragdrop_drag_source
variable _dodragdrop_drop_target
variable _dodragdrop_drop_target_proxy
variable _dodragdrop_types
variable _dodragdrop_waiting_status
variable _dodragdrop_drop_occured
if {$_dodragdrop_drop_target > 0} _SendXdndLeave
if {$_dodragdrop_drop_occured} return
set _dodragdrop_drop_target $window
set _dodragdrop_drop_target_proxy $proxy
set _dodragdrop_waiting_status 0
if {$_dodragdrop_drop_target < 1} return
# puts "XdndEnter: $_dodragdrop_drop_target $_dodragdrop_drop_target_proxy"
_send_XdndEnter $_dodragdrop_drag_source $_dodragdrop_drop_target \
$_dodragdrop_drop_target_proxy $_dodragdrop_types
};# xdnd::_SendXdndEnter
# ----------------------------------------------------------------------------
# Command xdnd::_SendXdndPosition
# ----------------------------------------------------------------------------
proc xdnd::_SendXdndPosition {rootx rooty action} {
variable _dodragdrop_drag_source
variable _dodragdrop_drop_target
if {$_dodragdrop_drop_target < 1} return
variable _dodragdrop_drop_occured
if {$_dodragdrop_drop_occured} return
variable _dodragdrop_drop_target_proxy
variable _dodragdrop_waiting_status
## Arrange a new XdndPosition, to be send periodically...
variable _dodragdrop_xdnd_position_heartbeat
catch {after cancel $_dodragdrop_xdnd_position_heartbeat}
set _dodragdrop_xdnd_position_heartbeat [after 200 \
[list ::tkdnd::xdnd::_SendXdndPosition $rootx $rooty $action]]
if {$_dodragdrop_waiting_status} {return}
# puts "XdndPosition: $_dodragdrop_drop_target $rootx $rooty $action"
_send_XdndPosition $_dodragdrop_drag_source $_dodragdrop_drop_target \
$_dodragdrop_drop_target_proxy $rootx $rooty $action
set _dodragdrop_waiting_status 1
};# xdnd::_SendXdndPosition
# ----------------------------------------------------------------------------
# Command xdnd::_HandleXdndStatus
# ----------------------------------------------------------------------------
proc xdnd::_HandleXdndStatus {event} {
variable _dodragdrop_drop_target
variable _dodragdrop_waiting_status
variable _dodragdrop_drop_target_accepts_drop
variable _dodragdrop_drop_target_accepts_action
set _dodragdrop_waiting_status 0
foreach key {target accept want_position action x y w h} {
set $key [dict get $event $key]
}
set _dodragdrop_drop_target_accepts_drop $accept
set _dodragdrop_drop_target_accepts_action $action
if {$_dodragdrop_drop_target < 1} return
variable _dodragdrop_drop_occured
if {$_dodragdrop_drop_occured} return
_update_cursor
# puts "XdndStatus: $event"
};# xdnd::_HandleXdndStatus
# ----------------------------------------------------------------------------
# Command xdnd::_HandleXdndFinished
# ----------------------------------------------------------------------------
proc xdnd::_HandleXdndFinished {event} {
variable _dodragdrop_xdnd_finished_event_after_id
catch {after cancel $_dodragdrop_xdnd_finished_event_after_id}
set _dodragdrop_xdnd_finished_event_after_id {}
variable _dodragdrop_drop_target
set _dodragdrop_drop_target 0
variable _dragging
if {$_dragging} {set _dragging 0}
variable _dodragdrop_drop_target_accepts_drop
variable _dodragdrop_drop_target_accepts_action
if {[dict size $event]} {
foreach key {target accept action} {
set $key [dict get $event $key]
}
set _dodragdrop_drop_target_accepts_drop $accept
set _dodragdrop_drop_target_accepts_action $action
} else {
set _dodragdrop_drop_target_accepts_drop 0
}
if {!$_dodragdrop_drop_target_accepts_drop} {
set _dodragdrop_drop_target_accepts_action refuse_drop
}
# puts "XdndFinished: $event"
};# xdnd::_HandleXdndFinished
# ----------------------------------------------------------------------------
# Command xdnd::_SendXdndLeave
# ----------------------------------------------------------------------------
proc xdnd::_SendXdndLeave {} {
variable _dodragdrop_drag_source
variable _dodragdrop_drop_target
if {$_dodragdrop_drop_target < 1} return
variable _dodragdrop_drop_target_proxy
# puts "XdndLeave: $_dodragdrop_drop_target"
_send_XdndLeave $_dodragdrop_drag_source $_dodragdrop_drop_target \
$_dodragdrop_drop_target_proxy
set _dodragdrop_drop_target 0
variable _dodragdrop_drop_target_accepts_drop
variable _dodragdrop_drop_target_accepts_action
set _dodragdrop_drop_target_accepts_drop 0
set _dodragdrop_drop_target_accepts_action refuse_drop
variable _dodragdrop_drop_occured
if {$_dodragdrop_drop_occured} return
_update_cursor
};# xdnd::_SendXdndLeave
# ----------------------------------------------------------------------------
# Command xdnd::_SendXdndDrop
# ----------------------------------------------------------------------------
proc xdnd::_SendXdndDrop {} {
variable _dodragdrop_drag_source
variable _dodragdrop_drop_target
if {$_dodragdrop_drop_target < 1} {
## The mouse has been released over a widget that does not accept drops.
_HandleXdndFinished {}
return
}
variable _dodragdrop_drop_occured
if {$_dodragdrop_drop_occured} {return}
variable _dodragdrop_drop_target_proxy
variable _dodragdrop_drop_target_accepts_drop
variable _dodragdrop_drop_target_accepts_action
set _dodragdrop_drop_occured 1
_update_cursor clock
if {!$_dodragdrop_drop_target_accepts_drop} {
_SendXdndLeave
_HandleXdndFinished {}
return
}
# puts "XdndDrop: $_dodragdrop_drop_target"
variable _dodragdrop_drop_timestamp
set _dodragdrop_drop_timestamp [_send_XdndDrop \
$_dodragdrop_drag_source $_dodragdrop_drop_target \
$_dodragdrop_drop_target_proxy]
set _dodragdrop_drop_target 0
# puts "XdndDrop: $_dodragdrop_drop_target"
## Arrange a timeout for receiving XdndFinished...
variable _dodragdrop_xdnd_finished_event_after_id
set _dodragdrop_xdnd_finished_event_after_id \
[after 10000 [list ::tkdnd::xdnd::_HandleXdndFinished {}]]
};# xdnd::_SendXdndDrop
# ----------------------------------------------------------------------------
# Command xdnd::_update_cursor
# ----------------------------------------------------------------------------
proc xdnd::_update_cursor { {cursor {}}} {
# puts "_update_cursor $cursor"
variable _dodragdrop_current_cursor
variable _dodragdrop_drag_source
variable _dodragdrop_drop_target_accepts_drop
variable _dodragdrop_drop_target_accepts_action
if {![string length $cursor]} {
set cursor refuse_drop
if {$_dodragdrop_drop_target_accepts_drop} {
set cursor $_dodragdrop_drop_target_accepts_action
}
}
if {![string equal $cursor $_dodragdrop_current_cursor]} {
_set_pointer_cursor $_dodragdrop_drag_source $cursor
set _dodragdrop_current_cursor $cursor
}
};# xdnd::_update_cursor
# ----------------------------------------------------------------------------
# Command xdnd::_default_action
# ----------------------------------------------------------------------------
proc xdnd::_default_action {event} {
variable _dodragdrop_actions
variable _dodragdrop_actions_len
if {$_dodragdrop_actions_len == 1} {return [lindex $_dodragdrop_actions 0]}
set alt [dict get $event Alt]
set shift [dict get $event Shift]
set control [dict get $event Control]
if {$shift && $control && [lsearch $_dodragdrop_actions link] != -1} {
return link
} elseif {$control && [lsearch $_dodragdrop_actions copy] != -1} {
return copy
} elseif {$shift && [lsearch $_dodragdrop_actions move] != -1} {
return move
} elseif {$alt && [lsearch $_dodragdrop_actions link] != -1} {
return link
}
return default
};# xdnd::_default_action
# ----------------------------------------------------------------------------
# Command xdnd::getFormatForType
# ----------------------------------------------------------------------------
proc xdnd::getFormatForType {type} {
switch -glob [string tolower $type] {
text/plain\;charset=utf-8 -
text/html\;charset=utf-8 -
utf8_string {set format UTF8_STRING}
text/html -
text/plain -
string -
text -
compound_text {set format STRING}
text/uri-list* {set format UTF8_STRING}
application/x-color {set format $type}
default {set format $type}
}
return $format
};# xdnd::getFormatForType
# ----------------------------------------------------------------------------
# Command xdnd::registerSelectionHandler
# ----------------------------------------------------------------------------
proc xdnd::registerSelectionHandler {source types} {
foreach type $types {
selection handle -selection XdndSelection \
-type $type \
-format [getFormatForType $type] \
$source [list ::tkdnd::xdnd::_SendData $type]
}
};# xdnd::registerSelectionHandler
# ----------------------------------------------------------------------------
# Command xdnd::unregisterSelectionHandler
# ----------------------------------------------------------------------------
proc xdnd::unregisterSelectionHandler {source types} {
foreach type $types {
catch {
selection handle -selection XdndSelection \
-type $type \
-format [getFormatForType $type] \
$source {}
}
}
};# xdnd::unregisterSelectionHandler
# ----------------------------------------------------------------------------
# Command xdnd::_convert_to_unsigned
# ----------------------------------------------------------------------------
proc xdnd::_convert_to_unsigned {data format} {
switch $format {
8 { set mask 0xff }
16 { set mask 0xffff }
32 { set mask 0xffffff }
default {error "unsupported format $format"}
}
## Convert signed integer into unsigned...
set d [list]
foreach num $data {
lappend d [expr { $num & $mask }]
}
return $d
};# xdnd::_convert_to_unsigned
# ----------------------------------------------------------------------------
# Command xdnd::_SendData
# ----------------------------------------------------------------------------
proc xdnd::_SendData {type offset bytes args} {
variable _dodragdrop_drag_source
variable _dodragdrop_types
variable _dodragdrop_data
variable _dodragdrop_transfer_data
## The variable _dodragdrop_data contains a list of data, one for each
## type in the _dodragdrop_types variable. We have to search types, and find
## the corresponding entry in the _dodragdrop_data list.
set index [lsearch $_dodragdrop_types $type]
if {$index < 0} {
error "unable to locate data suitable for type \"$type\""
}
set typed_data [lindex $_dodragdrop_data $index]
set format 8
if {$offset == 0} {
## Prepare the data to be transferred...
switch -glob $type {
text/plain* - UTF8_STRING - STRING - TEXT - COMPOUND_TEXT {
binary scan [encoding convertto utf-8 $typed_data] \
c* _dodragdrop_transfer_data
set _dodragdrop_transfer_data \
[_convert_to_unsigned $_dodragdrop_transfer_data $format]
}
text/uri-list* {
set files [list]
foreach file $typed_data {
switch -glob $file {
*://* {lappend files $file}
default {lappend files file://$file}
}
}
binary scan [encoding convertto utf-8 "[join $files \r\n]\r\n"] \
c* _dodragdrop_transfer_data
set _dodragdrop_transfer_data \
[_convert_to_unsigned $_dodragdrop_transfer_data $format]
}
application/x-color {
set format 16
## Try to understand the provided data: we accept a standard Tk colour,
## or a list of 3 values (red green blue) or a list of 4 values
## (red green blue opacity).
switch [llength $typed_data] {
1 { set color [winfo rgb $_dodragdrop_drag_source $typed_data]
lappend color 65535 }
3 { set color $typed_data; lappend color 65535 }
4 { set color $typed_data }
default {error "unknown color data: \"$typed_data\""}
}
## Convert the 4 elements into 16 bit values...
set _dodragdrop_transfer_data [list]
foreach c $color {
lappend _dodragdrop_transfer_data [format 0x%04X $c]
}
}
default {
set format 32
binary scan $typed_data c* _dodragdrop_transfer_data
}
}
}
##
## Data has been split into bytes. Count the bytes requested, and return them
##
set data [lrange $_dodragdrop_transfer_data $offset [expr {$offset+$bytes-1}]]
switch $format {
8 {
set data [encoding convertfrom utf-8 [binary format c* $data]]
}
16 {
variable _dodragdrop_selection_requestor
if {$_dodragdrop_selection_requestor} {
## Tk selection cannot process this format (only 8 & 32 supported).
## Call our XChangeProperty...
set numItems [llength $data]
variable _dodragdrop_selection_property
variable _dodragdrop_selection_selection
variable _dodragdrop_selection_target
variable _dodragdrop_selection_time
XChangeProperty $_dodragdrop_drag_source \
$_dodragdrop_selection_requestor \
$_dodragdrop_selection_property \
$_dodragdrop_selection_target \
$format \
$_dodragdrop_selection_time \
$data $numItems
return -code break
}
}
32 {
}
default {
error "unsupported format $format"
}
}
# puts "SendData: $type $offset $bytes $args ($typed_data)"
# puts " $data"
return $data
};# xdnd::_SendData

View File

@ -0,0 +1,252 @@
#
# tkdnd_utils.tcl --
#
# This file implements some utility procedures that are used by the TkDND
# package.
#
# This software is copyrighted by:
# George Petasis, National Centre for Scientific Research "Demokritos",
# Aghia Paraskevi, Athens, Greece.
# e-mail: petasis@iit.demokritos.gr
#
# The following terms apply to all files associated
# with the software unless explicitly disclaimed in individual files.
#
# The authors hereby grant permission to use, copy, modify, distribute,
# and license this software and its documentation for any purpose, provided
# that existing copyright notices are retained in all copies and that this
# notice is included verbatim in any distributions. No written agreement,
# license, or royalty fee is required for any of the authorized uses.
# Modifications to this software may be copyrighted by their authors
# and need not follow the licensing terms described here, provided that
# the new terms are clearly indicated on the first page of each file where
# they apply.
#
# IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
# FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
# ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
# DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
#
# THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE
# IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
# NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
# MODIFICATIONS.
#
package require tkdnd
namespace eval ::tkdnd {
namespace eval utils {
};# namespace ::tkdnd::utils
namespace eval text {
variable _drag_tag tkdnd::drag::selection::tag
variable _state {}
variable _drag_source_widget {}
variable _drop_target_widget {}
variable _now_dragging 0
};# namespace ::tkdnd::text
};# namespace ::tkdnd
bind TkDND_Drag_Text1 <ButtonPress-1> {tkdnd::text::_begin_drag clear 1 %W %s %X %Y %x %y}
bind TkDND_Drag_Text1 <B1-Motion> {tkdnd::text::_begin_drag motion 1 %W %s %X %Y %x %y}
bind TkDND_Drag_Text1 <B1-Leave> {tkdnd::text::_TextAutoScan %W %x %y}
bind TkDND_Drag_Text1 <ButtonRelease-1> {tkdnd::text::_begin_drag reset 1 %W %s %X %Y %x %y}
bind TkDND_Drag_Text2 <ButtonPress-2> {tkdnd::text::_begin_drag clear 2 %W %s %X %Y %x %y}
bind TkDND_Drag_Text2 <B2-Motion> {tkdnd::text::_begin_drag motion 2 %W %s %X %Y %x %y}
bind TkDND_Drag_Text2 <ButtonRelease-2> {tkdnd::text::_begin_drag reset 2 %W %s %X %Y %x %y}
bind TkDND_Drag_Text3 <ButtonPress-3> {tkdnd::text::_begin_drag clear 3 %W %s %X %Y %x %y}
bind TkDND_Drag_Text3 <B3-Motion> {tkdnd::text::_begin_drag motion 3 %W %s %X %Y %x %y}
bind TkDND_Drag_Text3 <ButtonRelease-3> {tkdnd::text::_begin_drag reset 3 %W %s %X %Y %x %y}
# ----------------------------------------------------------------------------
# Command tkdnd::text::drag_source
# ----------------------------------------------------------------------------
proc ::tkdnd::text::drag_source { mode path { types DND_Text } { event 1 } { tagprefix TkDND_Drag_Text } { tag sel } } {
switch -exact -- $mode {
register {
$path tag bind $tag <ButtonPress-${event}> \
"tkdnd::text::_begin_drag press ${event} %W %s %X %Y %x %y"
## Set a binding to the widget, to put selection as data...
bind $path <<DragInitCmd>> "::tkdnd::text::DragInitCmd $path {%t} $tag"
## Set a binding to the widget, to remove selection if action is move...
bind $path <<DragEndCmd>> "::tkdnd::text::DragEndCmd $path %A $tag"
}
unregister {
$path tag bind $tag <ButtonPress-${event}> {}
bind $path <<DragInitCmd>> {}
bind $path <<DragEndCmd>> {}
}
}
::tkdnd::drag_source $mode $path $types $event $tagprefix
};# ::tkdnd::text::drag_source
# ----------------------------------------------------------------------------
# Command tkdnd::text::drop_target
# ----------------------------------------------------------------------------
proc ::tkdnd::text::drop_target { mode path { types DND_Text } } {
switch -exact -- $mode {
register {
bind $path <<DropPosition>> "::tkdnd::text::DropPosition $path %X %Y %A %a %m"
bind $path <<Drop>> "::tkdnd::text::Drop $path %D %X %Y %A %a %m"
}
unregister {
bind $path <<DropEnter>> {}
bind $path <<DropPosition>> {}
bind $path <<DropLeave>> {}
bind $path <<Drop>> {}
}
}
::tkdnd::drop_target $mode $path $types
};# ::tkdnd::text::drop_target
# ----------------------------------------------------------------------------
# Command tkdnd::text::DragInitCmd
# ----------------------------------------------------------------------------
proc ::tkdnd::text::DragInitCmd { path { types DND_Text } { tag sel } { actions { copy move } } } {
## Save the selection indices...
variable _drag_source_widget
variable _drop_target_widget
set _drag_source_widget $path
set _drop_target_widget {}
_save_selection $path $tag
list $actions $types [$path get $tag.first $tag.last]
};# ::tkdnd::text::DragInitCmd
# ----------------------------------------------------------------------------
# Command tkdnd::text::DragEndCmd
# ----------------------------------------------------------------------------
proc ::tkdnd::text::DragEndCmd { path action { tag sel } } {
variable _drag_source_widget
variable _drop_target_widget
set _drag_source_widget {}
set _drop_target_widget {}
_restore_selection $path $tag
switch -exact -- $action {
move {
## Delete the original selected text...
variable _selection_first
variable _selection_last
$path delete $_selection_first $_selection_last
}
}
};# ::tkdnd::text::DragEndCmd
# ----------------------------------------------------------------------------
# Command tkdnd::text::DropPosition
# ----------------------------------------------------------------------------
proc ::tkdnd::text::DropPosition { path X Y action actions keys} {
variable _drag_source_widget
variable _drop_target_widget
set _drop_target_widget $path
## This check is primitive, a more accurate one is needed!
if {$path eq $_drag_source_widget} {
## This is a drag within the same widget! Set action to move...
if {"move" in $actions} {set action move}
}
incr X -[winfo rootx $path]
incr Y -[winfo rooty $path]
$path mark set insert @$X,$Y; update
return $action
};# ::tkdnd::text::DropPosition
# ----------------------------------------------------------------------------
# Command tkdnd::text::Drop
# ----------------------------------------------------------------------------
proc ::tkdnd::text::Drop { path data X Y action actions keys } {
incr X -[winfo rootx $path]
incr Y -[winfo rooty $path]
$path mark set insert @$X,$Y
$path insert [$path index insert] $data
return $action
};# ::tkdnd::text::Drop
# ----------------------------------------------------------------------------
# Command tkdnd::text::_save_selection
# ----------------------------------------------------------------------------
proc ::tkdnd::text::_save_selection { path tag} {
variable _drag_tag
variable _selection_first
variable _selection_last
variable _selection_tag $tag
set _selection_first [$path index $tag.first]
set _selection_last [$path index $tag.last]
$path tag add $_drag_tag $_selection_first $_selection_last
$path tag configure $_drag_tag \
-background [$path tag cget $tag -background] \
-foreground [$path tag cget $tag -foreground]
};# tkdnd::text::_save_selection
# ----------------------------------------------------------------------------
# Command tkdnd::text::_restore_selection
# ----------------------------------------------------------------------------
proc ::tkdnd::text::_restore_selection { path tag} {
variable _drag_tag
variable _selection_first
variable _selection_last
$path tag delete $_drag_tag
$path tag remove $tag 0.0 end
#$path tag add $tag $_selection_first $_selection_last
};# tkdnd::text::_restore_selection
# ----------------------------------------------------------------------------
# Command tkdnd::text::_begin_drag
# ----------------------------------------------------------------------------
proc ::tkdnd::text::_begin_drag { event button source state X Y x y } {
variable _drop_target_widget
variable _state
# puts "::tkdnd::text::_begin_drag $event $button $source $state $X $Y $x $y"
switch -exact -- $event {
clear {
switch -exact -- $_state {
press {
## Do not execute other bindings, as they will erase selection...
return -code break
}
}
set _state clear
}
motion {
variable _now_dragging
if {$_now_dragging} {return -code break}
if { [string equal $_state "press"] } {
variable _x0; variable _y0
if { abs($_x0-$X) > ${::tkdnd::_dx} || abs($_y0-$Y) > ${::tkdnd::_dy} } {
set _state "done"
set _drop_target_widget {}
set _now_dragging 1
set code [catch {
::tkdnd::_init_drag $button $source $state $X $Y $x $y
} info options]
set _drop_target_widget {}
set _now_dragging 0
if {$code != 0} {
## Something strange occurred...
return -options $options $info
}
}
return -code break
}
set _state clear
}
press {
variable _x0; variable _y0
set _x0 $X
set _y0 $Y
set _state "press"
}
reset {
set _state {}
}
}
if {$source eq $_drop_target_widget} {return -code break}
return -code continue
};# tkdnd::text::_begin_drag
proc tkdnd::text::_TextAutoScan {w x y} {
variable _now_dragging
if {$_now_dragging} {return -code break}
return -code continue
};# tkdnd::text::_TextAutoScan

View File

@ -0,0 +1,167 @@
#
# tkdnd_windows.tcl --
#
# This file implements some utility procedures that are used by the TkDND
# package.
#
# This software is copyrighted by:
# George Petasis, National Centre for Scientific Research "Demokritos",
# Aghia Paraskevi, Athens, Greece.
# e-mail: petasis@iit.demokritos.gr
#
# The following terms apply to all files associated
# with the software unless explicitly disclaimed in individual files.
#
# The authors hereby grant permission to use, copy, modify, distribute,
# and license this software and its documentation for any purpose, provided
# that existing copyright notices are retained in all copies and that this
# notice is included verbatim in any distributions. No written agreement,
# license, or royalty fee is required for any of the authorized uses.
# Modifications to this software may be copyrighted by their authors
# and need not follow the licensing terms described here, provided that
# the new terms are clearly indicated on the first page of each file where
# they apply.
#
# IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
# FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
# ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
# DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
#
# THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE
# IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
# NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
# MODIFICATIONS.
#
namespace eval olednd {
proc initialise { } {
## Mapping from platform types to TkDND types...
::tkdnd::generic::initialise_platform_to_tkdnd_types [list \
CF_UNICODETEXT DND_Text \
CF_TEXT DND_Text \
CF_HDROP DND_Files \
UniformResourceLocator DND_URL \
CF_HTML DND_HTML \
{HTML Format} DND_HTML \
CF_RTF DND_RTF \
CF_RTFTEXT DND_RTF \
{Rich Text Format} DND_RTF \
]
# FileGroupDescriptorW DND_Files \
# FileGroupDescriptor DND_Files \
## Mapping from TkDND types to platform types...
::tkdnd::generic::initialise_tkdnd_to_platform_types [list \
DND_Text {CF_UNICODETEXT CF_TEXT} \
DND_Files {CF_HDROP} \
DND_URL {UniformResourceLocator UniformResourceLocatorW} \
DND_HTML {CF_HTML {HTML Format}} \
DND_RTF {CF_RTF CF_RTFTEXT {Rich Text Format}} \
]
};# initialise
};# namespace olednd
# ----------------------------------------------------------------------------
# Command olednd::HandleDragEnter
# ----------------------------------------------------------------------------
proc olednd::HandleDragEnter { drop_target typelist actionlist pressedkeys
rootX rootY codelist { data {} } } {
::tkdnd::generic::SetDroppedData $data
focus $drop_target
::tkdnd::generic::HandleEnter $drop_target 0 $typelist \
$codelist $actionlist $pressedkeys
set action [::tkdnd::generic::HandlePosition $drop_target {} \
$pressedkeys $rootX $rootY]
if {$::tkdnd::_auto_update} {update idletasks}
return $action
};# olednd::HandleDragEnter
# ----------------------------------------------------------------------------
# Command olednd::HandleDragOver
# ----------------------------------------------------------------------------
proc olednd::HandleDragOver { drop_target pressedkeys rootX rootY } {
set action [::tkdnd::generic::HandlePosition $drop_target {} \
$pressedkeys $rootX $rootY]
if {$::tkdnd::_auto_update} {update idletasks}
return $action
};# olednd::HandleDragOver
# ----------------------------------------------------------------------------
# Command olednd::HandleDragLeave
# ----------------------------------------------------------------------------
proc olednd::HandleDragLeave { drop_target } {
::tkdnd::generic::HandleLeave
if {$::tkdnd::_auto_update} {update idletasks}
};# olednd::HandleDragLeave
# ----------------------------------------------------------------------------
# Command olednd::HandleDrop
# ----------------------------------------------------------------------------
proc olednd::HandleDrop { drop_target pressedkeys rootX rootY type data } {
::tkdnd::generic::SetDroppedData [normalise_data $type $data]
set action [::tkdnd::generic::HandleDrop $drop_target {} \
$pressedkeys $rootX $rootY 0]
if {$::tkdnd::_auto_update} {update idletasks}
return $action
};# olednd::HandleDrop
# ----------------------------------------------------------------------------
# Command olednd::GetDataType
# ----------------------------------------------------------------------------
proc olednd::GetDataType { drop_target typelist } {
foreach {drop_target common_drag_source_types common_drop_target_types} \
[::tkdnd::generic::FindWindowWithCommonTypes $drop_target $typelist] {break}
lindex $common_drag_source_types 0
};# olednd::GetDataType
# ----------------------------------------------------------------------------
# Command olednd::GetDragSourceCommonTypes
# ----------------------------------------------------------------------------
proc olednd::GetDragSourceCommonTypes { drop_target } {
::tkdnd::generic::GetDragSourceCommonTypes
};# olednd::GetDragSourceCommonTypes
# ----------------------------------------------------------------------------
# Command olednd::platform_specific_types
# ----------------------------------------------------------------------------
proc olednd::platform_specific_types { types } {
::tkdnd::generic::platform_specific_types $types
}; # olednd::platform_specific_types
# ----------------------------------------------------------------------------
# Command olednd::platform_specific_type
# ----------------------------------------------------------------------------
proc olednd::platform_specific_type { type } {
::tkdnd::generic::platform_specific_type $type
}; # olednd::platform_specific_type
# ----------------------------------------------------------------------------
# Command tkdnd::platform_independent_types
# ----------------------------------------------------------------------------
proc ::tkdnd::platform_independent_types { types } {
::tkdnd::generic::platform_independent_types $types
}; # tkdnd::platform_independent_types
# ----------------------------------------------------------------------------
# Command olednd::platform_independent_type
# ----------------------------------------------------------------------------
proc olednd::platform_independent_type { type } {
::tkdnd::generic::platform_independent_type $type
}; # olednd::platform_independent_type
# ----------------------------------------------------------------------------
# Command olednd::normalise_data
# ----------------------------------------------------------------------------
proc olednd::normalise_data { type data } {
switch [lindex [::tkdnd::generic::platform_independent_type $type] 0] {
DND_Text {return $data}
DND_Files {return $data}
DND_HTML {return [encoding convertfrom utf-8 $data]}
default {return $data}
}
}; # olednd::normalise_data