Fixup for selection-data where format=32. X specification is odd.
[cl-gtk2.git] / gtk / gtk.selections.lisp
1 (in-package :gtk)
2
3 (define-g-boxed-cstruct target-entry "GtkTargetEntry"
4   (target :string :initform 0)
5   (flags target-flags :initform 0)
6   (info :uint :initform 0))
7
8 (export (boxed-related-symbols 'target-entry))
9
10 ;;
11
12 (defcfun (selection-owner-set "gtk_selection_owner_set") :boolean
13   (widget (g-object widget))
14   (selection gdk-atom-as-string)
15   (time :uint32))
16
17 (defcfun (selection-owner-set-for-display "gtk_selection_owner_set_for_display")
18     :boolean
19   (display (g-object display))
20   (widget (g-object widget))
21   (selection gdk-atom-as-string)
22   (time :uint32))
23
24 (defcfun (selection-add-target "gtk_selection_add_target") :void
25   (widget (g-object display))
26   (selection gdk-atom-as-string)
27   (target gdk-atom-as-string)
28   (info :uint))
29
30 (defcfun (selection-clear-targets "gtk_selection_clear_targets") :void
31   (widget (g-object display))
32   (selection gdk-atom-as-string))
33
34 (defcfun (selection-convert "gtk_selection_convert") :boolean
35   (widget (g-object display))
36   (selection gdk-atom-as-string)
37   (target gdk-atom-as-string)
38   (time :uint32))
39
40 ;;
41
42 (define-g-boxed-opaque selection-data "GtkSelectionData"
43   :alloc (error "Not allocated"))
44
45 (export (boxed-related-symbols 'selection-data))
46
47 (defcfun (gtk-selection-data-set "gtk_selection_data_set") :void
48   (selection-data (g-boxed-foreign selection-data))
49   (type gdk-atom-as-string)
50   (format :int)
51   (data :pointer)
52   (length :int))
53
54 (defcfun (gtk-selection-data-get-data "gtk_selection_data_get_data") :pointer
55   (selection-data (g-boxed-foreign selection-data)))
56
57 (defcfun (gtk-selection-data-get-data-type "gtk_selection_data_get_data_type")
58     gdk-atom-as-string
59   (selection-data (g-boxed-foreign selection-data)))
60
61 (defcfun (gtk-selection-data-get-format "gtk_selection_data_get_format")
62     :int
63   (selection-data (g-boxed-foreign selection-data)))
64
65 (defcfun (gtk-selection-data-get-length "gtk_selection_data_get_length") :int
66   (selection-data (g-boxed-foreign selection-data)))
67
68 (defcfun (gtk-selection-data-set-pixbuf "gtk_selection_data_set_pixbuf") :boolean
69   (selection-data (g-boxed-foreign selection-data))
70   (pixbuf (g-object pixbuf)))
71
72 (defcfun (selection-data-get-pixbuf "gtk_selection_data_get_pixbuf") (g-object pixbuf)
73   (selection-data (g-boxed-foreign selection-data)))
74
75 (defcfun (selection-data-targets-include-image "gtk_selection_data_targets_include_image")
76     :boolean
77   (selection-data (g-boxed-foreign selection-data))
78   (writable :boolean))
79
80 (defcfun (selection-data-targets-include-text "gtk_selection_data_targets_include_text")
81     :boolean
82   (selection-data (g-boxed-foreign selection-data)))
83
84 (defcfun (selection-data-targets-include-uri "gtk_selection_data_targets_include_uri")
85     :boolean
86   (selection-data (g-boxed-foreign selection-data)))
87
88 (defcfun (selection-data-targets-include-rich-text "gtk_selection_data_targets_include_rich_text")
89     :boolean
90   (selection-data (g-boxed-foreign selection-data))
91   (buffer (g-object text-buffer)))
92
93 (defcfun (selection-data-get-selection "gtk_selection_data_get_selection")
94     gdk-atom-as-string
95   (selection-data (g-boxed-foreign selection-data)))
96
97 (defcfun (selection-data-get-display "gtk_selection_data_get_display")
98     (g-object display)
99   (selection-data (g-boxed-foreign selection-data)))
100
101 (defcfun (selection-data-get-target "gtk_selection_data_get_target")
102     gdk-atom-as-string
103   (selection-data (g-boxed-foreign selection-data)))
104
105 ; Easy future extension
106 (defgeneric selection-set (selection-data data &key type &allow-other-keys))
107
108 (defmethod selection-set ((selection-data selection-data) (data string)
109                           &key (type "text/plain"))
110   (with-foreign-string ((ptr len) data)
111     (gtk-selection-data-set selection-data type 8 ptr (1- len))))
112
113 (defmethod selection-set ((selection-data selection-data) (data pixbuf)
114                           &key (type "image/png"))
115   (gtk-selection-data-set selection-data type 8 (null-pointer) 0)
116   (gtk-selection-data-set-pixbuf selection-data data))
117
118 (defun foreign-to-int-or-array (ptr fmt len)
119   (let ((ctype (case fmt (8 :int8) (16 :int16) (32 :long)))
120         (clen (/ len (if (= fmt 32) (foreign-type-size :long) fmt))))
121     (if (= clen 1)
122         (mem-ref ptr ctype)
123         (let ((array (make-array clen :element-type 'fixnum)))
124           (loop for i from 0 below clen
125              do (setf (aref array i) (mem-aref ptr ctype)))
126           array))))
127
128 (defun selection-get (selection-data)
129   (let ((fmt (gtk-selection-data-get-format selection-data))
130         (len (gtk-selection-data-get-length selection-data))
131         (ptr (gtk-selection-data-get-data selection-data)))
132   (values
133    (cond
134      ((= len -1) nil)
135      ((= fmt 8) (foreign-string-to-lisp ptr :count len))
136      (t (foreign-to-int-or-array ptr fmt len)))
137    (gtk-selection-data-get-data-type selection-data)
138    fmt)))
139
140 (export '(selection-set selection-get))