[gtk-cffi-cvs] CVS gtk-cffi/cffi

[CVS User rklochkov]

Update of /project/gtk-cffi/cvsroot/gtk-cffi/cffi
In directory tiger.common-lisp.net:/tmp/cvs-serv16215/cffi

Modified Files:
	cffi-object.asd object.lisp package.lisp string.lisp 
Log Message:
Added GTK3 support. Dropped GTK2 support.
Refactored CFFI layer.



--- /project/gtk-cffi/cvsroot/gtk-cffi/cffi/cffi-object.asd	2011/04/25 19:16:08	1.1.1.1
+++ /project/gtk-cffi/cvsroot/gtk-cffi/cffi/cffi-object.asd	2011/08/26 17:16:13	1.2
@@ -14,9 +14,10 @@
   :author "Roman Klochkov <kalimehtar at mail.ru>"
   :version "0.9"
   :license "BSD"
-  :depends-on (cffi)
+  :depends-on (cffi iterate gtk-cffi-utils)
   :components
-  ((:file :package)
-   (:file :object :depends-on (:package))
-   (:file :pfunction :depends-on (:package))
-   (:file :string :depends-on (:package))))
\ No newline at end of file
+  ((:file package)
+   (:file object :depends-on (package))
+   (:file pfunction :depends-on (package))
+   (:file string :depends-on (package))
+   (:file struct :depends-on (package))))
--- /project/gtk-cffi/cvsroot/gtk-cffi/cffi/object.lisp	2011/08/08 15:02:01	1.2
+++ /project/gtk-cffi/cvsroot/gtk-cffi/cffi/object.lisp	2011/08/26 17:16:13	1.3
@@ -7,11 +7,6 @@
 
 (in-package :cffi-object)
 
-(defmacro debug-out (&body body)
-;  (declare (ignore body))
-  `(format t , at body)
-  )
-
 (defvar *objects* (make-hash-table)
   "Hash table: foreign-pointer address as integer -> lisp object")
 
@@ -47,9 +42,10 @@
   (format t "No constructor for ~a ~a~%" something-bad rest)
   nil)
 
-(defmethod initialize-instance ((object object) &rest initargs
-                                &key pointer &allow-other-keys)
-  (call-next-method) ;; should be here to initialize VOLATILE slot
+(defmethod shared-initialize :after ((object object) slot-names 
+                              &rest initargs
+                              &key pointer &allow-other-keys)
+;  (call-next-method) ;; should be here to initialize VOLATILE slot
   (setf (pointer object)
         (or pointer (apply #'gconstructor (cons object initargs)))))
 
@@ -62,8 +58,8 @@
   (:documentation "Removes object pointer from lisp hashes."))
 
 (defmethod free ((object object))
-  (debug-out "Freeing ~a~%" object) 
   (when (pointer object)
+    (debug-out "Freeing ~a@~a~%" (type-of object) (pointer object)) 
     (remhash (pointer-address (pointer object)) *objects*)
     (remhash (id object) *objects-ids*)
     (setf (pointer object) (null-pointer)
@@ -95,7 +91,6 @@
 (define-foreign-type cffi-object ()
   ((class :initarg :class :accessor obj-class))
   (:actual-type :pointer))
-;  (:simple-parser object))
 
 (define-parse-method object (&optional class)
   (make-instance 'cffi-object :class class))
@@ -106,11 +101,19 @@
 (defmethod translate-to-foreign ((value object) (type cffi-object))
   (pointer value))
 
+(defmethod translate-to-foreign ((value object) 
+                                 (type cffi::foreign-pointer-type))
+  (pointer value))
+
+(defmethod translate-to-foreign ((value null) 
+                                 (type cffi::foreign-pointer-type))
+  (null-pointer))
+
+
 (defmethod translate-to-foreign (value (type cffi-object))
   (check-type value foreign-pointer)
   value)
 
-
 (defmethod translate-from-foreign (ptr (cffi-object cffi-object))
   (object ptr :class (obj-class cffi-object)))
 
--- /project/gtk-cffi/cvsroot/gtk-cffi/cffi/package.lisp	2011/04/25 19:16:08	1.1.1.1
+++ /project/gtk-cffi/cvsroot/gtk-cffi/cffi/package.lisp	2011/08/26 17:16:13	1.2
@@ -10,11 +10,9 @@
 (in-package #:cl-user)
 
 (defpackage #:cffi-object
-  (:use #:common-lisp #:cffi)
+  (:use #:iterate #:common-lisp #:cffi #:gtk-cffi-utils)
   (:export
 
-   #:debug-out
-
    #:gconstructor
 
    #:object
@@ -29,4 +27,7 @@
    #:gtk-dyn-string
    #:gtk-new-string
    #:pfunction
-   #:cffi-object))
\ No newline at end of file
+   #:cffi-object
+
+   #:defcstruct-accessors
+   #:defcstruct*))
--- /project/gtk-cffi/cvsroot/gtk-cffi/cffi/string.lisp	2011/04/25 19:16:08	1.1.1.1
+++ /project/gtk-cffi/cvsroot/gtk-cffi/cffi/string.lisp	2011/08/26 17:16:13	1.2
@@ -26,9 +26,9 @@
 (defmethod translate-from-foreign (ptr (name gtk-string))
   (foreign-string-to-lisp ptr :encoding :utf-8))
 
-(defmethod free-translated-object (value (name gtk-string) free-p)
-  (when free-p
-    (foreign-string-free value)))
+(defmethod free-translated-object (value (name gtk-string) param)
+  (declare (ignore param))
+  (foreign-string-free value))
 
 (define-foreign-type gtk-dyn-string ()
   ()