;; 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")
#+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))))
(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)))
(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)
(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))
;; 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")
;; 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))
(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))
(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))