/[cffi-objects]/object.lisp
ViewVC logotype

Diff of /object.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1 by rklochkov, Thu Feb 9 15:53:55 2012 UTC revision 3 by rklochkov, Fri May 4 11:25:20 2012 UTC
# Line 31  shouldn't be stored in *OBJECTS*. Stored Line 31  shouldn't be stored in *OBJECTS*. Stored
31    (tg:cancel-finalization object)    (tg:cancel-finalization object)
32    (when (and (slot-value object 'free-after) (not (null-pointer-p value)))    (when (and (slot-value object 'free-after) (not (null-pointer-p value)))
33      (let ((class (class-of object)))      (let ((class (class-of object)))
34        (tg:finalize object (lambda ()        (format t "Set finalizer: ~a ~a ~a~%" object class value)
35          (tg:finalize object (lambda ()
36                                (format t "Finalize: ~a ~a~%" class value)
37                              (free-ptr class value)))))                              (free-ptr class value)))))
38                                          ; specialize EQL CLASS to override                                          ; specialize EQL CLASS to override
39    (unless (or (volatile object) (null-pointer-p value))    (unless (or (volatile object) (null-pointer-p value))
# Line 77  for example, by g_object_new.")) Line 79  for example, by g_object_new."))
79  If not found or found with wrong class, create new one with given CLASS"  If not found or found with wrong class, create new one with given CLASS"
80    (declare (type symbol class) (type foreign-pointer pointer))    (declare (type symbol class) (type foreign-pointer pointer))
81    (unless (null-pointer-p pointer)    (unless (null-pointer-p pointer)
82      (let  ((try-find (gethash (pointer-address pointer) *objects*)))      (let ((try-find (gethash (pointer-address pointer) *objects*)))
83        (if class        (if class
84            (progn            (progn
85              (unless (or (null try-find)              (unless (or (null try-find)
# Line 85  If not found or found with wrong class, Line 87  If not found or found with wrong class,
87                (progn                (progn
88                  (free try-find)                  (free try-find)
89                  (setf try-find nil)))                  (setf try-find nil)))
90              (or try-find (make-instance class :pointer pointer)))              (or try-find (make-instance class
91                                            :pointer pointer
92                                            :free-after nil)))
93          try-find))))          try-find))))
94    
95  (defun object-by-id (id-key)  (defun object-by-id (id-key)
# Line 117  If not found or found with wrong class, Line 121  If not found or found with wrong class,
121                                   (type cffi::foreign-pointer-type))                                   (type cffi::foreign-pointer-type))
122    (null-pointer))    (null-pointer))
123    
124    ;; nil = null string
125    (defmethod translate-to-foreign ((value null)
126                                     (type cffi::foreign-string-type))
127      (null-pointer))
128    
129    
130  (defmethod translate-to-foreign (value (type cffi-object))  (defmethod translate-to-foreign (value (type cffi-object))
131    (check-type value foreign-pointer)    (check-type value foreign-pointer)
132    value)    value)

Legend:
Removed from v.1  
changed lines
  Added in v.3

  ViewVC Help
Powered by ViewVC 1.1.5