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

diff --git a/gtk/gtk.selections.lisp b/gtk/gtk.selections.lisp
index 0d8ac75..d5c0ab4 100644
--- a/gtk/gtk.selections.lisp
+++ b/gtk/gtk.selections.lisp
@@ -116,24 +116,24 @@
   (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)
+  (let ((ctype (case fmt (8 :int8) (16 :int16) (32 :long)))
+        (clen (/ len (if (= fmt 32) (foreign-type-size :long) fmt))))
+    (if (= clen 1)
         (mem-ref ptr ctype)
-        (let ((array (make-array len :element-type 'fixnum)))
-          (loop for i from 0 below len
+        (let ((array (make-array clen :element-type 'fixnum)))
+          (loop for i from 0 below clen
              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))))
+   (cond
+     ((= len -1) nil)
+     ((= fmt 8) (foreign-string-to-lisp ptr :count len))
+     (t (foreign-to-int-or-array ptr fmt len)))
    (gtk-selection-data-get-data-type selection-data)
    fmt)))