X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=gtk%2Fgtk.selections.lisp;fp=gtk%2Fgtk.selections.lisp;h=0d8ac75a2138ddff68a835b398831fb7dcfc0133;hb=a96dde2b8a0d1c9fed57faf6a828eeef4d2b8218;hp=d97d01427f06cf679eaad7f73cc98fc783fd251f;hpb=3aac876ec530d646852acfd28ed60de0b50a3371;p=cl-gtk2.git

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))