From: Ryan Pavlik <rpavlik@gmail.com>
Date: Mon, 29 Aug 2011 14:22:10 +0000 (-0500)
Subject: Patch for the majority of the gtk drag'n'drop API. This changes
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=a96dde2b8a0d1c9fed57faf6a828eeef4d2b8218;p=cl-gtk2.git

Patch for the majority of the gtk drag'n'drop API. This changes
selection-data to g-boxed-opaque and _removes_ boxed-copy-fn from
parsed GValues.  Also establish selection-get and selection-set for
easy selection data access.
---

diff --git a/glib/gobject.boxed.lisp b/glib/gobject.boxed.lisp
index 12f4cda..3a69cee 100644
--- a/glib/gobject.boxed.lisp
+++ b/glib/gobject.boxed.lisp
@@ -589,7 +589,7 @@
   (g-value-take-boxed gvalue-ptr (translate-to-foreign proxy (make-foreign-type info :return-p nil))))
 
 (defmethod boxed-parse-g-value (gvalue-ptr (info g-boxed-opaque-wrapper-info))
-  (translate-from-foreign (boxed-copy-fn info (g-value-get-boxed gvalue-ptr)) (make-foreign-type info :return-p nil)))
+  (translate-from-foreign (g-value-get-boxed gvalue-ptr) (make-foreign-type info :return-p t)))
 
 (defmethod boxed-set-g-value (gvalue-ptr (info g-boxed-opaque-wrapper-info) proxy)
   (g-value-set-boxed gvalue-ptr (translate-to-foreign proxy (make-foreign-type info :return-p nil))))
diff --git a/gtk/gtk.dnd.lisp b/gtk/gtk.dnd.lisp
index 0470321..c52cb3e 100644
--- a/gtk/gtk.dnd.lisp
+++ b/gtk/gtk.dnd.lisp
@@ -1,5 +1,73 @@
 (in-package :gtk)
 
+;;
+(define-g-boxed-opaque target-list "GtkTargetList"
+  :alloc (error "Use make-target-list to allocate GtkTargetList"))
+
+(defcfun (gtk-target-list-new "gtk_target_list_new")
+    (g-boxed-foreign target-list :free-from-foreign nil)
+  (targets :pointer)
+  (n-targets :int))
+
+(defun make-target-list (targets)
+  (with-foreign-boxed-array (n-targets targets-ptr target-entry targets)
+    (gtk-target-list-new targets-ptr n-targets)))
+
+(defcfun (gtk-target-list-ref "gtk_target_list_ref")
+    (g-boxed-foreign target-list :free-from-foreign nil)
+  (target-list (g-boxed-foreign target-list)))
+
+(defcfun (gtk-target-list-unref "gtk_target_list_unref") :void
+  (target-list (g-boxed-foreign target-list)))
+
+(export (boxed-related-symbols 'target-list))
+
+;;
+
+(defcfun (gtk-drag-dest-set "gtk_drag_dest_set") :void
+  (widget (g-object widget))
+  (flags dest-defaults)
+  (targets :pointer)
+  (n-targets :int)
+  (actions gdk-drag-action))
+
+(defun drag-dest-set (widget flags targets actions)
+  (with-foreign-boxed-array (n-targets targets-ptr target-entry targets)
+    (gtk-drag-dest-set widget flags targets-ptr n-targets actions)))
+
+(export 'drag-dest-set)
+
+(defcfun (drag-dest-unset "gtk_drag_dest_unset") :void
+  (widget (g-object widget)))
+
+(export 'drag-dest-unset)
+
+(defcfun (drag-dest-add-text-targets "gtk_drag_dest_add_text_targets") :void
+  (widget (g-object widget)))
+
+(export 'drag-dest-add-text-targets)
+
+(defcfun (drag-dest-add-image-targets "gtk_drag_dest_add_image_targets") :void
+  (widget (g-object widget)))
+
+(export 'drag-dest-add-image-targets)
+
+(defcfun (drag-dest-add-uri-targets "gtk_drag_dest_add_uri_targets") :void
+  (widget (g-object widget)))
+
+(export 'drag-dest-add-uri-targets)
+
+(defcfun (drag-dest-set-track-motion "gtk_drag_dest_set_track_motion") :void
+  (widget (g-object widget))
+  (track-motion :boolean))
+
+(export 'drag-dest-set-track-motion)
+
+(defcfun (drag-dest-get-track-motion "gtk_drag_dest_get_track_motion") :boolean
+  (widget (g-object widget)))
+
+(export 'drag-dest-get-track-motion)
+
 (defcfun (drag-finish "gtk_drag_finish") :void
   (context (g-object drag-context))
   (success :boolean)
@@ -8,3 +76,145 @@
 
 (export 'drag-finish)
 
+(defcfun (drag-get-data "gtk_drag_get_data") :void
+  (widget (g-object widget))
+  (context (g-object drag-context))
+  (target gdk-atom-as-string)
+  (time :uint32))
+
+(export 'drag-get-data)
+
+(defcfun (drag-get-source-widget "gtk_drag_get_source_widget")
+    (g-object widget)
+  (context (g-object drag-context)))
+
+(export 'drag-get-source-widget)
+
+(defcfun (drag-highlight "gtk_drag_highlight") :void
+  (widget (g-object widget)))
+
+(export 'drag-highlight)
+
+(defcfun (drag-unhighlight "gtk_drag_unhighlight") :void
+  (widget (g-object widget)))
+
+(export 'drag-unhighlight)
+
+(defcfun (gtk-drag-begin "gtk_drag_begin") (g-object drag-context :free-from-foreign nil)
+  (widget (g-object widget))
+  (targets (g-boxed-foreign target-list))
+  (actions gdk-drag-action)
+  (button :int)
+  (event (g-object gdk:event)))
+
+(defun drag-begin (widget targets actions button event)
+  (let* ((target-list (make-target-list targets))
+         (context (gtk-drag-begin widget target-list actions button event)))
+    (gtk-target-list-unref target-list)
+    context))
+
+(export 'drag-begin)
+
+(defcfun (drag-set-icon-widget "gtk_drag_set_icon_widget") :void
+  (context (g-object drag-context))
+  (widget (g-object widget))
+  (hot-x :int)
+  (hot-y :int))
+
+(export 'drag-set-icon-widget)
+
+(defcfun (drag-set-icon-pixbuf "gtk_drag_set_icon_pixbuf") :void
+  (context (g-object drag-context))
+  (pixbuf (g-object pixbuf))
+  (hot-x :int)
+  (hot-y :int))
+
+(export 'drag-set-icon-pixbuf)
+
+(defcfun (drag-set-icon-stock "gtk_drag_set_icon_stock") :void
+  (context (g-object drag-context))
+  (stock-id :string)
+  (hot-x :int)
+  (hot-y :int))
+
+(export 'drag-set-icon-stock)
+
+(defcfun (drag-set-icon-name "gtk_drag_set_icon_name") :void
+  (context (g-object drag-context))
+  (icon-name :string)
+  (hot-x :int)
+  (hot-y :int))
+
+(export 'drag-set-icon-name)
+
+(defcfun (drag-set-icon-default "gtk_drag_set_icon_default") :void
+  (context (g-object drag-context)))
+
+(export 'drag-set-icon-default)
+
+(defcfun (drag-check-threshold "gtk_drag_check_threshold") :boolean
+  (widget (g-object widget))
+  (start-x :int)
+  (start-y :int)
+  (current-x :int)
+  (current-y :int))
+
+(export 'drag-check-threshold)
+
+(defcfun (gtk-drag-source-set "gtk_drag_source_set") :void
+  (widget (g-object widget))
+  (start-button-mask modifier-type)
+  (targets :pointer)
+  (n-targets :int)
+  (actions gdk-drag-action))
+
+(defun drag-source-set (widget button-mask targets actions)
+  (with-foreign-boxed-array (n-targets targets-ptr target-entry targets)
+    (gtk-drag-source-set widget button-mask targets-ptr n-targets actions)))
+
+(export 'drag-source-set)
+
+(defcfun (drag-source-set-icon-pixbuf "gtk_drag_source_set_icon_pixbuf") :void
+  (widget (g-object widget))
+  (pixbuf (g-object pixbuf)))
+
+(export 'drag-source-set-icon-pixbuf)
+
+(defcfun (drag-source-set-icon-stock "gtk_drag_source_set_icon_stock") :void
+  (widget (g-object widget))
+  (stock-id :string))
+
+(export 'drag-source-set-icon-stock)
+
+(defcfun (drag-source-set-icon-name "gtk_drag_source_set_icon_name") :void
+  (widget (g-object widget))
+  (icon-name :string))
+
+(export 'drag-source-set-icon-name)
+
+(defcfun (gtk-drag-source-unset "gtk_drag_source_unset") :void
+  (widget (g-object widget))
+  (target-list :pointer))
+
+(defun drag-source-unset (widget targets)
+  (let ((target-list (make-target-list targets)))
+    (gtk-drag-source-unset widget target-list)
+    (gtk-target-list-unref target-list)
+    nil))
+
+(export 'drag-source-unset)
+
+(defcfun (drag-source-add-text-targets "gtk_drag_source_add_text_targets") :void
+  (widget (g-object widget)))
+
+(export 'drag-source-add-text-targets)
+
+(defcfun (drag-source-add-image-targets "gtk_drag_source_add_image_targets") :void
+  (widget (g-object widget)))
+
+(export 'drag-source-add-image-targets)
+
+(defcfun (drag-source-add-uri-targets "gtk_drag_source_add_uri_targets") :void
+  (widget (g-object widget)))
+
+(export 'drag-source-add-uri-targets)
diff --git a/gtk/gtk.selections.lisp b/gtk/gtk.selections.lisp
index d97d014..0d8ac75 100644
--- a/gtk/gtk.selections.lisp
+++ b/gtk/gtk.selections.lisp
@@ -7,3 +7,134 @@
 
 (export (boxed-related-symbols 'target-entry))
 
+;;
+
+(defcfun (selection-owner-set "gtk_selection_owner_set") :boolean
+  (widget (g-object widget))
+  (selection gdk-atom-as-string)
+  (time :uint32))
+
+(defcfun (selection-owner-set-for-display "gtk_selection_owner_set_for_display")
+    :boolean
+  (display (g-object display))
+  (widget (g-object widget))
+  (selection gdk-atom-as-string)
+  (time :uint32))
+
+(defcfun (selection-add-target "gtk_selection_add_target") :void
+  (widget (g-object display))
+  (selection gdk-atom-as-string)
+  (target gdk-atom-as-string)
+  (info :uint))
+
+(defcfun (selection-clear-targets "gtk_selection_clear_targets") :void
+  (widget (g-object display))
+  (selection gdk-atom-as-string))
+
+(defcfun (selection-convert "gtk_selection_convert") :boolean
+  (widget (g-object display))
+  (selection gdk-atom-as-string)
+  (target gdk-atom-as-string)
+  (time :uint32))
+
+;;
+
+(define-g-boxed-opaque selection-data "GtkSelectionData"
+  :alloc (error "Not allocated"))
+
+(export (boxed-related-symbols 'selection-data))
+
+(defcfun (gtk-selection-data-set "gtk_selection_data_set") :void
+  (selection-data (g-boxed-foreign selection-data))
+  (type gdk-atom-as-string)
+  (format :int)
+  (data :pointer)
+  (length :int))
+
+(defcfun (gtk-selection-data-get-data "gtk_selection_data_get_data") :pointer
+  (selection-data (g-boxed-foreign selection-data)))
+
+(defcfun (gtk-selection-data-get-data-type "gtk_selection_data_get_data_type")
+    gdk-atom-as-string
+  (selection-data (g-boxed-foreign selection-data)))
+
+(defcfun (gtk-selection-data-get-format "gtk_selection_data_get_format")
+    :int
+  (selection-data (g-boxed-foreign selection-data)))
+
+(defcfun (gtk-selection-data-get-length "gtk_selection_data_get_length") :int
+  (selection-data (g-boxed-foreign selection-data)))
+
+(defcfun (gtk-selection-data-set-pixbuf "gtk_selection_data_set_pixbuf") :boolean
+  (selection-data (g-boxed-foreign selection-data))
+  (pixbuf (g-object pixbuf)))
+
+(defcfun (selection-data-get-pixbuf "gtk_selection_data_get_pixbuf") (g-object pixbuf)
+  (selection-data (g-boxed-foreign selection-data)))
+
+(defcfun (selection-data-targets-include-image "gtk_selection_data_targets_include_image")
+    :boolean
+  (selection-data (g-boxed-foreign selection-data))
+  (writable :boolean))
+
+(defcfun (selection-data-targets-include-text "gtk_selection_data_targets_include_text")
+    :boolean
+  (selection-data (g-boxed-foreign selection-data)))
+
+(defcfun (selection-data-targets-include-uri "gtk_selection_data_targets_include_uri")
+    :boolean
+  (selection-data (g-boxed-foreign selection-data)))
+
+(defcfun (selection-data-targets-include-rich-text "gtk_selection_data_targets_include_rich_text")
+    :boolean
+  (selection-data (g-boxed-foreign selection-data))
+  (buffer (g-object text-buffer)))
+
+(defcfun (selection-data-get-selection "gtk_selection_data_get_selection")
+    gdk-atom-as-string
+  (selection-data (g-boxed-foreign selection-data)))
+
+(defcfun (selection-data-get-display "gtk_selection_data_get_display")
+    (g-object display)
+  (selection-data (g-boxed-foreign selection-data)))
+
+(defcfun (selection-data-get-target "gtk_selection_data_get_target")
+    gdk-atom-as-string
+  (selection-data (g-boxed-foreign selection-data)))
+
+; Easy future extension
+(defgeneric selection-set (selection-data data &key type &allow-other-keys))
+
+(defmethod selection-set ((selection-data selection-data) (data string)
+                          &key (type "text/plain"))
+  (with-foreign-string ((ptr len) data)
+    (gtk-selection-data-set selection-data type 8 ptr (1- len))))
+
+(defmethod selection-set ((selection-data selection-data) (data pixbuf)
+                          &key (type "image/png"))
+  (gtk-selection-data-set selection-data type 8 (null-pointer) 0)
+  (gtk-selection-data-set-pixbuf selection-data data))
+
+(defun foreign-to-int-or-array (ptr fmt len)
+  (let ((ctype (case fmt (8 :int8) (16 :int16) (32 :int32))))
+    (if (= len 1)
+        (mem-ref ptr ctype)
+        (let ((array (make-array len :element-type 'fixnum)))
+          (loop for i from 0 below len
+             do (setf (aref array i) (mem-aref ptr ctype)))
+          array))))
+
+;; As of writing, gtk is not 64-bit clean.  This may not work as intended
+;; for fmt>8.
+(defun selection-get (selection-data)
+  (let ((fmt (gtk-selection-data-get-format selection-data))
+        (len (gtk-selection-data-get-length selection-data))
+        (ptr (gtk-selection-data-get-data selection-data)))
+  (values
+   (if (= fmt 8)
+       (foreign-string-to-lisp ptr :count len)
+       (foreign-to-int-or-array ptr fmt (/ len (/ fmt 8))))
+   (gtk-selection-data-get-data-type selection-data)
+   fmt)))
+
+(export '(selection-set selection-get))
diff --git a/gtk/gtk.widget.lisp b/gtk/gtk.widget.lisp
index 67c0404..0611852 100644
--- a/gtk/gtk.widget.lisp
+++ b/gtk/gtk.widget.lisp
@@ -2,17 +2,6 @@
 
 ; TODO: GtkWidget
 
-(define-g-boxed-cstruct selection-data "GtkSelectionData"
-  (selection gdk-atom-as-string :initform nil)
-  (target gdk-atom-as-string :initform nil)
-  (type gdk-atom-as-string :initform nil)
-  (format :int :initform 0)
-  (data :pointer :initform (null-pointer))
-  (length :int :initform 0)
-  (display (g-object display) :initform nil))
-
-(export (boxed-related-symbols 'selection-data))
-
 (defun widget-flags (widget)
   (convert-from-foreign (gtk-object-flags-as-integer widget) 'widget-flags))