Add files via upload

This commit is contained in:
Anjok07 2022-12-18 21:25:31 -06:00 committed by GitHub
parent 5050eb726b
commit e8f5550d88
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
55 changed files with 8986 additions and 0 deletions

142
gui_data/app_size_values.py Normal file
View File

@ -0,0 +1,142 @@
import os
from screeninfo import get_monitors
from PIL import Image
from PIL import ImageTk
MAC = False
def get_screen_height():
monitors = get_monitors()
if len(monitors) == 0:
raise Exception("Failed to get screen height")
return monitors[0].height
SCREEN_SIZE_VALUES = {
"normal": {
"credits_img":(100, 100),
## App Size
'IMAGE_HEIGHT': 140,
'FILEPATHS_HEIGHT': 75,
'OPTIONS_HEIGHT': 262,
'CONVERSIONBUTTON_HEIGHT': 30,
'COMMAND_HEIGHT': 141,
'PROGRESS_HEIGHT': 25,
'PADDING': 7,
},
"small": {
"credits_img":(50, 50),
## App Size
'IMAGE_HEIGHT': 135,
'FILEPATHS_HEIGHT': 85,
'OPTIONS_HEIGHT': 274,
'CONVERSIONBUTTON_HEIGHT': 35,
'COMMAND_HEIGHT': 80,
'PROGRESS_HEIGHT': 6,
'PADDING': 5,
},
"medium": {
"credits_img":(50, 50),
## App Size
'IMAGE_HEIGHT': 135,
'FILEPATHS_HEIGHT': 85,
'OPTIONS_HEIGHT': 274,
'CONVERSIONBUTTON_HEIGHT': 20,
'COMMAND_HEIGHT': 115,
'PROGRESS_HEIGHT': 9,
'PADDING': 7,
},
"mac": {
"credits_img":(200, 200),
## App Size
'IMAGE_HEIGHT': 135,
'FILEPATHS_HEIGHT': 75,
'OPTIONS_HEIGHT': 262,
'CONVERSIONBUTTON_HEIGHT': 30,
'COMMAND_HEIGHT': 141,
'PROGRESS_HEIGHT': 25,
'PADDING': 5,
},
}
if MAC:
determined_size = SCREEN_SIZE_VALUES["mac"]
normal_screen = True
else:
try:
if get_screen_height() >= 900:
determined_size = SCREEN_SIZE_VALUES["normal"]
normal_screen = True
elif get_screen_height() <= 720:
determined_size = SCREEN_SIZE_VALUES["small"]
normal_screen = False
else:
determined_size = SCREEN_SIZE_VALUES["medium"]
normal_screen = False
except:
determined_size = SCREEN_SIZE_VALUES["normal"]
normal_screen = False
class ImagePath():
def __init__(self, base_path):
img_path = os.path.join(base_path, 'gui_data', 'img')
credits_path = os.path.join(img_path, 'credits.png')
donate_path = os.path.join(img_path, 'donate.png')
download_path = os.path.join(img_path, 'download.png')
efile_path = os.path.join(img_path, 'file.png')
help_path = os.path.join(img_path, 'help.png')
key_path = os.path.join(img_path, 'key.png')
stop_path = os.path.join(img_path, 'stop.png')
play_path = os.path.join(img_path, 'play.png')
pause_path = os.path.join(img_path, 'pause.png')
self.banner_path = os.path.join(img_path, 'UVR-banner.png')
self.efile_img = self.open_image(path=efile_path,size=(20, 20))
self.stop_img = self.open_image(path=stop_path, size=(20, 20))
self.play_img = self.open_image(path=play_path, size=(20, 20))
self.pause_img = self.open_image(path=pause_path, size=(20, 20))
self.help_img = self.open_image(path=help_path, size=(20, 20))
self.download_img = self.open_image(path=download_path, size=(30, 30))
self.donate_img = self.open_image(path=donate_path, size=(30, 30))
self.key_img = self.open_image(path=key_path, size=(30, 30))
self.credits_img = self.open_image(path=credits_path, size=determined_size["credits_img"])
def open_image(self, path: str, size: tuple = None, keep_aspect: bool = True, rotate: int = 0) -> ImageTk.PhotoImage:
"""
Open the image on the path and apply given settings\n
Paramaters:
path(str):
Absolute path of the image
size(tuple):
first value - width
second value - height
keep_aspect(bool):
keep aspect ratio of image and resize
to maximum possible width and height
(maxima are given by size)
rotate(int):
clockwise rotation of image
Returns(ImageTk.PhotoImage):
Image of path
"""
img = Image.open(path).convert(mode='RGBA')
ratio = img.height/img.width
img = img.rotate(angle=-rotate)
if size is not None:
size = (int(size[0]), int(size[1]))
if keep_aspect:
img = img.resize((size[0], int(size[0] * ratio)), Image.ANTIALIAS)
else:
img = img.resize(size, Image.ANTIALIAS)
return ImageTk.PhotoImage(img)
class AdjustedValues():
IMAGE_HEIGHT = determined_size["IMAGE_HEIGHT"]
FILEPATHS_HEIGHT = determined_size["FILEPATHS_HEIGHT"]
OPTIONS_HEIGHT = determined_size["OPTIONS_HEIGHT"]
CONVERSIONBUTTON_HEIGHT = determined_size["CONVERSIONBUTTON_HEIGHT"]
COMMAND_HEIGHT = determined_size["COMMAND_HEIGHT"]
PROGRESS_HEIGHT = determined_size["PROGRESS_HEIGHT"]
PADDING = determined_size["PADDING"]
normal_screen = normal_screen

807
gui_data/constants.py Normal file
View File

@ -0,0 +1,807 @@
#Model Types
VR_ARCH_TYPE = 'VR Arc'
MDX_ARCH_TYPE = 'MDX-Net'
DEMUCS_ARCH_TYPE = 'Demucs'
VR_ARCH_PM = 'VR Architecture'
ENSEMBLE_MODE = 'Ensemble Mode'
ENSEMBLE_STEM_CHECK = 'Ensemble Stem'
SECONDARY_MODEL = 'Secondary Model'
DEMUCS_6_STEM_MODEL = 'htdemucs_6s'
DEMUCS_V3_ARCH_TYPE = 'Demucs v3'
DEMUCS_V4_ARCH_TYPE = 'Demucs v4'
DEMUCS_NEWER_ARCH_TYPES = [DEMUCS_V3_ARCH_TYPE, DEMUCS_V4_ARCH_TYPE]
DEMUCS_V1 = 'v1'
DEMUCS_V2 = 'v2'
DEMUCS_V3 = 'v3'
DEMUCS_V4 = 'v4'
DEMUCS_V1_TAG = 'v1 | '
DEMUCS_V2_TAG = 'v2 | '
DEMUCS_V3_TAG = 'v3 | '
DEMUCS_V4_TAG = 'v4 | '
DEMUCS_NEWER_TAGS = [DEMUCS_V3_TAG, DEMUCS_V4_TAG]
DEMUCS_VERSION_MAPPER = {
DEMUCS_V1:DEMUCS_V1_TAG,
DEMUCS_V2:DEMUCS_V2_TAG,
DEMUCS_V3:DEMUCS_V3_TAG,
DEMUCS_V4:DEMUCS_V4_TAG}
#Download Center
DOWNLOAD_FAILED = 'Download Failed'
DOWNLOAD_STOPPED = 'Download Stopped'
DOWNLOAD_COMPLETE = 'Download Complete'
DOWNLOAD_UPDATE_COMPLETE = 'Update Download Complete'
SETTINGS_MENU_EXIT = 'exit'
NO_CONNECTION = 'No Internet Connection'
VIP_SELECTION = 'VIP:'
DEVELOPER_SELECTION = 'VIP:'
NO_NEW_MODELS = 'All Available Models Downloaded'
ENSEMBLE_PARTITION = ': '
NO_MODEL = 'No Model Selected'
CHOOSE_MODEL = 'Choose Model'
SINGLE_DOWNLOAD = 'Downloading Item 1/1...'
DOWNLOADING_ITEM = 'Downloading Item'
FILE_EXISTS = 'File already exists!'
DOWNLOADING_UPDATE = 'Downloading Update...'
DOWNLOAD_MORE = 'Download More Models'
#Menu Options
AUTO_SELECT = 'Auto'
#LINKS
DOWNLOAD_CHECKS = "https://raw.githubusercontent.com/TRvlvr/application_data/main/filelists/download_checks.json"
MDX_MODEL_DATA_LINK = "https://raw.githubusercontent.com/TRvlvr/application_data/main/mdx_model_data/model_data.json"
VR_MODEL_DATA_LINK = "https://raw.githubusercontent.com/TRvlvr/application_data/main/vr_model_data/model_data.json"
DONATE_LINK_BMAC = "https://www.buymeacoffee.com/uvr5"
DONATE_LINK_PATREON = "https://www.patreon.com/uvr"
#DOWNLOAD REPOS
NORMAL_REPO = "https://github.com/TRvlvr/model_repo/releases/download/all_public_uvr_models/"
UPDATE_REPO = "https://github.com/TRvlvr/model_repo/releases/download/uvr_update_patches/"
ISSUE_LINK = 'https://github.com/Anjok07/ultimatevocalremovergui/issues/new'
VIP_REPO = b'\xf3\xc2W\x19\x1foI)\xc2\xa9\xcc\xb67(Z\xf5',\
b'gAAAAABjQAIQ-NpNMMxMedpKHHb7ze_nqB05hw0YhbOy3pFzuzDrfqumn8_qvraxEoUpZC5ZXC0gGvfDxFMqyq9VWbYKlA67SUFI_wZB6QoVyGI581vs7kaGfUqlXHIdDS6tQ_U-BfjbEAK9EU_74-R2zXjz8Xzekw=='
NO_CODE = 'incorrect_code'
#Extensions
ONNX = '.onnx'
YAML = '.yaml'
PTH = '.pth'
JSON = '.json'
#GUI Buttons
START_PROCESSING = 'Start Processing'
WAIT_PROCESSING = 'Please wait...'
STOP_PROCESSING = 'Halting process, please wait...'
LOADING_MODELS = 'Loading models...'
#---Messages and Logs----
MISSING_MODEL = 'missing'
MODEL_PRESENT = 'present'
UNRECOGNIZED_MODEL = 'Unrecognized Model Detected', ' is an unrecognized model.\n\n' + \
'Would you like to select the correct parameters before continuing?'
STOP_PROCESS_CONFIRM = 'Confirmation', 'You are about to stop all active processes.\n\nAre you sure you wish to continue?'
NO_ENSEMBLE_SELECTED = 'No Models Selected', 'Please select ensemble and try again.'
PICKLE_CORRU = 'File Corrupted', 'Unable to load this ensemble.\n\n' + \
'Would you like to remove this ensemble from your list?'
DELETE_ENS_ENTRY = 'Confirm Removal', 'Are you sure you want to remove this entry?'
ALL_STEMS = 'All Stems'
VOCAL_STEM = 'Vocals'
INST_STEM = 'Instrumental'
OTHER_STEM = 'Other'
BASS_STEM = 'Bass'
DRUM_STEM = 'Drums'
GUITAR_STEM = 'Guitar'
PIANO_STEM = 'Piano'
SYNTH_STEM = 'Synthesizer'
STRINGS_STEM = 'Strings'
WOODWINDS_STEM = 'Woodwinds'
NO_OTHER_STEM = 'No Other'
NO_BASS_STEM = 'No Bass'
NO_DRUM_STEM = 'No Drums'
NO_GUITAR_STEM = 'No Guitar'
NO_PIANO_STEM = 'No Piano'
NO_SYNTH_STEM = 'No Synthesizer'
NO_STRINGS_STEM = 'No Strings'
NO_WOODWINDS_STEM = 'No Woodwinds'
PRIMARY_STEM = 'Primary Stem'
SECONDARY_STEM = 'Secondary Stem'
#Other Constants
DEMUCS_2_SOURCE = ["instrumental", "vocals"]
DEMUCS_4_SOURCE = ["drums", "bass", "other", "vocals"]
DEMUCS_2_SOURCE_MAPPER = {
INST_STEM: 0,
VOCAL_STEM: 1}
DEMUCS_4_SOURCE_MAPPER = {
BASS_STEM: 0,
DRUM_STEM: 1,
OTHER_STEM: 2,
VOCAL_STEM: 3}
DEMUCS_6_SOURCE_MAPPER = {
BASS_STEM: 0,
DRUM_STEM: 1,
OTHER_STEM: 2,
VOCAL_STEM: 3,
GUITAR_STEM:4,
PIANO_STEM:5}
DEMUCS_4_SOURCE_LIST = [BASS_STEM, DRUM_STEM, OTHER_STEM, VOCAL_STEM]
DEMUCS_6_SOURCE_LIST = [BASS_STEM, DRUM_STEM, OTHER_STEM, VOCAL_STEM, GUITAR_STEM, PIANO_STEM]
DEMUCS_UVR_MODEL = 'UVR_Model'
CHOOSE_STEM_PAIR = 'Choose Stem Pair'
STEM_SET_MENU = (VOCAL_STEM,
INST_STEM,
OTHER_STEM,
BASS_STEM,
DRUM_STEM,
GUITAR_STEM,
PIANO_STEM,
SYNTH_STEM,
STRINGS_STEM,
WOODWINDS_STEM,
NO_OTHER_STEM,
NO_BASS_STEM,
NO_DRUM_STEM,
NO_GUITAR_STEM,
NO_PIANO_STEM,
NO_SYNTH_STEM,
NO_STRINGS_STEM,
NO_WOODWINDS_STEM)
STEM_PAIR_MAPPER = {
VOCAL_STEM: INST_STEM,
INST_STEM: VOCAL_STEM,
OTHER_STEM: NO_OTHER_STEM,
BASS_STEM: NO_BASS_STEM,
DRUM_STEM: NO_DRUM_STEM,
GUITAR_STEM: NO_GUITAR_STEM,
PIANO_STEM: NO_PIANO_STEM,
NO_OTHER_STEM: OTHER_STEM,
NO_BASS_STEM: BASS_STEM,
NO_DRUM_STEM: DRUM_STEM,
PRIMARY_STEM: SECONDARY_STEM,
NO_GUITAR_STEM: GUITAR_STEM,
NO_PIANO_STEM: PIANO_STEM,
SYNTH_STEM: NO_SYNTH_STEM,
STRINGS_STEM: NO_STRINGS_STEM,
WOODWINDS_STEM: NO_WOODWINDS_STEM}
MDX_NET_FREQ_CUT = [VOCAL_STEM, INST_STEM]
DEMUCS_4_STEM_OPTIONS = (ALL_STEMS, VOCAL_STEM, OTHER_STEM, BASS_STEM, DRUM_STEM)
DEMUCS_6_STEM_OPTIONS = (ALL_STEMS, VOCAL_STEM, OTHER_STEM, BASS_STEM, DRUM_STEM, GUITAR_STEM, PIANO_STEM)
DEMUCS_2_STEM_OPTIONS = (VOCAL_STEM, INST_STEM)
DEMUCS_4_STEM_CHECK = (OTHER_STEM, BASS_STEM, DRUM_STEM)
#Menu Dropdowns
VOCAL_PAIR = f'{VOCAL_STEM}/{INST_STEM}'
INST_PAIR = f'{INST_STEM}/{VOCAL_STEM}'
OTHER_PAIR = f'{OTHER_STEM}/{NO_OTHER_STEM}'
DRUM_PAIR = f'{DRUM_STEM}/{NO_DRUM_STEM}'
BASS_PAIR = f'{BASS_STEM}/{NO_BASS_STEM}'
FOUR_STEM_ENSEMBLE = '4 Stem Ensemble'
ENSEMBLE_MAIN_STEM = (CHOOSE_STEM_PAIR, VOCAL_PAIR, OTHER_PAIR, DRUM_PAIR, BASS_PAIR, FOUR_STEM_ENSEMBLE)
MIN_SPEC = 'Min Spec'
MAX_SPEC = 'Max Spec'
AUDIO_AVERAGE = 'Average'
MAX_MIN = f'{MAX_SPEC}/{MIN_SPEC}'
MAX_MAX = f'{MAX_SPEC}/{MAX_SPEC}'
MAX_AVE = f'{MAX_SPEC}/{AUDIO_AVERAGE}'
MIN_MAX = f'{MIN_SPEC}/{MAX_SPEC}'
MIN_MIX = f'{MIN_SPEC}/{MIN_SPEC}'
MIN_AVE = f'{MIN_SPEC}/{AUDIO_AVERAGE}'
AVE_MAX = f'{AUDIO_AVERAGE}/{MAX_SPEC}'
AVE_MIN = f'{AUDIO_AVERAGE}/{MIN_SPEC}'
AVE_AVE = f'{AUDIO_AVERAGE}/{AUDIO_AVERAGE}'
ENSEMBLE_TYPE = (MAX_MIN, MAX_MAX, MAX_AVE, MIN_MAX, MIN_MIX, MIN_AVE, AVE_MAX, AVE_MIN, AVE_AVE)
ENSEMBLE_TYPE_4_STEM = (MAX_SPEC, MIN_SPEC, AUDIO_AVERAGE)
CHUNKS = (AUTO_SELECT, '1', '5', '10', '15', '20',
'25', '30', '35', '40', '45', '50',
'55', '60', '65', '70', '75', '80',
'85', '90', '95', 'Full')
VOL_COMPENSATION = (AUTO_SELECT, '1.035', '1.08')
MARGIN_SIZE = ('44100', '22050', '11025')
AUDIO_TOOLS = 'Audio Tools'
MANUAL_ENSEMBLE = 'Manual Ensemble'
TIME_STRETCH = 'Time Stretch'
CHANGE_PITCH = 'Change Pitch'
ALIGN_INPUTS = 'Align Inputs'
AUDIO_TOOL_OPTIONS = (MANUAL_ENSEMBLE, TIME_STRETCH, CHANGE_PITCH)
MANUAL_ENSEMBLE_OPTIONS = (MIN_SPEC, MAX_SPEC, AUDIO_AVERAGE)
PROCESS_METHODS = (VR_ARCH_PM, MDX_ARCH_TYPE, DEMUCS_ARCH_TYPE, ENSEMBLE_MODE, AUDIO_TOOLS)
DEMUCS_SEGMENTS = ('Default', '1', '5', '10', '15', '20',
'25', '30', '35', '40', '45', '50',
'55', '60', '65', '70', '75', '80',
'85', '90', '95', '100')
DEMUCS_SHIFTS = (0, 1, 2, 3, 4, 5,
6, 7, 8, 9, 10, 11,
12, 13, 14, 15, 16, 17,
18, 19, 20)
DEMUCS_OVERLAP = (0.25, 0.50, 0.75, 0.99)
VR_AGGRESSION = (1, 2, 3, 4, 5,
6, 7, 8, 9, 10, 11,
12, 13, 14, 15, 16, 17,
18, 19, 20)
VR_WINDOW = ('320', '512','1024')
VR_CROP = ('256', '512', '1024')
VR_BATCH = ('4', '6', '8')
MDX_POP_PRO = ('MDX-NET_Noise_Profile_14_kHz', 'MDX-NET_Noise_Profile_17_kHz', 'MDX-NET_Noise_Profile_Full_Band')
MDX_POP_STEMS = ('Vocals', 'Instrumental', 'Other', 'Drums', 'Bass')
MDX_POP_NFFT = ('4096', '5120', '6144', '7680', '8192', '16384')
MDX_POP_DIMF = ('2048', '3072', '4096')
SAVE_ENSEMBLE = 'Save Ensemble'
CLEAR_ENSEMBLE = 'Clear Selection(s)'
MENU_SEPARATOR = 35*''
CHOOSE_ENSEMBLE_OPTION = 'Choose Option'
INVALID_ENTRY = 'Invalid Input, Please Try Again'
ENSEMBLE_INPUT_RULE = '1. Only letters, numbers, spaces, and dashes allowed.\n2. No dashes or spaces at the start or end of input.'
ENSEMBLE_OPTIONS = (SAVE_ENSEMBLE, CLEAR_ENSEMBLE)
ENSEMBLE_CHECK = 'ensemble check'
SELECT_SAVED_ENSEMBLE = 'Select Saved Ensemble'
SELECT_SAVED_SETTING = 'Select Saved Setting'
ENSEMBLE_OPTION = "Ensemble Customization Options"
MDX_OPTION = "Advanced MDX-Net Options"
DEMUCS_OPTION = "Advanced Demucs Options"
VR_OPTION = "Advanced VR Options"
HELP_OPTION = "Open Information Guide"
ERROR_OPTION = "Open Error Log"
VERIFY_BEGIN = 'Verifying file '
SAMPLE_BEGIN = 'Creating Sample '
MODEL_MISSING_CHECK = 'Model Missing:'
# Audio Player
PLAYING_SONG = ": Playing"
PAUSE_SONG = ": Paused"
STOP_SONG = ": Stopped"
SELECTED_VER = 'Selected'
DETECTED_VER = 'Detected'
SAMPLE_MODE_CHECKBOX = lambda v:f'Sample Mode ({v}s)'
REMOVED_FILES = lambda r, e:f'Audio Input Verification Report:\n\nRemoved Files:\n\n{r}\n\nError Details:\n\n{e}'
ADVANCED_SETTINGS = (ENSEMBLE_OPTION, MDX_OPTION, DEMUCS_OPTION, VR_OPTION, HELP_OPTION, ERROR_OPTION)
WAV = 'WAV'
FLAC = 'FLAC'
MP3 = 'MP3'
MP3_BIT_RATES = ('96k', '128k', '160k', '224k', '256k', '320k')
WAV_TYPE = ('PCM_U8', 'PCM_16', 'PCM_24', 'PCM_32', '32-bit Float', '64-bit Float')
SELECT_SAVED_SET = 'Choose Option'
SAVE_SETTINGS = 'Save Current Settings'
RESET_TO_DEFAULT = 'Reset to Default'
RESET_FULL_TO_DEFAULT = 'Reset to Default'
RESET_PM_TO_DEFAULT = 'Reset All Application Settings to Default'
SAVE_SET_OPTIONS = (SAVE_SETTINGS, RESET_TO_DEFAULT)
TIME_PITCH = ('1.0', '2.0', '3.0', '4.0')
TIME_TEXT = '_time_stretched'
PITCH_TEXT = '_pitch_shifted'
#RegEx Input Validation
REG_TIME_PITCH = r'^[-+]?(1[0]|[0-9]([.][0-9]*)?)$'
REG_COMPENSATION = r'\b^(1[0]|[0-9]([.][0-9]*)?|Auto|None)$\b'
REG_COMPENSATION = r'\b^(1[0]|[0-9]([.][0-9]*)?|Auto|None)$\b'
REG_CHUNKS = r'\b^(200|1[0-9][0-9]|[1-9][0-9]?|Auto|Full)$\b'
REG_MARGIN = r'\b^[0-9]*$\b'
REG_SEGMENTS = r'\b^(200|1[0-9][0-9]|[1-9][0-9]?|Default)$\b'
REG_SAVE_INPUT = r'\b^([a-zA-Z0-9 -]{0,25})$\b'
REG_AGGRESSION = r'^[-+]?[0-9]\d*?$'
REG_WINDOW = r'\b^[0-9]{0,4}$\b'
REG_SHIFTS = r'\b^[0-9]*$\b'
REG_OVERLAP = r'\b^([0]([.][0-9]{0,6})?|None)$\b'
# Sub Menu
VR_ARCH_SETTING_LOAD = 'Load for VR Arch'
MDX_SETTING_LOAD = 'Load for MDX-Net'
DEMUCS_SETTING_LOAD = 'Load for Demucs'
ALL_ARCH_SETTING_LOAD = 'Load for Full Application'
# Mappers
MDX_NAME_SELECT = {
"UVR_MDXNET_1_9703": 'UVR-MDX-NET 1',
"UVR_MDXNET_2_9682": 'UVR-MDX-NET 2',
"UVR_MDXNET_3_9662": 'UVR-MDX-NET 3',
"UVR_MDXNET_KARA": 'UVR-MDX-NET Karaoke',
"UVR_MDXNET_Main": 'UVR-MDX-NET Main',
"UVR-MDX-NET-Inst_1": 'UVR-MDX-NET Inst 1',
"UVR-MDX-NET-Inst_2": 'UVR-MDX-NET Inst 2',
"UVR-MDX-NET-Inst_3": 'UVR-MDX-NET Inst 3',
"UVR-MDX-NET-Inst_Main": 'UVR-MDX-NET Inst Main'}
DEMUCS_NAME_SELECT = {
'tasnet.th': 'v1 | Tasnet',
'tasnet_extra.th': 'v1 | Tasnet_extra',
'demucs.th': 'v1 | Demucs',
'demucs_extra.th': 'v1 | Demucs_extra',
'light.th': 'v1 | Light',
'light_extra.th': 'v1 | Light_extra',
'tasnet.th.gz': 'v1 | Tasnet.gz',
'tasnet_extra.th.gz': 'v1 | Tasnet_extra.gz',
'demucs.th.gz': 'v1 | Demucs_extra.gz',
'light.th.gz': 'v1 | Light.gz',
'light_extra.th.gz': "v1 | Light_extra.gz'",
'tasnet-beb46fac.th': 'v2 | Tasnet',
'tasnet_extra-df3777b2.th': 'v2 | Tasnet_extra',
'demucs48_hq-28a1282c.th': 'v2 | Demucs48_hq',
'demucs_extra-3646af93.th': 'v2 | Demucs_extra',
'demucs_unittest-09ebc15f.th': 'v2 | Demucs_unittest',
'mdx.yaml': 'v3 | mdx',
'mdx_extra.yaml': 'v3 | mdx_extra',
'mdx_extra_q.yaml': 'v3 | mdx_extra_q',
'mdx_q.yaml': 'v3 | mdx_q',
'repro_mdx_a.yaml': 'v3 | repro_mdx_a',
'repro_mdx_a_hybrid_only.yaml': 'v3 | repro_mdx_a_hybrid',
'repro_mdx_a_time_only.yaml': 'v3 | repro_mdx_a_time',
'UVR_Demucs_Model_1.yaml': 'v3 | UVR_Model_1',
'UVR_Demucs_Model_2.yaml': 'v3 | UVR_Model_2',
'UVR_Demucs_Model_Bag.yaml': 'v3 | UVR_Model_Bag',
'hdemucs_mmi.yaml': 'v4 | hdemucs_mmi',
'htdemucs.yaml': 'v4 | htdemucs',
'htdemucs_ft.yaml': 'v4 | htdemucs_ft',
'htdemucs_6s.yaml': 'v4 | htdemucs_6s'
}
DEFAULT_DATA = {
'chosen_process_method': MDX_ARCH_TYPE,
'vr_model': CHOOSE_MODEL,
'aggression_setting': 10,
'window_size': 512,
'batch_size': 4,
'crop_size': 256,
'is_tta': False,
'is_output_image': False,
'is_post_process': False,
'is_high_end_process': False,
'vr_voc_inst_secondary_model': NO_MODEL,
'vr_other_secondary_model': NO_MODEL,
'vr_bass_secondary_model': NO_MODEL,
'vr_drums_secondary_model': NO_MODEL,
'vr_is_secondary_model_activate': False,
'vr_voc_inst_secondary_model_scale': 0.9,
'vr_other_secondary_model_scale': 0.7,
'vr_bass_secondary_model_scale': 0.5,
'vr_drums_secondary_model_scale': 0.5,
'demucs_model': CHOOSE_MODEL,
'demucs_stems': ALL_STEMS,
'segment': DEMUCS_SEGMENTS[0],
'overlap': DEMUCS_OVERLAP[0],
'shifts': 2,
'chunks_demucs': CHUNKS[0],
'margin_demucs': 44100,
'is_chunk_demucs': False,
'is_primary_stem_only_Demucs': False,
'is_secondary_stem_only_Demucs': False,
'is_split_mode': True,
'is_demucs_combine_stems': True,
'demucs_voc_inst_secondary_model': NO_MODEL,
'demucs_other_secondary_model': NO_MODEL,
'demucs_bass_secondary_model': NO_MODEL,
'demucs_drums_secondary_model': NO_MODEL,
'demucs_is_secondary_model_activate': False,
'demucs_voc_inst_secondary_model_scale': 0.9,
'demucs_other_secondary_model_scale': 0.7,
'demucs_bass_secondary_model_scale': 0.5,
'demucs_drums_secondary_model_scale': 0.5,
'demucs_stems': ALL_STEMS,
'demucs_pre_proc_model': NO_MODEL,
'is_demucs_pre_proc_model_activate': False,
'is_demucs_pre_proc_model_inst_mix': False,
'mdx_net_model': CHOOSE_MODEL,
'chunks': CHUNKS[0],
'margin': 44100,
'compensate': AUTO_SELECT,
'is_denoise': False,
'is_invert_spec': False,
'mdx_voc_inst_secondary_model': NO_MODEL,
'mdx_other_secondary_model': NO_MODEL,
'mdx_bass_secondary_model': NO_MODEL,
'mdx_drums_secondary_model': NO_MODEL,
'mdx_is_secondary_model_activate': False,
'mdx_voc_inst_secondary_model_scale': 0.9,
'mdx_other_secondary_model_scale': 0.7,
'mdx_bass_secondary_model_scale': 0.5,
'mdx_drums_secondary_model_scale': 0.5,
'is_save_all_outputs_ensemble': True,
'is_append_ensemble_name': False,
'chosen_audio_tool': AUDIO_TOOL_OPTIONS[0],
'choose_algorithm': MANUAL_ENSEMBLE_OPTIONS[0],
'time_stretch_rate': 2.0,
'pitch_rate': 2.0,
'is_gpu_conversion': False,
'is_primary_stem_only': False,
'is_secondary_stem_only': False,
'is_testing_audio': False,
'is_add_model_name': False,
'is_accept_any_input': False,
'is_task_complete': False,
'is_normalization': False,
'is_create_model_folder': False,
'mp3_bit_set': '320k',
'save_format': WAV,
'wav_type_set': 'PCM_16',
'user_code': '',
'export_path': '',
'input_paths': [],
'lastDir': None,
'export_path': '',
'model_hash_table': None,
'help_hints_var': False,
'model_sample_mode': False,
'model_sample_mode_duration': 30
}
# Message Box Text
INVALID_INPUT = 'Invalid Input', 'The input is invalid.\n\nPlease verify the input still exists or is valid and try again.'
INVALID_EXPORT = 'Invalid Export Directory', 'You have selected an invalid export directory.\n\nPlease make sure the selected directory still exists.'
INVALID_ENSEMBLE = 'Not Enough Models', 'You must select 2 or more models to run ensemble.'
INVALID_MODEL = 'No Model Chosen', 'You must select an model to continue.'
MISSING_MODEL = 'Model Missing', 'The selected model is missing or not valid.'
ERROR_OCCURED = 'Error Occured', '\n\nWould you like to open the error log for more details?\n'
# GUI Text Constants
BACK_TO_MAIN_MENU = 'Back to Main Menu'
# Help Hint Text
INTERNAL_MODEL_ATT = 'Internal model attribute. \n\n ***Do not change this setting if you are unsure!***'
STOP_HELP = 'Halts any running processes. \n A pop-up window will ask the user to confirm the action.'
SETTINGS_HELP = 'Opens the main settings guide. This window includes the \"Download Center\"'
COMMAND_TEXT_HELP = 'Provides information on the progress of the current process.'
SAVE_CURRENT_SETTINGS_HELP = 'Allows the user to open any saved settings or save the current application settings.'
CHUNKS_HELP = ('This option allows the user to reduce (or increase) RAM or V-RAM usage.\n\n' + \
'• Smaller chunk sizes use less RAM or V-RAM but can also increase processing times.\n' + \
'• Larger chunk sizes use more RAM or V-RAM but can also reduce processing times.\n' + \
'• Selecting \"Auto\" calculates an appropriate chuck size based on how much RAM or V-RAM your system has.\n' + \
'• Selecting \"Full\" will process the track as one whole chunk.\n' + \
'• This option is only recommended for those with powerful PCs.\n' +\
'• The default selection is \"Auto\".')
MARGIN_HELP = 'Selects the frequency margins to slice the chunks from.\n\n• The recommended margin size is 44100.\n• Other values can give unpredictable results.'
AGGRESSION_SETTING_HELP = ('This option allows you to set how strong the primary stem extraction will be.\n\n' + \
'• The range is 0-100.\n' + \
'• Higher values perform deeper extractions.\n' + \
'• The default is 10 for instrumental & vocal models.\n' + \
'• Values over 10 can result in muddy-sounding instrumentals for the non-vocal models')
WINDOW_SIZE_HELP = ('The smaller your window size, the better your conversions will be. \nHowever, a smaller window means longer conversion times and heavier resource usage.\n\n' + \
'Breakdown of the selectable window size values:\n' + \
'• 1024 - Low conversion quality, shortest conversion time, low resource usage.\n' + \
'• 512 - Average conversion quality, average conversion time, normal resource usage.\n' + \
'• 320 - Better conversion quality.')
DEMUCS_STEMS_HELP = ('Here, you can choose which stem to extract using the selected model.\n\n' +\
'Stem Selections:\n\n' +\
'• All Stems - Saves all of the stems the model is able to extract.\n' +\
'• Vocals - Pulls vocal stem only.\n' +\
'• Other - Pulls other stem only.\n' +\
'• Bass - Pulls bass stem only.\n' +\
'• Drums - Pulls drum stem only.\n')
SEGMENT_HELP = ('This option allows the user to reduce (or increase) RAM or V-RAM usage.\n\n' + \
'• Smaller segment sizes use less RAM or V-RAM but can also increase processing times.\n' + \
'• Larger segment sizes use more RAM or V-RAM but can also reduce processing times.\n' + \
'• Selecting \"Default\" uses the recommended segment size.\n' + \
'• It is recommended that you not use segments with \"Chunking\".')
ENSEMBLE_MAIN_STEM_HELP = 'Allows the user to select the type of stems they wish to ensemble.\n\nOptions:\n\n' +\
f'{VOCAL_PAIR} - The primary stem will be the vocals and the secondary stem will be the the instrumental\n' +\
f'{OTHER_PAIR} - The primary stem will be other and the secondary stem will be no other (the mixture without the \'other\' stem)\n' +\
f'{BASS_PAIR} - The primary stem will be bass and the secondary stem will be no bass (the mixture without the \'bass\' stem)\n' +\
f'{DRUM_PAIR} - The primary stem will be drums and the secondary stem will be no drums (the mixture without the \'drums\' stem)\n' +\
f'{FOUR_STEM_ENSEMBLE} - This option will gather all the 4 stem Demucs models and ensemble all of the outputs.\n'
ENSEMBLE_TYPE_HELP = 'Allows the user to select the ensemble algorithm to be used to generate the final output.\n\nExample & Other Note:\n\n' +\
f'{MAX_MIN} - If this option is chosen, the primary stem outputs will be processed through \nthe \'Max Spec\' algorithm, and the secondary stem will be processed through the \'Min Spec\' algorithm.\n' +\
f'• Only a single algorithm will be shown when the \'4 Stem Ensemble\' option is chosen.\n\nAlgorithm Details:\n\n' +\
f'{MAX_SPEC} - This algorithm combines the final results and generates the highest possible output from them.\nFor example, if this algorithm were processing vocal stems, you would get the fullest possible \n' +\
'result making the ensembled vocal stem sound cleaner. However, it might result in more unwanted artifacts.\n' +\
f'{MIN_SPEC} - This algorithm combines the results and generates the lowest possible output from them.\nFor example, if this algorithm were processing instrumental stems, you would get the cleanest possible result \n' +\
'result, eliminating more unwanted artifacts. However, the result might also sound \'muddy\' and lack a fuller sound.\n' +\
f'{AUDIO_AVERAGE} - This algorithm simply combines the results and averages all of them together. \n'
ENSEMBLE_LISTBOX_HELP = 'List of the all the models available for the main stem pair selected.'
IS_GPU_CONVERSION_HELP = ('When checked, the application will attempt to use your GPU (if you have one).\n' +\
'If you do not have a GPU but have this checked, the application will default to your CPU.\n\n' +\
'Note: CPU conversions are much slower than those processed through the GPU.')
SAVE_STEM_ONLY_HELP = 'Allows the user to save only the selected stem.'
IS_NORMALIZATION_HELP = 'Normalizes output to prevent clipping.'
CROP_SIZE_HELP = '**Only compatible with select models only!**\n\n Setting should match training crop-size value. Leave as is if unsure.'
BATCH_SIZE_HELP = '**Only compatible with select models only!**\n\n Lower values allows for less resource usage but longer conversion times.'
IS_TTA_HELP = ('This option performs Test-Time-Augmentation to improve the separation quality.\n\n' +\
'Note: Having this selected will increase the time it takes to complete a conversion')
IS_POST_PROCESS_HELP = ('This option can potentially identify leftover instrumental artifacts within the vocal outputs. \nThis option may improve the separation of some songs.\n\n' +\
'Note: Selecting this option can adversely affect the conversion process, depending on the track. Because of this, it is only recommended as a last resort.')
IS_HIGH_END_PROCESS_HELP = 'The application will mirror the missing frequency range of the output.'
SHIFTS_HELP = ('Performs multiple predictions with random shifts of the input and averages them.\n\n' +\
'• The higher number of shifts, the longer the prediction will take. \n- Not recommended unless you have a GPU.')
OVERLAP_HELP = 'This option controls the amount of overlap between prediction windows (for Demucs one window is 10 seconds)'
IS_CHUNK_DEMUCS_HELP = '• Enables the using \"Chunks\".\n• We recommend you not enable this option with \"Split Mode\" enabled or with the Demucs v4 Models.'
IS_SPLIT_MODE_HELP = ('• Enables \"Segments\". \n• We recommend you not enable this option with \"Enable Chunks\".\n' +\
'• Deselecting this option is only recommended for those with powerful PCs or if using \"Chunk\" mode instead.')
IS_DEMUCS_COMBINE_STEMS_HELP = 'The application will create the secondary stem by combining the remaining stems \ninstead of inverting the primary stem with the mixture.'
COMPENSATE_HELP = 'Compensates the audio of the primary stems to allow for a better secondary stem.'
IS_DENOISE_HELP = '\n• This option removes a majority of the noise generated by the MDX-Net models.\n• The conversion will take nearly twice as long with this enabled.'
CLEAR_CACHE_HELP = 'Clears any user selected model settings for previously unrecognized models.'
IS_SAVE_ALL_OUTPUTS_ENSEMBLE_HELP = 'Enabling this option will keep all indivudual outputs generated by an ensemble.'
IS_APPEND_ENSEMBLE_NAME_HELP = 'The application will append the ensemble name to the final output \nwhen this option is enabled.'
DONATE_HELP = 'Takes the user to an external web-site to donate to this project!'
IS_INVERT_SPEC_HELP = '• This option may produce a better secondary stem.\n• Inverts primary stem with mixture using spectragrams instead of wavforms.\n• This inversion method is slightly slower.'
IS_TESTING_AUDIO_HELP = 'Appends a unique 10 digit number to output files so the user \ncan compare results with different settings.'
IS_MODEL_TESTING_AUDIO_HELP = 'Appends the model name to output files so the user \ncan compare results with different settings.'
IS_ACCEPT_ANY_INPUT_HELP = 'The application will accept any input when enabled, even if it does not have an audio format extension.\n\nThis is for experimental purposes, and having it enabled is not recommended.'
IS_TASK_COMPLETE_HELP = 'When enabled, chimes will be heard when a process completes or fails.'
IS_CREATE_MODEL_FOLDER_HELP = 'Two new directories will be generated for the outputs in \nthe export directory after each conversion.\n\n' +\
'• First directory - Named after the model.\n' +\
'• Second directory - Named after the track.\n\n' +\
'• Example: \n\n' +\
'─ Export Directory\n' +\
' └── First Directory\n' +\
' └── Second Directory\n' +\
' └── Output File(s)'
DELETE_YOUR_SETTINGS_HELP = 'This menu contains your saved settings. You will be asked to \nconfirm if you wish to delete the selected setting.'
SET_STEM_NAME_HELP = 'Choose the primary stem for the selected model.'
MDX_DIM_T_SET_HELP = INTERNAL_MODEL_ATT
MDX_DIM_F_SET_HELP = INTERNAL_MODEL_ATT
MDX_N_FFT_SCALE_SET_HELP = 'Set the N_FFT size the model was trained with.'
POPUP_COMPENSATE_HELP = f'Choose the appropriate voluem compensattion for the selected model\n\nReminder: {COMPENSATE_HELP}'
VR_MODEL_PARAM_HELP = 'Choose the parameters needed to run the selected model.'
CHOSEN_ENSEMBLE_HELP = 'Select saved enselble or save current ensemble.\n\nDefault Selections:\n\n• Save the current ensemble.\n• Clears all current model selections.'
CHOSEN_PROCESS_METHOD_HELP = 'Here, you choose between different Al networks and algorithms to process your track.\n\n' +\
'There are four options:\n\n' +\
'• VR Architecture - These models use magnitude spectrograms for Source Separation.\n' +\
'• MDX-Net - These models use Hybrid Spectrogram/Waveform for Source Separation.\n' +\
'• Demucs v3 - These models use Hybrid Spectrogram/Waveform for Source Separation.\n' +\
'• Ensemble Mode - Here, you can get the best results from multiple models and networks.\n' +\
'• Audio Tools - These are additional tools for added convenience.'
INPUT_FOLDER_ENTRY_HELP = 'Select Input:\n\nHere is where you select the audio files(s) you wish to process.'
OUTPUT_FOLDER_ENTRY_HELP = 'Select Output:\n\nHere is where you select the directory where your processed files are to be saved.'
INPUT_FOLDER_BUTTON_HELP = 'Open Input Folder Button: \n\nOpens the directory containing the selected input audio file(s).'
OUTPUT_FOLDER_BUTTON_HELP = 'Open Output Folder Button: \n\nOpens the selected output folder.'
CHOOSE_MODEL_HELP = 'Each process method comes with its own set of options and models.\n\nHere is where you choose the model associated with the selected process method.'
FORMAT_SETTING_HELP = 'Save outputs as '
SECONDARY_MODEL_ACTIVATE_HELP = 'When enabled, the application will run an additional inference with the selected model(s) above.'
SECONDARY_MODEL_HELP = 'Choose the secondary model associated with this stem you wish to run with the current process method.'
SECONDARY_MODEL_SCALE_HELP = 'The scale determines how the final audio outputs will be averaged between the primary and secondary models.\n\nFor example:\n\n' +\
'• 10% - 10 percent of the main model result will be factored into the final result.\n' +\
'• 50% - The results from the main and secondary models will be averaged evenly.\n' +\
'• 90% - 90 percent of the main model result will be factored into the final result.'
PRE_PROC_MODEL_ACTIVATE_HELP = 'The application will run an inference with the selected model above, pulling only the instrumental stem when enabled. \nFrom there, all of the non-vocal stems will be pulled from the generated instrumental.\n\nNotes:\n\n' +\
'• This option can significantly reduce vocal bleed within the non-vocal stems.\n' +\
'• It is only available in Demucs.\n' +\
'• It is only compatible with non-vocal and non-instrumental stem outputs.\n' +\
'• This will increase thetotal processing time.\n' +\
'• Only VR and MDX-Net Vocal or Instrumental models are selectable above.'
AUDIO_TOOLS_HELP = 'Here, you choose between different audio tools to process your track.\n\n' +\
'• Manual Ensemble - You must have 2 or more files selected as your inputs. Allows the user to run their tracks through \nthe same algorithms used in Ensemble Mode.\n' +\
'• Align Inputs - You must have exactly 2 files selected as your inputs. The second input will be aligned with the first input.\n' +\
'• Time Stretch - The user can speed up or slow down the selected inputs.\n' +\
'• Change Pitch - The user can change the pitch for the selected inputs.\n'
PRE_PROC_MODEL_INST_MIX_HELP = 'When enabled, the application will generate a third output without the selected stem and vocals.'
MODEL_SAMPLE_MODE_HELP = 'Allows the user to process only part of a track to sample settings or a model without \nrunning a full conversion.\n\nNotes:\n\n' +\
'• The number in the parentheses is the current number of seconds the generated sample will be.\n' +\
'• You can choose the number of seconds to extract from the track in the \"Additional Settings\" menu.'
# Warning Messages
STORAGE_ERROR = 'Insufficient Storage', 'There is not enough storage on main drive to continue. Your main drive must have at least 3 GB\'s of storage in order for this application function properly. \n\nPlease ensure your main drive has at least 3 GB\'s of storage and try again.\n\n'
STORAGE_WARNING = 'Available Storage Low', 'Your main drive is running low on storage. Your main drive must have at least 3 GB\'s of storage in order for this application function properly.\n\n'
CONFIRM_WARNING = '\nAre you sure you wish to continue?'
PROCESS_FAILED = 'Process failed, please see error log\n'
EXIT_PROCESS_ERROR = 'Active Process', 'Please stop the active process or wait for it to complete before you exit.'
EXIT_HALTED_PROCESS_ERROR = 'Halting Process', 'Please wait for the application to finish halting the process before exiting.'
EXIT_DOWNLOAD_ERROR = 'Active Download', 'Please stop the download or wait for it to complete before you exit.'
SET_TO_DEFAULT_PROCESS_ERROR = 'Active Process', 'You cannot reset all of the application settings during an active process.'
SET_TO_ANY_PROCESS_ERROR = 'Active Process', 'You cannot reset the application settings during an active process.'
RESET_ALL_TO_DEFAULT_WARNING = 'Reset Settings Confirmation', 'All application settings will be set to factory default.\n\nAre you sure you wish to continue?'
AUDIO_VERIFICATION_CHECK = lambda i, e:f'++++++++++++++++++++++++++++++++++++++++++++++++++++\n\nBroken File Removed: \n\n{i}\n\nError Details:\n\n{e}\n++++++++++++++++++++++++++++++++++++++++++++++++++++'
# Separation Text
LOADING_MODEL = 'Loading model...'
INFERENCE_STEP_1 = 'Running inference...'
INFERENCE_STEP_1_SEC = 'Running inference (secondary model)...'
INFERENCE_STEP_1_4_STEM = lambda stem:f'Running inference (secondary model for {stem})...'
INFERENCE_STEP_1_PRE = 'Running inference (pre-process model)...'
INFERENCE_STEP_2_PRE = lambda pm, m:f'Loading pre-process model ({pm}: {m})...'
INFERENCE_STEP_2_SEC = lambda pm, m:f'Loading secondary model ({pm}: {m})...'
INFERENCE_STEP_2_SEC_CACHED_MODOEL = lambda pm, m:f'Secondary model ({pm}: {m}) cache loaded.\n'
INFERENCE_STEP_2_PRE_CACHED_MODOEL = lambda pm, m:f'Pre-process model ({pm}: {m}) cache loaded.\n'
INFERENCE_STEP_2_SEC_CACHED = 'Loading cached secondary model source(s)... Done!\n'
INFERENCE_STEP_2_PRIMARY_CACHED = 'Model cache loaded.\n'
INFERENCE_STEP_2 = 'Inference complete.'
SAVING_STEM = 'Saving ', ' stem...'
SAVING_ALL_STEMS = 'Saving all stems...'
ENSEMBLING_OUTPUTS = 'Ensembling outputs...'
DONE = ' Done!\n'
ENSEMBLES_SAVED = 'Ensembled outputs saved!\n\n'
NEW_LINES = "\n\n"
NEW_LINE = "\n"
NO_LINE = ''
# Widget Placements
MAIN_ROW_Y = -15, -17
MAIN_ROW_X = -4, 21
MAIN_ROW_WIDTH = -53
MAIN_ROW_2_Y = -15, -17
MAIN_ROW_2_X = -28, 1
CHECK_BOX_Y = 0
CHECK_BOX_X = 20
CHECK_BOX_WIDTH = -50
CHECK_BOX_HEIGHT = 2
LEFT_ROW_WIDTH = -10
LABEL_HEIGHT = -5
OPTION_HEIGHT = 7
LOW_MENU_Y = 18, 16
FFMPEG_EXT = (".aac", ".aiff", ".alac" ,".flac", ".mov", ".mp4",
".m4a", ".mp2", ".mp3", ".mp4", ".mpc", ".mpc8",
".mpeg", ".ogg", ".tta", ".wav", ".wma")
FFMPEG_MORE_EXT = (".aa", ".aac", ".ac3", ".aiff", ".alac", ".avi", ".f4v",".flac", ".flic", ".flv",
".m4v",".mlv", ".mov", ".mp4", ".m4a", ".mp2", ".mp3", ".mp4", ".mpc", ".mpc8",
".mpeg", ".ogg", ".tta", ".tty", ".vcd", ".wav", ".wma")
ANY_EXT = ""
# Secondary Menu Constants
VOCAL_PAIR_PLACEMENT = 1, 2, 3, 4
OTHER_PAIR_PLACEMENT = 5, 6, 7, 8
BASS_PAIR_PLACEMENT = 9, 10, 11, 12
DRUMS_PAIR_PLACEMENT = 13, 14, 15, 16
LICENSE_TEXT = lambda a, p:f'Current Application Version: Ultimate Vocal Remover {a}\n' +\
f'Current Patch Version: {p}\n\n' +\
'Copyright (c) 2022 Ultimate Vocal Remover\n\n' +\
'UVR is free and open-source, but MIT licensed. Please credit us if you use our\n' +\
'models or code for projects unrelated to UVR.\n\n' +\
'• This application is intended for those running Windows 10 or higher.\n' +\
'• Application functionality for systems running Windows 7 or lower.\n' +\
'• Application functionality for Intel Pentium & Celeron CPUs systems is not guaranteed.\n\n' +\
'This bundle contains the UVR interface, Python, PyTorch, and other\n' +\
'dependencies needed to run the application effectively.\n\n' +\
'Website Links: This application, System or Service(s) may contain links to\n' +\
'other websites and downloads, and they are solely provided to you as an\n' +\
'additional convenience. You understand and acknowledge that by clicking\n' +\
'or activating such links you are accessing a site or service outside of\n' +\
'this application, and that we do not screen, review, approve, or otherwise\n' +\
'endorse any content or information contained in these linked websites.\n' +\
'You acknowledge and agree that we, our affiliates and partners are not\n' +\
'responsible for the contents of any of these linked websites, including\n' +\
'the accuracy or availability of information provided by the linked websites,\n' +\
'and we make no representations or warranties regarding your use of\n' +\
'the linked websites.\n\n' +\
'This application is MIT Licensed\n\n' +\
'Permission is hereby granted, free of charge, to any person obtaining a copy\n' +\
'of this software and associated documentation files (the "Software"), to deal\n' +\
'in the Software without restriction, including without limitation the rights\n' +\
'to use, copy, modify, merge, publish, distribute, sublicense, and/or sell\n' +\
'copies of the Software, and to permit persons to whom the Software is\n' +\
'furnished to do so, subject to the following conditions:\n\n' +\
'The above copyright notice and this permission notice shall be included in all\n' +\
'copies or substantial portions of the Software.\n\n' +\
'THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR\n' +\
'IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,\n' +\
'FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE\n' +\
'AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER\n' +\
'LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,\n' +\
'OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE\n' +\
'SOFTWARE.'
# INTERNAL_MODEL_ATT = '内部模型属性 \n\n ***如果不确定,请勿更改此设置!***'
# STOP_HELP = '停止任何正在运行的进程 \n 弹出窗口将要求用户确认操作'
# SETTINGS_HELP = '打开设置指南此窗口包括\"下载中心\"'
# COMMAND_TEXT_HELP = '提供有关当前进程进度的信息'
# SAVE_CURRENT_SETTINGS_HELP = '允许用户打开任何保存的设置或保存当前应用程序设置'
# CHUNKS_HELP = ('此选项允许用户减少或增加RAM或VRAM\n\n' + \
# '• 较小的块大小使用较少的RAM或VRAM但也会增加处理时间\n' + \
# '• 较大的块大小使用更多的RAM或VRAM但也可以减少处理时间\n' + \
# '• 选择“自动”可根据系统的RAM或VRAM大小计算适当的运行内存\n' + \
# '• 选择“完整”将使用全部电脑可用资源处理曲目\n' + \
# '• 此选项仅适用于具有强大pc的用户,不要对自己电脑过于自信\n' +\
# '• 默认选择为“自动”.')
# MARGIN_HELP = '选择要从中分割块的频率\n\n- 建议的频率大小为44100\n- 其他值可能会产生不可预测的结果'
# AGGRESSION_SETTING_HELP = ('该选项允许您设置主轨道提取的强度\n\n' + \
# '• 范围为0-100\n' + \
# '• 值越高,提取程度越高\n' + \
# '• 乐器和声乐模型的默认值为10\n' + \
# '• 超过10的值可能会导致非发声模型的乐器发出浑浊的声音')
# WINDOW_SIZE_HELP = ('分块大小越小,转换效果越好 \n然而较小的分块意味着更长的转换时间和更重的资源使用\n\n' + \
# '可选窗口大小值的细分:\n' + \
# '• 1024 - 转换质量低,转换时间短,资源使用率低\n' + \
# '• 512 - 平均转换质量、平均转换时间、正常资源使用\n' + \
# '• 320 - 更好的转换质量')
# DEMUCS_STEMS_HELP = ('在这里,您可以选择使用所选模型提取某个轨道\n\n' +\
# '轨道选择:\n\n' +\
# '• All Stems - 保存模型能够提取的所有轨道.\n' +\
# '• Vocals -仅人声轨道.\n' +\
# '• Other - 仅其他轨道.\n' +\
# '• Bass - 仅贝斯轨道.\n' +\
# '• Drums - 仅鼓轨道.\n')
# SEGMENT_HELP = ('此选项允许用户减少或增加RAM或VRAM使用\n\n' + \
# '• 较小的段大小使用较少的RAM或VRAM但也会增加处理时间.\n' + \
# '• 较大的段大小使用更多的RAM或VRAM但也可以减少处理时间\n' + \
# '• 选择“默认值”使用建议的段大小\n' + \
# '• 建议不要使用带有“分段”的段".')
# ENSEMBLE_MAIN_STEM_HELP = '允许用户选择要集成的阀杆类型\n\n示例主阀杆/次阀杆'
# ENSEMBLE_TYPE_HELP = '允许用户选择用于生成最终输出的集成算法'
# ENSEMBLE_LISTBOX_HELP = '所选主阀杆对的所有可用型号列表'
# IS_GPU_CONVERSION_HELP = ('选中后应用程序将尝试使用您的GPU如果您有.\n' +\
# '如果您没有GPU但选中了此项则应用程序将默认为CPU\n\n' +\
# '注CPU转换比通过GPU处理的转换慢得多.')
# SAVE_STEM_ONLY_HELP = '允许用户仅保存选定的阀杆'
# IS_NORMALIZATION_HELP = '规格化输出以防止剪裁'
# CROP_SIZE_HELP = '**仅与部分型号兼容!**\n\n 设置应与训练作物大小值相匹配,如果不确定,则保持原样'
# BATCH_SIZE_HELP = '**仅与部分型号兼容!**\n\n 值越低,资源使用量越少,但转换时间越长'
# IS_TTA_HELP = ('此选项执行测试时间增强以提高分离质量\n\n' +\
# '注意:选择此选项将增加完成转换所需的时间')
# IS_POST_PROCESS_HELP = ('该选项可以潜在地识别声音输出中残留的乐器伪影 \n此选项可能会改进某些歌曲的分离.\n\n' +\
# '注意:选择此选项可能会对转换过程产生不利影响,具体取决于曲目。因此,建议将其作为最后救命稻草')
# IS_HIGH_END_PROCESS_HELP = '应用程序将镜像输出的缺失频率范围'
# SHIFTS_HELP = ('使用输入的随机移位执行多个预测,并对其进行平均.\n\n' +\
# '• 移位次数越多,预测所需时间越长\n- 除非您有GPU最低8g否则别瞎选电脑爆炸概不负责')
# OVERLAP_HELP = '此选项控制预测窗口之间的重叠量对于demucs一个窗口为10秒'
# IS_CHUNK_DEMUCS_HELP = '启用使用“块”.\n\n请注意我们建议您不要在启用“拆分模式”的情况下启用此选项'
# IS_SPLIT_MODE_HELP = ('启用“分段”. \n\n请注意我们建议您不要使用“启用区块”来启用此选项.\n' +\
# '仅建议具有强大pc或使用“块”模式.再次提醒别瞎点,要对自己电脑负责.别选!不负责任的狗男人')
# IS_DEMUCS_COMBINE_STEMS_HELP = '应用程序将通过组合剩余的阀杆来创建第二阀杆\n而不是用混合物反转主茎'
# COMPENSATE_HELP = '补偿主杆的音频,以获得更好的辅助杆'
# IS_DENOISE_HELP = '该选项消除了MDX-NET模型产生的大部分噪声\n\n请注意启用此选项后转换所需的时间几乎是原来的两倍'
# CLEAR_CACHE_HELP = '清除以前无法识别的模型的任何用户选择的模型设置'
# IS_SAVE_ALL_OUTPUTS_ENSEMBLE_HELP = '启用此选项将保留集成生成的所有单独输出'
# IS_APPEND_ENSEMBLE_NAME_HELP = '应用程序将在最终输出中附加集成名称 \n启用此选项时'
# DONATE_HELP = '将用户带到外部网站为该项目捐款!'
# IS_INVERT_SPEC_HELP = '相反,使用光谱图用混合物反转主阀杆 \n这种反演方法稍慢'
# IS_TESTING_AUDIO_HELP = '在输出文件中附加一个唯一的10位数字以便用户\nc不同设置的比较结果'
# IS_CREATE_MODEL_FOLDER_HELP = '将为中的输出生成两个新目录 \n每次转换后的导出目录'
# DELETE_YOUR_SETTINGS_HELP = '此菜单包含您保存的设置,系统将要求您\n确认是否要删除所选设置'
# SET_STEM_NAME_HELP = '为所选模型选择主阀杆'
# MDX_DIM_T_SET_HELP = INTERNAL_MODEL_ATT
# MDX_DIM_F_SET_HELP = INTERNAL_MODEL_ATT
# MDX_N_FFT_SCALE_SET_HELP = '设置训练模型的N_FFT大小'
# POPUP_COMPENSATE_HELP = f'为所选模型选择适当的体积补偿\n\n提醒 {COMPENSATE_HELP}'
# VR_MODEL_PARAM_HELP = '选择运行所选模型所需的参数'
# CHOSEN_ENSEMBLE_HELP = '选择保存的集合或保存当前集合\n\n默认选择\n\n- 保存当前集合\n- 清除所有当前模型选择'
# CHOSEN_PROCESS_METHOD_HELP = '选择要运行曲目的进程'
# FORMAT_SETTING_HELP = '将输出另存为'

View File

@ -0,0 +1,99 @@
from datetime import datetime
import traceback
CUDA_MEMORY_ERROR = "CUDA out of memory"
CUDA_RUNTIME_ERROR = "CUDNN error executing cudnnSetTensorNdDescriptor"
DEMUCS_MODEL_MISSING_ERROR = "is neither a single pre-trained model or a bag of models."
ENSEMBLE_MISSING_MODEL_ERROR = "local variable \'enseExport\' referenced before assignment"
FFMPEG_MISSING_ERROR = """audioread\__init__.py", line 116, in audio_open"""
FILE_MISSING_ERROR = "FileNotFoundError"
MDX_MEMORY_ERROR = "onnxruntime::CudaCall CUDA failure 2: out of memory"
MDX_MODEL_MISSING = "[ONNXRuntimeError] : 3 : NO_SUCHFILE"
MDX_MODEL_SETTINGS_ERROR = "Got invalid dimensions for input"
MDX_RUNTIME_ERROR = "onnxruntime::BFCArena::AllocateRawInternal"
MODULE_ERROR = "ModuleNotFoundError"
WINDOW_SIZE_ERROR = "h1_shape[3] must be greater than h2_shape[3]"
SF_WRITE_ERROR = "sf.write"
SYSTEM_MEMORY_ERROR = "DefaultCPUAllocator: not enough memory"
MISSING_MODEL_ERROR = "'NoneType\' object has no attribute \'model_basename\'"
CONTACT_DEV = 'If this error persists, please contact the developers with the error details.'
ERROR_MAPPER = {
CUDA_MEMORY_ERROR:
('The application was unable to allocate enough GPU memory to use this model. ' +
'Please close any GPU intensive applications and try again.\n' +
'If the error persists, your GPU might not be supported.') ,
CUDA_RUNTIME_ERROR:
(f'Your PC cannot process this audio file with the chunk size selected. Please lower the chunk size and try again.\n\n{CONTACT_DEV}'),
DEMUCS_MODEL_MISSING_ERROR:
('The selected Demucs model is missing. ' +
'Please download the model or make sure it is in the correct directory.'),
ENSEMBLE_MISSING_MODEL_ERROR:
('The application was unable to locate a model you selected for this ensemble.\n\n' +
'Please do the following to use all compatible models:\n\n1. Navigate to the \"Updates\" tab in the Help Guide.\n2. Download and install the model expansion pack.\n3. Then try again.\n\n' +
'If the error persists, please verify all models are present.'),
FFMPEG_MISSING_ERROR:
('The input file type is not supported or FFmpeg is missing. Please select a file type supported by FFmpeg and try again. ' +
'If FFmpeg is missing or not installed, you will only be able to process \".wav\" files until it is available on this system. ' +
f'See the \"More Info\" tab in the Help Guide.\n\n{CONTACT_DEV}'),
FILE_MISSING_ERROR:
(f'Missing file error raised. Please address the error and try again.\n\n{CONTACT_DEV}'),
MDX_MEMORY_ERROR:
('The application was unable to allocate enough GPU memory to use this model.\n\n' +
'Please do the following:\n\n1. Close any GPU intensive applications.\n2. Lower the set chunk size.\n3. Then try again.\n\n' +
'If the error persists, your GPU might not be supported.'),
MDX_MODEL_MISSING:
('The application could not detect this MDX-Net model on your system. ' +
'Please make sure all the models are present in the correct directory.\n\n' +
'If the error persists, please reinstall application or contact the developers.'),
MDX_RUNTIME_ERROR:
('The application was unable to allocate enough GPU memory to use this model.\n\n' +
'Please do the following:\n\n1. Close any GPU intensive applications.\n2. Lower the set chunk size.\n3. Then try again.\n\n' +
'If the error persists, your GPU might not be supported.'),
WINDOW_SIZE_ERROR:
('Invalid window size.\n\n' +
'The chosen window size is likely not compatible with this model. Please select a different size and try again.'),
SF_WRITE_ERROR:
('Could not write audio file.\n\n' +
'This could be due to one of the following:\n\n1. Low storage on target device.\n2. The export directory no longer exists.\n3. A system permissions issue.'),
SYSTEM_MEMORY_ERROR:
('The application was unable to allocate enough system memory to use this model.\n\n' +
'Please do the following:\n\n1. Restart this application.\n2. Ensure any CPU intensive applications are closed.\n3. Then try again.\n\n' +
'Please Note: Intel Pentium and Intel Celeron processors do not work well with this application.\n\n' +
'If the error persists, the system may not have enough RAM, or your CPU might not be supported.'),
MISSING_MODEL_ERROR:
('Model Missing: The application was unable to locate the chosen model.\n\n' +
'If the error persists, please verify any selected models are present.'),
}
def error_text(process_method, exception):
traceback_text = ''.join(traceback.format_tb(exception.__traceback__))
message = f'{type(exception).__name__}: "{exception}"\nTraceback Error: "\n{traceback_text}"\n'
error_message = f'\n\nRaw Error Details:\n\n{message}\nError Time Stamp [{datetime.now().strftime("%Y-%m-%d %H:%M:%S")}]\n'
process = f'Last Error Received:\n\nProcess: {process_method}\n\n'
for error_type, full_text in ERROR_MAPPER.items():
if error_type in message:
final_message = full_text
break
else:
final_message = (CONTACT_DEV)
return f"{process}{final_message}{error_message}"
def error_dialouge(exception):
error_name = f'{type(exception).__name__}'
traceback_text = ''.join(traceback.format_tb(exception.__traceback__))
message = f'{error_name}: "{exception}"\n{traceback_text}"'
for error_type, full_text in ERROR_MAPPER.items():
if error_type in message:
final_message = full_text
break
else:
final_message = (f'{error_name}: {exception}\n\n{CONTACT_DEV}')
return final_message

BIN
gui_data/fail_chime.wav Normal file

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

BIN
gui_data/img/File.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 3.6 KiB

BIN
gui_data/img/GUI-Icon.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.4 KiB

BIN
gui_data/img/GUI-Icon.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.1 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 60 KiB

BIN
gui_data/img/UVR-banner.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 45 KiB

BIN
gui_data/img/UVR_5_5.jpg Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 76 KiB

BIN
gui_data/img/credits.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 235 KiB

BIN
gui_data/img/donate.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 20 KiB

BIN
gui_data/img/download.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 13 KiB

BIN
gui_data/img/help.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 8.7 KiB

BIN
gui_data/img/key.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 11 KiB

BIN
gui_data/img/pause.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 2.9 KiB

BIN
gui_data/img/play.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 4.2 KiB

BIN
gui_data/img/splash.bmp Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 276 KiB

BIN
gui_data/img/stop.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 2.0 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 2.5 KiB

View File

@ -0,0 +1,27 @@
import os
import shutil
def file_check(original_dir, new_dir):
if os.path.isdir(original_dir):
for file in os.listdir(original_dir):
shutil.move(os.path.join(original_dir, file), os.path.join(new_dir, file))
if len(os.listdir(original_dir)) == 0:
shutil.rmtree(original_dir)
def remove_unneeded_yamls(demucs_dir):
for file in os.listdir(demucs_dir):
if file.endswith('.yaml'):
if os.path.isfile(os.path.join(demucs_dir, file)):
os.remove(os.path.join(demucs_dir, file))
def remove_temps(remove_dir):
if os.path.isdir(remove_dir):
try:
shutil.rmtree(remove_dir)
except Exception as e:
print(e)

View File

@ -0,0 +1,293 @@
'''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.
'''
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)
#print('_subst_format_dnd: ', _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)

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