From 3877c83502e5c7ea381027c7b8a03c2a309c59cf Mon Sep 17 00:00:00 2001 From: wordtech Date: Mon, 21 Dec 2009 04:52:48 +0000 Subject: Additional Mac OS X updates--track drag widget via array lookup --- demos/macdemo.tcl | 9 ++- library/tkdnd.tcl | 12 +-- library/tkdnd_macosx.tcl | 188 +++++++++++++++++++++++++---------------------- macosx/macdnd.m | 49 ++++++++++-- 4 files changed, 157 insertions(+), 101 deletions(-) diff --git a/demos/macdemo.tcl b/demos/macdemo.tcl index d3b4d65..8d6de4e 100644 --- a/demos/macdemo.tcl +++ b/demos/macdemo.tcl @@ -2,15 +2,18 @@ package require tkdnd -pack [text .t -bg white] -fill both -expand yes + +pack [text .t -bg white ] -fill both -expand no -side top tkdnd::drop_target register .t * bind .t <> {%W insert end %D} -##Note these two bindings are no-op on the Mac; the C-level impelmentation takes care of the changing cursor. +#Note these two bindings are no-op on the Mac; the C-level impelmentation takes care of the changing cursor. bind .t <> { %W configure -bg red} bind .t <> {list copy; %W configure -bg white} +pack [text .f -bg blue] -fill both -expand no -side top +tkdnd::drop_target register .f * - +bind .f <> {%W insert end %D} diff --git a/library/tkdnd.tcl b/library/tkdnd.tcl index d2d31a7..1d494a7 100644 --- a/library/tkdnd.tcl +++ b/library/tkdnd.tcl @@ -47,7 +47,7 @@ namespace eval tkdnd { variable _platform_namespace variable _drop_file_temp_dir variable _auto_update 1 - global _macpath + global _macpath ;#put array of Mac drop targets in global namespace bind TkDND_Drag1 {tkdnd::_begin_drag press %W %s %X %Y} bind TkDND_Drag1 {tkdnd::_begin_drag motion %W %s %X %Y} @@ -130,7 +130,6 @@ namespace eval tkdnd { source $dir/tkdnd_macosx.tcl set _platform_namespace macdnd load $dir/$PKG_LIB_FILE $PACKAGE_NAME - set _macpath {} } } source $dir/tkdnd_compat.tcl @@ -192,9 +191,10 @@ proc tkdnd::drop_target { mode path { types {} } } { } aqua { global _macpath - macdnd::registerdragwidget [winfo toplevel $path] $types - set _macpath $path - return $_macpath + global _mactypes ;#list of registered drag types + macdnd::registerdragwidget $path $types + set _macpath($path) $path + set _mactypes $types } } set old_types [bind $path <>] @@ -212,7 +212,7 @@ proc tkdnd::drop_target { mode path { types {} } } { } aqua { global _macpath - macdnd::unregisterdragwidget [winfo toplevel $path] + macdnd::unregisterdragwidget _macpath($path) } } bind $path <> {} diff --git a/library/tkdnd_macosx.tcl b/library/tkdnd_macosx.tcl index 28e012b..d4f12df 100644 --- a/library/tkdnd_macosx.tcl +++ b/library/tkdnd_macosx.tcl @@ -36,7 +36,7 @@ #two data types supported: strings and file paths -#two commands at C level: ::macdnd::registerdragwidget and ::macdnd::unregisterdragwidget +#two commands at C level: ::macdnd::registerdragwidget, ::macdnd::unregisterdragwidget #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 @@ -61,6 +61,7 @@ namespace eval macdnd { # ---------------------------------------------------------------------------- proc macdnd::_HandleEnter { path drag_source typelist } { global _macpath + global _mactypes variable _typelist; set _typelist $typelist variable _pressedkeys; set _pressedkeys 1 variable _action; set _action {} @@ -68,14 +69,20 @@ proc macdnd::_HandleEnter { path drag_source typelist } { 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 $_macpath ;# pass + variable _drop_target; set _drop_target $path variable _actionlist; set _actionlist \ {copy move link ask private} - # puts "macdnd::_HandleEnter: path=$path, drag_source=$drag_source,\ - # typelist=$typelist" + + #check to see if path is in array of registered Mac drop targets + if {[lsearch -inline -exact [array names _macpath] $path] == {}} { + set _drop_target {} + } else { + set _drop_target [set _macpath($path)] + } + + puts "macdnd::_HandleEnter: path=$path, drag_source=$drag_source,\ + typelist=$typelist" - puts "macdnd::_HandleXdndEnter ($_drop_target)" - bind $_drop_target <> update return default };# macdnd::_HandleEnter @@ -86,6 +93,7 @@ proc macdnd::_HandleEnter { path drag_source typelist } { proc macdnd::_HandleXdndPosition { drop_target rootX rootY } { global _macpath + global _mactypes variable _types variable _typelist variable _actionlist @@ -96,97 +104,103 @@ proc macdnd::_HandleXdndPosition { drop_target rootX rootY } { variable _drag_source variable _drop_target + #check to see if path is in array of registered Mac drop targets + if {[lsearch -inline -exact [array names _macpath] $drop_target] == {}} { + set _drop_target {} + } else { + set _drop_target [set _macpath($drop_target)] + } - #This command is not implemented at the C level for OSX because it prevents drops. + puts "macdnd::_HandleXdndPosition: drop_target=$drop_target,\ + _drop_target=$_drop_target, rootX=$rootX, rootY=$rootY" - # puts "macdnd::_HandleXdndPosition: drop_target=$drop_target,\ - # _drop_target=$_drop_target, rootX=$rootX, rootY=$rootY" + ##not applicable on the Mac because we are not implemented drag sources + # if {![info exists _drag_source] && ![string length $_drag_source]} { + # return refuse_drop + # } - 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 <>] + set _types [bind $_drop_target <>] 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 - } - } + ## 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)" + # puts "($_drop_target) -> ($drop_target)" if {$drop_target != $_drop_target} { - puts "no drop target" - if {[string length $_drop_target]} { - ## Call the <> event. - set cmd [bind $_drop_target <>] - 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 <> \ - %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 <>. - # puts "<> -> $drop_target" - set cmd [bind $drop_target <>] - 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 <> \ - %L \{$_typelist\} %% % \ - %t \{$_typelist\} %T \{\}] $cmd] - set _action [uplevel \#0 $cmd] - } - } - set _drop_target $drop_target + puts "no drop target" + if {[string length $_drop_target]} { + ## Call the <> event. + set cmd [bind $_drop_target <>] + 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 <> \ + %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 <>. + # puts "<> -> $drop_target" + set cmd [bind $drop_target <>] + 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 <> \ + %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 <>. - set cmd [bind $drop_target <>] - 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 <> \ - %L \{$_typelist\} %% % \ - %t \{$_typelist\} %T \{\}] $cmd] - set _action [uplevel \#0 $cmd] - } + 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 <>. + set cmd [bind $drop_target <>] + 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 <> \ + %L \{$_typelist\} %% % \ + %t \{$_typelist\} %T \{\}] $cmd] + set _action [uplevel \#0 $cmd] + } } # Return values: copy, move, link, ask, private, refuse_drop, default return $_action @@ -207,6 +221,7 @@ proc macdnd::_HandleXdndLeave { args } { variable _drop_target global _macpath + puts "macdnd::_HandleXdndLeave ($_drop_target)" if {[info exists _drop_target] && [string length $_drop_target]} { set cmd [bind $_drop_target <>] @@ -221,7 +236,7 @@ proc macdnd::_HandleXdndLeave { args } { %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 @@ -247,6 +262,7 @@ proc macdnd::_HandleXdndDrop { args } { set rootY 0 global _macpath + global _mactypes #these lines interfere with the drop, so they are commented out @@ -259,7 +275,6 @@ proc macdnd::_HandleXdndDrop { args } { # if {![llength $_common_drag_source_types]} {return refuse_drop} ## Get the drop target and dropped data. - # set _drop_target [winfo toplevel $_macpath] set data [_GetDroppedData] ## Try to select the most specific <> event. @@ -294,6 +309,7 @@ proc macdnd::_HandleXdndDrop { args } { } # Return values: XdndActionCopy, XdndActionMove, XdndActionLink, # XdndActionAsk, XdndActionPrivate, refuse_drop + return $_action };# macdnd::_HandleXdndDrop diff --git a/macosx/macdnd.m b/macosx/macdnd.m index bc0835c..66019f4 100644 --- a/macosx/macdnd.m +++ b/macosx/macdnd.m @@ -60,6 +60,7 @@ Tcl_Interp * TkDND_Interp(Tk_Window tkwin) { - (NSDragOperation)draggingEntered:(id )sender; - (BOOL)prepareForDragOperation:(id )sender; - (BOOL)performDragOperation:(id )sender; +- (NSDragOperation)draggingUpdated:(id < NSDraggingInfo >)sender; TkWindow* TkMacOSXGetTkWindow( NSWindow *w); @end @@ -123,7 +124,7 @@ TkWindow* TkMacOSXGetTkWindow(NSWindow *w) { } /* Evaluate the command and get the result...*/ TkDND_Status_Eval(4); - printf("Status=%d (%d)\n", status, TCL_OK);fflush(0); + // printf("Status=%d (%d)\n", status, TCL_OK);fflush(0); if (status != TCL_OK) { /* An error has happened. Cancel the drop! */ return NSDragOperationNone; @@ -154,6 +155,44 @@ TkWindow* TkMacOSXGetTkWindow(NSWindow *w) { } +- (NSDragOperation)draggingUpdated:(id < NSDraggingInfo >)sender { + sourcePasteBoard = [sender draggingPasteboard]; + + //get the coordinates of the cursor + NSPoint mouseLoc; + mouseLoc = [NSEvent mouseLocation]; + + TkWindow *winPtr = TkMacOSXGetTkWindow([self window]); + Tk_Window tkwin = (Tk_Window) winPtr; + Tcl_Interp *interp = Tk_Interp(tkwin); + Tk_Window mouse_tkwin; + + Tcl_Obj* objv[4], *element, *result; + int i, index, status; + + //map the coordinates to the target window + float rootX = mouseLoc.x; + float rootY = mouseLoc.y; + mouse_tkwin = Tk_CoordsToWindow(rootX, rootY, tkwin); + + if (mouse_tkwin != NULL) { + objv[0] = Tcl_NewStringObj("tkdnd::macdnd::_HandleXdndPosition", -1); + objv[1] = Tcl_NewStringObj(Tk_PathName(mouse_tkwin), -1); + objv[2] = Tcl_NewIntObj(rootX); + objv[3] = Tcl_NewIntObj(rootY); + + /* Evaluate the command and get the result...*/ + TkDND_Status_Eval(4); + + // printf("Status=%d (%d)\n", status, TCL_OK);fflush(0); + if (status != TCL_OK) { + /* An error has happened. Cancel the drop! */ + return NSDragOperationNone; + } + + } +} + //prepare to perform drag operation - (BOOL)prepareForDragOperation:(id )sender { sourcePasteBoard = [sender draggingPasteboard]; @@ -203,7 +242,7 @@ TkWindow* TkMacOSXGetTkWindow(NSWindow *w) { /* Evaluate the command and get the result...*/ TkDND_Status_Eval(4); - printf("Status=%d (%d)\n", status, TCL_OK);fflush(0); + // printf("Status=%d (%d)\n", status, TCL_OK);fflush(0); if (status != TCL_OK) { /* An error has happened. Cancel the drop! */ return NSDragOperationNone; @@ -236,7 +275,7 @@ TkWindow* TkMacOSXGetTkWindow(NSWindow *w) { /* Evaluate the command and get the result...*/ TkDND_Status_Eval(4); - printf("Status=%d (%d)\n", status, TCL_OK);fflush(0); + // printf("Status=%d (%d)\n", status, TCL_OK);fflush(0); if (status != TCL_OK) { /* An error has happened. Cancel the drop! */ return NSDragOperationNone; @@ -372,7 +411,6 @@ int UnregisterDragWidget(ClientData clientData, Tcl_Interp *ip, } - //initalize the package in the tcl interpreter, create tcl commands int Tkdnd_Init (Tcl_Interp *ip) { @@ -390,8 +428,7 @@ int Tkdnd_Init (Tcl_Interp *ip) { Tcl_CreateObjCommand(ip, "::macdnd::registerdragwidget", RegisterDragWidget,(ClientData)NULL, (Tcl_CmdDeleteProc *)NULL); Tcl_CreateObjCommand(ip, "::macdnd::unregisterdragwidget", UnregisterDragWidget,(ClientData)NULL, (Tcl_CmdDeleteProc *)NULL); - - + if (Tcl_PkgProvide(ip, PACKAGE_NAME, PACKAGE_VERSION) != TCL_OK) { return TCL_ERROR; } -- cgit v0.12