diff options
author | petasis <petasis@f3661a36-4baa-549a-d6c7-40e0ffef350e> | 2012-06-07 15:58:36 (GMT) |
---|---|---|
committer | petasis <petasis@f3661a36-4baa-549a-d6c7-40e0ffef350e> | 2012-06-07 15:58:36 (GMT) |
commit | ecf7b7d7c1312357e11244124490df33f35c856a (patch) | |
tree | 8e2ca54a1bc5116ee5951efda476922b501619eb | |
parent | ac795d6ade829b799bc7130320ac608612f5a2ee (diff) | |
download | tkdnd-ecf7b7d7c1312357e11244124490df33f35c856a.zip tkdnd-ecf7b7d7c1312357e11244124490df33f35c856a.tar.gz tkdnd-ecf7b7d7c1312357e11244124490df33f35c856a.tar.bz2 |
Linux (XDND) support completed\!
-rw-r--r-- | Changelog | 7 | ||||
-rw-r--r-- | demos/basic.tcl | 41 | ||||
-rw-r--r-- | library/tkdnd_unix.tcl | 254 | ||||
-rw-r--r-- | unix/TkDND_XDND.c | 120 | ||||
-rw-r--r-- | unix/tkUnixSelect.c | 51 |
5 files changed, 415 insertions, 58 deletions
@@ -1,3 +1,10 @@ +2012-06-07 Petasis George <petasis@iit.demokritos.gr> + * demos/basic.tcl: Updated demo with support for colours, which only + works for XDND right now. + + * unix/TkDND_XDND.c: + * unix/tkUnixSelect.c: Implementation of unix (XDND) drags completed. + 2012-06-06 Petasis George <petasis@iit.demokritos.gr> * unix/Cursors.c: Ported cursors from TkDND 1.x to TkDND 2.x diff --git a/demos/basic.tcl b/demos/basic.tcl index af74d72..6b852c4 100644 --- a/demos/basic.tcl +++ b/demos/basic.tcl @@ -39,7 +39,8 @@ foreach colour {red green blue navy} { pack [label .colours.$colour -text $colour -fg white -bg $colour] \
-side left -padx 2
tkdnd::drag_source register .colours.$colour
- bind .colours.$colour <<DragInitCmd>> "list copy TK_COLOUR $colour"
+ bind .colours.$colour <<DragInitCmd>> \
+ "list copy DND_Color $colour"
}
grid .colours -sticky snew -columnspan 2
@@ -50,8 +51,15 @@ grid [label .drop_target -text {Drop Target:} -bg yellow] \ # Register .drop_target as a drop target of every type!
tkdnd::drop_target register .drop_target *
-# Add the various events...
+# During drag and drop, the drop target receives information through 3
+# virtual events: <<DropEnter>> <<DropPosition>> <<DropLeave>>
+# The fields that can be used in the event callbacks, are given in "cmd",
+# while their "label" is given in "itemList"...
set cmd {handle_event %e %W %X %Y %ST %TT %a %A %CST %CTT %t %T %b %D}
+set itemList {Event Widget X Y Source_Types Target_Types Source_Actions Action
+ Common_Source_Types Common_Target_Types Types Drop_Type
+ Pressed_Keys Data}
+# Add the various events...
bind .drop_target <<DropEnter>> $cmd
bind .drop_target <<DropPosition>> $cmd
bind .drop_target <<DropLeave>> $cmd
@@ -63,10 +71,10 @@ bind .drop_target <<Drop>> $cmd # Add a specialised <<Drop>> event, when will be called if a file is dropped.
bind .drop_target <<Drop:DND_Files>> $cmd
+# Add a special drop command for DND_Color...
+bind .drop_target <<Drop:DND_Color>> $cmd
+
# Create some widgets for showing event info.
-set itemList {Event Widget X Y Source_Types Target_Types Source_Actions Action
- Common_Source_Types Common_Target_Types Types Drop_Type
- Pressed_Keys Data}
foreach item $itemList {
grid [label .[string tolower $item] -text [string map {_ \ } $item]:\
-anchor w] [label .[string tolower $item]_val -width 30 -anchor w \
@@ -81,11 +89,26 @@ proc handle_event $itemList { .[string tolower $item]_val configure -text [set $item]
}
switch -glob $Event {
- <<DropEnter>> {$Widget configure -bg green}
- <<DropLeave>> {$Widget configure -bg yellow}
+ <<DropEnter>> {$Widget configure -bg green}
+ <<DropLeave>> {$Widget configure -bg yellow}
+ <<Drop:DND_Color>> {
+ $Widget configure -bg yellow
+ .drop_target_value configure -text $Data
+ ## Convert data into a Tk color: the colour data is a list of 4 elements
+ ## (red green blue opacity), expressed as Hex numbers...
+ set color "#"
+ for {set i 0} {$i < 3} {incr i} {
+ ## Just remove the 0x prefix...
+ append color [string range [lindex $Data $i] 2 end]
+ }
+ .drop_target_value configure -background $color -foreground white
+ }
<<Drop>> -
- <<Drop:*>> {$Widget configure -bg yellow
- .drop_target_value configure -text $Data}
+ <<Drop:*>> {
+ $Widget configure -bg yellow
+ .drop_target_value configure -text $Data \
+ -background [. cget -background] -foreground black
+ }
}
return copy
};# handle_event
diff --git a/library/tkdnd_unix.tcl b/library/tkdnd_unix.tcl index 58ce39a..fbaef3d 100644 --- a/library/tkdnd_unix.tcl +++ b/library/tkdnd_unix.tcl @@ -327,6 +327,7 @@ proc xdnd::_GetDroppedData { time } { } else { set _use_tk_selection 1 } + #set _use_tk_selection 1 foreach type $_common_drag_source_types { # puts "TYPE: $type ($_drop_target)" # _get_selection $_drop_target $time $type @@ -400,25 +401,28 @@ proc xdnd::_normalise_data { type data } { # STRING, TEXT, COMPOUND_TEXT # UTF8_STRING # Else, it returns a list of 8 or 32 bit numbers... - switch $type { + switch -glob $type { STRING - UTF8_STRING - TEXT - COMPOUND_TEXT {return $data} text/html - text/plain { - if {[catch {tkdnd::bytes_to_string $data} string]} { + if {[catch { + encoding convertfrom utf-8 [tkdnd::bytes_to_string $data] + } string]} { set string $data } - return [string map {\r\n \n} \ - [encoding convertfrom utf-8 $string]] + return [string map {\r\n \n} $string } - text/uri-list { - if {[catch {tkdnd::bytes_to_string $data} string]} { + text/uri-list* { + if {[catch { + encoding convertfrom utf-8 [tkdnd::bytes_to_string $data + } string]} { set string $data } ## Get rid of \r\n set string [string trim [string map {\r\n \n} $string]] set files {} foreach quoted_file [split $string] { - set file [encoding convertfrom utf-8 [tkdnd::urn_unquote $quoted_file]] + set file [tkdnd::urn_unquote $quoted_file] switch -glob $file { file://* {lappend files [string range $file 7 end]} ftp://* - @@ -429,6 +433,9 @@ proc xdnd::_normalise_data { type data } { } return $files } + application/x-color { + return $data + } text/x-moz-url - application/q-iconlist - default {return $data} @@ -441,8 +448,9 @@ proc xdnd::_normalise_data { type data } { proc xdnd::_platform_specific_type { type } { switch $type { DND_Text {return [list text/plain\;charset=utf-8 UTF8_STRING \ - text/plain STRING]} + text/plain STRING TEXT COMPOUND_TEXT]} DND_Files {return [list text/uri-list]} + DND_Color {return [list application/x-color]} default {return [list $type]} } }; # xdnd::_platform_specific_type @@ -451,12 +459,15 @@ proc xdnd::_platform_specific_type { type } { # Command xdnd::_platform_independent_type # ---------------------------------------------------------------------------- proc xdnd::_platform_independent_type { type } { - switch $type { - UTF8_STRING - - STRING - - text/plain {return DND_Text} - text/uri-list {return DND_Files} - default {return [list $type]} + switch -glob $type { + UTF8_STRING - + STRING - + TEXT - + COMPOUND_TEXT - + text/plain* {return DND_Text} + text/uri-list* {return DND_Files} + application/x-color {return DND_Color} + default {return [list $type]} } }; # xdnd::_platform_independent_type @@ -464,9 +475,11 @@ proc xdnd::_platform_independent_type { type } { # Command xdnd::_supported_type # ---------------------------------------------------------------------------- proc xdnd::_supported_type { type } { - switch $type { - {text/plain;charset=UTF-8} - text/plain - - text/uri-list {return 1} + switch -glob [string tolower $type] { + {text/plain;charset=utf-8} - text/plain - + utf8_string - string - text - compound_text - + text/uri-list* - + application/x-color {return 1} } return 0 }; # xdnd::_supported_type @@ -491,8 +504,8 @@ proc xdnd::_selection_ownership_lost {} { proc xdnd::_dodragdrop { source actions types data button } { variable _dragging - puts "xdnd::_dodragdrop: source: $source, actions: $actions, types: $types,\ - data: \"$data\", button: $button" + # puts "xdnd::_dodragdrop: source: $source, actions: $actions, types: $types,\ + # data: \"$data\", button: $button" if {$_dragging} { ## We are in the middle of another drag operation... error "another drag operation in progress" @@ -507,6 +520,7 @@ proc xdnd::_dodragdrop { source actions types data button } { variable _dodragdrop_types $types variable _dodragdrop_types_len [llength $types] variable _dodragdrop_data $data + variable _dodragdrop_transfer_data {} variable _dodragdrop_button $button variable _dodragdrop_time 0 variable _dodragdrop_default_action refuse_drop @@ -515,6 +529,7 @@ proc xdnd::_dodragdrop { source actions types data button } { variable _dodragdrop_drop_target_accepts_action refuse_drop variable _dodragdrop_current_cursor $_dodragdrop_default_action variable _dodragdrop_drop_occured 0 + variable _dodragdrop_selection_requestor 0 ## ## If we have more than 3 types, the property XdndTypeList must be set on @@ -534,10 +549,7 @@ proc xdnd::_dodragdrop { source actions types data button } { ## ## Arrange selection handlers for our drag source, and all the supported types ## - foreach t $types { - selection handle -selection XdndSelection -type $t -format UTF8_STRING \ - $source [list ::tkdnd::xdnd::_SendData $t] - } + registerSelectionHandler $source $types ## ## Step 1: When a drag begins, the source takes ownership of XdndSelection. @@ -565,32 +577,33 @@ proc xdnd::_dodragdrop { source actions types data button } { _ungrab_pointer $source _unregister_generic_event_handler catch {selection clear -selection XdndSelection} - foreach t $types { - catch { - selection handle -selection XdndSelection -type $t -format UTF8_STRING \ - $source {} - } - } + unregisterSelectionHandler $source $types };# xdnd::_dodragdrop # ---------------------------------------------------------------------------- # Command xdnd::_process_drag_events # ---------------------------------------------------------------------------- proc xdnd::_process_drag_events {event} { + # The return value from proc is normally 0. A non-zero return value indicates + # that the event is not to be handled further; that is, proc has done all + # processing that is to be allowed for the event variable _dragging if {!$_dragging} {return 0} # puts $event variable _dodragdrop_time set time [dict get $event time] - if {$time < $_dodragdrop_time} {return 0} + set type [dict get $event type] + if {$time < $_dodragdrop_time && ![string equal $type SelectionRequest]} { + return 0 + } set _dodragdrop_time $time variable _dodragdrop_drag_source variable _dodragdrop_drop_target variable _dodragdrop_drop_target_proxy variable _dodragdrop_default_action - switch [dict get $event type] { + switch $type { MotionNotify { set rootx [dict get $event x_root] set rooty [dict get $event y_root] @@ -643,6 +656,19 @@ proc xdnd::_process_drag_events {event} { } } } + SelectionRequest { + variable _dodragdrop_selection_requestor + variable _dodragdrop_selection_property + variable _dodragdrop_selection_selection + variable _dodragdrop_selection_target + variable _dodragdrop_selection_time + set _dodragdrop_selection_requestor [dict get $event requestor] + set _dodragdrop_selection_property [dict get $event property] + set _dodragdrop_selection_selection [dict get $event selection] + set _dodragdrop_selection_target [dict get $event target] + set _dodragdrop_selection_time $time + return 0 + } default { return 0 } @@ -785,15 +811,6 @@ proc xdnd::_SendXdndDrop {} { };# xdnd::_SendXdndDrop # ---------------------------------------------------------------------------- -# Command xdnd::_SendData -# ---------------------------------------------------------------------------- -proc xdnd::_SendData {type s e args} { - variable _dodragdrop_data - puts "SendData: $type $s $e $args ($_dodragdrop_data)" - return [string range $_dodragdrop_data $s $e] -};# xdnd::_SendData - -# ---------------------------------------------------------------------------- # Command xdnd::_update_cursor # ---------------------------------------------------------------------------- proc xdnd::_update_cursor { {cursor {}}} { @@ -814,6 +831,7 @@ proc xdnd::_update_cursor { {cursor {}}} { set _dodragdrop_current_cursor $cursor } };# xdnd::_update_cursor + # ---------------------------------------------------------------------------- # Command xdnd::_default_action # ---------------------------------------------------------------------------- @@ -837,3 +855,159 @@ proc xdnd::_default_action {event} { } return default };# xdnd::_default_action + +# ---------------------------------------------------------------------------- +# Command xdnd::getFormatForType +# ---------------------------------------------------------------------------- +proc xdnd::getFormatForType {type} { + switch -glob [string tolower $type] { + text/plain\;charset=utf-8 - + utf8_string {set format UTF8_STRING} + text/plain - + string - + text - + compound_text {set format STRING} + text/uri-list* {set format UTF8_STRING} + application/x-color {set format $type} + default {set format $type} + } + return $format +};# xdnd::getFormatForType + +# ---------------------------------------------------------------------------- +# Command xdnd::registerSelectionHandler +# ---------------------------------------------------------------------------- +proc xdnd::registerSelectionHandler {source types} { + foreach type $types { + selection handle -selection XdndSelection \ + -type $type \ + -format [getFormatForType $type] \ + $source [list ::tkdnd::xdnd::_SendData $type] + } +};# xdnd::registerSelectionHandler + +# ---------------------------------------------------------------------------- +# Command xdnd::unregisterSelectionHandler +# ---------------------------------------------------------------------------- +proc xdnd::unregisterSelectionHandler {source types} { + foreach type $types { + catch { + selection handle -selection XdndSelection \ + -type $type \ + -format [getFormatForType $type] \ + $source {} + } + } +};# xdnd::unregisterSelectionHandler + +# ---------------------------------------------------------------------------- +# Command xdnd::_convert_to_unsigned +# ---------------------------------------------------------------------------- +proc xdnd::_convert_to_unsigned {data format} { + switch $format { + 8 { set mask 0xff } + 16 { set mask 0xffff } + 32 { set mask 0xffffff } + default {error "unsupported format $format"} + } + ## Convert signed integer into unsigned... + set d [list] + foreach num $data { + lappend d [expr { $num & $mask }] + } + return $d +};# xdnd::_convert_to_unsigned + +# ---------------------------------------------------------------------------- +# Command xdnd::_SendData +# ---------------------------------------------------------------------------- +proc xdnd::_SendData {type offset bytes args} { + variable _dodragdrop_drag_source + variable _dodragdrop_data + variable _dodragdrop_transfer_data + set format 8 + if {$offset == 0} { + ## Prepare the data to be transfered... + switch -glob $type { + text/plain* - UTF8_STRING - STRING - TEXT - COMPOUND_TEXT { + binary scan [encoding convertto utf-8 $_dodragdrop_data] \ + c* _dodragdrop_transfer_data + set _dodragdrop_transfer_data \ + [_convert_to_unsigned $_dodragdrop_transfer_data $format] + } + text/uri-list* { + set files [list] + foreach file $_dodragdrop_data { + switch -glob $file { + *://* {lappend files $file} + default {lappend files file://$file} + } + } + binary scan [encoding convertto utf-8 "[join $files \r\n]\r\n"] \ + c* _dodragdrop_transfer_data + set _dodragdrop_transfer_data \ + [_convert_to_unsigned $_dodragdrop_transfer_data $format] + } + application/x-color { + set format 16 + ## Try to understand the provided data: we accept a standard Tk colour, + ## or a list of 3 values (red green blue) or a list of 4 values + ## (red green blue opacity). + switch [llength $_dodragdrop_data] { + 1 { set color [winfo rgb $_dodragdrop_drag_source $_dodragdrop_data] + lappend color 65535 } + 3 { set color $_dodragdrop_data; lappend color 65535 } + 4 { set color $_dodragdrop_data } + default {error "unknown color data: \"$_dodragdrop_data\""} + } + ## Convert the 4 elements into 16 bit values... + set _dodragdrop_transfer_data [list] + foreach c $color { + lappend _dodragdrop_transfer_data [format 0x%04X $c] + } + } + default { + set format 32 + binary scan $_dodragdrop_data c* _dodragdrop_transfer_data + } + } + } + + ## + ## Data has been split into bytes. Count the bytes requested, and return them + ## + set data [lrange $_dodragdrop_transfer_data $offset [expr {$offset+$bytes-1}]] + switch $format { + 8 { + set data [encoding convertfrom utf-8 [binary format c* $data]] + } + 16 { + variable _dodragdrop_selection_requestor + if {$_dodragdrop_selection_requestor} { + ## Tk selection cannot process this format (only 8 & 32 supported). + ## Call our XChangeProperty... + set numItems [llength $data] + variable _dodragdrop_selection_property + variable _dodragdrop_selection_selection + variable _dodragdrop_selection_target + variable _dodragdrop_selection_time + XChangeProperty $_dodragdrop_drag_source \ + $_dodragdrop_selection_requestor \ + $_dodragdrop_selection_property \ + $_dodragdrop_selection_target \ + $format \ + $_dodragdrop_selection_time \ + $data $numItems + return -code break + } + } + 32 { + } + default { + error "unsupported format $format" + } + } + # puts "SendData: $type $offset $bytes $args ($_dodragdrop_data)" + # puts " $data" + return $data +};# xdnd::_SendData diff --git a/unix/TkDND_XDND.c b/unix/TkDND_XDND.c index 993a685..d807b66 100644 --- a/unix/TkDND_XDND.c +++ b/unix/TkDND_XDND.c @@ -38,6 +38,7 @@ #include "tcl.h" #include "tk.h" #include <string.h> +#include <stdlib.h> #include <X11/Xlib.h> #include <X11/X.h> #include <X11/Xatom.h> @@ -392,8 +393,8 @@ int TkDND_HandleXdndPosition(Tk_Window tkwin, XEvent *xevent) { ActionCopy, ActionMove, ActionLink, ActionAsk, ActionPrivate, refuse_drop, ActionDefault }; - Time time; - Atom action; +/*Time time; + Atom action;*/ if (interp == NULL || tkwin == NULL) return False; @@ -402,9 +403,9 @@ int TkDND_HandleXdndPosition(Tk_Window tkwin, XEvent *xevent) { rootX = XDND_POSITION_ROOT_X(xevent); rootY = XDND_POSITION_ROOT_Y(xevent); /* Get the time from the event... */ - time = XDND_POSITION_TIME(xevent); + /* time = XDND_POSITION_TIME(xevent); */ /* Get the user action from the event... */ - action = XDND_POSITION_ACTION(xevent); + /* action = XDND_POSITION_ACTION(xevent); */ /* The event may have been delivered to the toplevel wrapper. * Try to find the toplevel window... */ @@ -1032,7 +1033,21 @@ int TkDND_HandleGenericEvent(ClientData clientData, XEvent *eventPtr) { TkDND_Dict_Put(dict, "type", "LeaveNotify"); TkDND_Dict_PutLong(dict, "time", eventPtr->xcrossing.time); break; - default: + case SelectionRequest: + main_window = Tk_MainWindow(interp); + TkDND_Dict_Put(dict, "type", "SelectionRequest"); + TkDND_Dict_PutLong(dict, "time", eventPtr->xselectionrequest.time); + TkDND_Dict_PutLong(dict, "owner", eventPtr->xselectionrequest.owner); + TkDND_Dict_PutLong(dict, "requestor", + eventPtr->xselectionrequest.requestor); + TkDND_Dict_Put(dict, "selection", + Tk_GetAtomName(main_window, eventPtr->xselectionrequest.selection)); + TkDND_Dict_Put(dict, "target", + Tk_GetAtomName(main_window, eventPtr->xselectionrequest.target)); + TkDND_Dict_Put(dict, "property", + Tk_GetAtomName(main_window, eventPtr->xselectionrequest.property)); + break; + default: Tcl_DecrRefCount(dict); return 0; } @@ -1360,6 +1375,95 @@ int TkDND_SendXdndDropObjCmd(ClientData clientData, return TCL_OK; }; /* TkDND_SendXdndDropObjCmd */ +int TkDND_XChangePropertyObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { + XEvent event; + Window target; + Atom property = None, type = None; + int format, numItems, numFields, i; + Display *display; + Tk_Window source; + Time time; + unsigned char *data = NULL; + Tcl_Obj **field; + + if (objc != 9) { + Tcl_WrongNumArgs(interp, 1, objv, + "source requestor property type format time data data_items"); + return TCL_ERROR; + } + + source = TkDND_TkWin(objv[1]); + if (!source) return TCL_ERROR; + if (Tcl_GetLongFromObj(interp, objv[2], (long *) &target) != TCL_OK) { + return TCL_ERROR; + } + display = Tk_Display(source); + property = Tk_InternAtom(source, Tcl_GetString(objv[3])); + type = Tk_InternAtom(source, Tcl_GetString(objv[4])); + if (Tcl_GetIntFromObj(interp, objv[5], &format) != TCL_OK) { + return TCL_ERROR; + } + if (format != 8 && format != 16 && format != 32) { + Tcl_SetResult(interp, "unsupported format: not 8, 16 or 32", TCL_STATIC); + return TCL_ERROR; + } + if (Tcl_GetIntFromObj(interp, objv[5], &format) != TCL_OK) { + return TCL_ERROR; + } + if (Tcl_GetLongFromObj(interp, objv[6], (long *) &time) != TCL_OK) { + return TCL_ERROR; + } + if (Tcl_GetIntFromObj(interp, objv[8], &numItems) != TCL_OK) { + return TCL_ERROR; + } + if (!time) time = CurrentTime; + switch (format) { + case 8: + data = (unsigned char *) Tcl_GetString(objv[7]); + break; + case 16: { + short *propPtr = (short *) Tcl_Alloc(sizeof(short)*numItems); + data = (unsigned char *) propPtr; + if (Tcl_ListObjGetElements(interp, objv[7], &numFields, &field) + != TCL_OK) { + return TCL_ERROR; + } + for (i = 0; i < numItems; i++) { + char *dummy; + propPtr[i] = (short) strtol(Tcl_GetString(field[i]), &dummy, 0); + } + break; + } + case 32: { + long *propPtr = (long *) Tcl_Alloc(sizeof(long)*numItems); + data = (unsigned char *) propPtr; + if (Tcl_ListObjGetElements(interp, objv[7], &numFields, &field) + != TCL_OK) { + return TCL_ERROR; + } + for (i = 0; i < numItems; i++) { + char *dummy; + propPtr[i] = (short) strtol(Tcl_GetString(field[i]), &dummy, 0); + } + break; + } + } + XChangeProperty(display, target, property, type, format, PropModeReplace, + (unsigned char *) data, numItems); + if (format > 8 && data) Tcl_Free((char *) data); + /* Send selection notify to requestor... */ + event.xselection.type = SelectionNotify; + event.xselection.display = display; + event.xselection.requestor = target; + event.xselection.selection = Tk_InternAtom(source, "XdndSelection"); + event.xselection.target = type; + event.xselection.property = property; + event.xselection.time = time; + XSendEvent(display, target, False, NoEventMask, &event); + return TCL_OK; +}; /* TkDND_XChangePropertyObjCmd */ + /* * For C++ compilers, use extern "C" */ @@ -1500,6 +1604,12 @@ int DLLEXPORT Tkdnd_Init(Tcl_Interp *interp) { return TCL_ERROR; } + if (Tcl_CreateObjCommand(interp, "XChangeProperty", + (Tcl_ObjCmdProc*) TkDND_XChangePropertyObjCmd, + (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL) == NULL) { + return TCL_ERROR; + } + /* Create the cursors... */ TkDND_InitialiseCursors(interp); diff --git a/unix/tkUnixSelect.c b/unix/tkUnixSelect.c index 2baa0fb..99f208b 100644 --- a/unix/tkUnixSelect.c +++ b/unix/tkUnixSelect.c @@ -65,7 +65,7 @@ int TkDND_ClipboardReadProperty(Tk_Window tkwin, } XFree((char*)data); - int offset = 0, format_inc = 1; + int offset = 0, format_inc = 1, proplen = bytes_left; switch (*format) { case 8: @@ -75,10 +75,12 @@ int TkDND_ClipboardReadProperty(Tk_Window tkwin, case 16: format_inc = sizeof(short) / 2; + proplen *= sizeof(short) / 2; break; case 32: format_inc = sizeof(long) / 4; + proplen *= sizeof(long) / 4; break; } @@ -88,13 +90,46 @@ int TkDND_ClipboardReadProperty(Tk_Window tkwin, &length, &bytes_left, &data); if (r != Success || (type && *type == None)) break; + switch (*format) { + case 8: + default: + offset += length / (32 / *format); + length *= format_inc * (*format) / 8; + Tcl_DStringAppend(buffer, (char *) data, length); + break; + case 16: { + register unsigned short *propPtr = (unsigned short *) data; + for (; length > 0; propPtr++, length--) { + char buf[12]; + + sprintf(buf, "0x%04x", (unsigned short) *propPtr); + Tcl_DStringAppendElement(buffer, buf); + } + Tcl_DStringAppend(buffer, " ", 1); + break; + } + case 32: { + register unsigned long *propPtr = (unsigned long *) data; + for (; length > 0; propPtr++, length--) { + char buf[12]; - offset += length / (32 / *format); - length *= format_inc * (*format) / 8; - Tcl_DStringAppend(buffer, (char *) data, length); + sprintf(buf, "0x%x", (unsigned int) *propPtr); + Tcl_DStringAppendElement(buffer, buf); + } + Tcl_DStringAppend(buffer, " ", 1); + break; + } + } XFree((char*)data); } +#if 0 + printf("Selection details:\n"); + printf(" type: %s\n", XGetAtomName(display, *type)); + printf(" format: %d %s\n", *format, XGetAtomName(display, *format)); + printf(" length: %d\n", Tcl_DStringLength(buffer)); + printf(" data: \"%s\"\n", Tcl_DStringValue(buffer)); +#endif if (*format == 8 && *type == Tk_InternAtom(tkwin, "COMPOUND_TEXT")) { // convert COMPOUND_TEXT to a multibyte string @@ -166,6 +201,14 @@ void TkDND_SelectionNotifyEventProc(ClientData clientData, XEvent *eventPtr) { status = TkDND_ClipboardReadProperty(detail->tkwin, detail->property, 1, detail, &size, &type, &format); if (status) { +#ifdef TKDND_DebugSelectionRequests + printf("SelectionNotify: selection: %s, target: %s, property: %s,\ + type: %s, format: %d\n", + Tk_GetAtomName(detail->tkwin, eventPtr->xselection.selection), + Tk_GetAtomName(detail->tkwin, eventPtr->xselection.target), + Tk_GetAtomName(detail->tkwin, eventPtr->xselection.property), + Tk_GetAtomName(detail->tkwin, type), format); +#endif /* TKDND_DebugSelectionRequests */ if (type == Tk_InternAtom(detail->tkwin, "INCR")) { status = TkDND_ClipboardReadIncrementalProperty(detail->tkwin, detail->property, detail); |