chiark / gitweb /
New function CLIPBOARD-SET, marked CLIPBOARD-SET-DATA as deprecated
[clg] / gtk / gtkselection.lisp
CommitLineData
8b70d560 1;; Common Lisp bindings for GTK+ v2.x
8ab0db90 2;; Copyright 2005-2006 Espen S. Johnsen <espen@users.sf.net>
8b70d560 3;;
4;; Permission is hereby granted, free of charge, to any person obtaining
5;; a copy of this software and associated documentation files (the
6;; "Software"), to deal in the Software without restriction, including
7;; without limitation the rights to use, copy, modify, merge, publish,
8;; distribute, sublicense, and/or sell copies of the Software, and to
9;; permit persons to whom the Software is furnished to do so, subject to
10;; the following conditions:
11;;
12;; The above copyright notice and this permission notice shall be
13;; included in all copies or substantial portions of the Software.
14;;
15;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
16;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
17;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
18;; IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
19;; CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
20;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
21;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
22
646c5a74 23;; $Id: gtkselection.lisp,v 1.11 2007-12-12 15:47:29 espen Exp $
8b70d560 24
25
26(in-package "GTK")
27
28
29;;;; Selection
30
8b70d560 31(defbinding %target-list-ref () pointer
32 (location pointer))
33
34(defbinding %target-list-unref () nil
35 (location pointer))
36
8b70d560 37(defbinding %target-list-new () pointer
38 (targets (vector (inlined target-entry)))
39 ((length targets) int))
40
9176d301 41(defmethod allocate-foreign ((target-list target-list) &key targets)
42 (%target-list-new targets))
8b70d560 43
10844024 44(defbinding target-list-add (target-list target &optional flags info) nil
8b70d560 45 (target-list target-list)
a1bba49e 46 ((gdk:atom-intern target) gdk:atom)
47 (flags target-flags)
8b70d560 48 (info unsigned-int))
49
50(defbinding target-list-add-table (target-list targets) nil
51 (target-list target-list)
52 ((etypecase targets
53 ((or vector list) targets)
54 (target-entry (vector targets)))
55 (vector (inlined target-entry)))
56 ((etypecase targets
57 ((or vector list) (length targets))
58 (target-entry 1))
59 int))
60
8ab0db90 61#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
8b70d560 62(progn
63 (defbinding target-list-add-text-targets (target-list info &optional writable-p) nil
64 (target-list target-list)
65 (info unsigned-int)
66 (writable-p boolean))
67
68 (defbinding target-list-add-image-targets (target-list info &optional writable-p) nil
69 (target-list target-list)
70 (info unsigned-int)
71 (writable-p boolean))
72
73 (defbinding target-list-add-uri-targets (target-list info &optional writable-p) nil
74 (target-list target-list)
75 (info unsigned-int)
76 (writable-p boolean)))
77
a1bba49e 78(defbinding target-list-remove (target-list target) nil
79 (target-list target-list)
80 ((gdk:atom-intern target) gdk:atom))
81
82(defbinding target-list-find (target-list target) boolean
83 (target-list target-list)
84 ((gdk:atom-intern target) gdk:atom)
85 (info unsigned-int :out))
86
87(defbinding target-table-new-from-list () (vector (inlined target-entry) n-targets)
8b70d560 88 (target-list target-list)
a1bba49e 89 (n-targets int :out))
8b70d560 90
a1bba49e 91(defun ensure-target-table (targets)
92 (etypecase targets
93 (target-list (target-table-new-from-list targets))
94 ((or vector list) targets)))
8b70d560 95
96(defbinding (selection-set-owner "gtk_selection_owner_set_for_display")
97 (widget selection time &optional (display (gdk:display-get-default)))
98 boolean
99 (display gdk:display)
100 (widget widget)
11e5e1f8 101 ((gdk:atom-intern selection) gdk:atom)
102 (time (unsigned 32)))
8b70d560 103
a1bba49e 104(defbinding selection-add-target (widget selection target info) nil
8b70d560 105 (widget widget)
a1bba49e 106 ((gdk:atom-intern selection) gdk:atom)
107 ((gdk:atom-intern target) gdk:atom)
8b70d560 108 (info unsigned-int))
109
110(defbinding selection-add-targets (widget selection targets) nil
111 (widget widget)
a1bba49e 112 ((gdk:atom-intern selection) gdk:atom)
8b70d560 113 ((etypecase targets
114 ((or vector list) targets)
115 (target-entry (vector targets)))
116 (vector (inlined target-entry)))
117 ((etypecase targets
118 ((or vector list) (length targets))
119 (target-entry 1))
120 int))
121
a1bba49e 122(defbinding selection-clear-targets (widget selection) nil
8b70d560 123 (widget widget)
a1bba49e 124 ((gdk:atom-intern selection) gdk:atom))
8b70d560 125
a1bba49e 126(defbinding selection-convert (widget selection target time) boolean
8b70d560 127 (widget widget)
a1bba49e 128 ((gdk:atom-intern selection) gdk:atom)
129 ((gdk:atom-intern target) gdk:atom)
8b70d560 130 (time unsigned-int))
131
a1bba49e 132(defbinding selection-data-set (selection-data type format data length) boolean
8b70d560 133 (selection-data selection-data)
a1bba49e 134 ((gdk:atom-intern type) gdk:atom)
8b70d560 135 (format int)
136 (data pointer)
137 (length int))
138
139(defbinding selection-data-set-text () boolean
140 (selection-data selection-data)
141 (text string)
142 (-1 integer))
143
144(defbinding selection-data-get-text () string
145 (selection-data selection-data))
146
8ab0db90 147#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
8b70d560 148(progn
149 (defbinding selection-data-set-pixbuf () boolean
150 (selection-data selection-data)
151 (puxbuf gdk:pixbuf))
152
153 (defbinding selection-data-get-pixbuf () gdk:pixbuf
154 (selection-data selection-data))
155
156 (defbinding selection-data-set-uris () boolean
157 (selection-data selection-data)
158 (uris (null-terminated-vector string)))
159
160 (defbinding selection-data-get-uris () (null-terminated-vector string)
161 (selection-data selection-data)))
162
a1bba49e 163(defbinding %selection-data-get-targets () boolean
8b70d560 164 (selection-data selection-data)
a1bba49e 165 (targets (vector gdk:atom n-targets) :out)
166 (n-targets int :out))
167
168(defun selection-data-get-targets (selection-data)
169 (multiple-value-bind (valid-p targets)
170 (%selection-data-get-targets selection-data)
171 (when valid-p
172 (map-into targets #'gdk:atom-name targets))))
8b70d560 173
8ab0db90 174#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
8b70d560 175(defbinding selection-data-targets-include-image-p (selection-data &optional writable-p) boolean
176 (selection-data selection-data)
177 (writable-p boolean))
178
a1bba49e 179(defbinding selection-data-targets-include-text-p () boolean
8b70d560 180 (selection-data selection-data))
181
10844024 182(defbinding selection-remove-all () boolean
8b70d560 183 (widget widget))
184
185
186;;; Clipboard -- untestet
187
188(defbinding (clipboard-get "gtk_clipboard_get_for_display")
189 (selection &optional (display (gdk:display-get-default))) clipboard
190 (display gdk:display)
191 ((gdk:atom-intern selection) gdk:atom))
192
56ccd5b7 193(define-callback %clipboard-get-callback nil
194 ((clipboard pointer) (selection-data selection-data)
a1bba49e 195 (info unsigned-int) (callback-ids unsigned-int))
9b662d94 196 (declare (ignore clipboard))
56ccd5b7 197 (funcall (car (find-user-data callback-ids)) selection-data info))
8b70d560 198
56ccd5b7 199(define-callback %clipboard-clear-callback nil
200 ((clipboard pointer) (callback-ids unsigned-int))
9b662d94 201 (declare (ignore clipboard))
56ccd5b7 202 (funcall (cdr (find-user-data callback-ids))))
8b70d560 203
646c5a74 204;; Deprecated, use clipboard-set
205(defbinding clipboard-set-with-data (clipboard targets get-func clear-func) boolean
8b70d560 206 (clipboard clipboard)
35721da7 207 (targets (vector (inlined target-entry)))
8b70d560 208 ((length targets) unsigned-int)
56ccd5b7 209 (%clipboard-get-callback callback)
210 (%clipboard-clear-callback callback)
8b70d560 211 ((register-user-data (cons get-func clear-func)) unsigned-int))
212
646c5a74 213(defun clipboard-set (clipboard targets get-func &optional clear-func)
a1bba49e 214 (%clipboard-set-with-data clipboard (ensure-target-table targets)
215 get-func (or clear-func #'(lambda ()))))
216
8b70d560 217(defbinding clipboard-clear () nil
218 (clipboard clipboard))
219
a1bba49e 220(defbinding clipboard-set-text () nil
8b70d560 221 (clipboard clipboard)
222 (text string)
223 ((length text) int))
224
8ab0db90 225#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
8b70d560 226(defbinding clipboard-set-image () nil
227 (clipboard clipboard)
228 (pixbuf gdk:pixbuf))
229
230(defun clipboard-set (clipboard object)
231 (etypecase object
232 (string (clipboard-set-text clipboard object))
8ab0db90 233 #?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
8b70d560 234 (gdk:pixbuf (clipboard-set-image clipboard object))))
235
56ccd5b7 236(define-callback-marshal %clipboard-receive-callback nil
237 ((:ignore clipboard) selection-data))
8b70d560 238
239(defbinding clipboard-request-contents (clipboard target callback) nil
240 (clipboard clipboard)
241 ((gdk:atom-intern target) gdk:atom)
56ccd5b7 242 (%clipboard-receive-callback callback)
8b70d560 243 ((register-callback-function callback) unsigned-int))
244
56ccd5b7 245(define-callback-marshal %clipboard-text-receive-callback nil
246 ((:ignore clipboard) (text string)))
247
8b70d560 248
249(defbinding clipboard-request-text (clipboard callback) nil
250 (clipboard clipboard)
56ccd5b7 251 (%clipboard-text-receive-callback callback)
8b70d560 252 ((register-callback-function callback) unsigned-int))
253
8ab0db90 254#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
8b70d560 255(progn
56ccd5b7 256 (define-callback-marshal %clipboard-image-receive-callback nil
257 ((:ignore clipboard) (image gdk:pixbuf)))
8b70d560 258
259 (defbinding clipboard-request-image (clipboard callback) nil
260 (clipboard clipboard)
56ccd5b7 261 (%clipboard-image-receive-callback callback)
8b70d560 262 ((register-callback-function callback) unsigned-int)))
263
264
56ccd5b7 265(define-callback %clipboard-targets-receive-callback nil
266 ((clipboard pointer) (atoms (vector gdk:atom n-atoms))
267 (n-atoms unsigned-int) (callback-id unsigned-int))
8ab0db90 268 (declare (ignore clipboard))
a1bba49e 269 (funcall (find-user-data callback-id) (map-into atoms #'gdk:atom-name atoms)))
8b70d560 270
271(defbinding clipboard-request-targets (clipboard callback) nil
272 (clipboard clipboard)
56ccd5b7 273 (%clipboard-targets-receive-callback callback)
8b70d560 274 ((register-callback-function callback) unsigned-int))
275
a1bba49e 276(defbinding clipboard-wait-for-contents (clipboard target) selection-data
277 (clipboard clipboard)
278 ((gdk:atom-intern target) gdk:atom))
8b70d560 279
280(defbinding clipboard-wait-for-text () string
281 (clipboard clipboard))
282
8ab0db90 283#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
8b70d560 284(defbinding clipboard-wait-for-image () (referenced gdk:pixbuf)
285 (clipboard clipboard))
286
287(defbinding clipboard-wait-is-text-available-p () boolean
288 (clipboard clipboard))
289
8ab0db90 290#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
8b70d560 291(defbinding clipboard-wait-is-image-available-p () boolean
292 (clipboard clipboard))
293
a1bba49e 294(defbinding %clipboard-wait-for-targets () boolean
8b70d560 295 (clipboard clipboard)
296 (targets (vector gdk:atom n-targets) :out)
297 (n-targets unsigned-int :out))
298
a1bba49e 299(defun clipboard-wait-for-targets (clipboard)
300 (multiple-value-bind (valid-p targets)
301 (%clipboard-wait-for-targets clipboard)
302 (when valid-p
303 (map-into targets #'gdk:atom-name targets))))
304
8ab0db90 305#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
a1bba49e 306(defbinding clipboard-wait-is-target-available-p (clipboard target) boolean
8b70d560 307 (clipboard clipboard)
a1bba49e 308 ((gdk:atom-intern target) gdk:atom))
8b70d560 309
8ab0db90 310#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
a1bba49e 311(defbinding clipboard-set-can-store (clipboard targets) nil
8b70d560 312 (clipboard clipboard)
a1bba49e 313 ((map 'vector #'gdk:atom-intern targets) (vector gdk:atom))
8b70d560 314 ((length targets) int))
315
8ab0db90 316#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
8b70d560 317(defbinding clipboard-store () nil
318 (clipboard clipboard))
319
35721da7 320
8b70d560 321;;;; Drag and Drop
322
323(defbinding drag-dest-set (widget flags targets actions) nil
324 (widget widget)
325 (flags dest-defaults)
326 ((etypecase targets
327 ((or vector list) targets)
328 (target-entry (vector targets)))
329 (vector (inlined target-entry)))
330 ((etypecase targets
331 ((or vector list) (length targets))
332 (target-entry 1))
333 int)
334 (actions gdk:drag-action))
335
336(defbinding drag-dest-set-proxy () nil
337 (widget widget)
338 (window gdk:window)
339 (protocol gdk:drag-protocol)
340 (use-coordinates-p boolean))
341
342(defbinding drag-dest-unset () nil
343 (widget widget))
344
345(defbinding drag-dest-find-target () gdk:atom
346 (widget widget)
347 (context gdk:drag-context)
348 (targets target-list))
349
350(defbinding drag-dest-get-target-list () target-list
351 (widget widget))
352
353(defbinding drag-dest-set-target-list () nil
354 (widget widget)
355 (targets target-list))
356
8ab0db90 357#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
8b70d560 358(progn
359 (defbinding drag-dest-add-text-targets () nil
360 (widget widget))
361
362 (defbinding drag-dest-add-image-targets () nil
363 (widget widget))
364
365 (defbinding drag-dest-add-uri-targets () nil
366 (widget widget)))
367
368(defbinding drag-finish () nil
369 (context gdk:drag-context)
370 (success boolean)
371 (delete boolean)
372 (time unsigned-int))
373
374(defbinding drag-get-data () nil
375 (widget widget)
376 (context gdk:drag-context)
377 (target gdk:atom)
378 (time unsigned-int))
379
380(defbinding drag-get-source-widget () widget
381 (context gdk:drag-context))
382
383(defbinding drag-highlight () nil
384 (widget widget))
385
386(defbinding drag-unhighlight () nil
387 (widget widget))
388
389(defbinding drag-begin () gdk:drag-context
390 (widget widget)
391 (targets target-list)
392 (actions gdk:drag-action)
393 (button int)
394 (event gdk:event))
395
396(defbinding %drag-set-icon-widget () nil
397 (context gdk:drag-context)
398 (widget widget)
399 (hot-x int)
400 (hot-y int))
401
402(defbinding %drag-set-icon-pixmap () nil
403 (context gdk:drag-context)
404 (pixmap gdk:pixmap)
405 (mask gdk:bitmap)
406 (hot-x int)
407 (hot-y int))
408
409(defbinding %drag-set-icon-pixbuf () nil
410 (context gdk:drag-context)
411 (pixbuf gdk:pixbuf)
412 (hot-x int)
413 (hot-y int))
414
415(defbinding %drag-set-icon-stock () nil
416 (context gdk:drag-context)
417 (stock-id string)
418 (hot-x int)
419 (hot-y int))
420
421(defbinding %drag-set-icon-default () nil
422 (context gdk:drag-context))
423
424(defun drag-set-icon (context icon &optional (hot-x 0) (hot-y 0))
425 (etypecase icon
426 (widget (%drag-set-icon-widget context icon hot-x hot-y))
427 (gdk:pixbuf (%drag-set-icon-pixbuf context icon hot-x hot-y))
428 (string (%drag-set-icon-stock context icon hot-x hot-y))
429 (vector (multiple-value-bind (pixmap mask) (gdk:pixmap-create icon)
430 (%drag-set-icon-pixmap context pixmap mask hot-x hot-y)))
431 (pathname (let ((pixbuf (gdk:pixbuf-load icon)))
432 (%drag-set-icon-pixbuf context pixbuf hot-x hot-y)))
433 (null (%drag-set-icon-default context))))
434
435(defbinding drag-check-threshold-p () boolean
436 (widget widget)
437 (start-x int)
438 (start-y int)
439 (current-x int)
440 (current-y int))
441
442(defbinding drag-source-set (widget start-button-mask targets actions) nil
443 (widget widget)
444 (start-button-mask gdk:modifier-type)
445 ((etypecase targets
446 ((or vector list) targets)
447 (target-entry (vector targets)))
448 (vector (inlined target-entry)))
449 ((etypecase targets
450 ((or vector list) (length targets))
451 (target-entry 1))
452 int)
453 (actions gdk:drag-action))
454
455(defbinding %drag-source-set-icon-pixbuf () nil
456 (widget widget)
457 (pixbuf gdk:pixbuf))
458
459(defbinding %drag-source-set-icon-stock () nil
460 (widget widget)
461 (pixbuf gdk:pixbuf))
462
463(defun drag-source-set-icon (widget icon)
464 (etypecase icon
465 (gdk:pixbuf (%drag-source-set-icon-pixbuf widget icon))
466 (string (%drag-source-set-icon-stock widget icon))
467; (vector )
468 (pathname (let ((pixbuf (gdk:pixbuf-load icon)))
469 (%drag-source-set-icon-pixbuf widget pixbuf)))))
470
471(defbinding drag-source-unset () nil
472 (widget widget))
473
474(defbinding drag-source-set-target-list () nil
475 (widget widget)
476 (targets (or null target-list)))
477
478(defbinding drag-source-get-target-list () target-list
479 (widget widget))
480
8ab0db90 481#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
8b70d560 482(progn
483 (defbinding drag-source-add-text-targets () nil
484 (widget widget))
485
486 (defbinding drag-source-add-image-targets () nil
487 (widget widget))
488
489 (defbinding drag-source-add-uri-targets () nil
490 (widget widget)))