-(defmethod compute-virtual-slot-accessors
- ((class gobject-class) (slotd effective-gobject-slot-definition)
- direct-slotds)
- (with-slots (type) slotd
- (let ((param-name (slot-definition-param (first direct-slotds)))
- (type-number (find-type-number type))
- (getter (intern-reader-function type))
- (setter (intern-writer-function type))
- (destroy (intern-destroy-function type)))
- (list
+(defmethod compute-effective-slot-definition-initargs ((class gobject-class) direct-slotds)
+ (if (eq (most-specific-slot-value direct-slotds 'allocation) :property)
+ (nconc
+ (list :pname (signal-name-to-string
+ (most-specific-slot-value direct-slotds 'pname))
+ :readable (most-specific-slot-value direct-slotds 'readable)
+ :writable (most-specific-slot-value direct-slotds 'writable)
+ :construct (most-specific-slot-value direct-slotds 'construct))
+ (call-next-method))
+ (call-next-method)))
+
+
+(defmethod initialize-internal-slot-functions ((slotd effective-gobject-slot-definition))
+ (let* ((type (slot-definition-type slotd))
+ (pname (slot-definition-pname slotd))
+ (type-number (find-type-number type)))
+ (unless (slot-boundp slotd 'reader-function)
+ (setf
+ (slot-value slotd 'reader-function)
+ (if (slot-readable-p slotd)
+ #'(lambda (object)
+ (with-gc-disabled
+ (let ((gvalue (gvalue-new type-number)))
+ (%object-get-property object pname gvalue)
+ (unwind-protect
+ (funcall
+ (intern-reader-function (type-from-number type-number)) gvalue +gvalue-value-offset+) ; temporary workaround for wrong topological sorting of types
+ (gvalue-free gvalue t)))))
+ #'(lambda (value object)
+ (error "Slot is not readable: ~A" (slot-definition-name slotd))))))
+
+ (unless (slot-boundp slotd 'writer-function)
+ (setf
+ (slot-value slotd 'writer-function)
+ (if (slot-writable-p slotd)
+ #'(lambda (value object)
+ (with-gc-disabled
+ (let ((gvalue (gvalue-new type-number)))
+ (funcall
+ (intern-writer-function (type-from-number type-number)) ; temporary
+ value gvalue +gvalue-value-offset+)
+ (%object-set-property object pname gvalue)
+ (funcall
+ (intern-destroy-function (type-from-number type-number)) ; temporary
+ gvalue +gvalue-value-offset+)
+ (gvalue-free gvalue nil)
+ value)))
+ #'(lambda (value object)
+ (error "Slot is not writable: ~A" (slot-definition-name slotd))))))
+
+ (unless (slot-boundp slotd 'boundp-function)
+ (setf
+ (slot-value slotd 'boundp-function)