[gtk-cffi-cvs] CVS gtk-cffi/g-object
CVS User rklochkov
rklochkov at common-lisp.net
Wed Jan 25 19:15:08 UTC 2012
Update of /project/gtk-cffi/cvsroot/gtk-cffi/g-object
In directory tiger.common-lisp.net:/tmp/cvs-serv31071/g-object
Modified Files:
defslots.lisp g-type.lisp loadlib.lisp package.lisp
pobject.lisp
Log Message:
Refactored freeable
Added loadlib to gio
Fixed compilation without loading
--- /project/gtk-cffi/cvsroot/gtk-cffi/g-object/defslots.lisp 2012/01/21 18:35:00 1.7
+++ /project/gtk-cffi/cvsroot/gtk-cffi/g-object/defslots.lisp 2012/01/25 19:15:08 1.8
@@ -13,6 +13,9 @@
(defun register-prefix (package prefix)
(push (cons package prefix) *gtk-prefixes*))
+(defun get-prefix ()
+ (cdr (assoc *package* *gtk-prefixes*)))
+
(defun pair (maybe-pair)
(if (consp maybe-pair) maybe-pair (cons maybe-pair maybe-pair)))
@@ -34,7 +37,7 @@
(template ((defgtkslot 'gtk)
(defgdkslot 'gdk)
- (defslot (assoc *package* *gtk-prefixes*)))
+ (defslot (get-prefix)))
(destructuring-bind (name prefix) param
`(defmacro ,name (current-class slot-name slot-type)
(expand-defslot ,prefix current-class slot-name slot-type))))
@@ -49,7 +52,7 @@
(template ((defgtkslots 'gtk)
(defgdkslots 'gdk)
- (defslots (assoc *package* *gtk-prefixes*)))
+ (defslots (get-prefix)))
(destructuring-bind (name prefix) param
`(defmacro ,name (current-class &rest slots)
(expand-defslots ,prefix current-class slots))))
@@ -68,14 +71,14 @@
(template ((defgtkfun 'gtk)
(defgdkfun 'gdk)
- (deffun (assoc *package* *gtk-prefixes*)))
+ (deffun (get-prefix)))
(destructuring-bind (name prefix) param
`(defmacro ,name (name res-type class &rest params)
(expand-deffun ,prefix name res-type class params))))
(template ((defgtkgetter 'gtk)
(defgdkgetter 'gdk)
- (defgetter (assoc *package* *gtk-prefixes*)))
+ (defgetter (get-prefix)))
(destructuring-bind (name prefix) param
`(defmacro ,name (name res-type class &rest params)
(expand-deffun ,prefix name res-type class params :get t))))
@@ -83,7 +86,7 @@
(defun expand-defsetter (prefix name slot-type class params last)
(destructuring-bind (name-lisp . name-gtk) (pair name)
- (let ((setter (symbolicate prefix class '-set- name-gtk))
+ (let ((setter (symbolicate prefix '- class '-set- name-gtk))
(param-list (mapcar #'car params)))
`(progn
,(unless params `(save-setter ,class ,name-lisp))
@@ -99,7 +102,7 @@
(template ((defgtksetter 'gtk)
(defgdksetter 'gdk)
- (defsetter (assoc *package* *gtk-prefixes*)))
+ (defsetter (get-prefix)))
(destructuring-bind (name prefix) param
`(defmacro ,name (name slot-type class last &rest params)
(expand-defsetter ,prefix name slot-type class params last))))
@@ -122,7 +125,7 @@
(template ((defgtkfuns 'gtk)
(defgdkfuns 'gdk)
- (deffuns (assoc *package* *gtk-prefixes*)))
+ (deffuns (get-prefix)))
(destructuring-bind (name prefix) param
`(defmacro ,name (class &rest funs)
(expand-deffuns ,prefix class funs))))
--- /project/gtk-cffi/cvsroot/gtk-cffi/g-object/g-type.lisp 2011/09/10 16:26:10 1.4
+++ /project/gtk-cffi/cvsroot/gtk-cffi/g-object/g-type.lisp 2012/01/25 19:15:08 1.5
@@ -31,7 +31,7 @@
(defcstruct g-type-instance
"GTypeInstance"
- (g-class (:pointer g-type-class)))
+ (g-class g-type-class))
(defun g-type-from-instance (ptr)
(foreign-slot-value
--- /project/gtk-cffi/cvsroot/gtk-cffi/g-object/loadlib.lisp 2011/04/25 19:16:08 1.1.1.1
+++ /project/gtk-cffi/cvsroot/gtk-cffi/g-object/loadlib.lisp 2012/01/25 19:15:08 1.2
@@ -8,8 +8,9 @@
(in-package #:g-object-cffi)
-(define-foreign-library :g-object
- (:unix "libgobject-2.0.so")
- (:windows "libgobject-2.0-0.dll"))
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (define-foreign-library :g-object
+ (:unix "libgobject-2.0.so")
+ (:windows "libgobject-2.0-0.dll"))
-(load-foreign-library :g-object)
\ No newline at end of file
+ (load-foreign-library :g-object))
\ No newline at end of file
--- /project/gtk-cffi/cvsroot/gtk-cffi/g-object/package.lisp 2011/10/23 08:39:53 1.7
+++ /project/gtk-cffi/cvsroot/gtk-cffi/g-object/package.lisp 2012/01/25 19:15:08 1.8
@@ -61,6 +61,7 @@
#:register-type
#:register-package
+ #:register-prefix
#:ref
#:unref
@@ -75,16 +76,27 @@
#:make-closure
; utility functions
+ #:defslot
+ #:defgdkslot
#:defgtkslot
+
+ #:defslots
#:defgtkslots
- #:defgdkslot
#:defgdkslots
+
+ #:defgetter
#:defgtkgetter
#:defgdkgetter
+
+ #:defsetter
#:defgtksetter
#:defgdksetter
+
+ #:deffun
#:defgtkfun
#:defgdkfun
+
+ #:deffuns
#:defgtkfuns
#:defgdkfuns
--- /project/gtk-cffi/cvsroot/gtk-cffi/g-object/pobject.lisp 2011/09/21 12:03:47 1.4
+++ /project/gtk-cffi/cvsroot/gtk-cffi/g-object/pobject.lisp 2012/01/25 19:15:08 1.5
@@ -49,15 +49,13 @@
(foreign-free data)))
-(define-foreign-type cffi-pdata (cffi-pobject freeable)
+(define-foreign-type cffi-pdata (cffi-pobject freeable-base)
()
(:actual-type :pointer)
+ (:simple-parser pdata)
(:documentation "PDATA lets send any data via a c-pointer. C-pointer used as
an id for the data. NB! Don't forget to free pointers after use."))
-(define-parse-method pdata (&key free)
- (make-instance 'cffi-pdata :free free))
-
(defmethod free-ptr ((type cffi-pdata) object)
; it's not typo:
;we free object, not pointer
@@ -68,7 +66,7 @@
(let ((obj (object ptr)))
(if obj
(typecase obj
- (storage (prog1 (data obj) (free-if-needed type obj)))
+ (storage (prog1 (data obj) (free-returned-if-needed type obj)))
(t obj))
ptr)))
@@ -86,7 +84,7 @@
(defmethod free-translated-object (any-data (type cffi-pdata) param)
(when param
- (free-if-needed type param)))
+ (free-sent-if-needed type param)))
;; (defmethod translate-to-foreign :around ((any-data storage) (name cffi-pdata))
;; (call-next-method any-data name))
@@ -102,7 +100,7 @@
;; (mapcar (lambda (x) (convert-from-foreign x 'pobject))
;; (call-next-method)))
-(defctype g-list-object (g-list pobject))
+(defctype g-list-object (g-list :elt pobject))
(defcfun g-type-interface-peek-parent pobject (iface pobject))
More information about the gtk-cffi-cvs
mailing list