From 034e84622a14c46e317fb54a97b05518d77b782b Mon Sep 17 00:00:00 2001 From: Dmitry Kalyanov Date: Sat, 14 Nov 2009 05:00:02 +0300 Subject: [PATCH] Add Gdk/Drag-and-drop --- gdk/cl-gtk2-gdk.asd | 3 +- gdk/gdk.drag-and-drop.lisp | 157 ++++++++++++++++++++++++++++++++++++++++++++ gdk/gdk.objects.lisp | 43 +++++++++++- 3 files changed, 200 insertions(+), 3 deletions(-) create mode 100644 gdk/gdk.drag-and-drop.lisp diff --git a/gdk/cl-gtk2-gdk.asd b/gdk/cl-gtk2-gdk.asd index 2996f52..35692b5 100644 --- 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 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 --- 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) -- 1.7.10.4