OS X changes

1 files changed, 334 insertions, 1 deletions

diff --git a/library/tkdnd_macosx.tcl b/library/tkdnd_macosx.tcl
index 85e3242..3beb8b5 100644
--- a/library/tkdnd_macosx.tcl
+++ b/library/tkdnd_macosx.tcl
@@ -41,4 +41,337 @@
 #two commands at C level: ::macdnd::registerdragwidget and ::macdnd::unregisterdragwidget
 #::macdnd::registerdragwidget has hard-coded args: path stringtype filetype -- must have all three; if widget does not support strings, put {} there; if does not support files, put {} there; uses string length of that arg position to determine whether drag type is supported
 
-#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
\ No newline at end of file
+#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 {
+  variable _types {}
+  variable _typelist {}
+  variable _actionlist {}
+  variable _pressedkeys {}
+  variable _action {}
+  variable _common_drag_source_types {}
+  variable _common_drop_target_types {}
+  variable _drag_source {}
+  variable _drop_target {}
+};# namespace macdnd
+
+# ----------------------------------------------------------------------------
+#  Command macdnd::_HandleXdndEnter
+# ----------------------------------------------------------------------------
+proc macdnd::_HandleXdndEnter { path drag_source typelist } {
+  variable _typelist;                 set _typelist    $typelist
+  variable _pressedkeys;              set _pressedkeys 1
+  variable _action;                   set _action      {}
+  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  \
+                                           {copy move link ask private}
+  # puts "macdnd::_HandleXdndEnter: path=$path, drag_source=$drag_source,\
+  #             typelist=$typelist"
+  update
+};# macdnd::_HandleXdndEnter
+
+# ----------------------------------------------------------------------------
+#  Command macdnd::_HandleXdndPosition
+# ----------------------------------------------------------------------------
+proc macdnd::_HandleXdndPosition { drop_target rootX rootY } {
+  variable _types
+  variable _typelist
+  variable _actionlist
+  variable _pressedkeys
+  variable _action
+  variable _common_drag_source_types
+  variable _common_drop_target_types
+  variable _drag_source
+  variable _drop_target
+  # puts "macdnd::_HandleXdndPosition: drop_target=$drop_target,\
+  #       _drop_target=$_drop_target, rootX=$rootX, rootY=$rootY"
+
+  if {![info exists _drag_source] && ![string length $_drag_source]} {
+    return refuse_drop
+  }
+  ## Does the new drop target support any of our new types? 
+  set _types [bind $drop_target <<DropTargetTypes>>]
+  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
+      }
+    }
+  }
+  
+  # puts "($_drop_target) -> ($drop_target)"
+  if {$drop_target != $_drop_target} {
+    if {[string length $_drop_target]} {
+      ## Call the <<DropLeave>> event.
+      set cmd [bind $_drop_target <<DropLeave>>]
+      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\} \
+          %ST  \{$_typelist\}    %TT \{$_types\} \
+          %A   \{$_action\}      %a \{$_actionlist\} \
+          %b   \{$_pressedkeys\} %m \{$_pressedkeys\} \
+          %D   \{\}              %e <<DropLeave>> \
+          %L   \{$_typelist\}    %% % \
+          %t   \{$_typelist\}    %T \{\}] $cmd]
+        uplevel \#0 $cmd
+      }
+    }
+    set _drop_target {}
+
+    if {[info exists common_drag_source_types]} {
+      set _action copy
+      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 <<DropEnter>>.
+      # puts "<<DropEnter>> -> $drop_target"
+      set cmd [bind $drop_target <<DropEnter>>]
+      if {[string length $cmd]} {
+        focus $drop_target
+        set cmd [string map [list %W $drop_target %X $rootX %Y $rootY \
+          %CST \{$_common_drag_source_types\} \
+          %CTT \{$_common_drop_target_types\} \
+          %ST  \{$_typelist\}    %TT \{$_types\} \
+          %A   $_action          %a  \{$_actionlist\} \
+          %b   \{$_pressedkeys\} %m  \{$_pressedkeys\} \
+          %D   \{\}              %e  <<DropEnter>> \
+          %L   \{$_typelist\}    %%  % \
+          %t   \{$_typelist\}    %T  \{\}] $cmd]
+        set _action [uplevel \#0 $cmd]
+      }
+    }
+    set _drop_target $drop_target
+  }
+  
+  set _action refuse_drop
+  set _drop_target {}
+  if {[info exists common_drag_source_types]} {
+    set _action copy
+    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]} {
+      set cmd [string map [list %W $drop_target %X $rootX %Y $rootY \
+        %CST \{$_common_drag_source_types\} \
+        %CTT \{$_common_drop_target_types\} \
+        %ST  \{$_typelist\}    %TT \{$_types\} \
+        %A   $_action          %a  \{$_actionlist\} \
+        %b   \{$_pressedkeys\} %m  \{$_pressedkeys\} \
+        %D   \{\}              %e  <<DropPosition>> \
+        %L   \{$_typelist\}    %%  % \
+        %t   \{$_typelist\}    %T  \{\}] $cmd]
+      set _action [uplevel \#0 $cmd]
+    }
+  }
+  # Return values: copy, move, link, ask, private, refuse_drop, default
+  return $_action
+};# macdnd::_HandleXdndPosition
+
+# ----------------------------------------------------------------------------
+#  Command macdnd::_HandleXdndLeave
+# ----------------------------------------------------------------------------
+proc macdnd::_HandleXdndLeave {  } {
+  variable _types
+  variable _typelist
+  variable _actionlist
+  variable _pressedkeys
+  variable _action
+  variable _common_drag_source_types
+  variable _common_drop_target_types
+  variable _drag_source
+  variable _drop_target
+
+  # puts "macdnd::_HandleXdndLeave! ($_drop_target)"
+  if {[info exists _drop_target] && [string length $_drop_target]} {
+    set cmd [bind $_drop_target <<DropLeave>>]
+    if {[string length $cmd]} {
+      set cmd [string map [list %W $_drop_target %X 0 %Y 0 \
+        %CST \{$_common_drag_source_types\} \
+        %CTT \{$_common_drop_target_types\} \
+        %ST  \{$_typelist\}    %TT \{$_types\} \
+        %A   \{$_action\}      %a  \{$_actionlist\} \
+        %b   \{$_pressedkeys\} %m  \{$_pressedkeys\} \
+        %D   \{\}              %e  <<DropLeave>> \
+        %L   \{$_typelist\}    %%  % \
+        %t   \{$_typelist\}    %T  \{\}] $cmd]
+      set _action [uplevel \#0 $cmd]
+    }
+  }
+  foreach var {_types _typelist _actionlist _pressedkeys _action
+               _common_drag_source_types _common_drop_target_types
+               _drag_source _drop_target} {
+    set $var {}
+  }
+};# macdnd::_HandleXdndLeave
+
+# ----------------------------------------------------------------------------
+#  Command macdnd::_HandleXdndDrop
+# ----------------------------------------------------------------------------
+proc macdnd::_HandleXdndDrop { time } {
+  variable _types
+  variable _typelist
+  variable _actionlist
+  variable _pressedkeys
+  variable _action
+  variable _common_drag_source_types
+  variable _common_drop_target_types
+  variable _drag_source
+  variable _drop_target
+  set rootX 0
+  set rootY 0
+
+  # puts "macdnd::_HandleXdndDrop: $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]
+  ## 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 cmd [string map [list %W $_drop_target %X $rootX %Y $rootY \
+        %CST \{$_common_drag_source_types\} \
+        %CTT \{$_common_drop_target_types\} \
+        %ST  \{$_typelist\}    %TT \{$_types\} \
+        %A   $_action          %a \{$_actionlist\} \
+        %b   \{$_pressedkeys\} %m \{$_pressedkeys\} \
+        %D   \{$data\}         %e <<Drop:$type>> \
+        %L   \{$_typelist\}    %% % \
+        %t   \{$_typelist\}    %T \{\}] $cmd]
+      return [uplevel \#0 $cmd]
+    }
+  }
+  set cmd [bind $_drop_target <<Drop>>]
+  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\} \
+      %ST  \{$_typelist\}    %TT \{$_types\} \
+      %A   $_action          %a \{$_actionlist\} \
+      %b   \{$_pressedkeys\} %m \{$_pressedkeys\} \
+      %D   \{$data\}         %e <<Drop>> \
+      %L   \{$_typelist\}    %% % \
+      %t   \{$_typelist\}    %T \{\}] $cmd]
+    set _action [uplevel \#0 $cmd]
+  }
+  # Return values: XdndActionCopy, XdndActionMove,    XdndActionLink,
+  #                XdndActionAsk,  XdndActionPrivate, refuse_drop
+  return $_action
+};# macdnd::_HandleXdndDrop
+
+# ----------------------------------------------------------------------------
+#  Command macdnd::_GetDroppedData
+# ----------------------------------------------------------------------------
+proc macdnd::_GetDroppedData {  } {
+  variable _drop_target
+  return [selection get -displayof $_drop_target \
+                        -selection XdndSelection -type STRING]
+};# macdnd::_GetDroppedData
+
+# ----------------------------------------------------------------------------
+#  Command macdnd::_GetDragSource
+# ----------------------------------------------------------------------------
+proc macdnd::_GetDragSource {  } {
+  variable _drag_source
+  return $_drag_source
+};# macdnd::_GetDragSource
+
+# ----------------------------------------------------------------------------
+#  Command macdnd::_GetDropTarget
+# ----------------------------------------------------------------------------
+proc macdnd::_GetDropTarget {  } {
+  variable _drop_target
+  if {[string length $_drop_target]} {
+    return [winfo id $_drop_target]
+  }
+  return 0
+};# macdnd::_GetDropTarget
+
+# ----------------------------------------------------------------------------
+#  Command macdnd::_supported_types
+# ----------------------------------------------------------------------------
+proc macdnd::_supported_types { types } {
+  set new_types {}
+  foreach type $types {
+    if {[_supported_type $type]} {lappend new_types $type}
+  }
+  return $new_types
+}; # macdnd::_supported_types
+
+# ----------------------------------------------------------------------------
+#  Command macdnd::_platform_specific_types
+# ----------------------------------------------------------------------------
+proc macdnd::_platform_specific_types { types } {
+  set new_types {}
+  foreach type $types {
+    set new_types [concat $new_types [_platform_specific_type $type]]
+  }
+  return $new_types
+}; # macdnd::_platform_specific_types
+
+# ----------------------------------------------------------------------------
+#  Command macdnd::_normalise_data
+# ----------------------------------------------------------------------------
+proc macdnd::_normalise_data { type data } {
+  switch $type {
+    CF_HDROP   {return [encoding convertfrom $data]}
+    default    {return $data}
+  }
+}; # macdnd::_normalise_data
+
+# ----------------------------------------------------------------------------
+#  Command macdnd::_platform_specific_type
+# ----------------------------------------------------------------------------
+proc macdnd::_platform_specific_type { type } {
+  switch $type {
+    DND_Text   {return [list string]}
+    DND_Files  {return [list files]}
+    default    {return [list $type]}
+  }
+}; # macdnd::_platform_specific_type
+
+# ----------------------------------------------------------------------------
+#  Command macdnd::_platform_independent_type
+# ----------------------------------------------------------------------------
+proc macdnd::_platform_independent_type { type } {
+  switch $type {
+    string        {return DND_Text}
+    files         {return DND_Files}
+    default       {return [list $type]}
+  }
+}; # macdnd::_platform_independent_type
+
+# ----------------------------------------------------------------------------
+#  Command macdnd::_supported_type
+# ----------------------------------------------------------------------------
+proc macdnd::_supported_type { type } {
+  return 1
+  switch $type {
+    {text/plain;charset=UTF-8} - text/plain -
+    text/uri-list {return 1}
+  }
+  return 0
+}; # macdnd::_supported_type