From c0e198829957eb9122532707013fb324f4ef1d14 Mon Sep 17 00:00:00 2001 Message-Id: From: Mark Wooding Date: Wed, 8 Feb 2006 22:10:47 +0000 Subject: [PATCH] FOREIGN Organization: Straylight/Edgeware From: espen --- glib/gobject.lisp | 10 +++++----- glib/proxy.lisp | 15 ++++++++++++--- 2 files changed, 17 insertions(+), 8 deletions(-) diff --git a/glib/gobject.lisp b/glib/gobject.lisp index 2a91c0c..bd0151f 100644 --- 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.44 2006-02-06 11:34:05 espen Exp $ +;; $Id: gobject.lisp,v 1.45 2006-02-08 22:10:47 espen Exp $ (in-package "GLIB") @@ -212,7 +212,7 @@ (defclass gobject (ginstance) #+debug-ref-counting (defmethod print-object ((instance gobject) stream) (print-unreadable-object (instance stream :type t :identity nil) - (if (slot-boundp instance 'location) + (if (proxy-valid-p instance) (format stream "at 0x~X (~D)" (sap-int (foreign-location instance)) (ref-count instance)) (write-string "at \"unbound\"" stream)))) @@ -251,7 +251,7 @@ (defmethod initialize-instance :around ((object gobject) &rest initargs) (defmethod initialize-instance ((object gobject) &rest initargs) - (unless (slot-boundp object 'location) + (unless (proxy-valid-p object) ;; Extract initargs which we should pass directly to the GObject ;; constructor (let* ((slotds (class-slots (class-of object))) @@ -284,7 +284,7 @@ (defmethod initialize-instance ((object gobject) &rest initargs) (gvalue-init (sap+ tmp string-size) type value)) (unwind-protect (setf - (slot-value object 'location) + (foreign-location object) (%gobject-newv (type-number-of object) (length args) params)) (loop repeat (length args) @@ -293,7 +293,7 @@ (defmethod initialize-instance ((object gobject) &rest initargs) (gvalue-unset (sap+ tmp string-size))) (deallocate-memory params))) (setf - (slot-value object 'location) + (foreign-location object) (%gobject-new (type-number-of object)))))) (apply #'call-next-method object initargs)) diff --git a/glib/proxy.lisp b/glib/proxy.lisp index 44f2577..53d35ba 100644 --- 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.30 2006-02-08 21:43:33 espen Exp $ +;; $Id: proxy.lisp,v 1.31 2006-02-08 22:10:47 espen Exp $ (in-package "GLIB") @@ -292,7 +292,7 @@ (defun list-invalidated-instances () ;; TODO: add a ref-counted-proxy subclass (defclass proxy () - ((location :allocation :special :reader foreign-location :type pointer)) + ((location :allocation :special :type pointer)) (:metaclass virtual-slots-class)) (defgeneric instance-finalizer (object)) @@ -300,6 +300,15 @@ (defgeneric reference-foreign (class location)) (defgeneric unreference-foreign (class location)) (defgeneric invalidate-instance (object)) +(defun foreign-location (instance) + (slot-value instance 'location)) + +(defun (setf foreign-location) (location instance) + (setf (slot-value instance 'location) location)) + +(defun proxy-valid-p (instance) + (slot-boundp instance 'location)) + (defmethod reference-foreign ((name symbol) location) (reference-foreign (find-class name) location)) @@ -553,7 +562,7 @@ (defmethod make-proxy-instance ((class proxy-class) location &key weak) (or (find-invalidated-instance class) (allocate-instance class)))) - (setf (slot-value instance 'location) location) + (setf (foreign-location instance) location) (unless weak (finalize instance (instance-finalizer instance))) instance)) -- [mdw]