From 0537dcf41109ab0d500a9a958264e067e6339dc0 Mon Sep 17 00:00:00 2001
From: petasis <petasis@f3661a36-4baa-549a-d6c7-40e0ffef350e>
Date: Fri, 14 Jan 2011 22:05:38 +0000
Subject: XDND fixes for TIP 370

---
 Changelog              |  8 ++++++--
 library/tkdnd.tcl      | 27 +++++++++++++++++++++++++++
 library/tkdnd_unix.tcl | 33 +++++++++++++++++++++++++++++++--
 unix/TkDND_XDND.c      |  2 +-
 4 files changed, 65 insertions(+), 5 deletions(-)

diff --git a/Changelog b/Changelog
index 93dce26..605be8a 100644
--- a/Changelog
+++ b/Changelog
@@ -1,10 +1,14 @@
 2011-01-14  Petasis George  <petasis@iit.demokritos.gr>
-        * /library/tkdnd_macosx.tcl: Fixed a bug reported by Kevin Walzer:
+        * library/tkdnd_unix.tcl: Added support for accepting drops, if
+        TIP 370 is finally approved. Changes tested with a preliminary TIP 370
+        implementation.
+
+        * library/tkdnd_macosx.tcl: Fixed a bug reported by Kevin Walzer:
         macdnd::_GetDroppedData and xdnd::_GetDroppedData were missing the
         "time" argument, added in the XDND section for TIP 370 (if it gets
         accepted).
 
-        * /macosx/macdnd.m: Restored back a workarround by Kevin Walzer, as
+        * macosx/macdnd.m: Restored back a workarround by Kevin Walzer, as
         TkDND does not work well under all circumstances in OS X 10.6.
         (Reported by Kevin Walzer on 23 Dec 2010).
 
diff --git a/library/tkdnd.tcl b/library/tkdnd.tcl
index 0eba75a..b97385d 100644
--- a/library/tkdnd.tcl
+++ b/library/tkdnd.tcl
@@ -389,3 +389,30 @@ proc tkdnd::platform_independent_type { type } {
   variable _platform_namespace
   return [${_platform_namespace}::_platform_independent_type $type]
 }; # tkdnd::platform_independent_type
+
+# ----------------------------------------------------------------------------
+#  Command tkdnd::bytes_to_string
+# ----------------------------------------------------------------------------
+proc tkdnd::bytes_to_string { bytes } {
+  set string {}
+  foreach byte $bytes {
+    append string [binary format c $byte]
+  }
+  return $string
+};# tkdnd::bytes_to_string
+
+# ----------------------------------------------------------------------------
+#  Command tkdnd::urn_unquote
+# ----------------------------------------------------------------------------
+proc tkdnd::urn_unquote {url} {
+  set result ""
+  set start 0
+  while {[regexp -start $start -indices {%[0-9a-fA-F]{2}} $url match]} {
+    foreach {first last} $match break
+    append result [string range $url $start [expr {$first - 1}]]
+    append result [format %c 0x[string range $url [incr first] $last]]
+    set start [incr last]
+  }
+  append result [string range $url $start end]
+  return $result
+};# tkdnd::urn_unquote
diff --git a/library/tkdnd_unix.tcl b/library/tkdnd_unix.tcl
index 386dab7..2535245 100644
--- a/library/tkdnd_unix.tcl
+++ b/library/tkdnd_unix.tcl
@@ -311,9 +311,11 @@ proc xdnd::_GetDroppedData { time } {
     # puts "TYPE: $type ($_drop_target)"
     # _get_selection $_drop_target $time $type
     if {![catch {
+      # selection get -displayof $_drop_target -selection XdndSelection \
+      #               -type $type -time $time} result options]} {
       selection get -displayof $_drop_target -selection XdndSelection \
                     -type $type} result options]} {
-      return $result
+      return [_normalise_data $type $result]
     }
   }
   return -options $options $result
@@ -364,8 +366,35 @@ proc xdnd::_platform_specific_types { types } {
 #  Command xdnd::_normalise_data
 # ----------------------------------------------------------------------------
 proc xdnd::_normalise_data { type data } {
+  # Tk knows how to interpret the following types:
+  #    STRING, TEXT, COMPOUND_TEXT
+  #    UTF8_STRING
+  # Else, it returns a list of 8 or 32 bit numbers... 
   switch $type {
-    CF_HDROP   {return [encoding convertfrom $data]}
+    STRING - UTF8_STRING - TEXT - COMPOUND_TEXT {return $data}
+    text/html     -
+    text/plain    {
+      return [encoding convertfrom utf-8 [tkdnd::bytes_to_string $data]]
+    }
+    text/uri-list {
+      set string [tkdnd::bytes_to_string $data]
+      ## Get rid of \r\n
+      set string [string map {\r\n \n} $string]
+      set files {}
+      foreach quoted_file [split $string] {
+        set file [encoding convertfrom utf-8 [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
+    }
+    text/x-moz-url - 
+    application/q-iconlist -
     default    {return $data}
   }
 }; # xdnd::_normalise_data
diff --git a/unix/TkDND_XDND.c b/unix/TkDND_XDND.c
index 01bc920..f2faab8 100644
--- a/unix/TkDND_XDND.c
+++ b/unix/TkDND_XDND.c
@@ -311,7 +311,7 @@ int TkDND_HandleXdndDrop(Tk_Window tkwin, XClientMessageEvent cm) {
 
   /* Call out Tcl callback. */
   objv[0] = Tcl_NewStringObj("tkdnd::xdnd::_HandleXdndDrop", -1);
-  objv[1] = Tcl_NewLongObj(time);
+  objv[1] = Tcl_NewWideIntObj(time);
   TkDND_Status_Eval(2);
   finished.data.l[1] = 1; /* Accept drop. */
   if (status == TCL_OK) {
-- 
cgit v0.12