[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.15 2008-04-11 18:38:56 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)
  ((or info 0) 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  &optional info writable-p) nil
    (target-list target-list)
    ((or info 0) unsigned-int)
    (writable-p boolean))
  
  (defbinding target-list-add-image-targets (target-list &optional info writable-p) nil
    (target-list target-list)
    ((or info 0) unsigned-int)
    (writable-p boolean))

  (defbinding target-list-add-uri-targets (target-list &optional info writable-p) nil
    (target-list target-list)
    ((or info 0) 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 'vector #'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))))

;; Deprecated, use clipboard-set-contents
(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-contents (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))

(defgeneric clipboard-set (clipboard object))

(defmethod clipboard-set ((clipboard clipboard) (text string))
  (clipboard-set-text clipboard text))

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

(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 'vector #'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 'vector #'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)
  (stock-id string))

(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
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
fb90f18d	23	;; $Id: gtkselection.lisp,v 1.15 2008-04-11 18:38:56 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)
9176d301	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)
a1bba49e	47	(flags target-flags)
60b4d2eb	48	((or info 0) unsigned-int))
8b70d560	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
60b4d2eb	63	(defbinding target-list-add-text-targets (target-list &optional info writable-p) nil
8b70d560	64	(target-list target-list)
60b4d2eb	65	((or info 0) unsigned-int)
8b70d560	66	(writable-p boolean))
8b70d560	67
60b4d2eb	68	(defbinding target-list-add-image-targets (target-list &optional info writable-p) nil
8b70d560	69	(target-list target-list)
60b4d2eb	70	((or info 0) unsigned-int)
8b70d560	71	(writable-p boolean))
8b70d560	72
60b4d2eb	73	(defbinding target-list-add-uri-targets (target-list &optional info writable-p) nil
8b70d560	74	(target-list target-list)
60b4d2eb	75	((or info 0) unsigned-int)
8b70d560	76	(writable-p boolean)))
8b70d560	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)
11e5e1f8	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)
a1bba49e	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)
a1bba49e	129	((gdk:atom-intern target) gdk:atom)
8b70d560	130	(time unsigned-int))
8b70d560	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
fb90f18d	172	(map 'vector #'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))
8b70d560	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
56ccd5b7	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
56ccd5b7	200	((clipboard pointer) (callback-ids unsigned-int))
9b662d94	201	(declare (ignore clipboard))
56ccd5b7	202	(funcall (cdr (find-user-data callback-ids))))
8b70d560	203
c0ede953	204	;; Deprecated, use clipboard-set-contents
646c5a74	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)
56ccd5b7	210	(%clipboard-clear-callback callback)
8b70d560	211	((register-user-data (cons get-func clear-func)) unsigned-int))
8b70d560	212
c0ede953	213	(defun clipboard-set-contents (clipboard targets get-func &optional clear-func)
d08763df	214	(clipboard-set-with-data clipboard (ensure-target-table targets)
a1bba49e	215	get-func (or clear-func #'(lambda ()))))
a1bba49e	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
60b4d2eb	230	(defgeneric clipboard-set (clipboard object))
	231
	232	(defmethod clipboard-set ((clipboard clipboard) (text string))
	233	(clipboard-set-text clipboard text))
	234
	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))
8b70d560	238
56ccd5b7	239	(define-callback-marshal %clipboard-receive-callback nil
56ccd5b7	240	((:ignore clipboard) selection-data))
8b70d560	241
	242	(defbinding clipboard-request-contents (clipboard target callback) nil
	243	(clipboard clipboard)
	244	((gdk:atom-intern target) gdk:atom)
56ccd5b7	245	(%clipboard-receive-callback callback)
8b70d560	246	((register-callback-function callback) unsigned-int))
8b70d560	247
56ccd5b7	248	(define-callback-marshal %clipboard-text-receive-callback nil
	249	((:ignore clipboard) (text string)))
	250
8b70d560	251
	252	(defbinding clipboard-request-text (clipboard callback) nil
	253	(clipboard clipboard)
56ccd5b7	254	(%clipboard-text-receive-callback callback)
8b70d560	255	((register-callback-function callback) unsigned-int))
8b70d560	256
8ab0db90	257	#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
8b70d560	258	(progn
56ccd5b7	259	(define-callback-marshal %clipboard-image-receive-callback nil
56ccd5b7	260	((:ignore clipboard) (image gdk:pixbuf)))
8b70d560	261
	262	(defbinding clipboard-request-image (clipboard callback) nil
	263	(clipboard clipboard)
56ccd5b7	264	(%clipboard-image-receive-callback callback)
8b70d560	265	((register-callback-function callback) unsigned-int)))
	266
	267
56ccd5b7	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))
8ab0db90	271	(declare (ignore clipboard))
fb90f18d	272	(funcall (find-user-data callback-id) (map 'vector #'gdk:atom-name atoms)))
8b70d560	273
	274	(defbinding clipboard-request-targets (clipboard callback) nil
	275	(clipboard clipboard)
56ccd5b7	276	(%clipboard-targets-receive-callback callback)
8b70d560	277	((register-callback-function callback) unsigned-int))
8b70d560	278
a1bba49e	279	(defbinding clipboard-wait-for-contents (clipboard target) selection-data
	280	(clipboard clipboard)
	281	((gdk:atom-intern target) gdk:atom))
8b70d560	282
	283	(defbinding clipboard-wait-for-text () string
	284	(clipboard clipboard))
	285
8ab0db90	286	#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
8b70d560	287	(defbinding clipboard-wait-for-image () (referenced gdk:pixbuf)
	288	(clipboard clipboard))
	289
	290	(defbinding clipboard-wait-is-text-available-p () boolean
	291	(clipboard clipboard))
	292
8ab0db90	293	#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
8b70d560	294	(defbinding clipboard-wait-is-image-available-p () boolean
	295	(clipboard clipboard))
	296
a1bba49e	297	(defbinding %clipboard-wait-for-targets () boolean
8b70d560	298	(clipboard clipboard)
	299	(targets (vector gdk:atom n-targets) :out)
	300	(n-targets unsigned-int :out))
	301
a1bba49e	302	(defun clipboard-wait-for-targets (clipboard)
	303	(multiple-value-bind (valid-p targets)
	304	(%clipboard-wait-for-targets clipboard)
	305	(when valid-p
fb90f18d	306	(map 'vector #'gdk:atom-name targets))))
a1bba49e	307
8ab0db90	308	#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
a1bba49e	309	(defbinding clipboard-wait-is-target-available-p (clipboard target) boolean
8b70d560	310	(clipboard clipboard)
a1bba49e	311	((gdk:atom-intern target) gdk:atom))
8b70d560	312
8ab0db90	313	#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
a1bba49e	314	(defbinding clipboard-set-can-store (clipboard targets) nil
8b70d560	315	(clipboard clipboard)
a1bba49e	316	((map 'vector #'gdk:atom-intern targets) (vector gdk:atom))
8b70d560	317	((length targets) int))
8b70d560	318
8ab0db90	319	#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
8b70d560	320	(defbinding clipboard-store () nil
	321	(clipboard clipboard))
	322
35721da7	323
8b70d560	324	;;;; Drag and Drop
	325
	326	(defbinding drag-dest-set (widget flags targets actions) nil
	327	(widget widget)
	328	(flags dest-defaults)
	329	((etypecase targets
	330	((or vector list) targets)
	331	(target-entry (vector targets)))
	332	(vector (inlined target-entry)))
	333	((etypecase targets
	334	((or vector list) (length targets))
	335	(target-entry 1))
	336	int)
	337	(actions gdk:drag-action))
	338
	339	(defbinding drag-dest-set-proxy () nil
	340	(widget widget)
	341	(window gdk:window)
	342	(protocol gdk:drag-protocol)
	343	(use-coordinates-p boolean))
	344
	345	(defbinding drag-dest-unset () nil
	346	(widget widget))
	347
	348	(defbinding drag-dest-find-target () gdk:atom
	349	(widget widget)
	350	(context gdk:drag-context)
	351	(targets target-list))
	352
	353	(defbinding drag-dest-get-target-list () target-list
	354	(widget widget))
	355
	356	(defbinding drag-dest-set-target-list () nil
	357	(widget widget)
	358	(targets target-list))
	359
8ab0db90	360	#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
8b70d560	361	(progn
	362	(defbinding drag-dest-add-text-targets () nil
	363	(widget widget))
	364
	365	(defbinding drag-dest-add-image-targets () nil
	366	(widget widget))
	367
	368	(defbinding drag-dest-add-uri-targets () nil
	369	(widget widget)))
	370
	371	(defbinding drag-finish () nil
	372	(context gdk:drag-context)
	373	(success boolean)
	374	(delete boolean)
	375	(time unsigned-int))
	376
	377	(defbinding drag-get-data () nil
	378	(widget widget)
	379	(context gdk:drag-context)
	380	(target gdk:atom)
	381	(time unsigned-int))
	382
	383	(defbinding drag-get-source-widget () widget
	384	(context gdk:drag-context))
	385
	386	(defbinding drag-highlight () nil
	387	(widget widget))
	388
	389	(defbinding drag-unhighlight () nil
	390	(widget widget))
	391
	392	(defbinding drag-begin () gdk:drag-context
	393	(widget widget)
	394	(targets target-list)
	395	(actions gdk:drag-action)
	396	(button int)
	397	(event gdk:event))
	398
	399	(defbinding %drag-set-icon-widget () nil
	400	(context gdk:drag-context)
	401	(widget widget)
	402	(hot-x int)
	403	(hot-y int))
	404
	405	(defbinding %drag-set-icon-pixmap () nil
	406	(context gdk:drag-context)
	407	(pixmap gdk:pixmap)
	408	(mask gdk:bitmap)
	409	(hot-x int)
	410	(hot-y int))
	411
	412	(defbinding %drag-set-icon-pixbuf () nil
	413	(context gdk:drag-context)
	414	(pixbuf gdk:pixbuf)
	415	(hot-x int)
	416	(hot-y int))
	417
	418	(defbinding %drag-set-icon-stock () nil
	419	(context gdk:drag-context)
	420	(stock-id string)
	421	(hot-x int)
	422	(hot-y int))
	423
	424	(defbinding %drag-set-icon-default () nil
425	(context gdk:drag-context))
426
427	(defun drag-set-icon (context icon &optional (hot-x 0) (hot-y 0))
428	(etypecase icon
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))))
437
438	(defbinding drag-check-threshold-p () boolean
439	(widget widget)
440	(start-x int)
441	(start-y int)
442	(current-x int)
443	(current-y int))
444
445	(defbinding drag-source-set (widget start-button-mask targets actions) nil
446	(widget widget)
447	(start-button-mask gdk:modifier-type)
448	((etypecase targets
449	((or vector list) targets)
450	(target-entry (vector targets)))
451	(vector (inlined target-entry)))
452	((etypecase targets
453	((or vector list) (length targets))
454	(target-entry 1))
455	int)
456	(actions gdk:drag-action))
457
458	(defbinding %drag-source-set-icon-pixbuf () nil
459	(widget widget)
460	(pixbuf gdk:pixbuf))
461
462	(defbinding %drag-source-set-icon-stock () nil
463	(widget widget)
fb90f18d	464	(stock-id string))
8b70d560	465
	466	(defun drag-source-set-icon (widget icon)
	467	(etypecase icon
	468	(gdk:pixbuf (%drag-source-set-icon-pixbuf widget icon))
	469	(string (%drag-source-set-icon-stock widget icon))
	470	; (vector )
	471	(pathname (let ((pixbuf (gdk:pixbuf-load icon)))
	472	(%drag-source-set-icon-pixbuf widget pixbuf)))))
	473
	474	(defbinding drag-source-unset () nil
	475	(widget widget))
	476
	477	(defbinding drag-source-set-target-list () nil
	478	(widget widget)
	479	(targets (or null target-list)))
	480
	481	(defbinding drag-source-get-target-list () target-list
	482	(widget widget))
	483
8ab0db90	484	#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
8b70d560	485	(progn
	486	(defbinding drag-source-add-text-targets () nil
	487	(widget widget))
	488
	489	(defbinding drag-source-add-image-targets () nil
	490	(widget widget))
	491
	492	(defbinding drag-source-add-uri-targets () nil
	493	(widget widget)))