;; 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.6 2006/02/19 19:31:15 espen Exp $
+;; $Id: gtkselection.lisp,v 1.14 2008/01/02 16:01:17 espen Exp $
(in-package "GTK")
(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))
(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))
+
+(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))))
-#+gtk2.6
+#?(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 () boolean
(display gdk:display)
((gdk:atom-intern selection) gdk:atom))
-
(define-callback %clipboard-get-callback nil
((clipboard pointer) (selection-data selection-data)
- (info int) (callback-ids unsigned-int))
+ (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) gobject
+;; 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-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))
+
+(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))
(%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
(define-callback-marshal %clipboard-image-receive-callback nil
((:ignore clipboard) (image gdk:pixbuf)))
(define-callback %clipboard-targets-receive-callback nil
((clipboard pointer) (atoms (vector gdk:atom n-atoms))
(n-atoms unsigned-int) (callback-id unsigned-int))
- (funcall (find-user-data callback-id) atoms))
+ (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 () 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-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)
- (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))
(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-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