[cffi-objects-cvs] r7 -

[rklochkov at common-lisp.net]

Author: rklochkov
Date: Thu Aug  9 09:55:23 2012
New Revision: 7

Log:
Added function INITIALIZE

Modified:
   object.lisp
   package.lisp
   redefines.lisp
   setters.lisp
   struct.lisp

Modified: object.lisp
==============================================================================
--- object.lisp	Sun Jul 29 09:11:18 2012	(r6)
+++ object.lisp	Thu Aug  9 09:55:23 2012	(r7)
@@ -22,6 +22,8 @@
              :documentation "Will not be saved in hash")
    (free-after :type boolean :initarg :free-after :initform t
                :documentation "Should be freed by finalizer")
+   (initialized :type list :initform nil 
+                :documentation "For SETF-INIT. To avoid double-init")
    (id :type symbol :accessor id :initarg :id :initform nil))
   (:documentation "Lisp wrapper for any object. VOLATILE slot set when object
 shouldn't be stored in *OBJECTS*. Stored pointer GC'ed, if VOLATILE."))

Modified: package.lisp
==============================================================================
--- package.lisp	Sun Jul 29 09:11:18 2012	(r6)
+++ package.lisp	Thu Aug  9 09:55:23 2012	(r7)
@@ -24,6 +24,7 @@
    #:free-after
    #:find-object
    #:object-by-id
+   #:initialize
    #:*objects*
    #:*objects-ids*
    #:object-class
@@ -47,6 +48,7 @@
 
    #:cffi-keyword
    #:cffi-pathname
+   #:cffi-string
 
    #:struct
 ;   #:cffi-struct

Modified: redefines.lisp
==============================================================================
--- redefines.lisp	Sun Jul 29 09:11:18 2012	(r6)
+++ redefines.lisp	Thu Aug  9 09:55:23 2012	(r7)
@@ -31,7 +31,7 @@
 (defmethod translate-from-foreign (ptr (type cffi-string))
   (foreign-string-to-lisp ptr))
 
-(define-foreign-type cffi-keyword ()
+(define-foreign-type cffi-keyword (freeable)
   ()
   (:simple-parser cffi-keyword)
   (:actual-type :string))
@@ -42,7 +42,7 @@
 (defmethod translate-to-foreign ((value string) (type cffi-keyword))
   (convert-to-foreign value :string))
 
-(define-foreign-type cffi-pathname ()
+(define-foreign-type cffi-pathname (freeable)
   ()
   (:simple-parser cffi-pathname)
   (:actual-type :string))

Modified: setters.lisp
==============================================================================
--- setters.lisp	Sun Jul 29 09:11:18 2012	(r6)
+++ setters.lisp	Thu Aug  9 09:55:23 2012	(r7)
@@ -31,9 +31,21 @@
                        (field-p (if (consp field-all)
                                     (third field-all) field-all)))
                    `(when ,field-p
-                      (setf (,field ,object) ,field))))
+                      (unless (initialized ,object ,field)
+                        (setf (,field ,object) ,field)
+                        (initialize ,object ,field)))))
                fields)))
 
+(defun initialized (obj field)
+  (find field (slot-value obj 'initialized)))
+
+(defun initialize (obj fields)
+  "Used when you need to mark, that FIELDS already initialized"
+  (etypecase fields
+    (list (dolist (field fields)
+            (initialize obj field)))
+    (symbol (push fields (slot-value obj 'initialized)))))
+
 (defun name-p (name)
   (intern (format nil "~a-P" name) (symbol-package name)))
 

Modified: struct.lisp
==============================================================================
--- struct.lisp	Sun Jul 29 09:11:18 2012	(r6)
+++ struct.lisp	Thu Aug  9 09:55:23 2012	(r7)
@@ -22,7 +22,7 @@
   (:method (class value)
     (declare (ignore class))
  ;   (break)
-    (format t "Free ~a ~a~%" class value)
+    ;(format t "Free ~a ~a~%" class value)
     (foreign-free value)))
 
 (defmethod gconstructor ((struct struct) &key new-struct &allow-other-keys)