[clg] / gtk / gtkselection.lisp

;; Common Lisp bindings for GTK+ v2.x
;; Copyright 2005-2006 Espen S. Johnsen <espen@users.sf.net>
;;
;; Permission is hereby granted, free of charge, to any person obtaining
;; a copy of this software and associated documentation files (the
;; "Software"), to deal in the Software without restriction, including
;; without limitation the rights to use, copy, modify, merge, publish,
;; distribute, sublicense, and/or sell copies of the Software, and to
;; permit persons to whom the Software is furnished to do so, subject to
;; the following conditions:
;;
;; The above copyright notice and this permission notice shall be
;; included in all copies or substantial portions of the Software.
;;
;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
;; IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
;; CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

;; $Id: gtkselection.lisp,v 1.10 2007/12/12 15:10:04 espen Exp $


(in-package "GTK")


;;;; Selection

(defbinding %target-list-ref () pointer
  (location pointer))
  
(defbinding %target-list-unref () nil
  (location pointer))

(defbinding %target-list-new () pointer
  (targets (vector (inlined target-entry)))
  ((length targets) int))
  
(defmethod allocate-foreign ((target-list target-list) &key targets)
  (%target-list-new targets))

(defbinding target-list-add (target-list target &optional flags info) nil
  (target-list target-list)
  ((gdk:atom-intern target) gdk:atom)
  (flags target-flags)
  (info unsigned-int))

(defbinding target-list-add-table (target-list targets) nil
  (target-list target-list)
  ((etypecase targets 
     ((or vector list) targets)
     (target-entry (vector targets)))
   (vector (inlined target-entry)))
  ((etypecase targets 
     ((or vector list) (length targets))
     (target-entry 1))
   int))

#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
(progn
  (defbinding target-list-add-text-targets (target-list info &optional writable-p) nil
    (target-list target-list)
    (info unsigned-int)
    (writable-p boolean))
  
  (defbinding target-list-add-image-targets (target-list info &optional writable-p) nil
    (target-list target-list)
    (info unsigned-int)
    (writable-p boolean))

  (defbinding target-list-add-uri-targets (target-list info &optional writable-p) nil
    (target-list target-list)
    (info unsigned-int)
    (writable-p boolean)))

(defbinding target-list-remove (target-list target) nil
  (target-list target-list)
  ((gdk:atom-intern target) gdk:atom))

(defbinding target-list-find (target-list target) boolean
  (target-list target-list)
  ((gdk:atom-intern target) gdk:atom)
  (info unsigned-int :out))

(defbinding target-table-new-from-list () (vector (inlined target-entry) n-targets)
  (target-list target-list)
  (n-targets int :out))

(defun ensure-target-table (targets)
  (etypecase targets
    (target-list (target-table-new-from-list targets))
    ((or vector list) targets)))

(defbinding (selection-set-owner "gtk_selection_owner_set_for_display")
    (widget selection time &optional (display (gdk:display-get-default))) 
    boolean
  (display gdk:display)
  (widget widget)
  ((gdk:atom-intern selection) gdk:atom)
  (time (unsigned 32)))

(defbinding selection-add-target (widget selection target info) nil
  (widget widget)
  ((gdk:atom-intern selection) gdk:atom)
  ((gdk:atom-intern target) gdk:atom)
  (info unsigned-int))

(defbinding selection-add-targets (widget selection targets) nil
  (widget widget)
  ((gdk:atom-intern selection) gdk:atom)
  ((etypecase targets 
     ((or vector list) targets)
     (target-entry (vector targets)))
   (vector (inlined target-entry)))
  ((etypecase targets 
     ((or vector list) (length targets))
     (target-entry 1))
   int))

(defbinding selection-clear-targets (widget selection) nil
  (widget widget)
  ((gdk:atom-intern selection) gdk:atom))

(defbinding selection-convert (widget selection target time) boolean
  (widget widget)
  ((gdk:atom-intern selection) gdk:atom)
  ((gdk:atom-intern target) gdk:atom)
  (time unsigned-int))

(defbinding selection-data-set (selection-data type format data length) boolean
  (selection-data selection-data)
  ((gdk:atom-intern type) gdk:atom)
  (format int)
  (data pointer)
  (length int))

(defbinding selection-data-set-text () boolean
  (selection-data selection-data)
  (text string)
  (-1 integer))

(defbinding selection-data-get-text () string
  (selection-data selection-data))

#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
(progn
  (defbinding selection-data-set-pixbuf () boolean
    (selection-data selection-data)
    (puxbuf gdk:pixbuf))

  (defbinding selection-data-get-pixbuf () gdk:pixbuf
    (selection-data selection-data))

  (defbinding selection-data-set-uris () boolean
    (selection-data selection-data)
    (uris (null-terminated-vector string)))

  (defbinding selection-data-get-uris () (null-terminated-vector string)
    (selection-data selection-data)))

(defbinding %selection-data-get-targets () boolean
  (selection-data selection-data)
  (targets (vector gdk:atom n-targets) :out)
  (n-targets int :out))

(defun selection-data-get-targets (selection-data)
  (multiple-value-bind (valid-p targets) 
      (%selection-data-get-targets selection-data) 
    (when valid-p
      (map-into targets #'gdk:atom-name targets))))

#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
(defbinding selection-data-targets-include-image-p (selection-data &optional writable-p) boolean
  (selection-data selection-data)
  (writable-p boolean))

(defbinding selection-data-targets-include-text-p () boolean
  (selection-data selection-data))

(defbinding selection-remove-all () boolean
  (widget widget))


;;; Clipboard -- untestet

(defbinding (clipboard-get "gtk_clipboard_get_for_display") 
    (selection &optional (display (gdk:display-get-default))) clipboard
  (display gdk:display)
  ((gdk:atom-intern selection) gdk:atom))

(define-callback %clipboard-get-callback nil
    ((clipboard pointer) (selection-data selection-data)
     (info unsigned-int) (callback-ids unsigned-int))
  (declare (ignore clipboard))
  (funcall (car (find-user-data callback-ids)) selection-data info))

(define-callback %clipboard-clear-callback nil
    ((clipboard pointer) (callback-ids unsigned-int))
  (declare (ignore clipboard))
  (funcall (cdr (find-user-data callback-ids))))

(defbinding %clipboard-set-with-data (clipboard targets get-func clear-func) boolean
  (clipboard clipboard)
  (targets (vector (inlined target-entry)))
  ((length targets) unsigned-int)
  (%clipboard-get-callback callback)
  (%clipboard-clear-callback callback)
  ((register-user-data (cons get-func clear-func)) unsigned-int))

(defun clipboard-set-with-data (clipboard targets get-func &optional clear-func)
  (%clipboard-set-with-data clipboard (ensure-target-table targets) 
   get-func (or clear-func #'(lambda ()))))

(defbinding clipboard-clear () nil
  (clipboard clipboard))

(defbinding clipboard-set-text () nil
  (clipboard clipboard)
  (text string)
  ((length text) int))

#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
(defbinding clipboard-set-image () nil
  (clipboard clipboard)
  (pixbuf gdk:pixbuf))

(defun clipboard-set (clipboard object)
  (etypecase object
    (string (clipboard-set-text clipboard object))
    #?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
    (gdk:pixbuf (clipboard-set-image clipboard object))))

(define-callback-marshal %clipboard-receive-callback nil 
 ((:ignore clipboard) selection-data))

(defbinding clipboard-request-contents (clipboard target callback) nil
  (clipboard clipboard)
  ((gdk:atom-intern target) gdk:atom)
  (%clipboard-receive-callback callback)
  ((register-callback-function callback) unsigned-int))

(define-callback-marshal %clipboard-text-receive-callback nil
  ((:ignore clipboard) (text string)))


(defbinding clipboard-request-text (clipboard callback) nil
  (clipboard clipboard)
  (%clipboard-text-receive-callback callback)
  ((register-callback-function callback) unsigned-int))

#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
(progn
  (define-callback-marshal %clipboard-image-receive-callback nil 
    ((:ignore clipboard) (image gdk:pixbuf)))

  (defbinding clipboard-request-image (clipboard callback) nil
    (clipboard clipboard)
    (%clipboard-image-receive-callback callback)
    ((register-callback-function callback) unsigned-int)))


(define-callback %clipboard-targets-receive-callback nil
    ((clipboard pointer) (atoms (vector gdk:atom n-atoms))
     (n-atoms unsigned-int) (callback-id unsigned-int))
  (declare (ignore clipboard))
  (funcall (find-user-data callback-id) (map-into atoms #'gdk:atom-name atoms)))

(defbinding clipboard-request-targets (clipboard callback) nil
  (clipboard clipboard)
  (%clipboard-targets-receive-callback callback)
  ((register-callback-function callback) unsigned-int))

(defbinding clipboard-wait-for-contents (clipboard target) selection-data
  (clipboard clipboard)
  ((gdk:atom-intern target) gdk:atom))

(defbinding clipboard-wait-for-text () string
  (clipboard clipboard))

#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
(defbinding clipboard-wait-for-image () (referenced gdk:pixbuf)
  (clipboard clipboard))

(defbinding clipboard-wait-is-text-available-p () boolean
  (clipboard clipboard))

#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
(defbinding clipboard-wait-is-image-available-p () boolean
  (clipboard clipboard))

(defbinding %clipboard-wait-for-targets () boolean
  (clipboard clipboard)
  (targets (vector gdk:atom n-targets) :out)
  (n-targets unsigned-int :out))

(defun clipboard-wait-for-targets (clipboard)
  (multiple-value-bind (valid-p targets) 
      (%clipboard-wait-for-targets clipboard) 
    (when valid-p
      (map-into targets #'gdk:atom-name targets))))

#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
(defbinding clipboard-wait-is-target-available-p (clipboard target) boolean
  (clipboard clipboard)
  ((gdk:atom-intern target) gdk:atom))

#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
(defbinding clipboard-set-can-store (clipboard targets) nil
  (clipboard clipboard)
  ((map 'vector #'gdk:atom-intern targets) (vector gdk:atom))
  ((length targets) int))

#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
(defbinding clipboard-store () nil
  (clipboard clipboard))


;;;; Drag and Drop

(defbinding drag-dest-set (widget flags targets actions) nil
  (widget widget)
  (flags dest-defaults)
  ((etypecase targets 
     ((or vector list) targets)
     (target-entry (vector targets)))
   (vector (inlined target-entry)))
  ((etypecase targets 
     ((or vector list) (length targets))
     (target-entry 1))
   int)
  (actions gdk:drag-action))

(defbinding drag-dest-set-proxy () nil
  (widget widget)
  (window gdk:window)
  (protocol gdk:drag-protocol)
  (use-coordinates-p boolean))

(defbinding drag-dest-unset () nil
  (widget widget))

(defbinding drag-dest-find-target () gdk:atom
  (widget widget)
  (context gdk:drag-context)
  (targets target-list))

(defbinding drag-dest-get-target-list () target-list
  (widget widget))

(defbinding drag-dest-set-target-list () nil
  (widget widget)
  (targets target-list))

#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
(progn
  (defbinding drag-dest-add-text-targets () nil
    (widget widget))

  (defbinding drag-dest-add-image-targets () nil
    (widget widget))

  (defbinding drag-dest-add-uri-targets () nil
    (widget widget)))

(defbinding drag-finish () nil
  (context gdk:drag-context)
  (success boolean)
  (delete boolean)
  (time unsigned-int))

(defbinding drag-get-data () nil
  (widget widget)
  (context gdk:drag-context)
  (target gdk:atom)
  (time unsigned-int))

(defbinding drag-get-source-widget () widget
  (context gdk:drag-context))

(defbinding drag-highlight () nil
  (widget widget))

(defbinding drag-unhighlight () nil
  (widget widget))

(defbinding drag-begin () gdk:drag-context
  (widget widget)
  (targets target-list)
  (actions gdk:drag-action)
  (button int)
  (event gdk:event))

(defbinding %drag-set-icon-widget () nil
  (context gdk:drag-context)
  (widget widget)
  (hot-x int)
  (hot-y int))

(defbinding %drag-set-icon-pixmap () nil
  (context gdk:drag-context)
  (pixmap gdk:pixmap)
  (mask gdk:bitmap)
  (hot-x int)
  (hot-y int))

(defbinding %drag-set-icon-pixbuf () nil
  (context gdk:drag-context)
  (pixbuf gdk:pixbuf)
  (hot-x int)
  (hot-y int))

(defbinding %drag-set-icon-stock () nil
  (context gdk:drag-context)
  (stock-id string)
  (hot-x int)
  (hot-y int))

(defbinding %drag-set-icon-default () nil
  (context gdk:drag-context))

(defun drag-set-icon (context icon &optional (hot-x 0) (hot-y 0))
  (etypecase icon
    (widget (%drag-set-icon-widget context icon hot-x hot-y))
    (gdk:pixbuf (%drag-set-icon-pixbuf context icon hot-x hot-y))
    (string (%drag-set-icon-stock context icon hot-x hot-y))
    (vector (multiple-value-bind (pixmap mask) (gdk:pixmap-create icon)
	      (%drag-set-icon-pixmap context pixmap mask hot-x hot-y)))
    (pathname (let ((pixbuf (gdk:pixbuf-load icon)))
		(%drag-set-icon-pixbuf context pixbuf hot-x hot-y)))
    (null (%drag-set-icon-default context))))

(defbinding drag-check-threshold-p () boolean
  (widget widget)
  (start-x int)
  (start-y int)
  (current-x int)
  (current-y int))

(defbinding drag-source-set (widget start-button-mask targets actions) nil
  (widget widget)
  (start-button-mask gdk:modifier-type)
  ((etypecase targets 
     ((or vector list) targets)
     (target-entry (vector targets)))
   (vector (inlined target-entry)))
  ((etypecase targets 
     ((or vector list) (length targets))
     (target-entry 1)) 
   int)
  (actions gdk:drag-action))

(defbinding %drag-source-set-icon-pixbuf () nil
  (widget widget)
  (pixbuf gdk:pixbuf))
  
(defbinding %drag-source-set-icon-stock () nil
  (widget widget)
  (pixbuf gdk:pixbuf))

(defun drag-source-set-icon (widget icon)
  (etypecase icon
    (gdk:pixbuf (%drag-source-set-icon-pixbuf widget icon))
    (string (%drag-source-set-icon-stock widget icon))
;    (vector )
    (pathname (let ((pixbuf (gdk:pixbuf-load icon)))
		(%drag-source-set-icon-pixbuf widget pixbuf)))))

(defbinding drag-source-unset () nil
  (widget widget))

(defbinding drag-source-set-target-list () nil
  (widget widget)
  (targets (or null target-list)))

(defbinding drag-source-get-target-list () target-list
  (widget widget))

#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
(progn
  (defbinding drag-source-add-text-targets () nil
    (widget widget))

  (defbinding drag-source-add-image-targets () nil
    (widget widget))

  (defbinding drag-source-add-uri-targets () nil
    (widget widget)))
Commit	Line	Data
8cd52853	1	;; Common Lisp bindings for GTK+ v2.x
f957f519	2	;; Copyright 2005-2006 Espen S. Johnsen <espen@users.sf.net>
8cd52853	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
eabe4e30	23	;; $Id: gtkselection.lisp,v 1.10 2007/12/12 15:10:04 espen Exp $
8cd52853	24
	25
	26	(in-package "GTK")
	27
	28
	29	;;;; Selection
	30
8cd52853	31	(defbinding %target-list-ref () pointer
	32	(location pointer))
	33
	34	(defbinding %target-list-unref () nil
	35	(location pointer))
	36
8cd52853	37	(defbinding %target-list-new () pointer
	38	(targets (vector (inlined target-entry)))
	39	((length targets) int))
	40
39db92d4	41	(defmethod allocate-foreign ((target-list target-list) &key targets)
39db92d4	42	(%target-list-new targets))
8cd52853	43
3ae96406	44	(defbinding target-list-add (target-list target &optional flags info) nil
8cd52853	45	(target-list target-list)
eabe4e30	46	((gdk:atom-intern target) gdk:atom)
eabe4e30	47	(flags target-flags)
8cd52853	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
f957f519	61	#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
8cd52853	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
eabe4e30	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)
8cd52853	88	(target-list target-list)
eabe4e30	89	(n-targets int :out))
8cd52853	90
eabe4e30	91	(defun ensure-target-table (targets)
	92	(etypecase targets
	93	(target-list (target-table-new-from-list targets))
	94	((or vector list) targets)))
8cd52853	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)
e9269590	101	((gdk:atom-intern selection) gdk:atom)
e9269590	102	(time (unsigned 32)))
8cd52853	103
eabe4e30	104	(defbinding selection-add-target (widget selection target info) nil
8cd52853	105	(widget widget)
eabe4e30	106	((gdk:atom-intern selection) gdk:atom)
eabe4e30	107	((gdk:atom-intern target) gdk:atom)
8cd52853	108	(info unsigned-int))
	109
	110	(defbinding selection-add-targets (widget selection targets) nil
	111	(widget widget)
eabe4e30	112	((gdk:atom-intern selection) gdk:atom)
8cd52853	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
eabe4e30	122	(defbinding selection-clear-targets (widget selection) nil
8cd52853	123	(widget widget)
eabe4e30	124	((gdk:atom-intern selection) gdk:atom))
8cd52853	125
eabe4e30	126	(defbinding selection-convert (widget selection target time) boolean
8cd52853	127	(widget widget)
eabe4e30	128	((gdk:atom-intern selection) gdk:atom)
eabe4e30	129	((gdk:atom-intern target) gdk:atom)
8cd52853	130	(time unsigned-int))
8cd52853	131
eabe4e30	132	(defbinding selection-data-set (selection-data type format data length) boolean
8cd52853	133	(selection-data selection-data)
eabe4e30	134	((gdk:atom-intern type) gdk:atom)
8cd52853	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
f957f519	147	#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
8cd52853	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
eabe4e30	163	(defbinding %selection-data-get-targets () boolean
8cd52853	164	(selection-data selection-data)
eabe4e30	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))))
8cd52853	173
f957f519	174	#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
8cd52853	175	(defbinding selection-data-targets-include-image-p (selection-data &optional writable-p) boolean
	176	(selection-data selection-data)
	177	(writable-p boolean))
	178
eabe4e30	179	(defbinding selection-data-targets-include-text-p () boolean
8cd52853	180	(selection-data selection-data))
8cd52853	181
3ae96406	182	(defbinding selection-remove-all () boolean
8cd52853	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
a92553bd	193	(define-callback %clipboard-get-callback nil
a92553bd	194	((clipboard pointer) (selection-data selection-data)
eabe4e30	195	(info unsigned-int) (callback-ids unsigned-int))
3dbba767	196	(declare (ignore clipboard))
a92553bd	197	(funcall (car (find-user-data callback-ids)) selection-data info))
8cd52853	198
a92553bd	199	(define-callback %clipboard-clear-callback nil
a92553bd	200	((clipboard pointer) (callback-ids unsigned-int))
3dbba767	201	(declare (ignore clipboard))
a92553bd	202	(funcall (cdr (find-user-data callback-ids))))
8cd52853	203
eabe4e30	204	(defbinding %clipboard-set-with-data (clipboard targets get-func clear-func) boolean
8cd52853	205	(clipboard clipboard)
f8b57f5a	206	(targets (vector (inlined target-entry)))
8cd52853	207	((length targets) unsigned-int)
a92553bd	208	(%clipboard-get-callback callback)
a92553bd	209	(%clipboard-clear-callback callback)
8cd52853	210	((register-user-data (cons get-func clear-func)) unsigned-int))
8cd52853	211
eabe4e30	212	(defun clipboard-set-with-data (clipboard targets get-func &optional clear-func)
	213	(%clipboard-set-with-data clipboard (ensure-target-table targets)
	214	get-func (or clear-func #'(lambda ()))))
	215
8cd52853	216	(defbinding clipboard-clear () nil
	217	(clipboard clipboard))
	218
eabe4e30	219	(defbinding clipboard-set-text () nil
8cd52853	220	(clipboard clipboard)
	221	(text string)
	222	((length text) int))
	223
f957f519	224	#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
8cd52853	225	(defbinding clipboard-set-image () nil
	226	(clipboard clipboard)
	227	(pixbuf gdk:pixbuf))
	228
	229	(defun clipboard-set (clipboard object)
	230	(etypecase object
	231	(string (clipboard-set-text clipboard object))
f957f519	232	#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
8cd52853	233	(gdk:pixbuf (clipboard-set-image clipboard object))))
8cd52853	234
a92553bd	235	(define-callback-marshal %clipboard-receive-callback nil
a92553bd	236	((:ignore clipboard) selection-data))
8cd52853	237
	238	(defbinding clipboard-request-contents (clipboard target callback) nil
	239	(clipboard clipboard)
	240	((gdk:atom-intern target) gdk:atom)
a92553bd	241	(%clipboard-receive-callback callback)
8cd52853	242	((register-callback-function callback) unsigned-int))
8cd52853	243
a92553bd	244	(define-callback-marshal %clipboard-text-receive-callback nil
	245	((:ignore clipboard) (text string)))
	246
8cd52853	247
	248	(defbinding clipboard-request-text (clipboard callback) nil
	249	(clipboard clipboard)
a92553bd	250	(%clipboard-text-receive-callback callback)
8cd52853	251	((register-callback-function callback) unsigned-int))
8cd52853	252
f957f519	253	#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
8cd52853	254	(progn
a92553bd	255	(define-callback-marshal %clipboard-image-receive-callback nil
a92553bd	256	((:ignore clipboard) (image gdk:pixbuf)))
8cd52853	257
	258	(defbinding clipboard-request-image (clipboard callback) nil
	259	(clipboard clipboard)
a92553bd	260	(%clipboard-image-receive-callback callback)
8cd52853	261	((register-callback-function callback) unsigned-int)))
	262
	263
a92553bd	264	(define-callback %clipboard-targets-receive-callback nil
	265	((clipboard pointer) (atoms (vector gdk:atom n-atoms))
	266	(n-atoms unsigned-int) (callback-id unsigned-int))
f957f519	267	(declare (ignore clipboard))
eabe4e30	268	(funcall (find-user-data callback-id) (map-into atoms #'gdk:atom-name atoms)))
8cd52853	269
	270	(defbinding clipboard-request-targets (clipboard callback) nil
	271	(clipboard clipboard)
a92553bd	272	(%clipboard-targets-receive-callback callback)
8cd52853	273	((register-callback-function callback) unsigned-int))
8cd52853	274
eabe4e30	275	(defbinding clipboard-wait-for-contents (clipboard target) selection-data
	276	(clipboard clipboard)
	277	((gdk:atom-intern target) gdk:atom))
8cd52853	278
	279	(defbinding clipboard-wait-for-text () string
	280	(clipboard clipboard))
	281
f957f519	282	#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
8cd52853	283	(defbinding clipboard-wait-for-image () (referenced gdk:pixbuf)
	284	(clipboard clipboard))
	285
	286	(defbinding clipboard-wait-is-text-available-p () boolean
	287	(clipboard clipboard))
	288
f957f519	289	#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
8cd52853	290	(defbinding clipboard-wait-is-image-available-p () boolean
	291	(clipboard clipboard))
	292
eabe4e30	293	(defbinding %clipboard-wait-for-targets () boolean
8cd52853	294	(clipboard clipboard)
	295	(targets (vector gdk:atom n-targets) :out)
	296	(n-targets unsigned-int :out))
	297
eabe4e30	298	(defun clipboard-wait-for-targets (clipboard)
	299	(multiple-value-bind (valid-p targets)
	300	(%clipboard-wait-for-targets clipboard)
	301	(when valid-p
	302	(map-into targets #'gdk:atom-name targets))))
	303
f957f519	304	#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
eabe4e30	305	(defbinding clipboard-wait-is-target-available-p (clipboard target) boolean
8cd52853	306	(clipboard clipboard)
eabe4e30	307	((gdk:atom-intern target) gdk:atom))
8cd52853	308
f957f519	309	#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
eabe4e30	310	(defbinding clipboard-set-can-store (clipboard targets) nil
8cd52853	311	(clipboard clipboard)
eabe4e30	312	((map 'vector #'gdk:atom-intern targets) (vector gdk:atom))
8cd52853	313	((length targets) int))
8cd52853	314
f957f519	315	#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
8cd52853	316	(defbinding clipboard-store () nil
	317	(clipboard clipboard))
	318
f8b57f5a	319
8cd52853	320	;;;; Drag and Drop
	321
	322	(defbinding drag-dest-set (widget flags targets actions) nil
	323	(widget widget)
	324	(flags dest-defaults)
	325	((etypecase targets
	326	((or vector list) targets)
	327	(target-entry (vector targets)))
	328	(vector (inlined target-entry)))
	329	((etypecase targets
	330	((or vector list) (length targets))
	331	(target-entry 1))
	332	int)
	333	(actions gdk:drag-action))
	334
	335	(defbinding drag-dest-set-proxy () nil
	336	(widget widget)
	337	(window gdk:window)
	338	(protocol gdk:drag-protocol)
	339	(use-coordinates-p boolean))
	340
	341	(defbinding drag-dest-unset () nil
	342	(widget widget))
	343
	344	(defbinding drag-dest-find-target () gdk:atom
	345	(widget widget)
	346	(context gdk:drag-context)
	347	(targets target-list))
	348
	349	(defbinding drag-dest-get-target-list () target-list
	350	(widget widget))
	351
	352	(defbinding drag-dest-set-target-list () nil
	353	(widget widget)
	354	(targets target-list))
	355
f957f519	356	#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
8cd52853	357	(progn
	358	(defbinding drag-dest-add-text-targets () nil
	359	(widget widget))
	360
	361	(defbinding drag-dest-add-image-targets () nil
	362	(widget widget))
	363
	364	(defbinding drag-dest-add-uri-targets () nil
	365	(widget widget)))
	366
	367	(defbinding drag-finish () nil
	368	(context gdk:drag-context)
	369	(success boolean)
	370	(delete boolean)
	371	(time unsigned-int))
	372
	373	(defbinding drag-get-data () nil
	374	(widget widget)
	375	(context gdk:drag-context)
	376	(target gdk:atom)
	377	(time unsigned-int))
	378
	379	(defbinding drag-get-source-widget () widget
	380	(context gdk:drag-context))
	381
	382	(defbinding drag-highlight () nil
	383	(widget widget))
	384
	385	(defbinding drag-unhighlight () nil
	386	(widget widget))
	387
	388	(defbinding drag-begin () gdk:drag-context
	389	(widget widget)
	390	(targets target-list)
	391	(actions gdk:drag-action)
	392	(button int)
	393	(event gdk:event))
	394
	395	(defbinding %drag-set-icon-widget () nil
	396	(context gdk:drag-context)
	397	(widget widget)
	398	(hot-x int)
	399	(hot-y int))
	400
	401	(defbinding %drag-set-icon-pixmap () nil
	402	(context gdk:drag-context)
	403	(pixmap gdk:pixmap)
	404	(mask gdk:bitmap)
	405	(hot-x int)
	406	(hot-y int))
	407
	408	(defbinding %drag-set-icon-pixbuf () nil
	409	(context gdk:drag-context)
	410	(pixbuf gdk:pixbuf)
	411	(hot-x int)
	412	(hot-y int))
	413
	414	(defbinding %drag-set-icon-stock () nil
	415	(context gdk:drag-context)
	416	(stock-id string)
	417	(hot-x int)
	418	(hot-y int))
	419
	420	(defbinding %drag-set-icon-default () nil
421	(context gdk:drag-context))
422
423	(defun drag-set-icon (context icon &optional (hot-x 0) (hot-y 0))
424	(etypecase icon
425	(widget (%drag-set-icon-widget context icon hot-x hot-y))
426	(gdk:pixbuf (%drag-set-icon-pixbuf context icon hot-x hot-y))
427	(string (%drag-set-icon-stock context icon hot-x hot-y))
428	(vector (multiple-value-bind (pixmap mask) (gdk:pixmap-create icon)
429	(%drag-set-icon-pixmap context pixmap mask hot-x hot-y)))
430	(pathname (let ((pixbuf (gdk:pixbuf-load icon)))
431	(%drag-set-icon-pixbuf context pixbuf hot-x hot-y)))
432	(null (%drag-set-icon-default context))))
433
434	(defbinding drag-check-threshold-p () boolean
435	(widget widget)
436	(start-x int)
437	(start-y int)
438	(current-x int)
439	(current-y int))
440
441	(defbinding drag-source-set (widget start-button-mask targets actions) nil
442	(widget widget)
443	(start-button-mask gdk:modifier-type)
444	((etypecase targets
445	((or vector list) targets)
446	(target-entry (vector targets)))
447	(vector (inlined target-entry)))
448	((etypecase targets
449	((or vector list) (length targets))
450	(target-entry 1))
451	int)
452	(actions gdk:drag-action))
453
454	(defbinding %drag-source-set-icon-pixbuf () nil
455	(widget widget)
456	(pixbuf gdk:pixbuf))
457
458	(defbinding %drag-source-set-icon-stock () nil
459	(widget widget)
460	(pixbuf gdk:pixbuf))
461
462	(defun drag-source-set-icon (widget icon)
463	(etypecase icon
464	(gdk:pixbuf (%drag-source-set-icon-pixbuf widget icon))
465	(string (%drag-source-set-icon-stock widget icon))
466	; (vector )
467	(pathname (let ((pixbuf (gdk:pixbuf-load icon)))
468	(%drag-source-set-icon-pixbuf widget pixbuf)))))
469
470	(defbinding drag-source-unset () nil
471	(widget widget))
472
473	(defbinding drag-source-set-target-list () nil
474	(widget widget)
475	(targets (or null target-list)))
476
477	(defbinding drag-source-get-target-list () target-list
478	(widget widget))
479
f957f519	480	#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
8cd52853	481	(progn
	482	(defbinding drag-source-add-text-targets () nil
	483	(widget widget))
	484
	485	(defbinding drag-source-add-image-targets () nil
	486	(widget widget))
	487
	488	(defbinding drag-source-add-uri-targets () nil
	489	(widget widget)))