From da59d53c4b4e9f1df643e3b73ad5715c8b91dc62 Mon Sep 17 00:00:00 2001 From: petasis Date: Mon, 4 Jun 2012 23:37:02 +0000 Subject: Linux drag support --- Changelog | 7 + library/tkdnd.tcl | 2 +- library/tkdnd_unix.tcl | 319 +++++++++++++++++++++- unix/TkDND_XDND.c | 725 ++++++++++++++++++++++++++++++++++++++++++++++++- unix/tkUnixSelect.c | 95 ++++++- 5 files changed, 1124 insertions(+), 24 deletions(-) diff --git a/Changelog b/Changelog index ddd25c5..846c27d 100644 --- a/Changelog +++ b/Changelog @@ -1,3 +1,10 @@ +2012-06-05 Petasis George + * library/tkdnd.tcl: + * library/tkdnd_unix.tcl: + * unix/tkUnixSelect.c: + * unix/TkDND_XDND.c: Added support for initiating drags from Tk under + unix. Despite incomplete, seems to work with GTK. + 2012-06-02 Petasis George * library/tkdnd_unix.tcl: * unix/TkDND_XDND.c: diff --git a/library/tkdnd.tcl b/library/tkdnd.tcl index f09e133..5d64dc7 100644 --- a/library/tkdnd.tcl +++ b/library/tkdnd.tcl @@ -299,7 +299,7 @@ proc tkdnd::_init_drag { button source state rootX rootY } { set action refuse_drop switch $_windowingsystem { x11 { - error "dragging from Tk widgets not yet supported" + set action [xdnd::_dodragdrop $source $actions $types $data $button] } win32 - windows { diff --git a/library/tkdnd_unix.tcl b/library/tkdnd_unix.tcl index 5b945e6..8b94254 100644 --- a/library/tkdnd_unix.tcl +++ b/library/tkdnd_unix.tcl @@ -48,6 +48,8 @@ namespace eval xdnd { variable _drag_source {} variable _drop_target {} + variable _dragging 0 + proc debug {msg} { puts $msg };# debug @@ -402,8 +404,11 @@ proc xdnd::_normalise_data { type data } { STRING - UTF8_STRING - TEXT - COMPOUND_TEXT {return $data} text/html - text/plain { + if {[catch {tkdnd::bytes_to_string $data} string]} { + set string $data + } return [string map {\r\n \n} \ - [encoding convertfrom utf-8 [tkdnd::bytes_to_string $data]]] + [encoding convertfrom utf-8 $string]] } text/uri-list { if {[catch {tkdnd::bytes_to_string $data} string]} { @@ -464,3 +469,315 @@ proc xdnd::_supported_type { type } { } return 0 }; # xdnd::_supported_type + +############################################################################# +## +## XDND drag implementation +## +############################################################################# + +# ---------------------------------------------------------------------------- +# Command xdnd::_selection_ownership_lost +# ---------------------------------------------------------------------------- +proc xdnd::_selection_ownership_lost {} { + variable _dragging + set _dragging 0 +};# _selection_ownership_lost + +# ---------------------------------------------------------------------------- +# Command xdnd::_dodragdrop +# ---------------------------------------------------------------------------- +proc xdnd::_dodragdrop { source actions types data button } { + variable _dragging + + # 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" + } + + variable _dodragdrop_drag_source $source + variable _dodragdrop_drop_target 0 + variable _dodragdrop_drop_target_proxy 0 + variable _dodragdrop_actions $actions + variable _dodragdrop_action_descriptions $actions + variable _dodragdrop_actions_len [llength $actions] + variable _dodragdrop_types $types + variable _dodragdrop_types_len [llength $types] + variable _dodragdrop_data $data + variable _dodragdrop_button $button + variable _dodragdrop_time 0 + variable _dodragdrop_default_action default + variable _dodragdrop_waiting_status 0 + variable _dodragdrop_drop_target_accepts_drop 0 + variable _dodragdrop_drop_target_accepts_action refuse_drop + + ## + ## If we have more than 3 types, the property XdndTypeList must be set on + ## the drag source widget... + ## + if {$_dodragdrop_types_len > 3} { + _announce_type_list $_dodragdrop_drag_source $_dodragdrop_types + } + + ## + ## Announce the actions & their descriptions on the XdndActionList & + ## XdndActionDescription properties... + ## + _announce_action_list $_dodragdrop_drag_source $_dodragdrop_actions \ + $_dodragdrop_action_descriptions + + ## + ## Arrange selection handlers for our drag source, and all the supported types + ## + foreach t $types { + selection handle -selection XdndSelection -type $t $source \ + [list ::tkdnd::xdnd::_SendData $t] + } + + ## + ## Step 1: When a drag begins, the source takes ownership of XdndSelection. + ## + selection own -command ::tkdnd::xdnd::_selection_ownership_lost \ + -selection XdndSelection $source + set _dragging 1 + + ## Grab the mouse pointer... + _grab_pointer $source star + + ## Register our generic event handler... + # The generic event callback will report events by modifying variable + # ::xdnd::_dodragdrop_event: a dict with event information will be set as + # the value of the variable... + _register_generic_event_handler + + ## Set a timeout for debugging purposes... + # after 60000 {set ::tkdnd::xdnd::_dragging 0} + + tkwait variable ::tkdnd::xdnd::_dragging + _SendXdndLeave + + set _dragging 0 + _ungrab_pointer $source + _unregister_generic_event_handler + catch {selection clear -selection XdndSelection} + foreach t $types { + catch {selection handle -selection XdndSelection -type $t $source {}} + } +};# xdnd::_dodragdrop + +# ---------------------------------------------------------------------------- +# Command xdnd::_process_drag_events +# ---------------------------------------------------------------------------- +proc xdnd::_process_drag_events {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 _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] { + MotionNotify { + set rootx [dict get $event x_root] + set rooty [dict get $event y_root] + set window [_find_drop_target_window $_dodragdrop_drag_source \ + $rootx $rooty] + if {[string length $window]} { + ## Examine the modifiers to suggest an action... + set _dodragdrop_default_action [_default_action $event] + ## Is it a Tk widget? + # set path [winfo containing $rootx $rooty] + # puts "Window under mouse: $window ($path)" + if {$_dodragdrop_drop_target != $window} { + ## Send XdndLeave to $_dodragdrop_drop_target + _SendXdndLeave + ## Is there a proxy? If not, _find_drop_target_proxy returns the + ## target window, so we always get a valid "proxy". + set proxy [_find_drop_target_proxy $_dodragdrop_drag_source $window] + ## Send XdndEnter to $window + _SendXdndEnter $window $proxy + ## Send XdndPosition to $_dodragdrop_drop_target + _SendXdndPosition $rootx $rooty $_dodragdrop_default_action + } else { + ## Send XdndPosition to $_dodragdrop_drop_target + _SendXdndPosition $rootx $rooty $_dodragdrop_default_action + } + } else { + ## No window under the mouse. Send XdndLeave to $_dodragdrop_drop_target + _SendXdndLeave + } + } + ButtonPress { + } + ButtonRelease { + variable _dodragdrop_button + set button [dict get $event button] + if {$button == $_dodragdrop_button} { + ## The button that initiated the drag was released. Trigger drop... + _SendXdndDrop + } + return 1 + } + KeyPress { + } + KeyRelease { + } + EnterNotify { + } + LeaveNotify { + } + default { + return 0 + } + } + return 0 +};# _process_drag_events + +# ---------------------------------------------------------------------------- +# Command xdnd::_SendXdndEnter +# ---------------------------------------------------------------------------- +proc xdnd::_SendXdndEnter {window proxy} { + variable _dodragdrop_drag_source + variable _dodragdrop_drop_target + variable _dodragdrop_drop_target_proxy + variable _dodragdrop_types + variable _dodragdrop_waiting_status + if {$_dodragdrop_drop_target > 0} _SendXdndLeave + set _dodragdrop_drop_target $window + set _dodragdrop_drop_target_proxy $proxy + set _dodragdrop_waiting_status 0 + if {$_dodragdrop_drop_target < 1} return + # puts "XdndEnter: $_dodragdrop_drop_target $_dodragdrop_drop_target_proxy" + _send_XdndEnter $_dodragdrop_drag_source $_dodragdrop_drop_target \ + $_dodragdrop_drop_target_proxy $_dodragdrop_types +};# xdnd::_SendXdndEnter + +# ---------------------------------------------------------------------------- +# Command xdnd::_SendXdndPosition +# ---------------------------------------------------------------------------- +proc xdnd::_SendXdndPosition {rootx rooty action} { + variable _dodragdrop_drag_source + variable _dodragdrop_drop_target + if {$_dodragdrop_drop_target < 1} return + variable _dodragdrop_drop_target_proxy + variable _dodragdrop_waiting_status + ## Arrange a new XdndPosition, to be send periodically... + variable _dodragdrop_xdnd_position_heartbeat + catch {after cancel $_dodragdrop_xdnd_position_heartbeat} + set _dodragdrop_xdnd_position_heartbeat [after 200 \ + [list ::tkdnd::xdnd::_SendXdndPosition $rootx $rooty $action]] + if {$_dodragdrop_waiting_status} {return} + # puts "XdndPosition: $_dodragdrop_drop_target" + _send_XdndPosition $_dodragdrop_drag_source $_dodragdrop_drop_target \ + $_dodragdrop_drop_target_proxy $rootx $rooty $action + set _dodragdrop_waiting_status 1 +};# xdnd::_SendXdndPosition + +# ---------------------------------------------------------------------------- +# Command xdnd::_HandleXdndStatus +# ---------------------------------------------------------------------------- +proc xdnd::_HandleXdndStatus {event} { + variable _dodragdrop_drop_target + variable _dodragdrop_waiting_status + + variable _dodragdrop_drop_target_accepts_drop + variable _dodragdrop_drop_target_accepts_action + set _dodragdrop_waiting_status 0 + foreach key {target accept want_position action x y w h} { + set $key [dict get $event $key] + } + set _dodragdrop_drop_target_accepts_drop $accept + set _dodragdrop_drop_target_accepts_action $action + # puts "XdndStatus: $event" +};# xdnd::_HandleXdndStatus + +# ---------------------------------------------------------------------------- +# Command xdnd::_HandleXdndFinished +# ---------------------------------------------------------------------------- +proc xdnd::_HandleXdndFinished {event} { + variable _dodragdrop_drop_target + set _dodragdrop_drop_target 0 + variable _dragging + if {$_dragging} {set _dragging 0} + # puts "XdndFinished: $event" +};# xdnd::_HandleXdndFinished + +# ---------------------------------------------------------------------------- +# Command xdnd::_SendXdndLeave +# ---------------------------------------------------------------------------- +proc xdnd::_SendXdndLeave {} { + variable _dodragdrop_drag_source + variable _dodragdrop_drop_target + if {$_dodragdrop_drop_target < 1} return + variable _dodragdrop_drop_target_proxy + # puts "XdndLeave: $_dodragdrop_drop_target" + _send_XdndLeave $_dodragdrop_drag_source $_dodragdrop_drop_target \ + $_dodragdrop_drop_target_proxy + set _dodragdrop_drop_target 0 +};# xdnd::_SendXdndLeave + +# ---------------------------------------------------------------------------- +# Command xdnd::_SendXdndDrop +# ---------------------------------------------------------------------------- +proc xdnd::_SendXdndDrop {} { + variable _dodragdrop_drag_source + variable _dodragdrop_drop_target + if {$_dodragdrop_drop_target < 1} return + variable _dodragdrop_drop_target_proxy + variable _dodragdrop_drop_target_accepts_drop + variable _dodragdrop_drop_target_accepts_action + if {!$_dodragdrop_drop_target_accepts_drop} { + _SendXdndLeave + _HandleXdndFinished {} + return + } + # puts "XdndDrop: $_dodragdrop_drop_target" + variable _dodragdrop_drop_timestamp + set _dodragdrop_drop_timestamp [_send_XdndDrop \ + $_dodragdrop_drag_source $_dodragdrop_drop_target \ + $_dodragdrop_drop_target_proxy] + set _dodragdrop_drop_target 0 + ## Arrange a timeout for receiving XdndFinished... + after 10000 [list ::tkdnd::xdnd::_HandleXdndFinished {}] +};# xdnd::_SendXdndDrop + +# ---------------------------------------------------------------------------- +# Command xdnd::_SendData +# ---------------------------------------------------------------------------- +proc xdnd::_SendData {type s e args} { + #puts "SendData: $type $args" + variable _dodragdrop_data + return $_dodragdrop_data +};# xdnd::_SendData + +# ---------------------------------------------------------------------------- +# Command xdnd::_default_action +# ---------------------------------------------------------------------------- +proc xdnd::_default_action {event} { + variable _dodragdrop_actions + variable _dodragdrop_actions_len + if {$_dodragdrop_actions_len == 1} {return [lindex $_dodragdrop_actions 0]} + + set alt [dict get $event Alt] + set shift [dict get $event Shift] + set control [dict get $event Control] + + if {$shift && $control && [lsearch $_dodragdrop_actions link] != -1} { + return link + } elseif {$control && [lsearch $_dodragdrop_actions copy] != -1} { + return copy + } elseif {$shift && [lsearch $_dodragdrop_actions move] != -1} { + return move + } elseif {$alt && [lsearch $_dodragdrop_actions link] != -1} { + return link + } + return default +};# xdnd::_default_action diff --git a/unix/TkDND_XDND.c b/unix/TkDND_XDND.c index 4e8b4e2..cdf89d4 100644 --- a/unix/TkDND_XDND.c +++ b/unix/TkDND_XDND.c @@ -77,6 +77,30 @@ if (status != TCL_OK) Tk_BackgroundError(interp); \ for (i=0; ixclient.data.l[0]) +/* #define XDND_FINISHED_ACCEPTED(e) ((e)->xclient.data.l[1] & 0x1L) #define XDND_FINISHED_ACCEPTED_SET(e,b) (e)->xclient.data.l[1] = ((e)->xclient.data.l[1] & ~0x1UL) | (((b) == 0) ? 0 : 0x1UL) -#define XDND_FINISHED_ACTION(e) ((e)->xclient.data.l[2]) +*/ +#define XDND_FINISHED_ACCEPTED(e) ((e)->xclient.data.l[1] & (1 << 1)) +#define XDND_FINISHED_ACCEPTED_NO(e) ((e)->xclient.data.l[1] &= ~(1 << 1)) +#define XDND_FINISHED_ACCEPTED_YES(e) ((e)->xclient.data.l[1] |= (1 << 1)) +#define XDND_FINISHED_ACTION(e) ((e)->xclient.data.l[2]) extern int TkDND_GetSelection(Tcl_Interp *interp, Tk_Window tkwin, Atom selection, Atom target, Time time, @@ -162,6 +191,7 @@ int TkDND_RegisterTypesObjCmd(ClientData clientData, Tcl_Interp *interp, } path = TkDND_TkWin(objv[1]); + if (!path) return TCL_ERROR; Tk_MakeWindowExist(path); #if defined(TKDND_SET_XDND_PROPERTY_ON_WRAPPER) || \ @@ -346,7 +376,7 @@ int TkDND_HandleXdndEnter(Tk_Window tkwin, XEvent *xevent) { int TkDND_HandleXdndPosition(Tk_Window tkwin, XEvent *xevent) { Tcl_Interp *interp = Tk_Interp(tkwin); Tk_Window mouse_tkwin = NULL, toplevel; - Window drag_source, root, virtual_root, dummyChild; + Window drag_source, virtual_root, dummyChild; Tcl_Obj* result; Tcl_Obj* objv[5]; int rootX, rootY, dx, dy, i, index, status, w, h; @@ -489,17 +519,17 @@ int TkDND_HandleXdndDrop(Tk_Window tkwin, XEvent *xevent) { } memset(&finished, 0, sizeof(XEvent)); - finished.xany.type = ClientMessage; - finished.xany.display = xevent->xclient.display; + finished.xclient.type = ClientMessage; finished.xclient.window = XDND_DROP_SOURCE_WIN(xevent); finished.xclient.message_type = Tk_InternAtom(tkwin, "XdndFinished"); - finished.xclient.format = 32; + finished.xclient.format = 32; #if XDND_VERSION >= 3 XDND_FINISHED_TARGET_WIN(&finished) = Tk_WindowId(tkwin); #else XDND_FINISHED_TARGET_WIN(&finished) = xevent->xany.window; #endif - XDND_FINISHED_ACCEPTED_SET(&finished, 1); + XDND_FINISHED_ACCEPTED_YES(&finished); + //XFlush(Tk_Display(tkwin)); /* Call out Tcl callback. */ objv[0] = Tcl_NewStringObj("tkdnd::xdnd::_HandleXdndDrop", -1); @@ -516,7 +546,7 @@ int TkDND_HandleXdndDrop(Tk_Window tkwin, XEvent *xevent) { case ActionDefault: case ActionCopy: XDND_FINISHED_ACTION(&finished) = - Tk_InternAtom(tkwin, "XdndActionCopy"); break; + Tk_InternAtom(tkwin, "XdndActionCopy"); break; case ActionMove: XDND_FINISHED_ACTION(&finished) = Tk_InternAtom(tkwin, "XdndActionMove"); break; @@ -530,24 +560,90 @@ int TkDND_HandleXdndDrop(Tk_Window tkwin, XEvent *xevent) { XDND_FINISHED_ACTION(&finished) = Tk_InternAtom(tkwin, "XdndActionPrivate"); break; case refuse_drop: { - XDND_FINISHED_ACCEPTED_SET(&finished, 0); /* Drop canceled. */ + XDND_FINISHED_ACCEPTED_NO(&finished); /* Drop canceled. */ + XDND_FINISHED_ACTION(&finished) = None; } } } else { - XDND_FINISHED_ACCEPTED_SET(&finished, 0); + XDND_FINISHED_ACCEPTED_NO(&finished); + XDND_FINISHED_ACTION(&finished) = None; } /* Send XdndFinished. */ - XSendEvent(finished.xany.display, finished.xclient.window, + XSendEvent(Tk_Display(tkwin), finished.xclient.window, False, NoEventMask, (XEvent*)&finished); return True; } /* TkDND_HandleXdndDrop */ int TkDND_HandleXdndStatus(Tk_Window tkwin, XEvent *xevent) { - return False; + Tcl_Interp *interp = Tk_Interp(tkwin); + Tcl_Obj *objv[2], *key, *value; + int i; + Atom action; + if (interp == NULL) return False; + objv[0] = Tcl_NewStringObj("tkdnd::xdnd::_HandleXdndStatus", -1); + objv[1] = Tcl_NewDictObj(); + /* data.l[0] contains the XID of the target window */ + TkDND_Dict_PutLong(objv[1], "target", xevent->xclient.data.l[0]); + /* data.l[1] bit 0 is set if the current target will accept the drop */ + TkDND_Dict_PutInt(objv[1], "accept", XDND_STATUS_WILL_ACCEPT(xevent) ? 1:0); + /* data.l[1] bit 1 is set if the target wants XdndPosition messages while + * the mouse moves inside the rectangle in data.l[2,3] */ + TkDND_Dict_PutInt(objv[1], "want_position", + XDND_STATUS_WANT_POSITION(xevent) ? 1 : 0); + /* data.l[4] contains the action accepted by the target */ + action = XDND_STATUS_ACTION(xevent); + if (action == Tk_InternAtom(tkwin, "XdndActionCopy")) { + TkDND_Dict_Put(objv[1], "action", "copy"); + } else if (action == Tk_InternAtom(tkwin, "XdndActionMove")) { + TkDND_Dict_Put(objv[1], "action", "move"); + } else if (action == Tk_InternAtom(tkwin, "XdndActionLink")) { + TkDND_Dict_Put(objv[1], "action", "link"); + } else if (action == Tk_InternAtom(tkwin, "XdndActionAsk")) { + TkDND_Dict_Put(objv[1], "action", "ask"); + } else if (action == Tk_InternAtom(tkwin, "XdndActionPrivate")) { + TkDND_Dict_Put(objv[1], "action", "private"); + } else { + TkDND_Dict_Put(objv[1], "action", "refuse_drop"); + } + TkDND_Dict_PutInt(objv[1], "x", XDND_STATUS_RECT_X(xevent)); + TkDND_Dict_PutInt(objv[1], "y", XDND_STATUS_RECT_Y(xevent)); + TkDND_Dict_PutInt(objv[1], "w", XDND_STATUS_RECT_WIDTH(xevent)); + TkDND_Dict_PutInt(objv[1], "h", XDND_STATUS_RECT_HEIGHT(xevent)); + + TkDND_Eval(2); + return True; } /* TkDND_HandleXdndStatus */ int TkDND_HandleXdndFinished(Tk_Window tkwin, XEvent *xevent) { - return False; + Tcl_Interp *interp = Tk_Interp(tkwin); + Tcl_Obj *objv[2], *key, *value; + int i; + Atom action; + if (interp == NULL) return False; + objv[0] = Tcl_NewStringObj("tkdnd::xdnd::_HandleXdndFinished", -1); + objv[1] = Tcl_NewDictObj(); + /* data.l[0] contains the XID of the target window */ + TkDND_Dict_PutLong(objv[1], "target", xevent->xclient.data.l[0]); + /* data.l[1] bit 0 is set if the current target accepted the drop and + * successfully performed the accepted drop action */ + TkDND_Dict_PutInt(objv[1], "accept", (xevent->xclient.data.l[1] & 0x1L)?1:0); + /* data.l[2] contains the action performed by the target */ + action = xevent->xclient.data.l[2]; + if (action == Tk_InternAtom(tkwin, "XdndActionCopy")) { + TkDND_Dict_Put(objv[1], "action", "copy"); + } else if (action == Tk_InternAtom(tkwin, "XdndActionMove")) { + TkDND_Dict_Put(objv[1], "action", "move"); + } else if (action == Tk_InternAtom(tkwin, "XdndActionLink")) { + TkDND_Dict_Put(objv[1], "action", "link"); + } else if (action == Tk_InternAtom(tkwin, "XdndActionAsk")) { + TkDND_Dict_Put(objv[1], "action", "ask"); + } else if (action == Tk_InternAtom(tkwin, "XdndActionPrivate")) { + TkDND_Dict_Put(objv[1], "action", "private"); + } else { + TkDND_Dict_Put(objv[1], "action", "refuse_drop"); + } + TkDND_Eval(2); + return True; } /* TkDND_HandleXdndFinished */ static int TkDND_XDNDHandler(Tk_Window tkwin, XEvent *xevent) { @@ -687,6 +783,539 @@ int TkDND_GetSelectionObjCmd(ClientData clientData, Tcl_Interp *interp, return result; } /* TkDND_GetSelectionObjCmd */ +int TkDND_AnnounceTypeListObjCmd(ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[]) { + Tk_Window path; + Tcl_Obj **type; + int status, i, types; + Atom *typelist; + + if (objc != 3) { + Tcl_WrongNumArgs(interp, 1, objv, "path types-list"); + return TCL_ERROR; + } + path = TkDND_TkWin(objv[1]); + if (!path) return TCL_ERROR; + status = Tcl_ListObjGetElements(interp, objv[2], &types, &type); + if (status != TCL_OK) return status; + typelist = (Atom *) Tcl_Alloc(types * sizeof(Atom)); + if (typelist == NULL) return TCL_ERROR; + for (i = 0; i < types; ++i) { + typelist[i] = Tk_InternAtom(path, Tcl_GetString(type[i])); + } + XChangeProperty(Tk_Display(path), Tk_WindowId(path), + Tk_InternAtom(path, "XdndTypeList"), + XA_ATOM, 32, PropModeReplace, + (unsigned char*) typelist, types); + Tcl_Free((char *) typelist); + return TCL_OK; +}; /* TkDND_AnnounceTypeListObjCmd */ + +int TkDND_AnnounceActionListObjCmd(ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[]) { + Tk_Window path; + Tcl_Obj **action, **description; + int status, i, actions, descriptions; + Atom actionlist[10], descriptionlist[10]; + + if (objc != 4) { + Tcl_WrongNumArgs(interp, 1, objv, "path actions-list descriptions-list"); + return TCL_ERROR; + } + path = TkDND_TkWin(objv[1]); + if (!path) return TCL_ERROR; + status = Tcl_ListObjGetElements(interp, objv[2], &actions, &action); + if (status != TCL_OK) return status; + status = Tcl_ListObjGetElements(interp, objv[3], &descriptions, &description); + if (status != TCL_OK) return status; + + if (actions != descriptions) { + Tcl_SetResult(interp, "number of actions != number of descriptions", + TCL_STATIC); + return TCL_ERROR; + } + if (actions > 10) { + Tcl_SetResult(interp, "too many actions/descriptions", TCL_STATIC); + return TCL_ERROR; + } + + for (i = 0; i < actions; ++i) { + actionlist[i] = Tk_InternAtom(path, Tcl_GetString(action[i])); + descriptionlist[i] = Tk_InternAtom(path, Tcl_GetString(description[i])); + } + XChangeProperty(Tk_Display(path), Tk_WindowId(path), + Tk_InternAtom(path, "XdndActionList"), + XA_ATOM, 32, PropModeReplace, + (unsigned char*) actionlist, actions); + XChangeProperty(Tk_Display(path), Tk_WindowId(path), + Tk_InternAtom(path, "XdndActionDescription"), + XA_ATOM, 32, PropModeReplace, + (unsigned char*) descriptionlist, descriptions); + return TCL_OK; +}; /* TkDND_AnnounceActionListObjCmd */ + +int TkDND_GrabPointerObjCmd(ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[]) { + Tk_Window path; + Tk_Cursor cursor; + + if (objc != 3) { + Tcl_WrongNumArgs(interp, 1, objv, "path cursor"); + return TCL_ERROR; + } + + path = TkDND_TkWin(objv[1]); + if (!path) return TCL_ERROR; + Tk_MakeWindowExist(path); + + cursor = Tk_AllocCursorFromObj(interp, path, objv[2]); + if (cursor == None) { + Tcl_SetResult(interp, "invalid cursor", TCL_STATIC); + return TCL_ERROR; + } + + if (XGrabPointer(Tk_Display(path), Tk_WindowId(path), False, + ButtonPressMask | ButtonReleaseMask | + PointerMotionMask | EnterWindowMask | LeaveWindowMask, + GrabModeAsync, GrabModeAsync, + None, (Cursor) cursor, CurrentTime) != GrabSuccess) { + Tcl_SetResult(interp, "unable to grab mouse pointer", TCL_STATIC); + return TCL_ERROR; + } + return TCL_OK; +}; /* TkDND_GrabPointerObjCmd */ + +int TkDND_UnrabPointerObjCmd(ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[]) { + Tk_Window path; + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "path"); + return TCL_ERROR; + } + path = TkDND_TkWin(objv[1]); + if (!path) return TCL_ERROR; + XUngrabPointer(Tk_Display(path), CurrentTime); + return TCL_OK; +}; /* TkDND_GrabPointerObjCmd */ + +void TkDND_AddStateInformation(Tcl_Interp *interp, Tcl_Obj *dict, + unsigned int state) { + Tcl_Obj *key, *value; + TkDND_Dict_PutInt(dict, "state", state); + /* Masks... */ + TkDND_Dict_PutInt(dict, "1", state & Button1Mask ? 1 : 0); + TkDND_Dict_PutInt(dict, "2", state & Button2Mask ? 1 : 0); + TkDND_Dict_PutInt(dict, "3", state & Button3Mask ? 1 : 0); + TkDND_Dict_PutInt(dict, "4", state & Button4Mask ? 1 : 0); + TkDND_Dict_PutInt(dict, "5", state & Button5Mask ? 1 : 0); + TkDND_Dict_PutInt(dict, "Mod1", state & Mod1Mask ? 1 : 0); + TkDND_Dict_PutInt(dict, "Mod2", state & Mod2Mask ? 1 : 0); + TkDND_Dict_PutInt(dict, "Mod3", state & Mod3Mask ? 1 : 0); + TkDND_Dict_PutInt(dict, "Mod4", state & Mod4Mask ? 1 : 0); + TkDND_Dict_PutInt(dict, "Mod5", state & Mod5Mask ? 1 : 0); + TkDND_Dict_PutInt(dict, "Alt", state & Mod1Mask ? 1 : 0); + TkDND_Dict_PutInt(dict, "Shift", state & ShiftMask ? 1 : 0); + TkDND_Dict_PutInt(dict, "Lock", state & LockMask ? 1 : 0); + TkDND_Dict_PutInt(dict, "Control", state & ControlMask ? 1 : 0); +}; /* TkDND_AddStateInformation */ + +int TkDND_HandleGenericEvent(ClientData clientData, XEvent *eventPtr) { + Tcl_Interp *interp = (Tcl_Interp *) clientData; + Tcl_Obj *dict, *key, *value; + Tcl_Obj *objv[2], *result; + int status, i; + + if (interp == NULL) return 0; + dict = Tcl_NewDictObj(); + + switch (eventPtr->type) { + case MotionNotify: + TkDND_Dict_Put(dict, "type", "MotionNotify"); + TkDND_Dict_PutInt(dict, "x", eventPtr->xmotion.x); + TkDND_Dict_PutInt(dict, "y", eventPtr->xmotion.y); + TkDND_Dict_PutInt(dict, "x_root", eventPtr->xmotion.x_root); + TkDND_Dict_PutInt(dict, "y_root", eventPtr->xmotion.y_root); + TkDND_Dict_PutLong(dict, "time", eventPtr->xmotion.time); + TkDND_AddStateInformation(interp, dict, eventPtr->xmotion.state); + break; + case ButtonPress: + TkDND_Dict_Put(dict, "type", "ButtonPress"); + TkDND_Dict_PutInt(dict, "x", eventPtr->xbutton.x); + TkDND_Dict_PutInt(dict, "y", eventPtr->xbutton.y); + TkDND_Dict_PutInt(dict, "x_root", eventPtr->xbutton.x_root); + TkDND_Dict_PutInt(dict, "y_root", eventPtr->xbutton.y_root); + TkDND_Dict_PutLong(dict, "time", eventPtr->xbutton.time); + TkDND_AddStateInformation(interp, dict, eventPtr->xbutton.state); + TkDND_Dict_PutInt(dict, "button", eventPtr->xbutton.button); + break; + case ButtonRelease: + TkDND_Dict_Put(dict, "type", "ButtonRelease"); + TkDND_Dict_PutInt(dict, "x", eventPtr->xbutton.x); + TkDND_Dict_PutInt(dict, "y", eventPtr->xbutton.y); + TkDND_Dict_PutInt(dict, "x_root", eventPtr->xbutton.x_root); + TkDND_Dict_PutInt(dict, "y_root", eventPtr->xbutton.y_root); + TkDND_Dict_PutLong(dict, "time", eventPtr->xbutton.time); + TkDND_AddStateInformation(interp, dict, eventPtr->xbutton.state); + TkDND_Dict_PutInt(dict, "button", eventPtr->xbutton.button); + break; + case KeyPress: + TkDND_Dict_Put(dict, "type", "KeyPress"); + TkDND_Dict_PutInt(dict, "x", eventPtr->xkey.x); + TkDND_Dict_PutInt(dict, "y", eventPtr->xkey.y); + TkDND_Dict_PutInt(dict, "x_root", eventPtr->xkey.x_root); + TkDND_Dict_PutInt(dict, "y_root", eventPtr->xkey.y_root); + TkDND_Dict_PutLong(dict, "time", eventPtr->xkey.time); + TkDND_AddStateInformation(interp, dict, eventPtr->xkey.state); + TkDND_Dict_PutInt(dict, "keycode", eventPtr->xkey.keycode); + break; + case KeyRelease: + TkDND_Dict_Put(dict, "type", "KeyRelease"); + TkDND_Dict_PutInt(dict, "x", eventPtr->xkey.x); + TkDND_Dict_PutInt(dict, "y", eventPtr->xkey.y); + TkDND_Dict_PutInt(dict, "x_root", eventPtr->xkey.x_root); + TkDND_Dict_PutInt(dict, "y_root", eventPtr->xkey.y_root); + TkDND_Dict_PutLong(dict, "time", eventPtr->xkey.time); + TkDND_AddStateInformation(interp, dict, eventPtr->xkey.state); + TkDND_Dict_PutInt(dict, "keycode", eventPtr->xkey.keycode); + break; + case EnterNotify: + return 0; + TkDND_Dict_Put(dict, "type", "EnterNotify"); + TkDND_Dict_PutLong(dict, "time", eventPtr->xcrossing.time); + break; + case LeaveNotify: + return 0; + TkDND_Dict_Put(dict, "type", "LeaveNotify"); + TkDND_Dict_PutLong(dict, "time", eventPtr->xcrossing.time); + break; + default: + Tcl_DecrRefCount(dict); + return 0; + } + /* Call out Tcl callback. */ + objv[0] = Tcl_NewStringObj("tkdnd::xdnd::_process_drag_events", -1); + objv[1] = dict; + TkDND_Status_Eval(2); + if (status == TCL_OK) { + result = Tcl_GetObjResult(interp); Tcl_IncrRefCount(result); + status = Tcl_GetIntFromObj(interp, result, &i); + Tcl_DecrRefCount(result); + if (status == TCL_OK) return i; + } else { + /* An error occured, stop the drag action... */ + Tcl_SetVar(interp, "::tkdnd::xdnd::_dragging", "0", TCL_GLOBAL_ONLY); + } + return 0; +}; /* TkDND_HandleGenericEvent */ + +int TkDND_RegisterGenericEventHandlerObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { + if (objc != 1) { + Tcl_WrongNumArgs(interp, 1, objv, ""); + return TCL_ERROR; + } + Tk_CreateGenericHandler(TkDND_HandleGenericEvent, interp); + return TCL_OK; +}; /* TkDND_RegisterGenericEventHandlerObjCmd */ + +int TkDND_UnregisterGenericEventHandlerObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { + if (objc != 1) { + Tcl_WrongNumArgs(interp, 1, objv, ""); + return TCL_ERROR; + } + Tk_DeleteGenericHandler(TkDND_HandleGenericEvent, interp); + return TCL_OK; +}; /* TkDND_UnegisterGenericEventHandlerObjCmd */ + +int TkDND_FindDropTargetWindowObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { + int rootx, rooty; + Tk_Window path; + Window root, src, t; + Window target = 0; + int lx = 0, ly = 0, lx2, ly2; + Display *display; + Atom XdndAware; + Atom type = 0; + int f; + unsigned long n, a; + unsigned char *data = 0; + + if (objc != 4) { + Tcl_WrongNumArgs(interp, 1, objv, "path rootx rooty"); + return TCL_ERROR; + } + path = TkDND_TkWin(objv[1]); + if (!path) return TCL_ERROR; + if (Tcl_GetIntFromObj(interp, objv[2], &rootx) != TCL_OK) return TCL_ERROR; + if (Tcl_GetIntFromObj(interp, objv[3], &rooty) != TCL_OK) return TCL_ERROR; + root = RootWindowOfScreen(Tk_Screen(path)); + display = Tk_Display(path); + + if (!XTranslateCoordinates(display, root, root, rootx, rooty, + &lx, &ly, &target)) return TCL_ERROR; + if (target == root) return TCL_ERROR; + src = root; + XdndAware = Tk_InternAtom(path, "XdndAware"); + while (target != 0) { + if (!XTranslateCoordinates(display, src, target, lx, ly, &lx2, &ly2, &t)) { + target = 0; break; /* Error... */ + } + lx = lx2; ly = ly2; src = target; type = 0; data = NULL; + /* Check if we can find the XdndAware property... */ + XGetWindowProperty(display, target, XdndAware, 0, 0, False, + AnyPropertyType, &type, &f,&n,&a,&data); + if (data) XFree(data); + if (type) break; /* We have found a target! */ + /* Find child at the coordinates... */ + if (!XTranslateCoordinates(display, src, src, lx, ly, &lx2, &ly2, &target)){ + target = 0; break; /* Error */ + } + } + if (target) { + Tcl_SetObjResult(interp, Tcl_NewLongObj(target)); + } else { + Tcl_ResetResult(interp); + } + + return TCL_OK; +}; /* TkDND_FindDropTargetWindowObjCmd */ + +int TkDND_FindDropTargetProxyObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { + Window target, proxy, *proxy_ptr; + Atom type = None; + int f; + unsigned long n, a; + unsigned char *retval = NULL; + Display *display; + Tk_Window path; + + if (objc != 3) { + Tcl_WrongNumArgs(interp, 1, objv, "source target"); + return TCL_ERROR; + } + + path = TkDND_TkWin(objv[1]); + if (!path) return TCL_ERROR; + if (Tcl_GetLongFromObj(interp, objv[2], (long *) &target) != TCL_OK) { + return TCL_ERROR; + } + display = Tk_Display(path); + proxy = target; + XGetWindowProperty(display, target, Tk_InternAtom(path, "XdndProxy"), 0, 1, + False, XA_WINDOW, &type, &f,&n,&a,&retval); + proxy_ptr = (Window *) retval; + if (type == XA_WINDOW && proxy_ptr) { + proxy = *proxy_ptr; + XFree(proxy_ptr); + proxy_ptr = NULL; + /* Is the XdndProxy property pointing to the same window? */ + XGetWindowProperty(display, proxy, Tk_InternAtom(path, "XdndProxy"), 0, 1, + False, XA_WINDOW, &type, &f,&n,&a,&retval); + proxy_ptr = (Window *) retval; + if (type != XA_WINDOW || !proxy_ptr || *proxy_ptr != proxy) { + proxy = target; + } + } + if (proxy_ptr) XFree(proxy_ptr); + Tcl_SetObjResult(interp, Tcl_NewLongObj(proxy)); + + return TCL_OK; +}; /* TkDND_FindDropTargetProxyObjCmd */ + +int TkDND_SendXdndEnterObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { + XEvent event; + Tk_Window source; + Window target, proxy; + Display *display; + int types, r, f, *tv, target_version = XDND_VERSION, flags, status, i; + Atom t = None; + unsigned long n, a; + unsigned char *retval; + Tcl_Obj **type; + + if (objc != 5) { + Tcl_WrongNumArgs(interp, 1, objv, "source target proxy types_len"); + 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; + } + if (Tcl_GetLongFromObj(interp, objv[3], (long *) &proxy) != TCL_OK) { + return TCL_ERROR; + } + status = Tcl_ListObjGetElements(interp, objv[4], &types, &type); + if (status != TCL_OK) return status; + display = Tk_Display(source); + + /* Get the XDND version supported by the target... */ + r = XGetWindowProperty(display, proxy, Tk_InternAtom(source, "XdndAware"), 0, 1, + False, AnyPropertyType, &t, &f,&n,&a,&retval); + if (r != Success) { + Tcl_SetResult(interp, "cannot retrieve XDND version from target", + TCL_STATIC); + return TCL_ERROR; + } + tv = (int *)retval; + if (tv) { + if (*tv < target_version) target_version = *tv; + XFree(tv); + } + + memset (&event, 0, sizeof(event)); + event.type = ClientMessage; + event.xclient.window = target; + event.xclient.format = 32; + event.xclient.message_type = Tk_InternAtom(source, "XdndEnter"); + XDND_ENTER_SOURCE_WIN(&event) = Tk_WindowId(source); + flags = target_version << 24; + if (types > 3) flags |= 0x0001; + event.xclient.data.l[1] = flags; + for (i = 0; i < types && i < 3; ++i) { + event.xclient.data.l[2+i] = Tk_InternAtom(source, Tcl_GetString(type[i])); + } + XSendEvent(display, proxy, False, NoEventMask, &event); + + return TCL_OK; +}; /* TkDND_SendXdndEnterObjCmd */ + +int TkDND_SendXdndPositionObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { + static char *DropActions[] = { + "copy", "move", "link", "ask", "private", "default", + (char *) NULL + }; + enum dropactions { + ActionCopy, ActionMove, ActionLink, ActionAsk, ActionPrivate, ActionDefault + }; + + XEvent event; + Tk_Window source; + Window target, proxy; + Display *display; + int rootx, rooty, status, index; + + if (objc != 7) { + Tcl_WrongNumArgs(interp, 1, objv, "source target proxy rootx rooty action"); + 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; + } + if (Tcl_GetLongFromObj(interp, objv[3], (long *) &proxy) != TCL_OK) { + return TCL_ERROR; + } + if (Tcl_GetIntFromObj(interp, objv[4], &rootx) != TCL_OK) return TCL_ERROR; + if (Tcl_GetIntFromObj(interp, objv[5], &rooty) != TCL_OK) return TCL_ERROR; + status = Tcl_GetIndexFromObj(interp, objv[6], (const char **) DropActions, + "dropactions", 0, &index); + if (status != TCL_OK) return status; + display = Tk_Display(source); + + memset (&event, 0, sizeof(event)); + event.type = ClientMessage; + event.xclient.window = target; + event.xclient.format = 32; + event.xclient.message_type = Tk_InternAtom(source, "XdndPosition"); + event.xclient.data.l[0] = Tk_WindowId(source); + event.xclient.data.l[1] = 0; // flags + event.xclient.data.l[2] = (rootx << 16) + rooty; + event.xclient.data.l[3] = CurrentTime; + switch ((enum dropactions) index) { + case ActionDefault: + case ActionCopy: + XDND_POSITION_ACTION(&event) = + Tk_InternAtom(source, "XdndActionCopy"); break; + case ActionMove: + XDND_POSITION_ACTION(&event) = + Tk_InternAtom(source, "XdndActionMove"); break; + case ActionLink: + XDND_POSITION_ACTION(&event) = + Tk_InternAtom(source, "XdndActionLink"); break; + case ActionAsk: + XDND_POSITION_ACTION(&event) = + Tk_InternAtom(source, "XdndActionAsk"); break; + case ActionPrivate: + XDND_POSITION_ACTION(&event) = + Tk_InternAtom(source, "XdndActionPrivate"); break; + } + + XSendEvent(display, proxy, False, NoEventMask, &event); + + return TCL_OK; +}; /* TkDND_SendXdndPositionObjCmd */ + +int TkDND_SendXdndLeaveObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { + XEvent event; + Tk_Window source; + Window target, proxy; + + if (objc != 4) { + Tcl_WrongNumArgs(interp, 1, objv, "source target proxy"); + 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; + } + if (Tcl_GetLongFromObj(interp, objv[3], (long *) &proxy) != TCL_OK) { + return TCL_ERROR; + } + + memset (&event, 0, sizeof(event)); + event.type = ClientMessage; + event.xclient.window = target; + event.xclient.format = 32; + event.xclient.message_type = Tk_InternAtom(source, "XdndLeave"); + event.xclient.data.l[0] = Tk_WindowId(source); + XSendEvent(Tk_Display(source), proxy, False, NoEventMask, &event); + return TCL_OK; +}; /* TkDND_SendXdndLeaveObjCmd */ + +int TkDND_SendXdndDropObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { + XEvent event; + Tk_Window source; + Window target, proxy; + + if (objc != 4) { + Tcl_WrongNumArgs(interp, 1, objv, "source target proxy"); + 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; + } + if (Tcl_GetLongFromObj(interp, objv[3], (long *) &proxy) != TCL_OK) { + return TCL_ERROR; + } + + memset (&event, 0, sizeof(event)); + event.type = ClientMessage; + event.xclient.window = target; + event.xclient.format = 32; + event.xclient.message_type = Tk_InternAtom(source, "XdndDrop"); + event.xclient.data.l[0] = Tk_WindowId(source); + event.xclient.data.l[2] = CurrentTime; + XSendEvent(Tk_Display(source), proxy, False, NoEventMask, &event); + Tcl_SetObjResult(interp, Tcl_NewLongObj(event.xclient.data.l[2])); + return TCL_OK; +}; /* TkDND_SendXdndDropObjCmd */ + /* * For C++ compilers, use extern "C" */ @@ -749,6 +1378,78 @@ int DLLEXPORT Tkdnd_Init(Tcl_Interp *interp) { return TCL_ERROR; } + if (Tcl_CreateObjCommand(interp, "_grab_pointer", + (Tcl_ObjCmdProc*) TkDND_GrabPointerObjCmd, + (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL) == NULL) { + return TCL_ERROR; + } + + if (Tcl_CreateObjCommand(interp, "_ungrab_pointer", + (Tcl_ObjCmdProc*) TkDND_UnrabPointerObjCmd, + (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL) == NULL) { + return TCL_ERROR; + } + + if (Tcl_CreateObjCommand(interp, "_register_generic_event_handler", + (Tcl_ObjCmdProc*) TkDND_RegisterGenericEventHandlerObjCmd, + (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL) == NULL) { + return TCL_ERROR; + } + + if (Tcl_CreateObjCommand(interp, "_unregister_generic_event_handler", + (Tcl_ObjCmdProc*) TkDND_UnregisterGenericEventHandlerObjCmd, + (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL) == NULL) { + return TCL_ERROR; + } + + if (Tcl_CreateObjCommand(interp, "_announce_type_list", + (Tcl_ObjCmdProc*) TkDND_AnnounceTypeListObjCmd, + (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL) == NULL) { + return TCL_ERROR; + } + + if (Tcl_CreateObjCommand(interp, "_announce_action_list", + (Tcl_ObjCmdProc*) TkDND_AnnounceActionListObjCmd, + (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL) == NULL) { + return TCL_ERROR; + } + + if (Tcl_CreateObjCommand(interp, "_find_drop_target_window", + (Tcl_ObjCmdProc*) TkDND_FindDropTargetWindowObjCmd, + (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL) == NULL) { + return TCL_ERROR; + } + + if (Tcl_CreateObjCommand(interp, "_find_drop_target_proxy", + (Tcl_ObjCmdProc*) TkDND_FindDropTargetProxyObjCmd, + (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL) == NULL) { + return TCL_ERROR; + } + + if (Tcl_CreateObjCommand(interp, "_send_XdndEnter", + (Tcl_ObjCmdProc*) TkDND_SendXdndEnterObjCmd, + (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL) == NULL) { + return TCL_ERROR; + } + + if (Tcl_CreateObjCommand(interp, "_send_XdndPosition", + (Tcl_ObjCmdProc*) TkDND_SendXdndPositionObjCmd, + (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL) == NULL) { + return TCL_ERROR; + } + + if (Tcl_CreateObjCommand(interp, "_send_XdndLeave", + (Tcl_ObjCmdProc*) TkDND_SendXdndLeaveObjCmd, + (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL) == NULL) { + return TCL_ERROR; + } + + if (Tcl_CreateObjCommand(interp, "_send_XdndDrop", + (Tcl_ObjCmdProc*) TkDND_SendXdndDropObjCmd, + (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL) == NULL) { + return TCL_ERROR; + } + /* Finally, register the XDND Handler... */ Tk_CreateClientMessageHandler(&TkDND_XDNDHandler); diff --git a/unix/tkUnixSelect.c b/unix/tkUnixSelect.c index a57dccd..a56df9f 100644 --- a/unix/tkUnixSelect.c +++ b/unix/tkUnixSelect.c @@ -27,6 +27,8 @@ typedef struct { int idleTime; } TkDND_ProcDetail; +void TkDND_SelectionNotifyEventProc(ClientData clientData, XEvent *eventPtr); +void TkDND_PropertyNotifyEventProc(ClientData clientData, XEvent *eventPtr); static void TkDND_SelTimeoutProc(ClientData clientData); static inline int maxSelectionIncr(Display *dpy) { @@ -116,20 +118,92 @@ int TkDND_ClipboardReadProperty(Tk_Window tkwin, // correct size, not 0-term. if (size) *size = Tcl_DStringLength(buffer); if (deleteProperty) XDeleteProperty(display, win, property); - XFlush(display); + //XFlush(display); return 1; }; /* TkDND_ClipboardReadProperty */ -void TkDND_EventProc(ClientData clientData, XEvent *eventPtr) { +int TkDND_ClipboardReadIncrementalProperty(Tk_Window tkwin, + Atom property, + TkDND_ProcDetail *detail) { + TkDND_ProcDetail detail2; + Tcl_DString *buffer = (Tcl_DString *) detail->clientData; + Display *display = Tk_Display(tkwin); + detail2.interp = detail->interp; + detail2.tkwin = detail->tkwin; + detail2.property = detail->property; + detail2.proc = NULL; + detail2.clientData = buffer; + detail2.result = -1; + detail2.idleTime = 0; + Tcl_DStringFree(buffer); + Tcl_DStringInit(buffer); + + //XFlush(display); + /* Install a handler for PropertyNotify events... */ + Tk_CreateEventHandler(tkwin, PropertyNotify, + TkDND_PropertyNotifyEventProc, &detail2); + /* + * Enter a loop processing X events until the selection has been retrieved + * and processed. If no response is received within a few seconds, then + * timeout. + */ + detail2.timeout = Tcl_CreateTimerHandler(1000, TkDND_SelTimeoutProc, + &detail2); + while (detail2.result == -1) { + //XFlush(display); + Tcl_DoOneEvent(0); + } + Tk_DeleteEventHandler(tkwin, PropertyNotify, + TkDND_PropertyNotifyEventProc, &detail2); + Tcl_DeleteTimerHandler(detail2.timeout); + return detail2.result; +}; /* TkDND_ClipboardReadIncrementalProperty */ + +void TkDND_SelectionNotifyEventProc(ClientData clientData, XEvent *eventPtr) { TkDND_ProcDetail *detail = (TkDND_ProcDetail *) clientData; int status, size, format; Atom type; status = TkDND_ClipboardReadProperty(detail->tkwin, detail->property, 1, detail, &size, &type, &format); + if (status) { + if (type == Tk_InternAtom(detail->tkwin, "INCR")) { + status = TkDND_ClipboardReadIncrementalProperty(detail->tkwin, + detail->property, detail); + } + } if (status) detail->result = TCL_OK; -}; /* TkDND_EventProc */ - + else detail->result = TCL_ERROR; +}; /* TkDND_SelectionNotifyEventProc */ + +void TkDND_PropertyNotifyEventProc(ClientData clientData, XEvent *eventPtr) { + TkDND_ProcDetail *detail = (TkDND_ProcDetail *) clientData; + Tcl_DString *buffer = (Tcl_DString *) detail->clientData; + Tcl_DString ds; + int status, size, format; + Atom type; + if (eventPtr->xproperty.atom != detail->property || + eventPtr->xproperty.state != PropertyNewValue) return; + /* We will call TkDND_ClipboardReadProperty to read the property. Ensure that + * a temporary DString will be used... */ + Tcl_DStringInit(&ds); + detail->clientData = &ds; + status = TkDND_ClipboardReadProperty(detail->tkwin, detail->property, 1, + detail, &size, &type, &format); + detail->clientData = buffer; + if (status) { + if (size == 0) { + /* We are done! */ + detail->result = status; + } else { + Tcl_DStringAppend(buffer, Tcl_DStringValue(&ds), Tcl_DStringLength(&ds)); + } + } else { + /* An error occured... */ + detail->result = status; + } + Tcl_DStringFree(&ds); +}; /* TkDND_PropertyNotifyEventProc */ /* *---------------------------------------------------------------------- @@ -186,24 +260,25 @@ TkDNDSelGetSelection( * happens, the request will be rejected. */ + //XFlush(display); /* Register an event handler for tkwin... */ - Tk_CreateEventHandler(sel_tkwin, SelectionNotify, TkDND_EventProc, &detail); + Tk_CreateEventHandler(sel_tkwin, SelectionNotify, + TkDND_SelectionNotifyEventProc, &detail); XConvertSelection(display, selection, target, selection, Tk_WindowId(sel_tkwin), time); - XFlush(display); - /* * Enter a loop processing X events until the selection has been retrieved * and processed. If no response is received within a few seconds, then * timeout. */ - detail.timeout = Tcl_CreateTimerHandler(1000, TkDND_SelTimeoutProc, &detail); while (detail.result == -1) { - Tcl_DoOneEvent(0); + //XFlush(display); + Tcl_DoOneEvent(0); } - Tk_DeleteEventHandler(sel_tkwin, SelectionNotify, TkDND_EventProc, &detail); + Tk_DeleteEventHandler(sel_tkwin, SelectionNotify, + TkDND_SelectionNotifyEventProc, &detail); Tcl_DeleteTimerHandler(detail.timeout); return detail.result; -- cgit v0.12