Initial Import

1 files changed, 303 insertions, 0 deletions

diff --git a/library/tkdnd.tcl b/library/tkdnd.tcl
new file mode 100644
index 0000000..2d205d3
--- /dev/null
+++ b/library/tkdnd.tcl
@@ -0,0 +1,303 @@
+#
+# tkdnd.tcl --
+# 
+#    This file implements some utility procedures that are used by the TkDND
+#    package.
+#
+# This software is copyrighted by:
+# George Petasis, National Centre for Scientific Research "Demokritos",
+# Aghia Paraskevi, Athens, Greece.
+# e-mail: petasis@iit.demokritos.gr
+#
+# The following terms apply to all files associated
+# with the software unless explicitly disclaimed in individual files.
+#
+# The authors hereby grant permission to use, copy, modify, distribute,
+# and license this software and its documentation for any purpose, provided
+# that existing copyright notices are retained in all copies and that this
+# notice is included verbatim in any distributions. No written agreement,
+# license, or royalty fee is required for any of the authorized uses.
+# Modifications to this software may be copyrighted by their authors
+# and need not follow the licensing terms described here, provided that
+# the new terms are clearly indicated on the first page of each file where
+# they apply.
+# 
+# IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
+# FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
+# ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
+# DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
+# POSSIBILITY OF SUCH DAMAGE.
+# 
+# THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
+# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
+# FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT.  THIS SOFTWARE
+# IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
+# NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
+# MODIFICATIONS.
+#
+
+package require Tk
+
+namespace eval tkdnd {
+  variable _topw ".drag"
+  variable _tabops
+  variable _state
+  variable _x0
+  variable _y0
+  variable _platform_namespace
+  variable _drop_file_temp_dir
+  variable _auto_update 1
+
+  bind TkDND_Drag1 <ButtonPress-1> {tkdnd::_begin_drag press  %W %s %X %Y}
+  bind TkDND_Drag1 <B1-Motion>     {tkdnd::_begin_drag motion %W %s %X %Y}
+  bind TkDND_Drag2 <ButtonPress-2> {tkdnd::_begin_drag press  %W %s %X %Y}
+  bind TkDND_Drag2 <B2-Motion>     {tkdnd::_begin_drag motion %W %s %X %Y}
+  bind TkDND_Drag3 <ButtonPress-3> {tkdnd::_begin_drag press  %W %s %X %Y}
+  bind TkDND_Drag3 <B3-Motion>     {tkdnd::_begin_drag motion %W %s %X %Y}
+  
+  # ----------------------------------------------------------------------------
+  #  Command tkdnd::initialise: Initialise the TkDND package.
+  # ----------------------------------------------------------------------------
+  proc initialise { dir PKG_LIB_FILE PACKAGE_NAME} {
+    variable _platform_namespace
+    variable _drop_file_temp_dir
+    global env
+
+    ## 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
+        }
+      }
+    }
+    ## Under windows we have to also combine HOMEDRIVE & HOMEPATH...
+    if {![info exists UserHomeDir] && 
+         [string equal $tcl_platform(platform) windows] &&
+         [info exist env(HOMEDRIVE)] && [info exist 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]
+    }
+    
+    ## 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 /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 $UserAppDir
+    }
+    set _drop_file_temp_dir [file native $_drop_file_temp_dir]
+    
+    switch $::tcl_platform(platform) {
+      unix {
+        source $dir/tkdnd_unix.tcl
+        set _platform_namespace xdnd
+        load $dir/$PKG_LIB_FILE $PACKAGE_NAME
+      }
+      windows {
+        source $dir/tkdnd_windows.tcl
+        set _platform_namespace olednd
+        load $dir/libtkdnd20.dll TkDND
+      }
+    }
+    source $dir/tkdnd_compat.tcl
+  };# initialise
+
+  proc GetDropFileTempDirectory { } {
+    variable _drop_file_temp_dir
+    return $_drop_file_temp_dir
+  }
+  proc SetDropFileTempDirectory { dir } {
+    variable _drop_file_temp_dir
+    set _drop_file_temp_dir $dir
+  }
+  
+};# namespace tkdnd
+
+# ----------------------------------------------------------------------------
+#  Command tkdnd::drag_source
+# ----------------------------------------------------------------------------
+proc tkdnd::drag_source { mode path { types {} } { event 1 } } {
+  set tags [bindtags $path]
+  set idx  [lsearch $tags "TkDND_Drag*"]
+  switch -- $mode {
+    register {
+      if { $idx != -1 } {
+        bindtags $path [lreplace $tags $idx $idx TkDND_Drag$event]
+      } else {
+        bindtags $path [concat $tags TkDND_Drag$event]
+      }
+      set types [platform_specific_types $types]
+      set old_types [bind $path <<DragSourceTypes>>]
+      foreach type $types {
+        if {[lsearch $old_types $type] < 0} {lappend old_types $type}
+      }
+      bind $path <<DragSourceTypes>> $old_types
+    }
+    unregister {
+      if { $idx != -1 } {
+        bindtags $path [lreplace $tags $idx $idx]
+      }
+    }
+  }
+};# tkdnd::drag_source
+
+# ----------------------------------------------------------------------------
+#  Command tkdnd::drop_target
+# ----------------------------------------------------------------------------
+proc tkdnd::drop_target { mode path { types {} } } {
+  switch -- $mode {
+    set types [platform_specific_types $types]
+    register {
+      switch $::tcl_platform(platform) {
+        unix {
+          _register_types $path [winfo toplevel $path] $types
+        }
+        windows {
+          _RegisterDragDrop $path
+          bind <Destroy> $path {+ tkdnd::_RevokeDragDrop %W}
+        }
+      }
+      set old_types [bind $path <<DropTargetTypes>>]
+      foreach type $types {
+        if {[lsearch $old_types $type] < 0} {lappend old_types $type}
+      }
+      bind $path <<DropTargetTypes>> $old_types
+    }
+    unregister {
+      switch $::tcl_platform(platform) {
+        unix {
+        }
+        windows {
+          _RevokeDragDrop $path
+        }
+      }
+      bind $path <<DropTargetTypes>> {}
+    }
+  }
+};# tkdnd::drop_target
+
+# ----------------------------------------------------------------------------
+#  Command tkdnd::_begin_drag
+# ----------------------------------------------------------------------------
+proc tkdnd::_begin_drag { event source state X Y } {
+  variable _x0
+  variable _y0
+  variable _state
+
+  switch -- $event {
+    press {
+      set _x0    $X
+      set _y0    $Y
+      set _state "press"
+    }
+    motion {
+      if { ![info exists _state] } {
+        # This is just extra protection. There seem to be
+        # rare cases where the motion comes before the press.
+        return
+      }
+      if { [string equal $_state "press"] } {
+        if { abs($_x0-$X) > 3 || abs($_y0-$Y) > 3 } {
+          set _state "done"
+          _init_drag $source $state $X $Y
+        }
+      }
+    }
+  }
+};# tkdnd::_begin_drag
+
+# ----------------------------------------------------------------------------
+#  Command tkdnd::_init_drag
+# ----------------------------------------------------------------------------
+proc tkdnd::_init_drag { source state rootX rootY } {
+  # Call the <<DragInitCmd>> binding.
+  set cmd [bind $source <<DragInitCmd>>]
+  if {[string length $cmd]} {
+    set cmd [string map [list %W $source %X $rootX %Y $rootY \
+        %S $state %e <<DragInitCmd>> %A \{\} \
+        %t [bind $source <<DragSourceTypes>>]] $cmd]
+    set info [uplevel \#0 $cmd]
+    if { $info != "" } {
+      foreach { actions types data } $info { break }
+      set types [platform_specific_types $types]
+      set action [_DoDragDrop $source $actions $types $data]
+      _end_drag $source {} $action {} $data {} $state $rootX $rootY
+    }
+  }
+};# tkdnd::_init_drag
+
+# ----------------------------------------------------------------------------
+#  Command tkdnd::_end_drag
+# ----------------------------------------------------------------------------
+proc tkdnd::_end_drag { source target action type data result
+                        state rootX rootY } {
+  set rootX 0
+  set rootY 0
+  # Call the <<DragEndCmd>> binding.
+  set cmd [bind $source <<DragEndCmd>>]
+  if {[string length $cmd]} {
+    set cmd [string map [list %W $source %X $rootX %Y $rootY \
+        %S $state %e <<DragEndCmd>> %A \{$action\}] $cmd]
+    set info [uplevel \#0 $cmd]
+    if { $info != "" } {
+      foreach { actions types data } $info { break }
+      set types [platform_specific_types $types]
+      set action [_DoDragDrop $source $actions $types $data]
+      _end_drag $source {} $action {} $data {}
+    }
+  }
+};# tkdnd::_end_drag
+
+# ----------------------------------------------------------------------------
+#  Command tkdnd::platform_specific_types
+# ----------------------------------------------------------------------------
+proc tkdnd::platform_specific_types { types } {
+  variable _platform_namespace
+  return [${_platform_namespace}::_platform_specific_types $types]
+}; # tkdnd::platform_specific_types
+
+# ----------------------------------------------------------------------------
+#  Command tkdnd::platform_independent_types
+# ----------------------------------------------------------------------------
+proc tkdnd::platform_independent_types { types } {
+  variable _platform_namespace
+  return [${_platform_namespace}::_platform_independent_types $types]
+}; # tkdnd::platform_independent_types
+
+# ----------------------------------------------------------------------------
+#  Command tkdnd::platform_specific_type
+# ----------------------------------------------------------------------------
+proc tkdnd::platform_specific_type { type } {
+  variable _platform_namespace
+  return [${_platform_namespace}::_platform_specific_type $type]
+}; # tkdnd::platform_specific_type
+
+# ----------------------------------------------------------------------------
+#  Command tkdnd::platform_independent_type
+# ----------------------------------------------------------------------------
+proc tkdnd::platform_independent_type { type } {
+  variable _platform_namespace
+  return [${_platform_namespace}::_platform_independent_type $type]
+}; # tkdnd::platform_independent_type