anchor.diff:  ;; 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.3 2000-11-09 20:29:19 espen Exp $
  +;; $Id: gobject.lisp,v 1.4 2001-01-28 14:17:12 espen Exp $
   
   (in-package "GLIB")
   
  
positive.code: 
  
  
  
  
  
  ;;;; Methods for gobject-class
  
  (defmethod shared-initialize ((class gobject-class) names &rest initargs
  			      &key type-init name)
  
negative.code: ;   (class pointer)
  ;   (name string))
  
  
  (defmethod initialize-instance :after ((slotd direct-gobject-slot-definition)
  				       &rest initargs &key)
    (declare (ignore initargs))
    (unless (slot-boundp slotd 'location)
      ;; Find parameter name from slot name
      (with-slots (pcl::name location) slotd
        (setf location (signal-name-to-string pcl::name)))))
  
  (defmethod direct-slot-definition-class ((class gobject-class) initargs)
    (case (getf initargs :allocation)
      (:param (find-class 'direct-gobject-slot-definition))
      (t (call-next-method))))
  
  (defmethod effective-slot-definition-class ((class gobject-class) initargs)
    (case (getf initargs :allocation)
      (:param (find-class 'effective-gobject-slot-definition))
      (t (call-next-method))))
  
  (defmethod compute-virtual-slot-location
      ((class gobject-class) (slotd effective-gobject-slot-definition)
       direct-slotds)
    (with-slots (type) slotd
      (let ((param-name (slot-definition-location (first direct-slotds)))
  	  (type-number (find-type-number type))
  	  (reader (get-reader-function type))
  	  (writer (get-writer-function type))
  	  (destroy (get-destroy-function type)))
        (list
         #'(lambda (object)
  	   (with-gc-disabled
  	     (let ((gvalue (gvalue-new type-number)))
  	       (%object-get-property object param-name gvalue)
  	       (prog1
  		   (funcall reader gvalue +gvalue-value-offset+)
  		 (gvalue-free gvalue t)))))
         #'(lambda (value object)
  	   (with-gc-disabled
    	     (let ((gvalue (gvalue-new type-number)))
  	       (funcall writer value gvalue +gvalue-value-offset+)
  	       (%object-set-property object param-name gvalue)
  	       (funcall destroy gvalue +gvalue-value-offset+)
  	       (gvalue-free gvalue nil)
  	       value)))))))
  
  
  (defmethod validate-superclass ((class gobject-class)
  				(super pcl::standard-class))
    (subtypep (class-name super) 'gobject))
  