Linux (XDND) support completed\!

5 files changed, 415 insertions, 58 deletions

diff --git a/Changelog b/Changelog
index 9c9d6c7..fe13114 100644
--- a/Changelog
+++ b/Changelog
@@ -1,3 +1,10 @@
+2012-06-07  Petasis George  <petasis@iit.demokritos.gr>
+	* demos/basic.tcl: Updated demo with support for colours, which only
+	works for XDND right now.
+
+	* unix/TkDND_XDND.c:
+	* unix/tkUnixSelect.c: Implementation of unix (XDND) drags completed.
+
 2012-06-06  Petasis George  <petasis@iit.demokritos.gr>
 	* unix/Cursors.c: Ported cursors from TkDND 1.x to TkDND 2.x
 
diff --git a/demos/basic.tcl b/demos/basic.tcl
index af74d72..6b852c4 100644
--- a/demos/basic.tcl
+++ b/demos/basic.tcl
@@ -39,7 +39,8 @@ foreach colour {red green blue navy} {
   pack [label .colours.$colour -text $colour -fg white -bg $colour] \

     -side left -padx 2

   tkdnd::drag_source register .colours.$colour

-  bind .colours.$colour <<DragInitCmd>> "list copy TK_COLOUR $colour"

+  bind .colours.$colour <<DragInitCmd>> \

+   "list copy DND_Color $colour"

 }

 grid .colours -sticky snew -columnspan 2

 

@@ -50,8 +51,15 @@ grid [label .drop_target -text {Drop Target:} -bg yellow] \
 # Register .drop_target as a drop target of every type!

 tkdnd::drop_target register .drop_target *

 

-# Add the various events...

+# During drag and drop, the drop target receives information through 3

+# virtual events: <<DropEnter>> <<DropPosition>> <<DropLeave>>

+# The fields that can be used in the event callbacks, are given in "cmd",

+# while their "label" is given in "itemList"...

 set cmd {handle_event %e %W %X %Y %ST %TT %a %A %CST %CTT %t %T %b %D}

+set itemList {Event Widget X Y Source_Types Target_Types Source_Actions Action

+              Common_Source_Types Common_Target_Types Types Drop_Type

+              Pressed_Keys Data}

+# Add the various events...

 bind .drop_target <<DropEnter>>      $cmd

 bind .drop_target <<DropPosition>>   $cmd

 bind .drop_target <<DropLeave>>      $cmd

@@ -63,10 +71,10 @@ bind .drop_target <<Drop>>           $cmd
 # Add a specialised <<Drop>> event, when will be called if a file is dropped.

 bind .drop_target <<Drop:DND_Files>> $cmd

 

+# Add a special drop command for DND_Color...

+bind .drop_target <<Drop:DND_Color>> $cmd 

+

 # Create some widgets for showing event info.

-set itemList {Event Widget X Y Source_Types Target_Types Source_Actions Action

-              Common_Source_Types Common_Target_Types Types Drop_Type

-              Pressed_Keys Data}

 foreach item $itemList {

   grid [label .[string tolower $item] -text [string map {_ \ } $item]:\

           -anchor w] [label .[string tolower $item]_val -width 30 -anchor w \

@@ -81,11 +89,26 @@ proc handle_event $itemList {
     .[string tolower $item]_val configure -text [set $item]

   }

   switch -glob $Event {

-    <<DropEnter>> {$Widget configure -bg green}

-    <<DropLeave>> {$Widget configure -bg yellow}

+    <<DropEnter>>      {$Widget configure -bg green}

+    <<DropLeave>>      {$Widget configure -bg yellow}

+    <<Drop:DND_Color>> {

+      $Widget configure -bg yellow

+      .drop_target_value configure -text $Data

+      ## Convert data into a Tk color: the colour data is a list of 4 elements

+      ## (red green blue opacity), expressed as Hex numbers...

+      set color "#"

+      for {set i 0} {$i < 3} {incr i} {

+        ## Just remove the 0x prefix...

+        append color [string range [lindex $Data $i] 2 end]

+      }

+      .drop_target_value configure -background $color -foreground white

+    }

     <<Drop>> -

-    <<Drop:*>>    {$Widget configure -bg yellow

-                   .drop_target_value configure -text $Data}

+    <<Drop:*>>         {

+      $Widget configure -bg yellow

+      .drop_target_value configure -text $Data \

+           -background [. cget -background] -foreground black

+    }

   }

   return copy

 };# handle_event

diff --git a/library/tkdnd_unix.tcl b/library/tkdnd_unix.tcl
index 58ce39a..fbaef3d 100644
--- a/library/tkdnd_unix.tcl
+++ b/library/tkdnd_unix.tcl
@@ -327,6 +327,7 @@ proc xdnd::_GetDroppedData { time } {
   } else {
     set _use_tk_selection 1
   }
+  #set _use_tk_selection 1
   foreach type $_common_drag_source_types {
     # puts "TYPE: $type ($_drop_target)"
     # _get_selection $_drop_target $time $type
@@ -400,25 +401,28 @@ proc xdnd::_normalise_data { type data } {
   #    STRING, TEXT, COMPOUND_TEXT
   #    UTF8_STRING
   # Else, it returns a list of 8 or 32 bit numbers... 
-  switch $type {
+  switch -glob $type {
     STRING - UTF8_STRING - TEXT - COMPOUND_TEXT {return $data}
     text/html     -
     text/plain    {
-      if {[catch {tkdnd::bytes_to_string $data} string]} {
+      if {[catch {
+            encoding convertfrom utf-8 [tkdnd::bytes_to_string $data]
+           } string]} {
         set string $data
       }
-      return [string map {\r\n \n} \
-        [encoding convertfrom utf-8 $string]]
+      return [string map {\r\n \n} $string
     }
-    text/uri-list {
-      if {[catch {tkdnd::bytes_to_string $data} 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 [encoding convertfrom utf-8 [tkdnd::urn_unquote $quoted_file]]
+        set file [tkdnd::urn_unquote $quoted_file]
         switch -glob $file {
           file://*  {lappend files [string range $file 7 end]}
           ftp://*   -
@@ -429,6 +433,9 @@ proc xdnd::_normalise_data { type data } {
       }
       return $files
     }
+    application/x-color {
+      return $data
+    }
     text/x-moz-url - 
     application/q-iconlist -
     default    {return $data}
@@ -441,8 +448,9 @@ proc xdnd::_normalise_data { type data } {
 proc xdnd::_platform_specific_type { type } {
   switch $type {
     DND_Text   {return [list text/plain\;charset=utf-8 UTF8_STRING \
-                             text/plain STRING]}
+                             text/plain STRING TEXT COMPOUND_TEXT]}
     DND_Files  {return [list text/uri-list]}
+    DND_Color  {return [list application/x-color]}
     default    {return [list $type]}
   }
 }; # xdnd::_platform_specific_type
@@ -451,12 +459,15 @@ proc xdnd::_platform_specific_type { type } {
 #  Command xdnd::_platform_independent_type
 # ----------------------------------------------------------------------------
 proc xdnd::_platform_independent_type { type } {
-  switch $type {
-    UTF8_STRING   -
-    STRING        -
-    text/plain    {return DND_Text}
-    text/uri-list {return DND_Files}
-    default       {return [list $type]}
+  switch -glob $type {
+    UTF8_STRING         -
+    STRING              -
+    TEXT                -
+    COMPOUND_TEXT       -
+    text/plain*         {return DND_Text}
+    text/uri-list*      {return DND_Files}
+    application/x-color {return DND_Color}
+    default             {return [list $type]}
   }
 }; # xdnd::_platform_independent_type
 
@@ -464,9 +475,11 @@ proc xdnd::_platform_independent_type { type } {
 #  Command xdnd::_supported_type
 # ----------------------------------------------------------------------------
 proc xdnd::_supported_type { type } {
-  switch $type {
-    {text/plain;charset=UTF-8} - text/plain -
-    text/uri-list {return 1}
+  switch -glob [string tolower $type] {
+    {text/plain;charset=utf-8} - text/plain -
+    utf8_string - string - text - compound_text -
+    text/uri-list* -
+    application/x-color {return 1}
   }
   return 0
 }; # xdnd::_supported_type
@@ -491,8 +504,8 @@ proc xdnd::_selection_ownership_lost {} {
 proc xdnd::_dodragdrop { source actions types data button } {
   variable _dragging
 
-  puts "xdnd::_dodragdrop: source: $source, actions: $actions, types: $types,\
-        data: \"$data\", button: $button"
+  # puts "xdnd::_dodragdrop: source: $source, actions: $actions, types: $types,\
+  #       data: \"$data\", button: $button"
   if {$_dragging} {
     ## We are in the middle of another drag operation...
     error "another drag operation in progress"
@@ -507,6 +520,7 @@ proc xdnd::_dodragdrop { source actions types data button } {
   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
@@ -515,6 +529,7 @@ proc xdnd::_dodragdrop { source actions types data button } {
   variable _dodragdrop_drop_target_accepts_action refuse_drop
   variable _dodragdrop_current_cursor             $_dodragdrop_default_action
   variable _dodragdrop_drop_occured               0
+  variable _dodragdrop_selection_requestor        0
 
   ##
   ## If we have more than 3 types, the property XdndTypeList must be set on
@@ -534,10 +549,7 @@ proc xdnd::_dodragdrop { source actions types data button } {
   ##
   ## Arrange selection handlers for our drag source, and all the supported types
   ##
-  foreach t $types {
-    selection handle -selection XdndSelection -type $t -format UTF8_STRING \
-      $source [list ::tkdnd::xdnd::_SendData $t]
-  }
+  registerSelectionHandler $source $types
 
   ##
   ## Step 1: When a drag begins, the source takes ownership of XdndSelection.
@@ -565,32 +577,33 @@ proc xdnd::_dodragdrop { source actions types data button } {
   _ungrab_pointer $source
   _unregister_generic_event_handler
   catch {selection clear -selection XdndSelection}
-  foreach t $types {
-    catch {
-      selection handle -selection XdndSelection -type $t -format UTF8_STRING \
-                        $source {}
-    }
-  }
+  unregisterSelectionHandler $source $types
 };# xdnd::_dodragdrop
 
 # ----------------------------------------------------------------------------
 #  Command xdnd::_process_drag_events
 # ----------------------------------------------------------------------------
 proc xdnd::_process_drag_events {event} {
+  # The return value from proc is normally 0. A non-zero return value indicates
+  # that the event is not to be handled further; that is, proc has done all
+  # processing that is to be allowed for the event
   variable _dragging
   if {!$_dragging} {return 0}
   # puts $event
 
   variable _dodragdrop_time
   set time [dict get $event time]
-  if {$time < $_dodragdrop_time} {return 0}
+  set type [dict get $event type]
+  if {$time < $_dodragdrop_time && ![string equal $type SelectionRequest]} {
+    return 0
+  }
   set _dodragdrop_time $time
 
   variable _dodragdrop_drag_source
   variable _dodragdrop_drop_target
   variable _dodragdrop_drop_target_proxy
   variable _dodragdrop_default_action
-  switch [dict get $event type] {
+  switch $type {
     MotionNotify {
       set rootx  [dict get $event x_root]
       set rooty  [dict get $event y_root]
@@ -643,6 +656,19 @@ proc xdnd::_process_drag_events {event} {
         }
       }
     }
+    SelectionRequest {
+      variable _dodragdrop_selection_requestor
+      variable _dodragdrop_selection_property
+      variable _dodragdrop_selection_selection
+      variable _dodragdrop_selection_target
+      variable _dodragdrop_selection_time
+      set _dodragdrop_selection_requestor [dict get $event requestor]
+      set _dodragdrop_selection_property  [dict get $event property]
+      set _dodragdrop_selection_selection [dict get $event selection]
+      set _dodragdrop_selection_target    [dict get $event target]
+      set _dodragdrop_selection_time      $time
+      return 0
+    }
     default {
       return 0
     }
@@ -785,15 +811,6 @@ proc xdnd::_SendXdndDrop {} {
 };# xdnd::_SendXdndDrop
 
 # ----------------------------------------------------------------------------
-#  Command xdnd::_SendData
-# ----------------------------------------------------------------------------
-proc xdnd::_SendData {type s e args} {
-  variable _dodragdrop_data
-  puts "SendData: $type $s $e $args ($_dodragdrop_data)"
-  return [string range $_dodragdrop_data $s $e]
-};# xdnd::_SendData
-
-# ----------------------------------------------------------------------------
 #  Command xdnd::_update_cursor
 # ----------------------------------------------------------------------------
 proc xdnd::_update_cursor { {cursor {}}} {
@@ -814,6 +831,7 @@ proc xdnd::_update_cursor { {cursor {}}} {
     set _dodragdrop_current_cursor $cursor
   }
 };# xdnd::_update_cursor
+
 # ----------------------------------------------------------------------------
 #  Command xdnd::_default_action
 # ----------------------------------------------------------------------------
@@ -837,3 +855,159 @@ proc xdnd::_default_action {event} {
   }
   return default
 };# xdnd::_default_action
+
+# ----------------------------------------------------------------------------
+#  Command xdnd::getFormatForType
+# ----------------------------------------------------------------------------
+proc xdnd::getFormatForType {type} {
+  switch -glob [string tolower $type] {
+    text/plain\;charset=utf-8 -
+    utf8_string               {set format UTF8_STRING}
+    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_data
+  variable _dodragdrop_transfer_data
+  set format 8
+  if {$offset == 0} {
+    ## Prepare the data to be transfered...
+    switch -glob $type {
+      text/plain* - UTF8_STRING - STRING - TEXT - COMPOUND_TEXT {
+        binary scan [encoding convertto utf-8 $_dodragdrop_data] \
+                    c* _dodragdrop_transfer_data
+        set _dodragdrop_transfer_data \
+           [_convert_to_unsigned $_dodragdrop_transfer_data $format]
+      }
+      text/uri-list* {
+        set files [list]
+        foreach file $_dodragdrop_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 $_dodragdrop_data] {
+          1 { set color [winfo rgb $_dodragdrop_drag_source $_dodragdrop_data]
+              lappend color 65535 }
+          3 { set color $_dodragdrop_data; lappend color 65535 }
+          4 { set color $_dodragdrop_data }
+          default {error "unknown color data: \"$_dodragdrop_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 $_dodragdrop_data c* _dodragdrop_transfer_data
+      }
+    }
+  }
+
+  ##
+  ## Data has been split into bytes. Count the bytes requested, and return them
+  ##
+  set data [lrange $_dodragdrop_transfer_data $offset [expr {$offset+$bytes-1}]]
+  switch $format {
+    8  {
+      set data [encoding convertfrom utf-8 [binary format c* $data]]
+    }
+    16 {
+      variable _dodragdrop_selection_requestor
+      if {$_dodragdrop_selection_requestor} {
+        ## Tk selection cannot process this format (only 8 & 32 supported).
+        ## Call our XChangeProperty...
+        set numItems [llength $data]
+        variable _dodragdrop_selection_property
+        variable _dodragdrop_selection_selection
+        variable _dodragdrop_selection_target
+        variable _dodragdrop_selection_time
+        XChangeProperty $_dodragdrop_drag_source \
+                        $_dodragdrop_selection_requestor \
+                        $_dodragdrop_selection_property \
+                        $_dodragdrop_selection_target \
+                        $format \
+                        $_dodragdrop_selection_time \
+                        $data $numItems
+        return -code break
+      }
+    }
+    32 {
+    }
+    default {
+      error "unsupported format $format"
+    }
+  }
+  # puts "SendData: $type $offset $bytes $args ($_dodragdrop_data)"
+  # puts "          $data"
+  return $data
+};# xdnd::_SendData
diff --git a/unix/TkDND_XDND.c b/unix/TkDND_XDND.c
index 993a685..d807b66 100644
--- a/unix/TkDND_XDND.c
+++ b/unix/TkDND_XDND.c
@@ -38,6 +38,7 @@
 #include "tcl.h"
 #include "tk.h"
 #include <string.h>
+#include <stdlib.h>
 #include <X11/Xlib.h>
 #include <X11/X.h>
 #include <X11/Xatom.h>
@@ -392,8 +393,8 @@ int TkDND_HandleXdndPosition(Tk_Window tkwin, XEvent *xevent) {
     ActionCopy, ActionMove, ActionLink, ActionAsk, ActionPrivate,
     refuse_drop, ActionDefault
   };
-  Time time;
-  Atom action;
+/*Time time;
+  Atom action;*/
 
   if (interp == NULL || tkwin == NULL) return False;
 
@@ -402,9 +403,9 @@ int TkDND_HandleXdndPosition(Tk_Window tkwin, XEvent *xevent) {
   rootX  = XDND_POSITION_ROOT_X(xevent);
   rootY  = XDND_POSITION_ROOT_Y(xevent);
   /* Get the time from the event... */
-  time   = XDND_POSITION_TIME(xevent);
+  /* time   = XDND_POSITION_TIME(xevent); */
   /* Get the user action from the event... */
-  action = XDND_POSITION_ACTION(xevent);
+  /* action = XDND_POSITION_ACTION(xevent); */
 
   /* The event may have been delivered to the toplevel wrapper.
    * Try to find the toplevel window... */
@@ -1032,7 +1033,21 @@ int TkDND_HandleGenericEvent(ClientData clientData, XEvent *eventPtr) {
       TkDND_Dict_Put(dict, "type", "LeaveNotify");
       TkDND_Dict_PutLong(dict, "time",    eventPtr->xcrossing.time);
       break;
-        default:
+    case SelectionRequest:
+      main_window = Tk_MainWindow(interp);
+      TkDND_Dict_Put(dict, "type", "SelectionRequest");
+      TkDND_Dict_PutLong(dict, "time",     eventPtr->xselectionrequest.time);
+      TkDND_Dict_PutLong(dict, "owner",    eventPtr->xselectionrequest.owner);
+      TkDND_Dict_PutLong(dict, "requestor",
+                                eventPtr->xselectionrequest.requestor);
+      TkDND_Dict_Put(dict,     "selection",
+            Tk_GetAtomName(main_window, eventPtr->xselectionrequest.selection));
+      TkDND_Dict_Put(dict,     "target",
+            Tk_GetAtomName(main_window, eventPtr->xselectionrequest.target));
+      TkDND_Dict_Put(dict,     "property",
+            Tk_GetAtomName(main_window, eventPtr->xselectionrequest.property));
+      break;
+    default:
       Tcl_DecrRefCount(dict);
       return 0;
   }
@@ -1360,6 +1375,95 @@ int TkDND_SendXdndDropObjCmd(ClientData clientData,
   return TCL_OK;
 }; /* TkDND_SendXdndDropObjCmd */
 
+int TkDND_XChangePropertyObjCmd(ClientData clientData,
+                         Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) {
+  XEvent event;
+  Window target;
+  Atom property = None, type = None;
+  int format, numItems, numFields, i;
+  Display *display;
+  Tk_Window source;
+  Time time;
+  unsigned char *data = NULL;
+  Tcl_Obj **field;
+
+  if (objc != 9) {
+    Tcl_WrongNumArgs(interp, 1, objv,
+        "source requestor property type format time data data_items");
+    return TCL_ERROR;
+  }
+
+  source = TkDND_TkWin(objv[1]);
+  if (!source) return TCL_ERROR;
+  if (Tcl_GetLongFromObj(interp, objv[2], (long *) &target) != TCL_OK) {
+    return TCL_ERROR;
+  }
+  display  = Tk_Display(source);
+  property = Tk_InternAtom(source, Tcl_GetString(objv[3]));
+  type     = Tk_InternAtom(source, Tcl_GetString(objv[4]));
+  if (Tcl_GetIntFromObj(interp, objv[5], &format) != TCL_OK) {
+    return TCL_ERROR;
+  }
+  if (format != 8 && format != 16 && format != 32) {
+    Tcl_SetResult(interp, "unsupported format: not 8, 16 or 32", TCL_STATIC);
+    return TCL_ERROR;
+  }
+  if (Tcl_GetIntFromObj(interp, objv[5], &format) != TCL_OK) {
+    return TCL_ERROR;
+  }
+  if (Tcl_GetLongFromObj(interp, objv[6], (long *) &time) != TCL_OK) {
+    return TCL_ERROR;
+  }
+  if (Tcl_GetIntFromObj(interp, objv[8], &numItems) != TCL_OK) {
+    return TCL_ERROR;
+  }
+  if (!time) time = CurrentTime;
+  switch (format) {
+    case 8:
+      data = (unsigned char *) Tcl_GetString(objv[7]);
+      break;
+    case 16: {
+      short *propPtr = (short *) Tcl_Alloc(sizeof(short)*numItems);
+      data = (unsigned char *) propPtr;
+      if (Tcl_ListObjGetElements(interp, objv[7], &numFields, &field)
+                                                                   != TCL_OK) {
+        return TCL_ERROR;
+      }
+      for (i = 0; i < numItems; i++) {
+	char *dummy;
+	propPtr[i] = (short) strtol(Tcl_GetString(field[i]), &dummy, 0);
+      }
+      break;
+    }
+    case 32: {
+      long *propPtr  = (long *) Tcl_Alloc(sizeof(long)*numItems);
+      data = (unsigned char *) propPtr;
+      if (Tcl_ListObjGetElements(interp, objv[7], &numFields, &field)
+                                                                   != TCL_OK) {
+        return TCL_ERROR;
+      }
+      for (i = 0; i < numItems; i++) {
+	char *dummy;
+	propPtr[i] = (short) strtol(Tcl_GetString(field[i]), &dummy, 0);
+      }
+      break;
+    }
+  }
+  XChangeProperty(display, target, property, type, format, PropModeReplace,
+         (unsigned char *) data, numItems);
+  if (format > 8 && data) Tcl_Free((char *) data);
+  /* Send selection notify to requestor... */
+  event.xselection.type      = SelectionNotify;
+  event.xselection.display   = display;
+  event.xselection.requestor = target;
+  event.xselection.selection = Tk_InternAtom(source, "XdndSelection");
+  event.xselection.target    = type;
+  event.xselection.property  = property;
+  event.xselection.time      = time;
+  XSendEvent(display, target, False, NoEventMask, &event);
+  return TCL_OK;
+}; /* TkDND_XChangePropertyObjCmd */
+
 /*
  * For C++ compilers, use extern "C"
  */
@@ -1500,6 +1604,12 @@ int DLLEXPORT Tkdnd_Init(Tcl_Interp *interp) {
     return TCL_ERROR;
   }
 
+  if (Tcl_CreateObjCommand(interp, "XChangeProperty",
+           (Tcl_ObjCmdProc*) TkDND_XChangePropertyObjCmd,
+           (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL) == NULL) {
+    return TCL_ERROR;
+  }
+
   /* Create the cursors... */
   TkDND_InitialiseCursors(interp);
 
diff --git a/unix/tkUnixSelect.c b/unix/tkUnixSelect.c
index 2baa0fb..99f208b 100644
--- a/unix/tkUnixSelect.c
+++ b/unix/tkUnixSelect.c
@@ -65,7 +65,7 @@ int TkDND_ClipboardReadProperty(Tk_Window tkwin,
     }
     XFree((char*)data);
 
-    int offset = 0, format_inc = 1;
+    int offset = 0, format_inc = 1, proplen = bytes_left;
 
     switch (*format) {
     case 8:
@@ -75,10 +75,12 @@ int TkDND_ClipboardReadProperty(Tk_Window tkwin,
 
     case 16:
         format_inc = sizeof(short) / 2;
+        proplen   *= sizeof(short) / 2;
         break;
 
     case 32:
         format_inc = sizeof(long) / 4;
+        proplen   *= sizeof(long) / 4;
         break;
     }
 
@@ -88,13 +90,46 @@ int TkDND_ClipboardReadProperty(Tk_Window tkwin,
                              &length, &bytes_left, &data);
       if (r != Success || (type && *type == None))
           break;
+      switch (*format) {
+        case 8:
+        default:
+          offset += length / (32 / *format);
+          length *= format_inc * (*format) / 8;
+          Tcl_DStringAppend(buffer, (char *) data, length);
+          break;
+        case 16: {
+          register unsigned short *propPtr = (unsigned short *) data;
+          for (; length > 0; propPtr++, length--) {
+            char buf[12];
+
+	    sprintf(buf, "0x%04x", (unsigned short) *propPtr);
+	    Tcl_DStringAppendElement(buffer, buf);
+          }
+          Tcl_DStringAppend(buffer, " ", 1);
+          break;
+        }
+        case 32: {
+          register unsigned long *propPtr = (unsigned long *) data;
+          for (; length > 0; propPtr++, length--) {
+            char buf[12];
 
-      offset += length / (32 / *format);
-      length *= format_inc * (*format) / 8;
-      Tcl_DStringAppend(buffer, (char *) data, length);
+	    sprintf(buf, "0x%x", (unsigned int) *propPtr);
+	    Tcl_DStringAppendElement(buffer, buf);
+          }
+          Tcl_DStringAppend(buffer, " ", 1);
+          break;
+        }
+      }
 
       XFree((char*)data);
     }
+#if 0
+    printf("Selection details:\n");
+    printf("  type: %s\n", XGetAtomName(display, *type));
+    printf("  format: %d %s\n", *format, XGetAtomName(display, *format));
+    printf("  length: %d\n", Tcl_DStringLength(buffer));
+    printf("  data: \"%s\"\n", Tcl_DStringValue(buffer));
+#endif
 
     if (*format == 8 && *type == Tk_InternAtom(tkwin, "COMPOUND_TEXT")) {
       // convert COMPOUND_TEXT to a multibyte string
@@ -166,6 +201,14 @@ void TkDND_SelectionNotifyEventProc(ClientData clientData, XEvent *eventPtr) {
   status = TkDND_ClipboardReadProperty(detail->tkwin, detail->property, 1,
                                        detail, &size, &type, &format);
   if (status) {
+#ifdef TKDND_DebugSelectionRequests
+    printf("SelectionNotify: selection: %s, target: %s, property: %s,\
+            type: %s, format: %d\n",
+            Tk_GetAtomName(detail->tkwin, eventPtr->xselection.selection),
+            Tk_GetAtomName(detail->tkwin, eventPtr->xselection.target),
+            Tk_GetAtomName(detail->tkwin, eventPtr->xselection.property),
+            Tk_GetAtomName(detail->tkwin, type), format);
+#endif /* TKDND_DebugSelectionRequests */
     if (type == Tk_InternAtom(detail->tkwin, "INCR")) {
       status = TkDND_ClipboardReadIncrementalProperty(detail->tkwin,
                                        detail->property, detail);