;; Common Lisp bindings for GTK+ v2.x
-;; Copyright 2005 Espen S. Johnsen <espen@users.sf.net>
+;; 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
;; 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.1 2006-02-06 11:57:27 espen Exp $
+;; $Id: gtkselection.lisp,v 1.15 2008-04-11 18:38:56 espen Exp $
(in-package "GTK")
;;;; Selection
-(defbinding %selection-data-copy () pointer
- (location pointer))
-
-(defbinding %selection-data-free () nil
- (location pointer))
-
-(defmethod reference-foreign ((class (eql (find-class 'selection-data))) location)
- (declare (ignore class))
- (%selection-data-copy location))
-
-(defmethod unreference-foreign ((class (eql (find-class 'selection-data))) location)
- (declare (ignore class))
- (%selection-data-free location))
-
(defbinding %target-list-ref () pointer
(location pointer))
(defbinding %target-list-unref () nil
(location pointer))
-(defmethod reference-foreign ((class (eql (find-class 'target-list))) location)
- (declare (ignore class))
- (%target-list-ref location))
-
-(defmethod unreference-foreign ((class (eql (find-class 'target-list))) location)
- (declare (ignore class))
- (%target-list-unref location))
-
(defbinding %target-list-new () pointer
(targets (vector (inlined target-entry)))
((length targets) int))
-(defmethod initialize-instance ((target-list target-list) &key targets)
- (setf
- (slot-value target-list 'location)
- (%target-list-new targets))
- (call-next-method))
+(defmethod allocate-foreign ((target-list target-list) &key targets)
+ (%target-list-new targets))
-(defbinding target-list-add (target-list targets &optional flags info) nil
+(defbinding target-list-add (target-list target &optional flags info) nil
(target-list target-list)
- (target gdk:atom)
- (flags unsigned-int)
- (info unsigned-int))
+ ((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)
(target-entry 1))
int))
-#+gtk2.6
+#?(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
+ (defbinding target-list-add-text-targets (target-list &optional info writable-p) nil
(target-list target-list)
- (info unsigned-int)
+ ((or info 0) unsigned-int)
(writable-p boolean))
- (defbinding target-list-add-image-targets (target-list info &optional writable-p) nil
+ (defbinding target-list-add-image-targets (target-list &optional info writable-p) nil
(target-list target-list)
- (info unsigned-int)
+ ((or info 0) unsigned-int)
(writable-p boolean))
- (defbinding target-list-add-uri-targets (target-list info &optional writable-p) nil
+ (defbinding target-list-add-uri-targets (target-list &optional info writable-p) nil
(target-list target-list)
- (info unsigned-int)
+ ((or info 0) unsigned-int)
(writable-p boolean)))
-(defbinding target-list-remove () nil
+(defbinding target-list-remove (target-list target) nil
(target-list target-list)
- (target gdk:atom))
+ ((gdk:atom-intern target) gdk:atom))
-;; (defbinding target-list-find () nil
-;; (target-list target-list)
-;; (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))
+ ((gdk:atom-intern selection) gdk:atom)
+ (time (unsigned 32)))
-(defbinding selection-add-target () nil
+(defbinding selection-add-target (widget selection target info) nil
(widget widget)
- (selection gdk:atom)
- (target gdk:atom)
+ ((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)
- (selection gdk:atom)
+ ((gdk:atom-intern selection) gdk:atom)
((etypecase targets
((or vector list) targets)
(target-entry (vector targets)))
(target-entry 1))
int))
-(defbinding selection-clear-targets () nil
+(defbinding selection-clear-targets (widget selection) nil
(widget widget)
- (selection gdk:atom))
+ ((gdk:atom-intern selection) gdk:atom))
-(defbinding selection-convert () boolean
+(defbinding selection-convert (widget selection target time) boolean
(widget widget)
- (selection gdk:atom)
- (target gdk:atom)
+ ((gdk:atom-intern selection) gdk:atom)
+ ((gdk:atom-intern target) gdk:atom)
(time unsigned-int))
-(defbinding selection-data-set () boolean
+(defbinding selection-data-set (selection-data type format data length) boolean
(selection-data selection-data)
- (type gdk:atom)
+ ((gdk:atom-intern type) gdk:atom)
(format int)
(data pointer)
(length int))
(defbinding selection-data-get-text () string
(selection-data selection-data))
-#+gtk2.6
+#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
(progn
(defbinding selection-data-set-pixbuf () boolean
(selection-data selection-data)
(defbinding selection-data-get-uris () (null-terminated-vector string)
(selection-data selection-data)))
-(defbinding selection-data-get-targets () boolean
+(defbinding %selection-data-get-targets () boolean
(selection-data selection-data)
- (targets (vector gdk:atom n-atoms))
- (n-atoms int))
+ (targets (vector gdk:atom n-targets) :out)
+ (n-targets int :out))
-#+gtk2.6
+(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 (selection-data) boolean
+(defbinding selection-data-targets-include-text-p () boolean
(selection-data selection-data))
-(defbinding selection-remove-all (selection-data) boolean
+(defbinding selection-remove-all () boolean
(widget widget))
(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))
-(defcallback %clipboard-get-func (nil (clipboard pointer)
- (selection-data selection-data)
- (info int)
- (user-data unsigned-int))
- (funcall (car (find-user-data user-data)) selection-data info))
-
-(defcallback %clipboard-clear-func (nil (clipboard pointer)
- (user-data unsigned-int))
- (funcall (cdr (find-user-data user-data))))
+(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) gobject
+;; Deprecated, use clipboard-set-contents
+(defbinding clipboard-set-with-data (clipboard targets get-func clear-func) boolean
(clipboard clipboard)
- (targets (vector target-entry))
+ (targets (vector (inlined target-entry)))
((length targets) unsigned-int)
- (%clipboard-get-func callback)
- (%clipboard-clear-func callback)
+ (%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 (clipboard text) nil
+(defbinding clipboard-set-text () nil
(clipboard clipboard)
(text string)
((length text) int))
-#+gtk2.6
+#?(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))
- #+gtk2.6
- (gdk:pixbuf (clipboard-set-image clipboard object))))
+(defgeneric clipboard-set (clipboard object))
-(defcallback %clipboard-receive-func (nil (clipboard pointer)
- (selection-data selection-data)
- (user-data unsigned-int))
- (funcall (find-user-data user-data) selection-data))
+(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-func callback)
+ (%clipboard-receive-callback callback)
((register-callback-function callback) unsigned-int))
-(defcallback %clipboard-text-receive-func (nil (clipboard pointer)
- (text (copy-of string))
- (user-data unsigned-int))
- (funcall (find-user-data user-data) text))
+(define-callback-marshal %clipboard-text-receive-callback nil
+ ((:ignore clipboard) (text string)))
+
(defbinding clipboard-request-text (clipboard callback) nil
(clipboard clipboard)
- (%clipboard-text-receive-func callback)
+ (%clipboard-text-receive-callback callback)
((register-callback-function callback) unsigned-int))
-#+gtk2.6
+#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
(progn
- (defcallback %clipboard-image-receive-func (nil (clipboard pointer)
- (image gdk:pixbuf)
- (user-data unsigned-int))
- (funcall (find-user-data user-data) image))
+ (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-func callback)
+ (%clipboard-image-receive-callback callback)
((register-callback-function callback) unsigned-int)))
-(defcallback %clipboard-targets-receive-func
- (nil (clipboard pointer)
- (atoms (vector gdk:atom n-atoms))
- (n-atoms unsigned-int)
- (user-data unsigned-int))
- (funcall (find-user-data user-data) atoms))
+(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-func callback)
+ (%clipboard-targets-receive-callback callback)
((register-callback-function callback) unsigned-int))
-(defbinding clipboard-wait-for-contents () selection-data
- (clipboard clipboard))
+(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))
-#+gtk2.6
+#?(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))
-#+gtk2.6
+#?(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
+(defbinding %clipboard-wait-for-targets () boolean
(clipboard clipboard)
(targets (vector gdk:atom n-targets) :out)
(n-targets unsigned-int :out))
-#+gtk2.6
-(defbinding clipboard-wait-is-target-available-p () boolean
+(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)
- (target gdk:atom))
+ ((gdk:atom-intern target) gdk:atom))
-#+gtk2.6
-(defbinding clipboard-set-can-store () nil
+#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
+(defbinding clipboard-set-can-store (clipboard targets) nil
(clipboard clipboard)
- (targets (vector gdk:atom))
+ ((map 'vector #'gdk:atom-intern targets) (vector gdk:atom))
((length targets) int))
-#+gtk2.6
+#?(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)
(targets target-list))
-#+gtk2.6
+#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
(progn
(defbinding drag-dest-add-text-targets () nil
(widget widget))
(defbinding %drag-source-set-icon-stock () nil
(widget widget)
- (pixbuf gdk:pixbuf))
+ (stock-id string))
(defun drag-source-set-icon (widget icon)
(etypecase icon
(defbinding drag-source-get-target-list () target-list
(widget widget))
-#+gtk2.6
+#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
(progn
(defbinding drag-source-add-text-targets () nil
(widget widget))
~mdw / clg / blobdiff