Cool_Tools/ultimatevocalremovergui
1
0
Fork 0
mirror of https://github.com/Anjok07/ultimatevocalremovergui.git synced 2024-11-23 23:10:57 +01:00
Code Issues Packages Projects Releases Wiki Activity

Add files via upload

Browse Source
This commit is contained in:
Anjok07 2023-01-01 18:30:35 -06:00 committed by GitHub
parent 1b5fbe342a
commit 7f878d654a
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
10 changed files with 2800 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
gui_data/tkinterdnd2/TkinterDnD.py
View File

@ -28,6 +28,7 @@ import tkinter
from tkinter import tix
TkdndVersion = None
ARM = 'arm'
def _require(tkroot):
'''Internal function.'''
@ -37,7 +38,7 @@ def _require(tkroot):
import platform
if platform.system()=="Darwin":
tkdnd_platform_rep = "osx64"
tkdnd_platform_rep = "osx_arm" if platform.processor() == ARM or ARM in platform.platform() else "osx64"
elif platform.system()=="Linux":
tkdnd_platform_rep = "linux64"
elif platform.system()=="Windows":

BIN
gui_data/tkinterdnd2/tkdnd/osx_arm/libtkdnd2.9.3.dylib Normal file
View File

Binary file not shown.

62
gui_data/tkinterdnd2/tkdnd/osx_arm/pkgIndex.tcl Normal file
View File

@ -0,0 +1,62 @@
#
# Tcl package index file
#
namespace eval ::tkdnd {
## Check if a debug level must be set...
if {[info exists ::TKDND_DEBUG_LEVEL]} {
variable _debug_level $::TKDND_DEBUG_LEVEL
} elseif {[info exists ::env(TKDND_DEBUG_LEVEL)]} {
variable _debug_level $::env(TKDND_DEBUG_LEVEL)
} else {
variable _debug_level 0
}
# ----------------------------------------------------------------------------
# Command tkdnd::debug_enabled: returns the requested debug level (0 = no debug).
# ----------------------------------------------------------------------------
proc debug_enabled { {level {}} } {
variable _debug_level
if {$level != {}} {
if {[string is integer -strict $level]} {
set _debug_level $level
} elseif {[string is true $level]} {
set _debug_level 1
}
}
return $_debug_level
};# debug_enabled
# ----------------------------------------------------------------------------
# Command tkdnd::source: source a Tcl fileInitialise the TkDND package.
# ----------------------------------------------------------------------------
proc source { filename { encoding utf-8 } } {
variable _package_dir
# If in debug mode, enable debug statements...
set dbg_lvl [debug_enabled]
if {$dbg_lvl} {
puts "tkdnd::source (debug level $dbg_lvl) $filename"
set fd [open $filename r]
fconfigure $fd -encoding $encoding
set script [read $fd]
close $fd
set map {}
for {set lvl 0} {$lvl <= $dbg_lvl} {incr lvl} {
lappend map "#DBG$lvl " {}
}
lappend map {#DBG } {}
set script [string map $map $script]
return [eval $script]
}
::source -encoding $encoding $filename
};# source
}; # namespace ::tkdnd
package ifneeded tkdnd 2.9.3 \
"tkdnd::source \{$dir/tkdnd.tcl\} ; \
tkdnd::initialise \{$dir\} libtkdnd2.9.3.dylib tkdnd"
package ifneeded tkdnd::utils 2.9.3 \
"tkdnd::source \{$dir/tkdnd_utils.tcl\} ; \
package provide tkdnd::utils 2.9.3"

539
gui_data/tkinterdnd2/tkdnd/osx_arm/tkdnd.tcl Normal file
View File

@ -0,0 +1,539 @@
#
# 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 _package_dir {}
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
if {[info exists ::TKDND_DEBUG_LEVEL]} {
variable _debug_level $::TKDND_DEBUG_LEVEL
} elseif {[info exists ::env(TKDND_DEBUG_LEVEL)]} {
variable _debug_level $::env(TKDND_DEBUG_LEVEL)
} else {
variable _debug_level 0
}
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::debug_enabled: returns the requested debug level (0 = no debug).
# ----------------------------------------------------------------------------
proc debug_enabled { {level {}} } {
variable _debug_level
if {$level != {}} {
if {[string is integer -strict $level]} {
set _debug_level $level
} elseif {[string is true $level]} {
set _debug_level 1
}
}
return $_debug_level
};# debug_enabled
# ----------------------------------------------------------------------------
# Command tkdnd::source: source a Tcl fileInitialise the TkDND package.
# ----------------------------------------------------------------------------
proc source { filename { encoding utf-8 } } {
variable _package_dir
# If in debug mode, enable debug statements...
set dbg_lvl [debug_enabled]
if {$dbg_lvl} {
puts "tkdnd::source (debug level $dbg_lvl) $filename"
set fd [open $filename r]
fconfigure $fd -encoding $encoding
set script [read $fd]
close $fd
set map {}
for {set lvl 0} {$lvl <= $dbg_lvl} {incr lvl} {
lappend map "\#\D\B\G$lvl " {} ;# Do not remove these \\
}
lappend map "\#\D\B\G\ " {} ;# Do not remove these \\
set script [string map $map $script]
return [eval $script]
}
::source -encoding $encoding $filename
};# source
# ----------------------------------------------------------------------------
# Command tkdnd::initialise: Initialise the TkDND package.
# ----------------------------------------------------------------------------
proc initialise { dir PKG_LIB_FILE PACKAGE_NAME} {
variable _package_dir
variable _platform_namespace
variable _drop_file_temp_dir
variable _windowingsystem
global env
set _package_dir $dir
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
}
proc debug {msg} {
puts $msg
};# debug
};# namespace ::tkdnd
# ----------------------------------------------------------------------------
# Command tkdnd::drag_source
# ----------------------------------------------------------------------------
proc ::tkdnd::drag_source { mode path { types {} } { event 1 }
{ tagprefix TkDND_Drag } } {
#DBG debug "::tkdnd::drag_source $mode $path $types $event $tagprefix"
foreach single_event $event {
set tags [bindtags $path]
set idx [lsearch $tags ${tagprefix}$single_event]
switch -- $mode {
register {
if { $idx != -1 } {
## No need to do anything!
# bindtags $path [lreplace $tags $idx $idx ${tagprefix}$single_event]
} else {
bindtags $path [linsert $tags 1 ${tagprefix}$single_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 } {
#DBG debug "::tkdnd::_init_drag $button $source $state $rootX $rootY $X $Y"
# Call the <<DragInitCmd>> binding.
set cmd [bind $source <<DragInitCmd>>]
#DBG debug "CMD: $cmd"
if {[string length $cmd]} {
set cmd [string map [list %W [list $source] \
%X $rootX %Y $rootY %x $X %y $Y \
%S $state %e <<DragInitCmd>> %A \{\} %% % \
%b \{$button\} \
%t \{[bind $source <<DragSourceTypes>>]\}] $cmd]
set code [catch {uplevel \#0 $cmd} info options]
#DBG debug "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 {
foreach { actions } $info { break }
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
## Custom Cursors...
# Call the <<DragCursorMap>> binding.
set cursor_map [bind $source <<DragCursorMap>>]
variable _windowingsystem
#DBG debug "Source: \"$source\""
#DBG debug "Types: \"[join $types {", "}]\""
#DBG debug "Actions: \"[join $actions {", "}]\""
#DBG debug "Button: \"$button\""
#DBG debug "Data: \"[string range $data 0 100]\""
#DBG debug "CursorMap: \"[string range $cursor_map 0 100]\""
switch $_windowingsystem {
x11 {
set action [xdnd::_dodragdrop $source $actions $types $data $button $cursor_map]
}
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 [list $source] \
%X $rootX %Y $rootY %x $X %y $Y %% % \
%b \{$button\} \
%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

160
gui_data/tkinterdnd2/tkdnd/osx_arm/tkdnd_compat.tcl Normal file
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

587
gui_data/tkinterdnd2/tkdnd/osx_arm/tkdnd_generic.tcl Normal file
View File

@ -0,0 +1,587 @@
#
# 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 _pressedmods {}
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
variable _integer_test entier
if {[catch {string is entier 1234}]} {
set _integer_test integer
}
proc debug { msg } {
tkdnd::debug $msg
};# debug
proc initialise { } {
};# initialise
proc initialise_platform_to_tkdnd_types { types } {
variable _platform2tkdnd
variable _tkdnd2platform
# set _platform2tkdnd [dict create {*}$types] ;# {*} not available in 8.4
set _platform2tkdnd [dict create]
foreach {p t} $types {
dict set _platform2tkdnd $p $t
}
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] ;# {*} not available in 8.4
set _tkdnd2platform [dict create]
foreach {t p} $types {
dict set _tkdnd2platform $t $p
}
};# initialise_tkdnd_to_platform_types
};# namespace generic
# ----------------------------------------------------------------------------
# Command generic::SetPressedKeys
# ----------------------------------------------------------------------------
proc generic::SetPressedKeys { pressedkeys } {
variable _pressedkeys
variable _pressedmods
variable _integer_test
set keys {}
set mods {}
foreach {b} $pressedkeys {
if {[string is $_integer_test -strict $b]} {
lappend keys $b
} else {
lappend mods $b
}
}
set _pressedkeys $keys
set _pressedmods $mods
};# generic::SetPressedKeys
# ----------------------------------------------------------------------------
# Command generic::HandleEnter
# ----------------------------------------------------------------------------
proc generic::HandleEnter { drop_target drag_source typelist codelist
actionlist pressedkeys } {
variable _typelist; set _typelist $typelist
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
SetPressedKeys $pressedkeys
#DBG debug "\n==============================================================="
#DBG debug "generic::HandleEnter: drop_target=$drop_target,\
#DBG drag_source=$drag_source,\
#DBG typelist=$typelist"
#DBG debug "generic::HandleEnter: ACTION: default"
return default
};# generic::HandleEnter
# ----------------------------------------------------------------------------
# Command generic::HandlePosition
# ----------------------------------------------------------------------------
proc generic::HandlePosition { drop_target drag_source pressedkeys
rootX rootY { action {} } { time 0 } } {
variable _types
variable _typelist
variable _codelist
variable _actionlist
variable _pressedkeys
variable _pressedmods
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
#DBG debug "generic::HandlePosition: drop_target=$drop_target,\
#DBG _drop_target=$_drop_target, rootX=$rootX, rootY=$rootY"
if {![info exists _drag_source] || ![string length $_drag_source]} {
#DBG debug "generic::HandlePosition: no or empty _drag_source:\
#DBG return refuse_drop"
return refuse_drop
}
if {$drag_source ne "" && $drag_source ne $_drag_source} {
#DBG debug "generic position event from unexpected source: $_drag_source\
#DBG != $drag_source"
return refuse_drop
}
SetPressedKeys $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]
#DBG debug "\t($_drop_target) -> ($drop_target)"
if {$drop_target != $_drop_target} {
if {[string length $_drop_target]} {
## Call the <<DropLeave>> event.
#DBG debug "\t<<DropLeave>> on $_drop_target"
set cmd [bind $_drop_target <<DropLeave>>]
if {[string length $cmd]} {
set widgetX 0; set widgetY 0
catch {set widgetX [expr {$rootX - [winfo rootx $_drop_target]}]}
catch {set widgetY [expr {$rootY - [winfo rooty $_drop_target]}]}
set cmd [string map [list %W [list $_drop_target] \
%X $rootX %Y $rootY %x $widgetX %y $widgetY \
%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 \{$_pressedmods\} \
%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]} {
switch -exact -- $action {
default - {} { set _action [lindex $_actionlist 0] }
default { set _action $action }
}
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>>.
#DBG debug "<<DropEnter>> -> $drop_target"
set cmd [bind $drop_target <<DropEnter>>]
if {[string length $cmd]} {
set widgetX 0; set widgetY 0
catch {set widgetX [expr {$rootX - [winfo rootx $drop_target]}]}
catch {set widgetY [expr {$rootY - [winfo rooty $drop_target]}]}
focus $drop_target
set cmd [string map [list %W [list $drop_target] \
%X $rootX %Y $rootY %x $widgetX %y $widgetY \
%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 \{$_pressedmods\} \
%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]} {
switch -exact -- $action {
default - {} { set _action [lindex $_actionlist 0] }
default { set _action $action }
}
set widgetX 0; set widgetY 0
catch {set widgetX [expr {$rootX - [winfo rootx $drop_target]}]}
catch {set widgetY [expr {$rootY - [winfo rooty $drop_target]}]}
set cmd [string map [list %W [list $drop_target] \
%X $rootX %Y $rootY %x $widgetX %y $widgetY \
%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 \{$_pressedmods\} \
%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
#DBG 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 _pressedmods
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 {}}
#DBG 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 widgetX 0; set widgetY 0
catch {set widgetX [expr {$_last_mouse_root_x - [winfo rootx $_drop_target]}]}
catch {set widgetY [expr {$_last_mouse_root_y - [winfo rooty $_drop_target]}]}
set cmd [string map [list %W [list $_drop_target] \
%X $_last_mouse_root_x %Y $_last_mouse_root_y %x $widgetX %y $widgetY \
%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 \{$_pressedmods\} \
%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 _pressedmods _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 _pressedmods
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
SetPressedKeys $pressedkeys
#DBG debug "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 widgetX 0; set widgetY 0
catch {set widgetX [expr {$rootX - [winfo rootx $_drop_target]}]}
catch {set widgetY [expr {$rootY - [winfo rooty $_drop_target]}]}
set cmd [string map [list %W [list $_drop_target] \
%X $rootX %Y $rootY %x $widgetX %y $widgetY \
%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 \{$_pressedmods\} \
%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 widgetX 0; set widgetY 0
catch {set widgetX [expr {$rootX - [winfo rootx $_drop_target]}]}
catch {set widgetY [expr {$rootY - [winfo rooty $_drop_target]}]}
set cmd [string map [list %W [list $_drop_target] \
%X $rootX %Y $rootY %x $widgetX %y $widgetY \
%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 \{$_pressedmods\} \
%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>>]
#DBG 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 generic::platform_independent_types
# ----------------------------------------------------------------------------
proc generic::platform_independent_types { types } {
set new_types {}
foreach type $types {
set new_types [concat $new_types [platform_independent_type $type]]
}
return $new_types
}; # generic::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

144
gui_data/tkinterdnd2/tkdnd/osx_arm/tkdnd_macosx.tcl Normal file
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

883
gui_data/tkinterdnd2/tkdnd/osx_arm/tkdnd_unix.tcl Normal file
View File

@ -0,0 +1,883 @@
#
# 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 debug { msg } {
tkdnd::debug $msg
};# debug
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::GetPressedKeys { drop_target } {
#DBG debug "xdnd::GetPressedKeys: $drop_target"
if {[catch {set dict [_keyboard_get_state $drop_target]}]} {
return {}
}
set pressedkeys {}
for {set b 1} {$b <= 5} {incr b} {
if {[dict get $dict $b]} {lappend pressedkeys $b}
}
foreach {k l} {Alt alt Shift shift Control ctrl Lock caps_lock
Mod1 mod1 Mod2 mod2 Mod3 mod3 Mod4 mod4 Mod5 mod5} {
if {[dict get $dict $k]} {lappend pressedkeys $l}
}
#DBG debug "xdnd::GetPressedKeys: $drop_target -> $pressedkeys"
return $pressedkeys
};# xdnd::GetPressedKeys
# ----------------------------------------------------------------------------
# Command xdnd::HandleXdndEnter
# ----------------------------------------------------------------------------
proc xdnd::HandleXdndEnter { drop_target drag_source typelist time
{ data {} } } {
variable _pressedkeys
variable _actionlist
variable _typelist
set _pressedkeys [GetPressedKeys $drop_target]
set _actionlist { copy move link ask private }
set _typelist $typelist
#DBG debug "xdnd::HandleXdndEnter: $time"
::tkdnd::generic::SetDroppedData $data
::tkdnd::generic::HandleEnter $drop_target $drag_source $typelist $typelist \
$_actionlist $_pressedkeys
};# xdnd::HandleXdndEnter
# ----------------------------------------------------------------------------
# Command xdnd::HandleXdndPosition
# ----------------------------------------------------------------------------
proc xdnd::HandleXdndPosition { drop_target rootX rootY time
{ drag_source {} } { action default } } {
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
set _pressedkeys [GetPressedKeys $drop_target]
#DBG debug "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 $action
};# xdnd::HandleXdndPosition
# ----------------------------------------------------------------------------
# Command xdnd::HandleXdndLeave
# ----------------------------------------------------------------------------
proc xdnd::HandleXdndLeave { } {
#DBG debug "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
set _pressedkeys [GetPressedKeys [::tkdnd::generic::GetDropTarget]]
#DBG debug "xdnd::HandleXdndDrop: $time"
## 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]} {
return -code 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 {
#DBG debug "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 {
#DBG debug "_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 { cursor_map {} } } {
variable _dragging
#DBG debug "xdnd::_dodragdrop: source: $source, actions: $actions, types: $types,\
#DBG 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
variable _dodragdrop_cursor_map $cursor_map
##
## 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
##
#DBG debug "xdnd::_dodragdrop: registerSelectionHandler $source $types"
registerSelectionHandler $source $types
##
## Step 1: When a drag begins, the source takes ownership of XdndSelection.
##
#DBG debug "xdnd::_dodragdrop: selection own $source"
selection own -command ::tkdnd::xdnd::_selection_ownership_lost \
-selection XdndSelection $source
set _dragging 1
## Grab the mouse pointer...
#DBG debug "xdnd::_dodragdrop: _grab_pointer $source [_get_mapped_cursor $_dodragdrop_default_action]"
_grab_pointer $source [_get_mapped_cursor $_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...
#DBG debug "xdnd::_dodragdrop: _register_generic_event_handler"
_register_generic_event_handler
## Set a timeout for debugging purposes...
# after 60000 {set ::tkdnd::xdnd::_dragging 0}
#DBG debug "xdnd::_dodragdrop: waiting drag action to finish..."
tkwait variable ::tkdnd::xdnd::_dragging
#DBG debug "xdnd::_dodragdrop: drag action finished!"
_SendXdndLeave
set _dragging 0
#DBG debug "xdnd::_dodragdrop: _ungrab_pointer $source"
_ungrab_pointer $source
#DBG debug "xdnd::_dodragdrop: _unregister_generic_event_handler"
_unregister_generic_event_handler
catch {selection clear -selection XdndSelection}
#DBG debug "xdnd::_dodragdrop: unregisterSelectionHandler $source $types"
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}
#DBG debug "xdnd::_process_drag_events: $event"
variable _dodragdrop_time
set time [dict get $event time]
set type [dict get $event type]
if {$time < $_dodragdrop_time && ![string equal $type SelectionRequest]} {
#DBG debug "xdnd::_process_drag_events: return 0 (1)"
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?
#DBG set path [winfo containing $rootx $rooty]
#DBG debug "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...
#DBG debug "xdnd::_process_drag_events: _SendXdndDrop"
_SendXdndDrop
}
#DBG debug "xdnd::_process_drag_events: return 1 (2)"
# return 1 ;# Returning non-zero is not a good idea...
return 0
}
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
#DBG debug "xdnd::_process_drag_events: return 0 (3)"
return 0
}
default {
#DBG debug "xdnd::_process_drag_events: return 0 (4)"
return 0
}
}
#DBG debug "xdnd::_process_drag_events: return 0 (5)"
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
#DBG debug "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}
#DBG debug "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
#DBG debug "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
}
#DBG debug "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
#DBG debug "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
}
#DBG debug "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
#DBG debug "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 {}}} {
#DBG debug "_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 [_get_mapped_cursor $cursor]
set _dodragdrop_current_cursor $cursor
}
};# xdnd::_update_cursor
# ----------------------------------------------------------------------------
# Command xdnd::_get_mapped_cursor
# ----------------------------------------------------------------------------
proc xdnd::_get_mapped_cursor { cursor } {
variable _dodragdrop_cursor_map
variable _dodragdrop_drag_source
## Is there a custom cursor map?
if {[catch {dict get $_dodragdrop_cursor_map $cursor} mapped]} {
## Do not report the error, ignore the mapping.
set mapped $cursor
}
## Is there a cursor feedback command?
set cmd [bind $_dodragdrop_drag_source <<DragCursorFeedback>>]
if {$cmd ne ""} {
set code [catch {uplevel \#0 $cmd \{$_dodragdrop_drag_source\} \{$cursor\} \{$mapped\}} info options]
#DBG debug "CODE: $code ---- $info"
switch -exact -- $code {
0 {if {$info ne ""} {set mapped $info}}
default {
return -options $options $info
}
}
}
return $mapped
};# xdnd::_get_mapped_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"
}
}
#DBG debug "SendData: $type $offset $bytes $args ($typed_data)"
#DBG debug " $data"
return $data
};# xdnd::_SendData

256
gui_data/tkinterdnd2/tkdnd/osx_arm/tkdnd_utils.tcl Normal file
View File

@ -0,0 +1,256 @@
#
# 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}> \
[list 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>> \
[list ::tkdnd::text::DragInitCmd $path %t $tag]
## Set a binding to the widget, to remove selection if action is move...
bind $path <<DragEndCmd>> \
[list ::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>> \
[list ::tkdnd::text::DropPosition $path %X %Y %A %a %m]
bind $path <<Drop>> \
[list ::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

167
gui_data/tkinterdnd2/tkdnd/osx_arm/tkdnd_windows.tcl Normal file
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