Multiple data types on drag sources

13 files changed, 254 insertions, 142 deletions

diff --git a/CMakeLists.txt b/CMakeLists.txt
index a14dedb..5fdb561 100644
--- a/CMakeLists.txt
+++ b/CMakeLists.txt
@@ -19,7 +19,7 @@ PROJECT ( tkdnd )
 ## Package version information:
 SET ( PKG_NAME          ${PROJECT_NAME} )
 SET ( PKG_MAJOR_VERSION 2 )
-SET ( PKG_MINOR_VERSION 6 )
+SET ( PKG_MINOR_VERSION 7 )
 SET ( PKG_BUILD_VERSION 0 )
 ## Author:
 SET ( PKG_VENDOR        "Georgios Petasis" )
diff --git a/Changelog b/Changelog
index d067e91..7edfbce 100644
--- a/Changelog
+++ b/Changelog
@@ -1,3 +1,29 @@
+2014-08-04  Petasis George  <petasis@iit.demokritos.gr>
+	* library/tkdnd_unix.tcl: Fixed a bug where successive drags may
+	be canceled, by a delayed XDNDFinished event, which is scheduled by
+	xdnd::_SendXdndDrop to occur after 10 seconds (as a protection against
+	a failed selection transfer by the client).
+	Bug reported by Csaba Nemethi.
+
+2014-01-05  Petasis George  <petasis@iit.demokritos.gr>
+	* doc/tkDND.n: Updated the man page.
+
+	* demos/complex_source.tcl:
+	* demos/simple_source.tcl:
+	* demos/simple_target.tcl: New demos.
+
+	* win/OleDND.h:
+	* win/TkDND_OleDND.cpp:
+	* library/tkdnd.tcl:
+	* library/tkdnd_windows.tcl: Added support for sources with multiple
+	and (incompatible) types, that require different data to be dropped. The
+	changes affect the <<DragInitCmd>>, where there are now to types of
+	return values expected from the event. Changes have been tested only
+	under Windows. Unix/OS X not yet implemented.
+
+	* demos/basic.tcl: Added information about the cross-platform dropped
+	type.
+
 2012-11-27  Petasis George  <petasis@iit.demokritos.gr>
 	* library/tkdnd_unix.tcl:
 	* library/tkdnd_windows.tcl: Leave and Drop events do not report 0
diff --git a/configure b/configure
index 5883581..1baa822 100755
--- a/configure
+++ b/configure
@@ -1,6 +1,6 @@
 #! /bin/sh
 # Guess values for system-dependent variables and create Makefiles.
-# Generated by GNU Autoconf 2.68 for tkdnd 2.6.
+# Generated by GNU Autoconf 2.68 for tkdnd 2.7.
 #
 #
 # Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,
@@ -557,8 +557,8 @@ MAKEFLAGS=
 # Identity of this package.
 PACKAGE_NAME='tkdnd'
 PACKAGE_TARNAME='tkdnd'
-PACKAGE_VERSION='2.6'
-PACKAGE_STRING='tkdnd 2.6'
+PACKAGE_VERSION='2.7'
+PACKAGE_STRING='tkdnd 2.7'
 PACKAGE_BUGREPORT=''
 PACKAGE_URL=''
 
@@ -1295,7 +1295,7 @@ if test "$ac_init_help" = "long"; then
   # Omit some internal or obsolete options to make the list less imposing.
   # This message is too long to be a string in the A/UX 3.1 sh.
   cat <<_ACEOF
-\`configure' configures tkdnd 2.6 to adapt to many kinds of systems.
+\`configure' configures tkdnd 2.7 to adapt to many kinds of systems.
 
 Usage: $0 [OPTION]... [VAR=VALUE]...
 
@@ -1360,7 +1360,7 @@ fi
 
 if test -n "$ac_init_help"; then
   case $ac_init_help in
-     short | recursive ) echo "Configuration of tkdnd 2.6:";;
+     short | recursive ) echo "Configuration of tkdnd 2.7:";;
    esac
   cat <<\_ACEOF
 
@@ -1466,7 +1466,7 @@ fi
 test -n "$ac_init_help" && exit $ac_status
 if $ac_init_version; then
   cat <<\_ACEOF
-tkdnd configure 2.6
+tkdnd configure 2.7
 generated by GNU Autoconf 2.68
 
 Copyright (C) 2010 Free Software Foundation, Inc.
@@ -1923,7 +1923,7 @@ cat >config.log <<_ACEOF
 This file contains any messages produced by compilers while
 running configure, to aid debugging if configure makes a mistake.
 
-It was created by tkdnd $as_me 2.6, which was
+It was created by tkdnd $as_me 2.7, which was
 generated by GNU Autoconf 2.68.  Invocation command line was
 
   $ $0 $@
@@ -10515,7 +10515,7 @@ cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
 # report actual input values of CONFIG_FILES etc. instead of their
 # values after options handling.
 ac_log="
-This file was extended by tkdnd $as_me 2.6, which was
+This file was extended by tkdnd $as_me 2.7, which was
 generated by GNU Autoconf 2.68.  Invocation command line was
 
   CONFIG_FILES    = $CONFIG_FILES
@@ -10568,7 +10568,7 @@ _ACEOF
 cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
 ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`"
 ac_cs_version="\\
-tkdnd config.status 2.6
+tkdnd config.status 2.7
 configured by $0, generated by GNU Autoconf 2.68,
   with options \\"\$ac_cs_config\\"
 
diff --git a/configure.in b/configure.in
index 515152f..dff9c3d 100644
--- a/configure.in
+++ b/configure.in
@@ -19,7 +19,7 @@ dnl	to configure the system for the local environment.
 # so you can encode the package version directly into the source files.
 #-----------------------------------------------------------------------
 
-AC_INIT([tkdnd], [2.6])
+AC_INIT([tkdnd], [2.7])
 
 #--------------------------------------------------------------------
 # Call TEA_INIT as the first TEA_ macro to set up initial vars.
diff --git a/demos/basic.tcl b/demos/basic.tcl
index 6b852c4..ce1c2c9 100644
--- a/demos/basic.tcl
+++ b/demos/basic.tcl
@@ -55,9 +55,10 @@ tkdnd::drop_target register .drop_target *
 # 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 cmd {handle_event %e %W %X %Y %ST %TT %a %A %CST %CTT %t %T %CPT %b %D}

 set itemList {Event Widget X Y Source_Types Target_Types Source_Actions Action

-              Common_Source_Types Common_Target_Types Types Drop_Type

+              Common_Source_Types Common_Target_Types Types

+	      Drop_Type Cross_Platform_Drop_Type

               Pressed_Keys Data}

 # Add the various events...

 bind .drop_target <<DropEnter>>      $cmd

@@ -77,7 +78,7 @@ bind .drop_target <<Drop:DND_Color>> $cmd
 # Create some widgets for showing event info.

 foreach item $itemList {

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

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

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

           -background white -foreground navy] -sticky snew -padx 1 -pady 1

 }

 grid columnconfigure . 1 -weight 1

diff --git a/doc/tkDND.n b/doc/tkDND.n
index 308813e..a980de3 100644
--- a/doc/tkDND.n
+++ b/doc/tkDND.n
@@ -1,5 +1,5 @@
 '\"
-'\" This software (tkDND) is copyrighted by:
+'\" This software (TkDND) is copyrighted by:
 '\"   George Petasis, National Centre for Scientific Research "Demokritos",
 '\"   Aghia Paraskevi, Athens, Greece.
 '\"   e-mail: petasis@iit.demokritos.gr
@@ -92,7 +92,7 @@
 '\" .UL arg1 arg2
 '\"	Print arg1 underlined, then print arg2 normally.
 '\"
-'\" RCS: @(#) $Id: tkDND.n,v 1.2 2002/04/12 08:42:24 petasis Exp $
+'\" RCS: @(#) $Id: TkDND.n,v 1.2 2002/04/12 08:42:24 petasis Exp $
 '\"
 '\"	# Set up traps and other miscellaneous stuff for Tcl/Tk man pages.
 .if t .wh -1.3i ^B
@@ -268,11 +268,11 @@ Database Class:	\\fB\\$3\\fR
 .de UL
 \\$1\l'|0\(ul'\\$2
 ..
-.TH tkdnd n 8.4 Tk "Tk Built-In Commands"
+.TH TkDND n 8.4 Tk "Tk Built-In Commands"
 .BS
 '\" Note:  do not modify the .SH NAME line immediately below!
 .SH NAME
-tkdnd \- Tk Drag and Drop Interface
+TkDND \- Tk Drag and Drop Interface
 .SH SYNOPSIS
 \fBtkdnd::drop_target register\fI window ?type-list?\fR
 .br
@@ -291,22 +291,22 @@ tkdnd \- Tk Drag and Drop Interface
 \fBtkdnd::SetDropFileTempDirectory \fIdirectory\fR
 
 .SH INTRODUCTION
-The \fBtkdnd\fR family commands provide a Tcl interface to native,
+The \fBTkDND\fR family commands provide a Tcl interface to native,
 platform specific drag and drop mechanism.
 Under Unix the drag & drop protocol in use is the XDND protocol version 5
 (also used by the Qt toolkit, and the KDE and GNOME desktops). 
 Under Windows, the OLE2 drag & drop interfaces are used.
 Under Macintosh, the Cocoa drag and drop interfaces are used.
 .PP
-The \fbtkdnd\fR family can be built from source code using the standard configure; make; make install procedure. Cmake is also supported. Some binary package are available from the SourceForge download site, from ActiveState's ActiveTcl distribution, and elsewhere.
+The \fbTkDND\fR family can be built from source code using the standard configure; make; make install procedure. Cmake is also supported. Some binary package are available from the SourceForge download site, from ActiveState's ActiveTcl distribution, and elsewhere.
 .PP
-With the \fBtkdnd\fR family commands the user is able to register existing Tk
+With the \fBTkDND\fR family commands the user is able to register existing Tk
 widgets as drag sources or drop targets, that are able to send or receive data
 during drag and drop operations, encoded in specific types.
 These types can be platform independent types like DND_Text and DND_Files or
 platform specific types, like CF_UNICODETEXT or text/plain.
 .PP
-The legal forms for the \fBtkdnd\fR commands are:
+The legal forms for the \fBTkDND\fR commands are:
 .TP
 \fBtkdnd::drop_target register\fI window ?type-list?\fR
 This command will register \fIwindow\fR as a drop target. A drop target is a
@@ -380,12 +380,12 @@ temporary files to \fIdirectory\fR.
 .SH SUPPORTED TYPES
 In order to declare the format that the data that will transfered during
 a drag and drop operation, all drag and drop protocols use the notion of types.
-Unfortunately, each protocol defines its own, usually platform specific, types. Tkdnd, trying to maintain portability among different platforms, offers some
+Unfortunately, each protocol defines its own, usually platform specific, types. TkDND, trying to maintain portability among different platforms, offers some
 predefined types for some basic kinds of data, like text, and filenames.
-Currently, the following predifined cross-platform values are available:
+Currently, the following predefined cross-platform values are available:
 .IP  \fBDND_Text\fR: 5
-This type can be used for transfering textual data. Internally, it is translated
-to the following platform specific formats:
+This type can be used for transferring textual data. Internally, it is
+translated to the following platform specific formats:
 .br
 Windows: \fBCF_UNICODETEXT\fR, \fBCF_TEXT\fR.
 .br
@@ -393,7 +393,7 @@ Unix: \fBtext/plain;charset=UTF-8\fR, \fBtext/plain\fR.
 .br
 Mac: \fBNSStringPboardType\fR.
 .IP  \fBDND_Files\fR: 5
-This type can be used for transfering a list of file names.
+This type can be used for transferring a list of file names.
 Internally, it is translated to the following platform specific formats:
 .br
 Windows: \fBCF_HDROP\fR.
@@ -402,30 +402,30 @@ Unix: \fBtext/uri-list\fR.
 .br
 Mac: \fBNSFilenamesPboardType\fR.
 .TP
-Additionally to the platform independent types, tkdnd supports the following platform specific types:
+Additionally to the platform independent types, TkDND supports the following platform specific types:
 .IP  \fBWindows\fR: 5
-\fBCF_UNICODETEXT\fR: Text transfer encoded in unicode.
+\fBCF_UNICODETEXT\fR: Text transfer encoded in Unicode.
 .br
 \fBCF_TEXT\fR: Text transfer with application dependent encoding. If an encoding
 locale is specified through CF_LOCALE it is used, else the system encoding is
 used for the conversion.
 .br
 \fBFileGroupDescriptor - FileContents\fR: These two types are used for
-transfering a set of files that do not appear physically on disk, like files
+transferring a set of files that do not appear physically on disk, like files
 from compressed folders or Outlook e-mail messages. File names are transfered as
-in the CF_TEXT type, while file contents are transfered in binary. Tkdnd
+in the CF_TEXT type, while file contents are transfered in binary. TkDND
 retrieves both the file names and the file contents, and saves then in a
 temporary directory. When the transfer is complete, the file names of the saved
-files in the temporary folder are returned. Note that tkdnd support this type
+files in the temporary folder are returned. Note that TkDND support this type
 pair only as drop targets and not as drag sources.
 .br
 \fBFileGroupDescriptorW - FileContents\fR: These two types are used for
 transfering a set of files that do not appear physically on disk, like files
 from compressed folders or Outlook e-mail messages. File names are transfered as
-in the CF_UNICODETEXT type, while file contents are transfered in binary. Tkdnd
+in the CF_UNICODETEXT type, while file contents are transfered in binary. TkDND
 retrieves both the file names and the file contents, and saves then in a
 temporary directory. When the transfer is complete, the file names of the saved
-files in the temporary folder are returned. Note that tkdnd support this type
+files in the temporary folder are returned. Note that TkDND support this type
 pair only as drop targets and not as drag sources.
 .br
 \fBCF_HDROP\fR: Files transfer encoded in UTF-8.
@@ -443,17 +443,17 @@ exist), while others are not. However, it is a good practice to define bindings
 for all events, so as the application will behave as expected during drag and
 drop operations.
 
-The tkdnd package defines a set of virtual events, that correspond to various
+The TkDND package defines a set of virtual events, that correspond to various
 phases of a drag and drop operation. All windows that are either a drop target
 or a drag source are expected to have bindings for (all) these events, created
 with the \fBbind\fR Tk command. While these event bindings are regular Tk
 events, they have a small difference from plain Tk events: most of them are
-expected to return a value. Since Tk bindings cannot return a value, tkdnd does
+expected to return a value. Since Tk bindings cannot return a value, TkDND does
 not actually generate these events (i.e. through "event generate"). Instead,
-tkdnd locates the script that has been bound to the virtual event, and directly
+TkDND locates the script that has been bound to the virtual event, and directly
 executes it, as a script. Apart from this small difference in how the events are
-triggered, the events required by tkdnd can be viewed as regular events. In the
-following two sections all virtual events defined by the tkdnd package are
+triggered, the events required by TkDND can be viewed as regular events. In the
+following two sections all virtual events defined by the TkDND package are
 presented.
 .SH DROP TARGET EVENTS
 A window registered as a drop target, is expected to have bindings for the
@@ -483,7 +483,7 @@ is not returned, the drop is refused for this window.
 .TP
 \fB<<DropLeave>>\fR:
 This event is triggered when the mouse leaves outside the
-area covered by window, whithout a drop happening. The binding of such an event
+area covered by window, without a drop happening. The binding of such an event
 is expected to restore the visual state of the window to normal (i.e. the visual
 state the window was in before the <<DropEnter>> event was triggered). The
 binding for such an event is not expected to return a value.
@@ -530,9 +530,9 @@ bind .drag_source <<DragInitCmd>> \\
 .TP
 \fB<<DragEndCmd>>\fR:
 This event is triggered when the drag action has finished (either when the drop
-was succesful or not). Its main purpose is to process the dropped data according
-to the drop action returned by the drop target. Binding for such an event
-is not mandatory, and the binding is not expected to return a value.
+was successful or not). Its main purpose is to process the dropped data
+according to the drop action returned by the drop target. Binding for such an
+event is not mandatory, and the binding is not expected to return a value.
 .SH BINDING SCRIPTS AND SUBSTITUTIONS
 All bindings scripts defined for any of the virtual events above will be
 executed in the same interpreter that was used for creating the window the 
@@ -565,7 +565,7 @@ The list of types from the drag source type list that are common to the drop
 target type list.
 .IP  \fB%D\fR 5
 The data that has been dropped. Under some platforms the data will be 
-available before the drop has occured. The format of the data is the current
+available before the drop has occurred. The format of the data is the current
 type of the drop operation.
 .IP  \fB%e\fR 5
 The name of the current virtual event. One of <<DropEnter>>, <<DropPosition>>,
@@ -577,7 +577,7 @@ The list of modifier keyboard keys that are pressed.
 Modifier keys are some special keys, like Shift, Control or Alt. 
 Valid modifiers are "shift", "ctrl" and "alt". It is useful for
 binding scripts of drop target events to examine this list of modifiers, as it
-is quite usuall to change the action according to the state of some modifier
+is quite usual to change the action according to the state of some modifier
 keys.
 .IP  \fB%ST\fR 5
 The list of types supported by the drag source.
@@ -640,6 +640,17 @@ the actual data to be dropped:
 bind .text_drag_source <<DragInitCmd>> \\
      {list {copy move} DND_Text {Hello from Tk!}}
 .CE
+Please note that all specified format types must be compatible to each other, as
+they all characterise the same data.
+.SH SPECIFYING DRAG SOURCES WITH MULTIPLE DATA TYPES
+In the case the drag source wants to send a set of (incompatible) data types,
+the result of the <<DragInitCmd>> event binding must be slightly different, as
+it must return two items (instead of three described in the previous paragraph).
+The first element is again a list of allowable actions. However, the second item
+is a list of "format type" and "data" pairs:
+bind .text_drag_source <<DragInitCmd>> \\
+     {list {copy move} {DND_Text {Hello from Tk!} DND_Files {/tmp}}}
+.CE
 And that was all!
 .SH BUGS
 \fBUnix:\fR
diff --git a/library/tkdnd.tcl b/library/tkdnd.tcl
index 5d64dc7..0fbf3db 100644
--- a/library/tkdnd.tcl
+++ b/library/tkdnd.tcl
@@ -292,30 +292,48 @@ proc tkdnd::_init_drag { button source state rootX rootY } {
                               %S $state  %e <<DragInitCmd>> %A \{\} \
                               %t [bind $source <<DragSourceTypes>>]] $cmd]
     set info [uplevel \#0 $cmd]
-    if { $info != "" } {
-      variable _windowingsystem
-      foreach { actions types data } $info { break }
+    set len [llength $info]
+    if {$len == 3} {
+      foreach { actions types _data } $info { break }
       set types [platform_specific_types $types]
-      set action refuse_drop
-      switch $_windowingsystem {
-        x11 {
-          set action [xdnd::_dodragdrop $source $actions $types $data $button]
-        }
-        win32 -
-        windows {
-          set action [_DoDragDrop $source $actions $types $data $button]
-        }
-        aqua {
-          set action [macdnd::dodragdrop $source $actions $types $data]
-        }
-        default {
-          error "unknown Tk windowing system"
-        }
+      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
+	}
       }
-      ## Call _end_drag to notify the widget of the result of the drag
-      ## operation...
-      _end_drag $button $source {} $action {} $data {} $state $rootX $rootY
+      unset _data t d
+    } else {
+      error "not enough items in the result of the <<DragInitCmd>>\
+             event binding. Either 2 or 3 items are expected."
     }
+    set action refuse_drop
+    variable _windowingsystem
+    switch $_windowingsystem {
+      x11 {
+        set action [xdnd::_dodragdrop $source $actions $types $data $button]
+      }
+      win32 -
+      windows {
+        set action [_DoDragDrop $source $actions $types $data $button]
+      }
+      aqua {
+        set action [macdnd::dodragdrop $source $actions $types $data]
+      }
+      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::_init_drag
 
@@ -332,29 +350,29 @@ proc tkdnd::_end_drag { button source target action type data result
     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 != "" } {
-      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
-    }
+    # 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
 
diff --git a/library/tkdnd_unix.tcl b/library/tkdnd_unix.tcl
index 2f3b6c9..f5d0f25 100644
--- a/library/tkdnd_unix.tcl
+++ b/library/tkdnd_unix.tcl
@@ -763,6 +763,9 @@ proc xdnd::_HandleXdndStatus {event} {
 #  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
@@ -824,7 +827,9 @@ proc xdnd::_SendXdndDrop {} {
   set _dodragdrop_drop_target 0
   # puts "XdndDrop: $_dodragdrop_drop_target"
   ## Arrange a timeout for receiving XdndFinished...
-  after 10000 [list ::tkdnd::xdnd::_HandleXdndFinished {}]
+  variable _dodragdrop_xdnd_finished_event_after_id
+  set _dodragdrop_xdnd_finished_event_after_id \
+    [after 10000 [list ::tkdnd::xdnd::_HandleXdndFinished {}]]
 };# xdnd::_SendXdndDrop
 
 # ----------------------------------------------------------------------------
diff --git a/library/tkdnd_windows.tcl b/library/tkdnd_windows.tcl
index d839216..9533f0f 100644
--- a/library/tkdnd_windows.tcl
+++ b/library/tkdnd_windows.tcl
@@ -98,6 +98,7 @@ proc olednd::_HandleDragEnter { drop_target typelist actionlist pressedkeys
       set cmd [string map [list %W $drop_target %X $rootX %Y $rootY \
         %CST \{$_common_drag_source_types\} \
         %CTT \{$_common_drop_target_types\} \
+        %CPT \{[lindex [_platform_independent_type [lindex $_common_drag_source_types 0]] 0]\} \
         %ST  \{$_typelist\}    %TT \{$_types\} \
         %A   $_action          %a  \{$_actionlist\} \
         %b   \{$_pressedkeys\} %m  \{$_pressedkeys\} \
@@ -140,6 +141,7 @@ proc olednd::_HandleDragOver { drop_target pressedkeys rootX rootY } {
     set cmd [string map [list %W $drop_target %X $rootX %Y $rootY \
       %CST \{$_common_drag_source_types\} \
       %CTT \{$_common_drop_target_types\} \
+      %CPT \{[lindex [_platform_independent_type [lindex $_common_drag_source_types 0]] 0]\} \
       %ST  \{$_typelist\}    %TT \{$_types\} \
       %A   $_action          %a  \{$_actionlist\} \
       %b   \{$_pressedkeys\} %m  \{$_pressedkeys\} \
@@ -182,6 +184,7 @@ proc olednd::_HandleDragLeave { drop_target } {
       %X $_last_mouse_root_x %Y $_last_mouse_root_y \
       %CST \{$_common_drag_source_types\} \
       %CTT \{$_common_drop_target_types\} \
+      %CPT \{[lindex [_platform_independent_type [lindex $_common_drag_source_types 0]] 0]\} \
       %ST  \{$_typelist\}    %TT \{$_types\} \
       %A   \{$_action\}      %a  \{$_actionlist\} \
       %b   \{$_pressedkeys\} %m  \{$_pressedkeys\} \
@@ -216,12 +219,13 @@ proc olednd::_HandleDrop { drop_target pressedkeys rootX rootY _type data } {
   set _pressedkeys $pressedkeys
   ## 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 type [lindex [_platform_independent_type $type] 0]
     set cmd [bind $drop_target <<Drop:$type>>]
     if {[string length $cmd]} {
       set cmd [string map [list %W $drop_target %X $rootX %Y $rootY \
         %CST \{$_common_drag_source_types\} \
         %CTT \{$_common_drop_target_types\} \
+        %CPT \{[lindex [_platform_independent_type [lindex $_common_drag_source_types 0]] 0]\} \
         %ST  \{$_typelist\}    %TT \{$_types\} \
         %A   $_action          %a \{$_actionlist\} \
         %b   \{$_pressedkeys\} %m \{$_pressedkeys\} \
@@ -238,6 +242,7 @@ proc olednd::_HandleDrop { drop_target pressedkeys rootX rootY _type data } {
     set cmd [string map [list %W $drop_target %X $rootX %Y $rootY \
       %CST \{$_common_drag_source_types\} \
       %CTT \{$_common_drop_target_types\} \
+      %CPT \{[lindex [_platform_independent_type [lindex $_common_drag_source_types 0]] 0]\} \
       %ST  \{$_typelist\}    %TT \{$_types\} \
       %A   $_action          %a \{$_actionlist\} \
       %b   \{$_pressedkeys\} %m \{$_pressedkeys\} \
@@ -323,10 +328,10 @@ proc olednd::_platform_independent_types { types } {
 #  Command olednd::_normalise_data
 # ----------------------------------------------------------------------------
 proc olednd::_normalise_data { type data } {
-  switch $type {
-    CF_HDROP   {return $data}
-    DND_Text   {return [list CF_UNICODETEXT CF_TEXT]}
-    DND_Files  {return [list CF_HDROP]}
+  switch [lindex [_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
@@ -338,6 +343,8 @@ proc olednd::_platform_specific_type { type } {
   switch $type {
     DND_Text   {return [list CF_UNICODETEXT CF_TEXT]}
     DND_Files  {return [list CF_HDROP]}
+    DND_HTML   {return [list "HTML Format"]}
+    DND_RTF    {return [list "Rich Text Format"]}
     default    {
       # variable _unhandled_types
       # if {[lsearch -exact $_unhandled_types $type] == -1} {
@@ -352,9 +359,11 @@ proc olednd::_platform_specific_type { type } {
 # ----------------------------------------------------------------------------
 proc olednd::_platform_independent_type { type } {
   switch $type {
-    CF_UNICODETEXT - CF_TEXT {return DND_Text}
-    CF_HDROP                 {return DND_Files}
-    default    {return [list $type]}
+    CF_UNICODETEXT - CF_TEXT                 {return [list DND_Text]}
+    CF_HDROP                                 {return [list DND_Files]}
+    CF_HTML - "HTML Format"                  {return [list DND_HTML]}
+    CF_RTF - CF_RTFTEXT - "Rich Text Format" {return [list DND_RTF]}
+    default                                  {return [list $type]}
   }
 }; # olednd::_platform_independent_type
 
@@ -366,6 +375,8 @@ proc olednd::_supported_type { type } {
   switch $type {
     CF_UNICODETEXT - CF_TEXT -
     FileGroupDescriptor - FileGroupDescriptorW -
+    CF_HTML - CF_RTF - CF_RTFTEXT -
+    "HTML Format" - "Rich Text Format" -
     CF_HDROP {return 1}
   }
   # Is the type in our known, but unhandled types?
diff --git a/license.terms b/license.terms
index d96d9b6..40b7f19 100644
--- a/license.terms
+++ b/license.terms
@@ -2,7 +2,7 @@ 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,
+   Mac portions (c) 2009-2014 Kevin Walzer/WordTech Communications LLC,
    kw@codebykevin.com
 
 The following terms apply to all files associated with the
diff --git a/win/Makefile b/win/Makefile
index d572d40..8b3d443 100644
--- a/win/Makefile
+++ b/win/Makefile
@@ -14,8 +14,8 @@ TCL_VERSION		= 8.5  # or 8.6
 TCL_VERSION_NO_DOTS	= 85   # or 86

 MACHINE			= I386 # or AMD64 

 

-TKDND_VERSION		= 2.4

-TKDND_VERSION_NO_DOTS	= 24

+TKDND_VERSION		= 2.7

+TKDND_VERSION_NO_DOTS	= 27

 

 ##

 ## Usage:

diff --git a/win/OleDND.h b/win/OleDND.h
index 38f1d31..f1a01c4 100644
--- a/win/OleDND.h
+++ b/win/OleDND.h
@@ -309,7 +309,7 @@ public:
     }; /* Release */
         
     // IDataObject members
-    HRESULT __stdcall GetData(FORMATETC *pFormatEtc,  STGMEDIUM *pMedium) {
+    HRESULT __stdcall GetData(FORMATETC *pFormatEtc, STGMEDIUM *pMedium) {
       int idx;
       // try to match the specified FORMATETC with one of our supported formats
       if ((idx = LookupFormatEtc(pFormatEtc)) == -1) return DV_E_FORMATETC;
@@ -329,7 +329,7 @@ public:
       return S_OK;
     }; /* GetData */
     
-    HRESULT __stdcall GetDataHere(FORMATETC *pFormatEtc,  STGMEDIUM *pmedium) {
+    HRESULT __stdcall GetDataHere(FORMATETC *pFormatEtc, STGMEDIUM *pmedium) {
       return DATA_E_FORMATETC;
     }; /* GetDataHere */
             
@@ -411,7 +411,7 @@ public:
         if (ClipboardFormatBook[i].cfFormat == currentFormat)
                      return ClipboardFormatBook[i].name;
       }
-      GetClipboardFormatName((CLIPFORMAT) currentFormat, szTempStr, 78);
+      GetClipboardFormatName((CLIPFORMAT) currentFormat, szTempStr, 250);
       return szTempStr;
     }; /* GetCurrentFormatName */
 
@@ -424,7 +424,7 @@ private:
     LONG       m_nNumFormats;
     UINT       currentFormat;
 
-    TCHAR szTempStr[80];
+    TCHAR szTempStr[255];
 
     int LookupFormatEtc(FORMATETC *pFormatEtc) {
       // check each of our formats in turn to see if one matches
@@ -688,11 +688,15 @@ class TkDND_DropTarget: public IDropTarget {
       int i, type_index, status, index, typeObjc;
       static const char *DropTypes[] = {
         "CF_UNICODETEXT", "CF_TEXT", "CF_HDROP",
+        "CF_HTML", "HTML Format",
+        "CF_RTF", "CF_RTFTEXT", "Rich Text Format",
         "FileGroupDescriptorW", "FileGroupDescriptor",
         (char *) NULL
       };
       enum droptypes {
         TYPE_CF_UNICODETEXT, TYPE_CF_TEXT, TYPE_CF_HDROP,
+        TYPE_CF_HTML, TYPE_CF_HTMLFORMAT,
+        TYPE_CF_RTF, TYPE_CF_RTFTEXT, TYPE_CF_RICHTEXTFORMAT,
         TYPE_FILEGROUPDESCRIPTORW, TYPE_FILEGROUPDESCRIPTOR
       };
       static const char *DropActions[] = {
@@ -720,6 +724,14 @@ class TkDND_DropTarget: public IDropTarget {
           switch ((enum droptypes) index) {
             case TYPE_CF_UNICODETEXT:
               data = GetData_CF_UNICODETEXT(pDataObject); break;
+            case TYPE_CF_HTML:
+            case TYPE_CF_HTMLFORMAT:
+            case TYPE_CF_RTF:
+            case TYPE_CF_RTFTEXT:
+            case TYPE_CF_RICHTEXTFORMAT:
+              type = typeObj[type_index]; Tcl_IncrRefCount(type);
+              data = GetData_Bytearray(pDataObject, type);
+              break;
             case TYPE_CF_TEXT:
               data = GetData_CF_TEXT(pDataObject); break;
             case TYPE_CF_HDROP:
diff --git a/win/TkDND_OleDND.cpp b/win/TkDND_OleDND.cpp
index c4fb52b..7da6a57 100644
--- a/win/TkDND_OleDND.cpp
+++ b/win/TkDND_OleDND.cpp
@@ -118,25 +118,49 @@ int TkDND_RevokeDragDropObjCmd(ClientData clientData, Tcl_Interp *interp,
   return TCL_OK;

 }; /* TkDND_RevokeDragDropObjCmd */

 

+#define COPY_UTF8_TO_DATA_OBJECT \

+  Tcl_GetStringFromObj(data[i], &nDataLength); \

+  m_pstgmed[i].hGlobal = GlobalAlloc(GHND, nDataLength+1); \

+  if (m_pstgmed[i].hGlobal) { \

+    ptr = (char *) GlobalLock(m_pstgmed[i].hGlobal); \

+    memcpy(ptr, Tcl_GetString(data[i]), nDataLength); \

+    ptr[nDataLength] = '\0'; \

+    GlobalUnlock(m_pstgmed[i].hGlobal); \

+  }

+

+#define COPY_BYTEARRAY_TO_DATA_OBJECT(type_str) \

+  m_pfmtetc[i].cfFormat = RegisterClipboardFormat(type_str); \

+  bytes = Tcl_GetByteArrayFromObj(data[i], &nDataLength); \

+  m_pstgmed[i].hGlobal = GlobalAlloc(GHND, nDataLength); \

+  if (m_pstgmed[i].hGlobal) { \

+    ptr = (char *) GlobalLock(m_pstgmed[i].hGlobal); \

+    memcpy(ptr, bytes, nDataLength); \

+    GlobalUnlock(m_pstgmed[i].hGlobal); \

+  }

+

 int TkDND_DoDragDropObjCmd(ClientData clientData, Tcl_Interp *interp,

                            int objc, Tcl_Obj *CONST objv[]) {

   TkDND_DataObject *pDataObject = NULL;

   TkDND_DropSource *pDropSource = NULL;

-  Tcl_Obj         **elem;

+  Tcl_Obj         **type, **data;

   DWORD             actions = 0;

   DWORD             dwEffect;

   DWORD             dwResult;

-  int               status, elem_nu, i, index, nDataLength, button = 1;

+  int               status, type_nu, data_nu, i, index, nDataLength, button = 1;

   char             *ptr;

   Tcl_UniChar      *unicode, *ptr_u;

   FORMATETC        *m_pfmtetc;

   STGMEDIUM        *m_pstgmed;

   static const char *DropTypes[] = {

     "CF_UNICODETEXT", "CF_TEXT", "CF_HDROP",

+    "CF_HTML", "HTML Format",

+    "CF_RTF", "CF_RTFTEXT", "Rich Text Format",

     (char *) NULL

   };

   enum droptypes {

-    TYPE_CF_UNICODETEXT, TYPE_CF_TEXT, TYPE_CF_HDROP

+    TYPE_CF_UNICODETEXT, TYPE_CF_TEXT, TYPE_CF_HDROP,

+    TYPE_CF_HTML, TYPE_CF_HTMLFORMAT,

+    TYPE_CF_RTF, TYPE_CF_RTFTEXT, TYPE_CF_RICHTEXTFORMAT

   };

   static const char *DropActions[] = {

     "copy", "move", "link", "ask",  "private", "refuse_drop",

@@ -148,6 +172,7 @@ int TkDND_DoDragDropObjCmd(ClientData clientData, Tcl_Interp *interp,
     refuse_drop, ActionDefault

   };

   size_t buffer_size;

+  unsigned char *bytes;

 

   if (objc != 5 && objc != 6) {

     Tcl_WrongNumArgs(interp, 1, objv, "path actions types data ?mouse-button?");

@@ -166,10 +191,10 @@ int TkDND_DoDragDropObjCmd(ClientData clientData, Tcl_Interp *interp,
   }

 

   /* Process drag actions. */

-  status = Tcl_ListObjGetElements(interp, objv[2], &elem_nu, &elem);

+  status = Tcl_ListObjGetElements(interp, objv[2], &type_nu, &type);

   if (status != TCL_OK) return status;

-  for (i = 0; i < elem_nu; i++) {

-    status = Tcl_GetIndexFromObj(interp, elem[i], (const char **)DropActions,

+  for (i = 0; i < type_nu; i++) {

+    status = Tcl_GetIndexFromObj(interp, type[i], (const char **)DropActions,

                                  "dropactions", 0, &index);

     if (status != TCL_OK) return status;

     switch ((enum dropactions) index) {

@@ -184,28 +209,35 @@ int TkDND_DoDragDropObjCmd(ClientData clientData, Tcl_Interp *interp,
   }

 

   /* Process drag types. */

-  status = Tcl_ListObjGetElements(interp, objv[3], &elem_nu, &elem);

+  status = Tcl_ListObjGetElements(interp, objv[3], &type_nu, &type);

   if (status != TCL_OK) return status;

-  m_pfmtetc  = new FORMATETC[elem_nu];

+  status = Tcl_ListObjGetElements(interp, objv[4], &data_nu, &data);

+  if (status != TCL_OK) return status;

+  if (type_nu != data_nu) {

+    Tcl_SetResult(interp, "lists type & data must have the same length",

+                  TCL_STATIC);

+    return TCL_ERROR;

+  }

+  m_pfmtetc  = new FORMATETC[type_nu];

   if (m_pfmtetc == NULL) return TCL_ERROR;

-  m_pstgmed  = new STGMEDIUM[elem_nu];

+  m_pstgmed  = new STGMEDIUM[type_nu];

   if (m_pstgmed == NULL) {

     delete[] m_pfmtetc; return TCL_ERROR;

   }

-  for (i = 0; i < elem_nu; i++) {

+  for (i = 0; i < type_nu; i++) {

     m_pfmtetc[i].ptd            = 0;

     m_pfmtetc[i].dwAspect       = DVASPECT_CONTENT;

     m_pfmtetc[i].lindex         = -1;

     m_pfmtetc[i].tymed          = TYMED_HGLOBAL;

     m_pstgmed[i].tymed          = TYMED_HGLOBAL;

     m_pstgmed[i].pUnkForRelease = 0;

-    status = Tcl_GetIndexFromObj(interp, elem[i], (const char **) DropTypes,

+    status = Tcl_GetIndexFromObj(interp, type[i], (const char **) DropTypes,

                                  "dropactions", 0, &index);

     if (status == TCL_OK) {

       switch ((enum droptypes) index) {

         case TYPE_CF_UNICODETEXT: {

           m_pfmtetc[i].cfFormat = CF_UNICODETEXT;

-          unicode = Tcl_GetUnicodeFromObj(objv[4], &nDataLength);

+          unicode = Tcl_GetUnicodeFromObj(data[i], &nDataLength);

           buffer_size = (nDataLength+1) * sizeof(Tcl_UniChar);

           m_pstgmed[i].hGlobal = GlobalAlloc(GHND, buffer_size);

           if (m_pstgmed[i].hGlobal) {

@@ -219,16 +251,20 @@ int TkDND_DoDragDropObjCmd(ClientData clientData, Tcl_Interp *interp,
           }

           break;

         }

+        case TYPE_CF_HTMLFORMAT:

+        case TYPE_CF_HTML: {

+          COPY_BYTEARRAY_TO_DATA_OBJECT(TEXT("HTML Format"));

+          break;

+        }

+        case TYPE_CF_RICHTEXTFORMAT:

+        case TYPE_CF_RTF:

+        case TYPE_CF_RTFTEXT: {

+          COPY_BYTEARRAY_TO_DATA_OBJECT(TEXT("Rich Text Format"));

+          break;

+        }

         case TYPE_CF_TEXT: {

           m_pfmtetc[i].cfFormat = CF_TEXT;

-          nDataLength = Tcl_GetCharLength(objv[4]);

-          m_pstgmed[i].hGlobal = GlobalAlloc(GHND, nDataLength+1);

-          if (m_pstgmed[i].hGlobal) {

-            ptr = (char *) GlobalLock(m_pstgmed[i].hGlobal);

-            memcpy(ptr, Tcl_GetString(objv[4]), nDataLength);

-            ptr[nDataLength] = '\0';

-            GlobalUnlock(m_pstgmed[i].hGlobal);

-          }

+          COPY_UTF8_TO_DATA_OBJECT;

           break;

         }

         case TYPE_CF_HDROP: {

@@ -238,13 +274,13 @@ int TkDND_DoDragDropObjCmd(ClientData clientData, Tcl_Interp *interp,
           int file_nu, j, size, len;

           char *native_name;

 

-          status = Tcl_ListObjGetElements(interp, objv[4], &file_nu, &File);

-          if (status != TCL_OK) {elem_nu = i; goto error;}

+          status = Tcl_ListObjGetElements(interp, data[i], &file_nu, &File);

+          if (status != TCL_OK) {type_nu = i; goto error;}

           /* What we expect is a list of filenames. Convert the filenames into

            * the native format, and store the translated filenames into a new

            * list... */

           native_files_obj = Tcl_NewListObj(0, NULL);

-          if (native_files_obj == NULL) {elem_nu = i; goto error;}

+          if (native_files_obj == NULL) {type_nu = i; goto error;}

           size = 0;

           for (j = 0; j < file_nu; ++j) {

             Tcl_DStringInit(&ds);

@@ -282,7 +318,7 @@ int TkDND_DoDragDropObjCmd(ClientData clientData, Tcl_Interp *interp,
 #ifdef HAVE_STRSAFE_H

               StringCchCopyW(CurPosition, buffer_size, pszFileName);

 #else

-              lstrcpyW(CurPosition, pszFileName);

+              lstrcpyW((LPWSTR) CurPosition, (LPWSTR) pszFileName);

 #endif

               /*

                * Move the current position beyond the file name copied, and

@@ -302,21 +338,13 @@ int TkDND_DoDragDropObjCmd(ClientData clientData, Tcl_Interp *interp,
         }

       }

     } else {

-      unsigned char *bytes;

       /* A user defined type? */

-      m_pfmtetc[i].cfFormat = RegisterClipboardFormat(TCL_GETSTRING(elem[i]));

-      bytes = Tcl_GetByteArrayFromObj(objv[4], &nDataLength);

-      m_pstgmed[i].hGlobal = GlobalAlloc(GHND, nDataLength);

-      if (m_pstgmed[i].hGlobal) {

-        ptr = (char *) GlobalLock(m_pstgmed[i].hGlobal);

-        memcpy(ptr, bytes, nDataLength);

-        GlobalUnlock(m_pstgmed[i].hGlobal);

-      }

+      COPY_BYTEARRAY_TO_DATA_OBJECT(TCL_GETSTRING(type[i]));

       break;

     }

-  }; /* for (i = 0; i < elem_nu; i++) */

+  }; /* for (i = 0; i < type_nu; i++) */

   

-  pDataObject = new TkDND_DataObject(m_pfmtetc, m_pstgmed, elem_nu);

+  pDataObject = new TkDND_DataObject(m_pfmtetc, m_pstgmed, type_nu);

   if (pDataObject == NULL) {

     Tcl_SetResult(interp, "unable to create OLE Data object", TCL_STATIC);

     return TCL_ERROR;

@@ -333,7 +361,7 @@ int TkDND_DoDragDropObjCmd(ClientData clientData, Tcl_Interp *interp,
   // release the COM interfaces

   pDropSource->Release();

   pDataObject->Release();

-  for (i = 0; i < elem_nu; i++) {

+  for (i = 0; i < type_nu; i++) {

     ReleaseStgMedium(&m_pstgmed[i]);

   }

   delete[] m_pfmtetc;

@@ -352,7 +380,7 @@ error:
   // release the COM interfaces

   if (pDropSource) pDropSource->Release();

   if (pDataObject) pDataObject->Release();

-  for (i = 0; i < elem_nu; i++) {

+  for (i = 0; i < type_nu; i++) {

     ReleaseStgMedium(&m_pstgmed[i]);

   }

   delete[] m_pfmtetc;