Redesigned proxy initialization protocol

diff --git a/gdk/gdkevents.lisp b/gdk/gdkevents.lisp
index 526272252fab6a1a0773ace8063a8789e9e0a931..c2571cd0593bd98ba8cca886ea9404c1c9fd798c 100644 (file)
--- a/gdk/gdkevents.lisp
+++ b/gdk/gdkevents.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: gdkevents.lisp,v 1.10 2005/04/23 16:48:50 espen Exp $
+;; $Id: gdkevents.lisp,v 1.11 2006/02/05 15:39:40 espen Exp $
 
 (in-package "GDK")
 
@@ -64,7 +64,6 @@   (defmethod validate-superclass ((class event-class) (super standard-class))
     ;(subtypep (class-name super) 'event)
     t))
 
-
 (defmethod shared-initialize ((class event-class) names &key name type)
   (let ((class-name (or name (class-name class))))
     (unless (eq class-name 'event)
@@ -77,10 +76,10 @@ (let ((reader (reader-function 'event-type)))
   (defun %event-class (location)
     (gethash (funcall reader location 0) *event-classes*)))
 
-(defmethod ensure-proxy-instance ((class event-class) location)
+(defmethod make-proxy-instance :around ((class event-class) location &rest initargs)
   (declare (ignore class))
   (let ((class (%event-class location)))
-    (make-instance class :location location)))
+    (apply #'call-next-method class location initargs)))
 
 
 ;;;;

diff --git a/glib/genums.lisp b/glib/genums.lisp
index 4d148e8dfcd18df8326f482b7fa4a12f1f3c5c72..529145290dd680c96d05d62a4fb9de766a526d36 100644 (file)
--- a/glib/genums.lisp
+++ b/glib/genums.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: genums.lisp,v 1.15 2006/02/04 12:15:32 espen Exp $
+;; $Id: genums.lisp,v 1.16 2006/02/05 15:38:57 espen Exp $
 
 (in-package "GLIB")
   
@@ -277,7 +277,7 @@ (defun %query-enum-or-flags-values (query-function class type)
       (funcall query-function (type-class-ref type))
     (let ((values nil)
          (size (foreign-size (find-class class)))
-         (proxy (make-instance class :location sap)))
+         (proxy (ensure-proxy-instance class sap)))
       (dotimes (i length)
        (with-slots (location nickname value) proxy
          (setf location sap)

diff --git a/glib/gobject.lisp b/glib/gobject.lisp
index 2cdabd8b2abd60b4d8e48e7bfbd6cef4b3cb45df..5b5087bc6c889d3d51294231a50b33581bcb62d2 100644 (file)
--- a/glib/gobject.lisp
+++ b/glib/gobject.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: gobject.lisp,v 1.42 2006/02/04 12:15:32 espen Exp $
+;; $Id: gobject.lisp,v 1.43 2006/02/05 15:38:57 espen Exp $
 
 (in-package "GLIB")
 
@@ -224,6 +224,12 @@ (defun initial-apply-add (object function initargs key pkey)
               initargs key pkey))
 
 
+(defmethod make-proxy-instance ((class gobject-class) location &rest initargs)
+  (declare (ignore location initargs))
+  (if (slot-value class 'instance-slots-p)
+      (error "An object of class ~A has instance slots and should only be created with MAKE-INSTANCE" class)
+    (call-next-method)))
+
 (defmethod initialize-instance :around ((object gobject) &rest initargs)
   (declare (ignore initargs))
   (call-next-method)

diff --git a/glib/gtype.lisp b/glib/gtype.lisp
index c2a5108a44e0fcc18378ef6a29dba5ce762ce4e1..221614f68ee4dd4b4a0110ae72d7a82b21c15822 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.38 2006/02/04 12:15:32 espen Exp $
+;; $Id: gtype.lisp,v 1.39 2006/02/05 15:38:57 espen Exp $
 
 (in-package "GLIB")
 
@@ -320,7 +320,7 @@ (defun %type-number-of-ginstance (location)
   (let ((class (sap-ref-sap location 0)))
     (sap-ref-32 class 0)))
 
-(defmethod ensure-proxy-instance ((class ginstance-class) location)
+(defmethod make-proxy-instance :around ((class ginstance-class) location &rest initargs)
   (declare (ignore class))
   (let ((class (labels ((find-known-class (type-number)
                          (or
@@ -328,10 +328,22 @@ (defmethod ensure-proxy-instance ((class ginstance-class) location)
                           (unless (zerop type-number)
                             (find-known-class (type-parent type-number))))))
                 (find-known-class (%type-number-of-ginstance location)))))
+    ;; Note that chancing the class argument must not alter "the
+    ;; ordered set of applicable methods" as specified in the
+    ;; Hyperspec
     (if class
-       (make-instance class :location (reference-foreign class location))
-      (error "Object at ~A has an unkown type number: ~A" 
-        location (%type-number-of-ginstance location)))))
+       (apply #'call-next-method class location initargs)
+      (error "Object at ~A has an unkown type number: ~A"
+       location (%type-number-of-ginstance location)))))
+
+(defmethod make-proxy-instance ((class ginstance-class) location &rest initargs)
+  (declare (ignore initargs))
+  (reference-foreign class location)
+  ;; Since we make an explicit reference to the foreign object, we
+  ;; always have to release it when the proxy is garbage collected
+  ;; and therefor ignore the weak-p argument.
+  (call-next-method class location :weak 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 aae3e44f8a6790b906daaddbc364bac2b6fc937c..48af6e687090601fe5a248d3e8e1990ecb4c137f 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.24 2006/02/04 12:15:32 espen Exp $
+;; $Id: proxy.lisp,v 1.25 2006/02/05 15:38:57 espen Exp $
 
 (in-package "GLIB")
 
@@ -294,13 +294,12 @@ (defmethod print-object ((instance proxy) stream)
        (format stream "at 0x~X" (sap-int (foreign-location instance)))
       (write-string "at \"unbound\"" stream))))
 
-(defmethod initialize-instance :around ((instance proxy) &key location)
-  (if location
-      (setf (slot-value instance 'location) location)      
-    (call-next-method))
-  (cache-instance instance)
-  (finalize instance (instance-finalizer instance))
-  instance)
+(defmethod initialize-instance :around ((instance proxy) &rest initargs)
+  (declare (ignore initargs))
+  (prog1
+      (call-next-method)
+    (cache-instance instance)
+    (finalize instance (instance-finalizer instance))))
 
 (defmethod instance-finalizer ((instance proxy))
   (let ((location (foreign-location instance))
@@ -504,20 +503,32 @@ (defmethod unbound-value ((class proxy-class) &rest args)
   (declare (ignore args))
   (values t nil))
 
-(defgeneric ensure-proxy-instance (class location)
-  (:documentation "Returns a proxy object representing the foreign object at the give location."))
-
-(defmethod ensure-proxy-instance :around (class location)
+(defun ensure-proxy-instance (class location &rest initargs)
+  "Returns a proxy object representing the foreign object at the give
+location. If an existing object is not found in the cache
+MAKE-PROXY-INSTANCE is called to create one."
   (unless (null-pointer-p location)
     (or 
      (find-cached-instance location)
-     (call-next-method))))
-  
-(defmethod ensure-proxy-instance ((class symbol) location)
-  (ensure-proxy-instance (find-class class) location))
-
-(defmethod ensure-proxy-instance ((class proxy-class) location)
-  (make-instance class :location location))
+     (let ((instance (apply #'make-proxy-instance class location initargs)))
+       (cache-instance instance)
+       instance))))
+
+(defgeneric make-proxy-instance (class location &key weak)
+  (:documentation "Creates a new proxy object representing the foreign
+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 proxy-class) location &key weak)
+  (declare (ignore weak-p))
+  (let ((instance (allocate-instance class)))
+    (setf (slot-value instance 'location) location)
+    (unless weak
+      (finalize instance (instance-finalizer instance)))
+    instance))
 
 
 ;;;; Superclasses for wrapping of C structures