1 ;; Common Lisp bindings for GTK+ v2.x
2 ;; Copyright 2005-2006 Espen S. Johnsen <espen@users.sf.net>
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:
12 ;; The above copyright notice and this permission notice shall be
13 ;; included in all copies or substantial portions of the Software.
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.
23 ;; $Id: gtkselection.lisp,v 1.13 2007/12/13 14:34:41 espen Exp $
31 (defbinding %target-list-ref () pointer
34 (defbinding %target-list-unref () nil
37 (defbinding %target-list-new () pointer
38 (targets (vector (inlined target-entry)))
39 ((length targets) int))
41 (defmethod allocate-foreign ((target-list target-list) &key targets)
42 (%target-list-new targets))
44 (defbinding target-list-add (target-list target &optional flags info) nil
45 (target-list target-list)
46 ((gdk:atom-intern target) gdk:atom)
48 ((or info 0) unsigned-int))
50 (defbinding target-list-add-table (target-list targets) nil
51 (target-list target-list)
53 ((or vector list) targets)
54 (target-entry (vector targets)))
55 (vector (inlined target-entry)))
57 ((or vector list) (length targets))
61 #?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
63 (defbinding target-list-add-text-targets (target-list &optional info writable-p) nil
64 (target-list target-list)
65 ((or info 0) unsigned-int)
68 (defbinding target-list-add-image-targets (target-list &optional info writable-p) nil
69 (target-list target-list)
70 ((or info 0) unsigned-int)
73 (defbinding target-list-add-uri-targets (target-list &optional info writable-p) nil
74 (target-list target-list)
75 ((or info 0) unsigned-int)
76 (writable-p boolean)))
78 (defbinding target-list-remove (target-list target) nil
79 (target-list target-list)
80 ((gdk:atom-intern target) gdk:atom))
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))
87 (defbinding target-table-new-from-list () (vector (inlined target-entry) n-targets)
88 (target-list target-list)
91 (defun ensure-target-table (targets)
93 (target-list (target-table-new-from-list targets))
94 ((or vector list) targets)))
96 (defbinding (selection-set-owner "gtk_selection_owner_set_for_display")
97 (widget selection time &optional (display (gdk:display-get-default)))
101 ((gdk:atom-intern selection) gdk:atom)
102 (time (unsigned 32)))
104 (defbinding selection-add-target (widget selection target info) nil
106 ((gdk:atom-intern selection) gdk:atom)
107 ((gdk:atom-intern target) gdk:atom)
110 (defbinding selection-add-targets (widget selection targets) nil
112 ((gdk:atom-intern selection) gdk:atom)
114 ((or vector list) targets)
115 (target-entry (vector targets)))
116 (vector (inlined target-entry)))
118 ((or vector list) (length targets))
122 (defbinding selection-clear-targets (widget selection) nil
124 ((gdk:atom-intern selection) gdk:atom))
126 (defbinding selection-convert (widget selection target time) boolean
128 ((gdk:atom-intern selection) gdk:atom)
129 ((gdk:atom-intern target) gdk:atom)
132 (defbinding selection-data-set (selection-data type format data length) boolean
133 (selection-data selection-data)
134 ((gdk:atom-intern type) gdk:atom)
139 (defbinding selection-data-set-text () boolean
140 (selection-data selection-data)
144 (defbinding selection-data-get-text () string
145 (selection-data selection-data))
147 #?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
149 (defbinding selection-data-set-pixbuf () boolean
150 (selection-data selection-data)
153 (defbinding selection-data-get-pixbuf () gdk:pixbuf
154 (selection-data selection-data))
156 (defbinding selection-data-set-uris () boolean
157 (selection-data selection-data)
158 (uris (null-terminated-vector string)))
160 (defbinding selection-data-get-uris () (null-terminated-vector string)
161 (selection-data selection-data)))
163 (defbinding %selection-data-get-targets () boolean
164 (selection-data selection-data)
165 (targets (vector gdk:atom n-targets) :out)
166 (n-targets int :out))
168 (defun selection-data-get-targets (selection-data)
169 (multiple-value-bind (valid-p targets)
170 (%selection-data-get-targets selection-data)
172 (map-into targets #'gdk:atom-name targets))))
174 #?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
175 (defbinding selection-data-targets-include-image-p (selection-data &optional writable-p) boolean
176 (selection-data selection-data)
177 (writable-p boolean))
179 (defbinding selection-data-targets-include-text-p () boolean
180 (selection-data selection-data))
182 (defbinding selection-remove-all () boolean
186 ;;; Clipboard -- untestet
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))
193 (define-callback %clipboard-get-callback nil
194 ((clipboard pointer) (selection-data selection-data)
195 (info unsigned-int) (callback-ids unsigned-int))
196 (declare (ignore clipboard))
197 (funcall (car (find-user-data callback-ids)) selection-data info))
199 (define-callback %clipboard-clear-callback nil
200 ((clipboard pointer) (callback-ids unsigned-int))
201 (declare (ignore clipboard))
202 (funcall (cdr (find-user-data callback-ids))))
204 ;; Deprecated, use clipboard-set-contents
205 (defbinding clipboard-set-with-data (clipboard targets get-func clear-func) boolean
206 (clipboard clipboard)
207 (targets (vector (inlined target-entry)))
208 ((length targets) unsigned-int)
209 (%clipboard-get-callback callback)
210 (%clipboard-clear-callback callback)
211 ((register-user-data (cons get-func clear-func)) unsigned-int))
213 (defun clipboard-set-contents (clipboard targets get-func &optional clear-func)
214 (%clipboard-set-with-data clipboard (ensure-target-table targets)
215 get-func (or clear-func #'(lambda ()))))
217 (defbinding clipboard-clear () nil
218 (clipboard clipboard))
220 (defbinding clipboard-set-text () nil
221 (clipboard clipboard)
225 #?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
226 (defbinding clipboard-set-image () nil
227 (clipboard clipboard)
230 (defgeneric clipboard-set (clipboard object))
232 (defmethod clipboard-set ((clipboard clipboard) (text string))
233 (clipboard-set-text clipboard text))
235 #?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
236 (defmethod clipboard-set ((clipboard clipboard) (image gdk:pixbuf))
237 (clipboard-set-image clipboard image))
239 (define-callback-marshal %clipboard-receive-callback nil
240 ((:ignore clipboard) selection-data))
242 (defbinding clipboard-request-contents (clipboard target callback) nil
243 (clipboard clipboard)
244 ((gdk:atom-intern target) gdk:atom)
245 (%clipboard-receive-callback callback)
246 ((register-callback-function callback) unsigned-int))
248 (define-callback-marshal %clipboard-text-receive-callback nil
249 ((:ignore clipboard) (text string)))
252 (defbinding clipboard-request-text (clipboard callback) nil
253 (clipboard clipboard)
254 (%clipboard-text-receive-callback callback)
255 ((register-callback-function callback) unsigned-int))
257 #?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
259 (define-callback-marshal %clipboard-image-receive-callback nil
260 ((:ignore clipboard) (image gdk:pixbuf)))
262 (defbinding clipboard-request-image (clipboard callback) nil
263 (clipboard clipboard)
264 (%clipboard-image-receive-callback callback)
265 ((register-callback-function callback) unsigned-int)))
268 (define-callback %clipboard-targets-receive-callback nil
269 ((clipboard pointer) (atoms (vector gdk:atom n-atoms))
270 (n-atoms unsigned-int) (callback-id unsigned-int))
271 (declare (ignore clipboard))
272 (funcall (find-user-data callback-id) (map-into atoms #'gdk:atom-name atoms)))
274 (defbinding clipboard-request-targets (clipboard callback) nil
275 (clipboard clipboard)
276 (%clipboard-targets-receive-callback callback)
277 ((register-callback-function callback) unsigned-int))
279 (defbinding clipboard-wait-for-contents (clipboard target) selection-data
280 (clipboard clipboard)
281 ((gdk:atom-intern target) gdk:atom))
283 (defbinding clipboard-wait-for-text () string
284 (clipboard clipboard))
286 #?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
287 (defbinding clipboard-wait-for-image () (referenced gdk:pixbuf)
288 (clipboard clipboard))
290 (defbinding clipboard-wait-is-text-available-p () boolean
291 (clipboard clipboard))
293 #?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
294 (defbinding clipboard-wait-is-image-available-p () boolean
295 (clipboard clipboard))
297 (defbinding %clipboard-wait-for-targets () boolean
298 (clipboard clipboard)
299 (targets (vector gdk:atom n-targets) :out)
300 (n-targets unsigned-int :out))
302 (defun clipboard-wait-for-targets (clipboard)
303 (multiple-value-bind (valid-p targets)
304 (%clipboard-wait-for-targets clipboard)
306 (map-into targets #'gdk:atom-name targets))))
308 #?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
309 (defbinding clipboard-wait-is-target-available-p (clipboard target) boolean
310 (clipboard clipboard)
311 ((gdk:atom-intern target) gdk:atom))
313 #?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
314 (defbinding clipboard-set-can-store (clipboard targets) nil
315 (clipboard clipboard)
316 ((map 'vector #'gdk:atom-intern targets) (vector gdk:atom))
317 ((length targets) int))
319 #?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
320 (defbinding clipboard-store () nil
321 (clipboard clipboard))
326 (defbinding drag-dest-set (widget flags targets actions) nil
328 (flags dest-defaults)
330 ((or vector list) targets)
331 (target-entry (vector targets)))
332 (vector (inlined target-entry)))
334 ((or vector list) (length targets))
337 (actions gdk:drag-action))
339 (defbinding drag-dest-set-proxy () nil
342 (protocol gdk:drag-protocol)
343 (use-coordinates-p boolean))
345 (defbinding drag-dest-unset () nil
348 (defbinding drag-dest-find-target () gdk:atom
350 (context gdk:drag-context)
351 (targets target-list))
353 (defbinding drag-dest-get-target-list () target-list
356 (defbinding drag-dest-set-target-list () nil
358 (targets target-list))
360 #?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
362 (defbinding drag-dest-add-text-targets () nil
365 (defbinding drag-dest-add-image-targets () nil
368 (defbinding drag-dest-add-uri-targets () nil
371 (defbinding drag-finish () nil
372 (context gdk:drag-context)
377 (defbinding drag-get-data () nil
379 (context gdk:drag-context)
383 (defbinding drag-get-source-widget () widget
384 (context gdk:drag-context))
386 (defbinding drag-highlight () nil
389 (defbinding drag-unhighlight () nil
392 (defbinding drag-begin () gdk:drag-context
394 (targets target-list)
395 (actions gdk:drag-action)
399 (defbinding %drag-set-icon-widget () nil
400 (context gdk:drag-context)
405 (defbinding %drag-set-icon-pixmap () nil
406 (context gdk:drag-context)
412 (defbinding %drag-set-icon-pixbuf () nil
413 (context gdk:drag-context)
418 (defbinding %drag-set-icon-stock () nil
419 (context gdk:drag-context)
424 (defbinding %drag-set-icon-default () nil
425 (context gdk:drag-context))
427 (defun drag-set-icon (context icon &optional (hot-x 0) (hot-y 0))
429 (widget (%drag-set-icon-widget context icon hot-x hot-y))
430 (gdk:pixbuf (%drag-set-icon-pixbuf context icon hot-x hot-y))
431 (string (%drag-set-icon-stock context icon hot-x hot-y))
432 (vector (multiple-value-bind (pixmap mask) (gdk:pixmap-create icon)
433 (%drag-set-icon-pixmap context pixmap mask hot-x hot-y)))
434 (pathname (let ((pixbuf (gdk:pixbuf-load icon)))
435 (%drag-set-icon-pixbuf context pixbuf hot-x hot-y)))
436 (null (%drag-set-icon-default context))))
438 (defbinding drag-check-threshold-p () boolean
445 (defbinding drag-source-set (widget start-button-mask targets actions) nil
447 (start-button-mask gdk:modifier-type)
449 ((or vector list) targets)
450 (target-entry (vector targets)))
451 (vector (inlined target-entry)))
453 ((or vector list) (length targets))
456 (actions gdk:drag-action))
458 (defbinding %drag-source-set-icon-pixbuf () nil
462 (defbinding %drag-source-set-icon-stock () nil
466 (defun drag-source-set-icon (widget icon)
468 (gdk:pixbuf (%drag-source-set-icon-pixbuf widget icon))
469 (string (%drag-source-set-icon-stock widget icon))
471 (pathname (let ((pixbuf (gdk:pixbuf-load icon)))
472 (%drag-source-set-icon-pixbuf widget pixbuf)))))
474 (defbinding drag-source-unset () nil
477 (defbinding drag-source-set-target-list () nil
479 (targets (or null target-list)))
481 (defbinding drag-source-get-target-list () target-list
484 #?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
486 (defbinding drag-source-add-text-targets () nil
489 (defbinding drag-source-add-image-targets () nil
492 (defbinding drag-source-add-uri-targets () nil