Proxies may now have "weak" references to the foreign object

diff --git a/glib/gtype.lisp b/glib/gtype.lisp
index 7c368922d81bc9d029e702fd57505dcac21a58eb..2498302a8c839f490607f4528a5cc602f0f8201f 100644 (file)
--- a/glib/gtype.lisp
+++ b/glib/gtype.lisp
@@ -20,7 +20,7 @@
 ;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
 ;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
 
-;; $Id: gtype.lisp,v 1.39 2006-02-05 15:38:57 espen Exp $
+;; $Id: gtype.lisp,v 1.40 2006-02-06 11:52:24 espen Exp $
 
 (in-package "GLIB")
 
@@ -302,7 +302,6 @@              (default-alien-type-name class-name)))
       (warn "~A is the super type for ~A in the gobject type system."
        (supertype type-number) class-name))))
 
-
 (defmethod validate-superclass ((class ginstance-class) (super standard-class))
   (subtypep (class-name super) 'ginstance))
 
@@ -344,6 +343,10 @@ (defmethod make-proxy-instance ((class ginstance-class) location &rest initargs)
   ;; and therefor ignore the weak-p argument.
   (call-next-method class location :weak nil))
 
+(defmethod invalidate-instance ((instance ginstance))
+  (declare (ignore instance))
+  ;; A ginstance should never be invalidated since it is ref counted
+  nil)
 
 (defmethod copy-from-alien-form (location (class ginstance-class) &rest args)
   (declare (ignore location class args))

diff --git a/glib/proxy.lisp b/glib/proxy.lisp
index 5f0e5cfb24308aa22c31484d01cf50ce02c7fbe4..ff08b84900ce8df8736615ee638c49253a0b8e1a 100644 (file)
--- a/glib/proxy.lisp
+++ b/glib/proxy.lisp
@@ -20,7 +20,7 @@
 ;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
 ;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
 
-;; $Id: proxy.lisp,v 1.25 2006-02-05 15:38:57 espen Exp $
+;; $Id: proxy.lisp,v 1.26 2006-02-06 11:52:24 espen Exp $
 
 (in-package "GLIB")
 
@@ -270,6 +270,7 @@ (defun list-cached-instances ()
 
 ;;;; Proxy for alien instances
 
+;; TODO: add a ref-counted-proxy subclass
 (defclass proxy ()
   ((location :allocation :special :reader foreign-location :type pointer))
   (:metaclass virtual-slots-class))
@@ -277,6 +278,7 @@ (defclass proxy ()
 (defgeneric instance-finalizer (object))
 (defgeneric reference-foreign (class location))
 (defgeneric unreference-foreign (class location))
+(defgeneric invalidate-instance (object))
 
 (defmethod reference-foreign ((name symbol) location)
   (reference-foreign (find-class name) location))
@@ -310,6 +312,10 @@ (defmethod instance-finalizer ((instance proxy))
        (remove-cached-instance location)
        (unreference-foreign class location))))
 
+(defmethod invalidate-instance ((instance proxy))
+  (remove-cached-instance (foreign-location instance))
+  (slot-makunbound instance 'location))
+
 
 ;;;; Metaclass used for subclasses of proxy
 
@@ -509,7 +515,10 @@ (defun ensure-proxy-instance (class location &rest initargs)
 MAKE-PROXY-INSTANCE is called to create one."
   (unless (null-pointer-p location)
     (or 
-     (find-cached-instance location)
+     (let ((instance (find-cached-instance location)))
+       (when instance
+        (format t "Object found in cache: ~A~%" instance)
+        instance))
      (let ((instance (apply #'make-proxy-instance class location initargs)))
        (cache-instance instance)
        instance))))
@@ -519,11 +528,10 @@ (defgeneric make-proxy-instance (class location &key weak)
 object at the give location. If WEAK is non NIL the foreign memory
 will not be released when the proxy is garbage collected."))
 
-(defmethod make-proxy-instance ((class symbol) location &key weak)
-  (ensure-proxy-instance (find-class class) location :weak weak))
+(defmethod make-proxy-instance ((class symbol) location &rest initargs)
+  (apply #'make-proxy-instance (find-class class) location initargs))
 
 (defmethod make-proxy-instance ((class proxy-class) location &key weak)
-  (declare (ignore weak-p))
   (let ((instance (allocate-instance class)))
     (setf (slot-value instance 'location) location)
     (unless weak
@@ -573,6 +581,13 @@ (defmethod compute-foreign-size ((class struct-class))
                         (size-of (slot-definition-type slotd))))))
     (+ size (mod size +struct-alignmen+))))
 
+(defmethod weak-reader-function ((class struct-class) &rest args)
+  (declare (ignore args))
+  #'(lambda (location &optional (offset 0))
+      (let ((instance (sap-ref-sap location offset)))
+       (unless (null-pointer-p instance)
+         (ensure-proxy-instance class instance :weak t)))))
+
 
 (defclass static-struct-class (struct-class)
   ())
@@ -599,6 +614,12 @@ (defmethod reader-function ((type (eql 'inlined)) &rest args)
        (ensure-proxy-instance class 
         (reference-foreign class (sap+ location offset))))))
 
+(defmethod writer-function ((type (eql 'inlined)) &rest args)
+  (declare (ignore type))
+  (destructuring-bind (class) args
+    #'(lambda (instance location &optional (offset 0))
+       (copy-memory (foreign-location instance) (foreign-size class) (sap+ location offset)))))
+
 (defmethod destroy-function ((type (eql 'inlined)) &rest args)
   (declare (ignore args))
   #'(lambda (location &optional (offset 0))