Tree-view drag and drop - can't set gtk-selection-data
stacksmith opened this issue · comments
I will try to describe the issue as my code is large right now... SBCL 1.3.8 on Linux (xubuntu 14.04 up-to-date libraries)
With a tree control, upon enabling gtk-tree-view-enable-model-drag-dest (and source),
on "drag-data-get" signal I set the gtk-selection-data passed to me (it is a "text/uri-list" type drag). It appears to work fine (I can print it and the data, length, type and format are set correctly).
However, "drag-data-received" is invoked with a blank gtk-selection-data, as if I hadn't filled it out in my "drag-data-get" handler.
Dropping urls from external applications works fine. No luck dragging from my application to others - the problem seems to be in generating the source gtk-selection-data.
My gtk-foo is weak and it is possible that I am doing something stupid. However, no matter how I try I cannot get the gtk-selection-data object from my "drag-data-get" to "drag-data-received".
The handlers and their output:
(defun on-drag-data-get (widget context data info time)
(gtk-selection-data-set-uris data (list "file:///blah/blah.pdf"))
(format t "~A~%" data)) ; This works fine - output below
#S(GTK:GTK-SELECTION-DATA
:SELECTION XdndSelection
:TARGET text/uri-list
:TYPE text/uri-list
:FORMAT 8
:DATA #.(SB-SYS:INT-SAP #X7FFFD01DBFA0)
:LENGTH 21 ;
:DISPLAY #<GDK-DISPLAY {100E4DDE93}>)
(defun on-drag-data-received (widget context x y data info etime)
(format t "~A~%" data)) ; This shows a blank one - output below
#S(GTK:GTK-SELECTION-DATA
:SELECTION XdndSelection
:TARGET text/uri-list
:TYPE NONE
:FORMAT 0
:DATA #.(SB-SYS:INT-SAP #X00000000)
:LENGTH -1
:DISPLAY #<GDK-DISPLAY {100E4DDE93}>)
Some thoughts: perhaps data is passed by value (or as some copy of the original gtk object)???
I attempted to store the two gtk-selection-data objects in special vars, and they are not eq... Not that it is necessarily meaningful.
Immediately after (gtk-selection-data-set-uris data (list "....")) (and seeing the output above), calling
(gtk-selection-data-get-uris data) returns NIL!
More importantly, calling (gtk-selection-data-get-uris data) twice in a row does not work - second call returns NIL.
Interesting note: dragging from my application to other apps usually crashes on (gtk-selection-data-set-uris...) with something like:
NIL is not a Lisp string or pointer.
[Condition of type SIMPLE-ERROR]
Restarts:
0: [RETURN-FROM-G-CLOSURE] Return value from closure
1: [ABORT] abort thread (#<THREAD "cl-cffi-gtk main thread" RUNNING {100871DD13}>)
Backtrace:
0: ((:METHOD CFFI:TRANSLATE-TO-FOREIGN (T CFFI::FOREIGN-STRING-TYPE)) NIL #<unavailable argument>) [fast-method]
1: (GDK:GDK-ATOM-INTERN NIL NIL)
2: (CFFI::MEM-SET NIL #.(SB-SYS:INT-SAP #X7FFFD038D6D0) GDK:GDK-ATOM-AS-STRING 16)
3: ((:METHOD (SETF CFFI::FOREIGN-STRUCT-SLOT-VALUE) (T T CFFI::SIMPLE-STRUCT-SLOT)) NIL #.(SB-SYS:INT-SAP #X7FFFD038D6D0) #<CFFI::SIMPLE-STRUCT-SLOT {101380A863}>) [fast-method]
4: (GOBJECT::COPY-SLOTS-TO-NATIVE #S(GTK:GTK-SELECTION-DATA :SELECTION "XdndSelection" :TARGET "text/uri-list" :TYPE NIL :FORMAT -543682240 :DATA #.(SB-SYS:INT-SAP #X00000000) :LENGTH -1 ...) #.(SB-SYS:I..
5: ((:METHOD CFFI:TRANSLATE-TO-FOREIGN (T GOBJECT::BOXED-CSTRUCT-FOREIGN-TYPE)) #S(GTK:GTK-SELECTION-DATA :SELECTION "XdndSelection" :TARGET "text/uri-list" :TYPE NIL :FORMAT -543682240 :DATA #.(SB-SYS:I..
6: (GTK:GTK-SELECTION-DATA-SET-URIS #S(GTK:GTK-SELECTION-DATA :SELECTION "XdndSelection" :TARGET "text/uri-list" :TYPE NIL :FORMAT -543682240 :DATA #.(SB-SYS:INT-SAP #X00000000) :LENGTH -1 ...) ("file://..
7: (CL-FM::ON-DRAG-DATA-GET #<GTK:GTK-TREE-VIEW {100873A263}> #<GDK:GDK-DRAG-CONTEXT {100C079C13}> #S(GTK:GTK-SELECTION-DATA :SELECTION "XdndSelection" :TARGET "text/uri-list" :TYPE NIL :FORMAT -54368224..
...
Some of the crashes lock up the desktop UI, requiring me to switch to a text-mode terminal with C-M-F1 and kill SBCL, which unlocks the desktop UI.
So I think it is clear to assume that selection-seting code is buggy based on this and the fact that you after using the set routines the selection is nulled.
I modified drag and drop setup code to use the widget routines instead of tree-view-enable-model to see what happens. Now drops from external sources are still handled correctly; drops internal to the treeview invoke "drag-data-get" handler correctly, but "drag-data-received" is never signaled. This could be the consequence of a blank selection.
Still crashing as above setting URI in the selection.
I also tried to set the selection data the hard way, using setf and accessors for type, format, data and length using this code:
(let ((target (gtk-selection-data-target data))
(uri "file:///somefile.txt"))
(setf (gtk-selection-data-type data) target )
(setf (gtk-selection-data-format data) 8)
(setf (gtk-selection-data-data data) (cffi:foreign-string-alloc uri))
(setf (gtk-selection-data-length data) (length uri)))
No crashes!
But, alas, internal drags do not result in "drag-data-received", and dragging to other apps results in nothing. Receiving drags from the file manager works fine.
@stacksmith can you perhaps post a minimal example so it's easier to follow?
I'd guess that the locking up is just a result of the drag/drop mechanics on X11 - if you'd had an application in a different language crash in the middle of this the behaviour would probably be similar.
Minimal turned out to be about 150 SLOC. To run it in slime, (ql:quickload :cl-cffi-gtk), compile the file, (in-package :cl-trtest) (test). Messing around tends to lock the GUI, so I often switch to a text console and kill SBCL and go back to GUI and restart slime. Sadly, (test) needs to be re-run upon any change in source...Note that most signals are not connected, just "drag-data-get" and "drag-data-received".
Please check that I am setting up drag and drop correctly, as there were many guesses on my part. As is, you can drop a file onto the treeview to see that it receives uri-lists correctly. Dragging an item internally shows that the data generated in "drag-data-get" handler is not the same as data received in "drag-data-received"...
Please look at the (on-drag-data-get ...) handler. (gtk-selection-data-set-uris data (list "file:///test.txt")) behaves differently from manually setting the values -- get-uris returns NIL, and other issues come up. It appears to be a bug...
Dragging to any other application results in nothing happening - as I suspect the empty selection is dropped outside as well.
;;; (ql:quickload :cl-cffi-gtk) then compile this file. (in-package :cl-trtest) (test)
;;; This is a simple treeview implementation to debug drag and drop issues.
(defpackage #:cl-trtest
(:use :gtk :gdk :gdk-pixbuf :gobject
:glib :gio :pango :cairo :cffi :common-lisp :cl))
(in-package :cl-trtest)
(defstruct trtest widget store)
(defun on-drag-data-get (widget context data info time) (declare (ignore time))
(format t "DRAG-DATA-GET ~A~%" info)
(format t "Drag requests target: ~A~%" (gtk-drag-dest-find-target widget context))
;;(format t "URI target possible?: ~A~%" (gtk-drag-dest-get-target-list widget))
(let ((target (gtk-selection-data-target data))
(uri (format NIL "http://www.google.com/~C~C" #\linefeed #\return))
(setf (gtk-selection-data-type data) target )
(setf (gtk-selection-data-format data) 8)
(setf (gtk-selection-data-data data) (cffi:foreign-string-alloc uri))
(setf (gtk-selection-data-length data) (length uri))
;; Replace the above 4 lines with the one below - it should be the same.
;; But it is not - get-uris below gets NIL, suggesting a bug.
;(gtk-selection-data-set-uris data (list "file:///test.txt"))
(format t "GENERATED DRAG DATA ~A~%" data)
(format t "URIS: -~A----~%" (gtk-selection-data-get-uris data))))
(defun on-drag-data-received (widget context x y data info time )
(format t "DRAG-DATA-RECEIVED~%")
(format t "----~A----~%~%" data)
(format t "-URIS:-~A----~%~%" (gtk-selection-data-get-uris data)))
(defun on-drag-motion (widget context x y time)
(format t "DRAG-MOTION ~A (~A,~A)~%" widget x y)
;(gdk-drag-status context :copy time ); (gtk-drag-get-data widget context "text/uri-list" time)
; (format t "~A~%" (type-of (gdk-drag-get-selection context)))
t)
(defun on-drag-drop (widget context x y time)
(format t "DRAG-DROP ~A (~A,~A)~%" widget x y)
; (format t "~A~%" (gtk-drag-get-data widget context (gtk-drag-dest-find-target widget context) time ))
; (gtk-drag-finish context t nil time)
nil)
(defun on-drag-end (widget context )
(format t "DRAG-END ~A~%" context))
(defun create-trtest-widget (model)
"create gtk widget"
(let ((view (make-instance 'gtk-tree-view :model model)))
(loop for column in (create-columns) do (gtk-tree-view-append-column view column))
(gtk-tree-view-set-rules-hint view 1) ;display stripes
(gtk-tree-selection-set-mode (gtk-tree-view-get-selection view) :multiple)
(gtk-tree-view-enable-grid-lines view )
(let ((source-targets (vector
(gtk-target-entry-new "GTK_TREE_MODEL_ROW" 0 110)
(gtk-target-entry-new "text/html" 0 112)
(gtk-target-entry-new "text/uri-list" 0 115)
;; (gtk-target-entry-new "TEXT" 0 113)
;; (gtk-target-entry-new "STRING" 0 114)
))
(dest-targets (vector
;; (gtk-target-entry-new "GTK_TREE_MODEL_ROW" 0 110)
;; (gtk-target-entry-new "text/html" 0 112)
(gtk-target-entry-new "text/uri-list" 0 115)
;;
;; (gtk-target-entry-new "TEXT" 0 113)
;; (gtk-target-entry-new "STRING" 0 114)
))
)
(gtk-tree-view-enable-model-drag-dest view dest-targets '(:copy :move :link :private :ask))
(gtk-tree-view-enable-model-drag-source view :button1-mask
source-targets '(:copy :move :link :private :ask ))
;;DRAG
(g-signal-connect view "drag-data-get" #'on-drag-data-get)
;(g-signal-connect view "drag-end" #'on-drag-end)
;(g-signal-connect view "drag-motion" #'on-drag-motion)
;;DROP
(g-signal-connect view "drag-data-received" #'on-drag-data-received)
;(g-signal-connect view "drag-drop" #'on-drag-drop)
)
view))
(defun create-trtest ()
(let ((fb (make-trtest :store (create-model))))
(setf (trtest-widget fb)
(create-trtest-widget (trtest-store fb)))
(model-refill (trtest-store fb) )
fb))
;;;---------------------------------------------------
;;; M O D E L
;;
(defconstant COL-ID 0)
(defconstant COL-NAME 1)
(defun create-column (number title)
"helper - create a single column with a text renderer"
(let* ((renderer (gtk-cell-renderer-text-new))
(column (gtk-tree-view-column-new-with-attributes title renderer "text" number)))
(gtk-tree-view-column-set-sort-column-id column number)
column))
(defun create-columns ()
;; Create columns
(list (create-column COL-ID "#") (create-column COL-NAME "Startup ideas")))
(defun create-model ()
(let ((model (make-instance 'gtk-tree-store :column-types '("guint" "gchararray"))))
(g-signal-connect model "row-deleted" #'on-row-deleted)
(g-signal-connect model "row-inserted" #'on-row-inserted)
(g-signal-connect model "row-changed" #'on-row-changed)
model))
(defun model-refill (store)
(gtk-tree-store-clear store)
(gtk-tree-store-set store (gtk-tree-store-append store nil) 1 "abacus temp service")
(gtk-tree-store-set store (gtk-tree-store-append store nil) 2 "babaganuj cart")
(gtk-tree-store-set store (gtk-tree-store-append store nil) 3 "cataract recycling")
(gtk-tree-store-set store (gtk-tree-store-append store nil) 4 "dildo factory"))
(defun on-row-changed (model tp iter)
(format t "~A ROW-CHANGED ~A~%" (get-universal-time) (gtk-tree-model-get-value model iter COL-ID)))
(defun on-row-inserted (model tp iter)
(format t "~A ROW-INSERTED ~A~%" (get-universal-time) (gtk-tree-model-get model iter COL-ID)))
(defun on-row-deleted (model tp)
(format t "~A ROW-DELETED ~A~%" (get-universal-time) tp ))
;;;-----------------------
;;; T O P
;;;
(defun test (&key (stdout *standard-output*))
(let ((fb nil))
(within-main-loop
(setf *standard-output* stdout) ;enable output in this thread
(let ((window (make-instance 'gtk-window
:title "Great Ideas"
:type :toplevel :border-width 0
:default-width 640 :default-height 480))
(fb (create-trtest)))
(gtk-container-add window (trtest-widget fb ))
(g-signal-connect window "destroy"
(lambda (widget)
(declare (ignore widget))
(format t "done")
(leave-gtk-main)))
(gtk-widget-show-all window)))))
I am not sure why I, but I think that selection-type may have something to do with it. It comes in as a string, but is internally an atom... Is the setter looking up the atom? Interning is problematic as there is no way to tell if the atom existed (it probably should be fixed). Selection access - especially setters - caused some issues with my old code - I haven't had time to work the example code yet.
Something like that; the boxed selection data gets converted from C, the type is invalid and results in NIL on the Lisp side, which, when converted back for the when invoking gtk-selection-data-set-uris call, falls flat.
The whole boxed representation for selection data seems overkill here.
Unfortunately I don't see a quick fix for this - either the selection data type would need to be changed to the -opaque handling, or the boxed handling would need to be smarter, preserve the original object (and likely copy less in general). Your workaround seems the best option at the moment.
Now, I need to install a graphical file manager to try this (what are you using?), but I noticed that the format in GTK terminates each line of the URI list with \r\n - perhaps try that out in the meantime? I.e.:
(uri (format NIL "http://www.google.com/~C~C" #\linefeed #\return))
Ferada, adding lf/cr does not help (I noticed that earlier and it was on my list of things to try.
I am using nemo mostly, although PCMANFM acts the same way, so I am pretty sure inbound drags work fine and outbound drags are crap.
I do not have a workaround for dragging out to other applications, unfortunately! Inbound drags work fine, and for inside drag/drop it is simple enough to install a "drag-drop" handler to ask the treeview for its selection and do what is needed.
Hmm. Are (gdk-drag-context-get-actions) and (gdk-drag-context-get-suggested-actions) really not implemented?
The wrappers aren't particularly complicated to add, e.g.
(defcfun ("gdk_drag_context_get_actions" gdk-drag-context-get-actions) gdk-drag-action
(context (g-object gdk-drag-context)))
(export 'gdk-drag-context-get-actions)
(defcfun ("gdk_drag_context_get_suggested_actions" gdk-drag-context-get-suggested-actions) gdk-drag-action
(context (g-object gdk-drag-context)))
(export 'gdk-drag-context-get-suggested-actions)
in gdk/gdk.drag-and-drop.lisp should do it, just follow the lead (and then create a PR :).
Re drag&drop I'll play with it too some more, but I think this might also just be a GTK problem, not particularly this wrapper, perhaps there's some Python example somewhere that does this correctly?
Thanks for the binding pointers. I will PR when I get a chance.
I think that more drag and drop treeview problems exist. I could not get the widget to highlight rows from my "drag-motion" handler yesterday.
I suppose I should work up a parallel C case (who knows what problems lie inside the Python bindings) to show that the problem really exists. I was hoping to stay in Lisp for the rest of my life...
I didn't get any further I'm afraid. I'm relatively sure that the following is more correct than the current boxed representation though since it updates the original object instead of a copy:
(define-g-boxed-opaque gtk-selection-data "GtkSelectionData"
:alloc (error "GtkSelectionData can not be created from Lisp side."))
That said, I still can't get other applications to see anything but an empty string in the data and it's frustrating to debug.
Actually my minimal example (with some changes to the library, so doesn't work right out of the box) is this now:
(defpackage #:cl-trtest
(:use :gtk :gdk :gdk-pixbuf :gobject
:glib :gio :pango :cairo :cffi :common-lisp :cl))
(in-package :cl-trtest)
(defun on-drag-data-get (widget context data info time) (declare (ignore time))
(gtk-selection-data-set data "STRING" 8 "http://www.google.com/")
(format t "target ~A~%" (gtk-selection-data-get-target data))
(format t "format ~A~%" (gtk-selection-data-get-format data))
(format t "type ~A~%" (gtk-selection-data-get-data-type data))
(format t "text ~A~%" (gtk-selection-data-get-text data)))
(defun test (&key (stdout *standard-output*))
(within-main-loop
(setf *standard-output* stdout)
(let ((window (make-instance 'gtk-window
:title "Great Ideas"
:type :toplevel :border-width 0
:default-width 640 :default-height 480)))
(let ((source-targets (vector (gtk-target-entry-new "STRING" 0 113))))
(gtk-drag-source-set window :button1-mask source-targets '(:default :copy ;; :move :link :private :ask
))
(g-signal-connect window "drag-data-get" #'on-drag-data-get)
(g-signal-connect window "destroy"
(lambda (widget)
(declare (ignore widget))
(format t "done")
(leave-gtk-main)))
(gtk-widget-show-all window)))))
The Python example that resembles this, works, but something is really fishy with this one.
Yes, frustrating. I am constantly shelling out to kill -9 $(pidof sbcl) and restarting slime...
I am also fairly certain that (gtk-tree-view-set-drag-dest-row ...)has no effect whatsoever on the treeview... It is supposed to set highlighted drop row from inside "drag-motion" handler.
@stacksmith long time no see. Take a look at Ferada@7bc75fe / the master branch still. I've readded the drag&drop examples and they seem to work fine now. The issue is a simple copy of the boxed GtkSelectionData structure, which prevents the modifications to go through the original object. There's also another breaking change for the interface in that I turned it back into an opaque object, so some of the accessors aren't available anymore.
@Ferada - thank you so much! I was just dreading revisiting the issue... I will take a look at your repo; I have a bunch of cairo and pango bindings I've been meaning to contribute... Are you taking over the library?
@stacksmith well, effectively yes, at least I'm doing my best to fix and improve things. I've submitted a request for change of repo on Quicklisp with an explanation too, you can vote on that if you like.
If you've got things I'm happy to look at PRs.
Is there a place to vote? It looks like your request is not being challenged, other than attribution...
Nah, I meant as in writing "I want this too!" ^^
I am happy do to that, but Xach is often grumpy about things like that... ah, what the heck...