Added pseudo type COPY-OF

[clg] / glib / gobject.lisp

diff --git a/glib/gobject.lisp b/glib/gobject.lisp
index 4005672676cdf1a0b24029d04b0c7e1927a944d1..f888cc6d95932efb8fac43bd8401157ed9e25250 100644 (file)
--- a/glib/gobject.lisp
+++ b/glib/gobject.lisp
@@ -15,7 +15,7 @@
 ;; License along with this library; if not, write to the Free Software
 ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 
-;; $Id: gobject.lisp,v 1.19 2004-11-07 15:58:08 espen Exp $
+;; $Id: gobject.lisp,v 1.22 2004-11-12 14:24:17 espen Exp $
 
 (in-package "GLIB")
 
@@ -144,33 +144,26 @@   (defclass gobject (ginstance)
     (:metaclass gobject-class)
     (:alien-name "GObject")))
 
-(defmethod print-object ((instance gobject) stream)
-  (print-unreadable-object (instance stream :type t :identity nil)
-    (if (slot-boundp instance 'location)
-       (format stream "at 0x~X" (sap-int (proxy-location instance)))
-      (write-string "(destroyed)" stream))))
-
-
 (defmethod initialize-instance ((object gobject) &rest initargs)
   ;; Extract initargs which we should pass directly to the GObeject
   ;; constructor
   (let* ((slotds (class-slots (class-of object)))
-        (args (loop 
-               as tmp = initargs then (cddr tmp) while tmp
-               as key = (first tmp)
-               as value = (second tmp)
-               as slotd = (find-if
-                           #'(lambda (slotd)
-                               (member key (slot-definition-initargs slotd)))
-                           slotds)
-               when (and (typep slotd 'effective-property-slot-definition)
-                         (slot-value slotd 'construct))
-               collect (progn 
-                         (remf initargs key)
-                         (list 
-                          (slot-definition-pname slotd)
-                          (slot-definition-type slotd)
-                          value)))))
+        (args (when initargs
+                (loop 
+                 as (key value . rest) = initargs then rest
+                 as slotd = (find-if
+                             #'(lambda (slotd)
+                                 (member key (slot-definition-initargs slotd)))
+                             slotds)
+                 when (and (typep slotd 'effective-property-slot-definition)
+                           (slot-value slotd 'construct))
+                 collect (progn 
+                           (remf initargs key)
+                           (list 
+                            (slot-definition-pname slotd)
+                            (slot-definition-type slotd)
+                            value))
+                 while rest))))
     (if args
        (let* ((string-size (size-of 'string))
               (string-writer (writer-function 'string))
@@ -196,27 +189,15 @@ (defmethod initialize-instance ((object gobject) &rest initargs)
         (slot-value object 'location) 
         (%gobject-new (type-number-of object)))))
 
-  (%object-weak-ref object)
   (apply #'call-next-method object initargs))
 
 
-(defmethod initialize-instance :around ((object gobject) &rest initargs)
-  (declare (ignore initargs))
-  (call-next-method)
-  (%object-weak-ref object))
-
+(defmethod instance-finalizer ((instance gobject))
+  (let ((location (proxy-location instance)))
+    #'(lambda ()
+       (remove-cached-instance location)
+       (%object-unref location))))
 
-(defcallback weak-notify (nil (data int) (location pointer))
-  (let ((object (find-cached-instance location)))
-    (when object
-;;       (warn "~A being finalized by the GObject system while still in existence in lisp" object)
-      (slot-makunbound object 'location)
-      (remove-cached-instance location))))
-
-(defbinding %object-weak-ref (object) nil
-  (object gobject)
-  ((callback weak-notify) pointer)
-  (0 unsigned-int))
 
 (defbinding (%gobject-new "g_object_new") () pointer
   (type type-number)