Add Gdk/Drag-and-drop

diff --git a/gdk/cl-gtk2-gdk.asd b/gdk/cl-gtk2-gdk.asd
index 2996f52..35692b5 100644 (file)
--- a/gdk/cl-gtk2-gdk.asd
+++ b/gdk/cl-gtk2-gdk.asd
@@ -23,5 +23,6 @@
                (:file "gdk.windows")
                (:file "gdk.events")
                (:file "gdk.key-values")
-               (:file "gdk.selections"))
+               (:file "gdk.selections")
+               (:file "gdk.drag-and-drop"))
   :depends-on (:cl-gtk2-glib :cffi :cl-gtk2-pango))
\ No newline at end of file

diff --git a/gdk/gdk.drag-and-drop.lisp b/gdk/gdk.drag-and-drop.lisp
new file mode 100644 (file)
index 0000000..85253ef
--- /dev/null
+++ b/gdk/gdk.drag-and-drop.lisp
@@ -0,0 +1,157 @@
+(in-package :gdk)
+
+(defcstruct %gdk-drag-context
+  (parent-instance :pointer)
+  (protocol gdk-drag-protocol)
+  (is-source :boolean)
+  (source-window (g-object gdk-window))
+  (dest-window (g-object gdk-window))
+  (targets (glib:glist gdk-atom-as-string :free-from-foreign nil))
+  (actions gdk-drag-action)
+  (suggested-action gdk-drag-action)
+  (action gdk-drag-action)
+  (start-time :uint32))
+
+(defun %gdk-drag-context-get-protocol (context)
+  (foreign-slot-value (pointer context) '%gdk-drag-context 'protocol))
+
+(defun %gdk-drag-context-get-is-source (context)
+  (foreign-slot-value (pointer context) '%gdk-drag-context 'is-source))
+
+(defun %gdk-drag-context-get-source-window (context)
+  (foreign-slot-value (pointer context) '%gdk-drag-context 'source-window))
+
+(defun %gdk-drag-context-get-dest-window (context)
+  (foreign-slot-value (pointer context) '%gdk-drag-context 'dest-window))
+
+(defun %gdk-drag-context-get-targets (context)
+  (foreign-slot-value (pointer context) '%gdk-drag-context 'targets))
+
+(defun %gdk-drag-context-get-actions (context)
+  (foreign-slot-value (pointer context) '%gdk-drag-context 'actions))
+
+(defun %gdk-drag-context-get-suggested-action (context)
+  (foreign-slot-value (pointer context) '%gdk-drag-context 'suggested-action))
+
+(defun %gdk-drag-context-get-action (context)
+  (foreign-slot-value (pointer context) '%gdk-drag-context 'action))
+
+(defun %gdk-drag-context-get-start-time (context)
+  (foreign-slot-value (pointer context) '%gdk-drag-context 'start-time))
+
+(defcfun gdk-drag-get-selection gdk-atom-as-string
+  (context (g-object drag-context)))
+
+(export 'gdk-drag-get-selection)
+
+(defcfun gdk-drag-abort :void
+  (context (g-object drag-context))
+  (time :uint32))
+
+(export 'gdk-drag-abord)
+
+(defcfun gdk-drop-reply :void
+  (context (g-object drag-context))
+  (ok :boolean)
+  (time :uint32))
+
+(export 'gdk-drop-reply)
+
+(defcfun gdk-drag-drop :void
+  (context (g-object drag-context))
+  (time :uint32))
+
+(export 'gdk-drag-drop)
+
+(defcfun gdk_drag_find_window :void
+  (context (g-object drag-context))
+  (window (g-object gdk-window))
+  (x-root :int)
+  (y-root :int)
+  (dest-window (:pointer (g-object gdk-window)))
+  (protocol (:pointer gdk-drag-protocol)))
+
+(defun gdk-drag-find-window (context window x-root y-root)
+  (with-foreign-objects ((dest-window :pointer) (protocol 'gdk-drag-protocol))
+    (gdk_drag_find_window context window x-root y-root dest-window protocol)
+    (values (mem-ref dest-window '(g-object gdk-window))
+            (mem-ref protocol 'gdk-drag-protocol))))
+
+(export 'gdk-drag-find-window)
+
+(defcfun gdk_drag_find_window_for_screen :void
+  (context (g-object drag-context))
+  (window (g-object gdk-window))
+  (screen (g-object screen))
+  (x-root :int)
+  (y-root :int)
+  (dest-window (:pointer (g-object gdk-window)))
+  (protocol (:pointer gdk-drag-protocol)))
+
+(defun gdk-drag-find-window-for-screen (context window screen x-root y-root)
+  (with-foreign-objects ((dest-window :pointer) (protocol 'gdk-drag-protocol))
+    (gdk_drag_find_window_for_screen context window screen x-root y-root dest-window protocol)
+    (values (mem-ref dest-window '(g-object gdk-window))
+            (mem-ref protocol 'gdk-drag-protocol))))
+
+(export 'gdk-drag-find-window-for-screen)
+
+(defcfun gdk-drag-begin (g-object gdk-drag-context :already-referenced)
+  (window (g-object gdk-window))
+  (targets (glib:glist gdk-atom-as-string)))
+
+(export 'gdk-drag-begin)
+
+(defcfun gdk-drag-motion :boolean
+  (context (g-object drag-context))
+  (dest-window (g-object gdk-window))
+  (protocol gdk-drag-protocol)
+  (x-root :int)
+  (y-root :int)
+  (suggested-action gdk-drag-action)
+  (possible-actions gdk-drag-action)
+  (time :uint32))
+
+(export 'gdk-drag-motion)
+
+(defcfun gdk-drop-finish :void
+  (context (g-object drag-context))
+  (success :boolean)
+  (time :uint32))
+
+(export 'gdk-drop-finish)
+
+(defcfun gdk_drag_get_protocol native-window
+  (xid native-window)
+  (protocol (:pointer gdk-drag-protocol)))
+
+(defun gdk-drag-get-protocol (xid)
+  (with-foreign-object (protocol 'gdk-drag-protocol)
+    (let ((dest-window (gdk_drag_get_protocol xid protocol)))
+      (values dest-window (mem-ref protocol 'gdk-drag-protocol)))))
+
+(export 'gdk-drag-get-protocol)
+
+(defcfun gdk_drag_get_protocol_for_display native-window
+  (display (g-object display))
+  (xid native-window)
+  (protocol (:pointer gdk-drag-protocol)))
+
+(defun gdk-drag-get-protocol-for-dispaly (display xid)
+  (with-foreign-object (protocol 'gdk-drag-protocol)
+    (let ((dest-window (gdk_drag_get_protocol_for_display display xid protocol)))
+      (values dest-window (mem-ref protocol 'gdk-drag-protocol)))))
+
+(export 'gdk-drag-get-protocol-for-display)
+
+(defcfun gdk-drag-status :void
+  (context (g-object drag-context))
+  (action gdk-drag-action)
+  (time :uint32))
+
+(export 'gdk-drag-status)
+
+(defcfun gdk-drag-drop-succeeded :boolean
+  (context (g-object drag-context)))
+
+(export 'gdk-drag-drop-succeeded)

diff --git a/gdk/gdk.objects.lisp b/gdk/gdk.objects.lisp
index 0f076dd..19cf6e3 100644 (file)
--- a/gdk/gdk.objects.lisp
+++ b/gdk/gdk.objects.lisp
@@ -450,6 +450,27 @@
   (:wheel 6)
   (:last 7))
 
+(define-g-enum "GdkDragProtocol"
+    gdk-drag-protocol
+    (:export t :type-initializer "gdk_drag_protocol_get_type")
+  (:motif 0)
+  (:xdnd 1)
+  (:rootwin 2)
+  (:none 3)
+  (:win32-dropfiles 4)
+  (:ole2 5)
+  (:local 6))
+
+(define-g-flags "GdkDragAction"
+    gdk-drag-action
+    (:export t :type-initializer "gdk_drag_action_get_type")
+  (:default 1)
+  (:copy 2)
+  (:move 4)
+  (:link 8)
+  (:private 16)
+  (:ask 32))
+
 (export 'cursor-type)
 
 (define-g-boxed-cstruct geometry nil
@@ -675,7 +696,7 @@
               :drag-status
               :drop-start
               :drop-finished) event-dnd
-             (drag-context :pointer)
+             (drag-context (g-object drag-context))
              (time :uint32)
              (x-root :short)
              (y-root :short))
@@ -713,7 +734,25 @@
 
 (export (boxed-related-symbols 'event))
 
-(define-g-object-class "GdkDragContext" drag-context () ())
+(define-g-object-class "GdkDragContext" drag-context ()
+  ((:cffi protocol drag-context-protocol gdk-drag-protocol
+          %gdk-drag-context-get-protocol nil)
+   (:cffi is-source drag-context-is-source :boolean
+          %gdk-drag-context-get-is-source nil)
+   (:cffi source-window drag-context-source-window (g-object gdk-window)
+          %gdk-drag-context-get-source-window nil)
+   (:cffi dest-window drag-context-dest-window (g-object gdk-window)
+          %gdk-drag-context-get-dest-window nil)
+   (:cffi targets drag-context-targets (glib:glist gdk-atom-as-string :free-from-foreign nil)
+          %gdk-drag-context-get-targets nil)
+   (:cffi actions drag-context-actions gdk-drag-action
+          %gdk-drag-context-get-actions nil)
+   (:cffi suggested-action drag-context-suggested-action gdk-drag-action
+          %gdk-drag-context-get-suggested-action nil)
+   (:cffi action drag-context-action gdk-drag-action
+          %gdk-drag-context-get-action nil)
+   (:cffi start-time drag-context-start-time :uint32
+          %gdk-drag-context-get-start-time nil)))
 
 (define-g-object-class "GdkPixbuf" pixbuf ()
     ((colorspace pixbuf-colorspace "colorspace" "GdkColorspace" t nil)