X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=glib%2Fgobject.foreign-gobject.lisp;h=50ba2ff04581edc40e8607393023dda9b03b24e7;hb=5000a859638184ff956ee2f17cce4744b765a169;hp=c736aff38b9a6f27e9dbc12e9d9d68ec77c65d52;hpb=81e0009ee540f42c64ab1670a4fe936681fbdb6c;p=cl-gtk2.git

diff --git a/glib/gobject.foreign-gobject.lisp b/glib/gobject.foreign-gobject.lisp
index c736aff..50ba2ff 100644
--- a/glib/gobject.foreign-gobject.lisp
+++ b/glib/gobject.foreign-gobject.lisp
@@ -9,20 +9,17 @@
    (has-reference
     :type boolean
     :accessor g-object-has-reference
-    :initform nil)))
+    :initform nil))
+  (:documentation
+   "Base class for GObject classes hierarchy."))
 
 (defvar *foreign-gobjects* (make-weak-hash-table :test 'equal :weakness :value))
 (defvar *foreign-gobjects-ref-count* (make-hash-table :test 'equal))
 (defvar *lisp-objects-pointers* (make-hash-table :test 'equal))
 (defvar *current-creating-object* nil)
 
-(defcstruct g-object-struct
-  (type-instance g-type-instance)
-  (ref-count :uint)
-  (qdata :pointer))
-
 (defun ref-count (pointer)
-  (foreign-slot-value (if (pointerp pointer) pointer (pointer pointer)) 'g-object-struct 'ref-count))
+  (foreign-slot-value (if (pointerp pointer) pointer (pointer pointer)) 'g-object-struct :ref-count))
 
 (defmethod initialize-instance :around ((obj g-object) &key)
   (let ((*current-creating-object* obj))
@@ -138,11 +135,12 @@
 (defun registered-object-type-by-name (name)
   (gethash name *registered-object-types*))
 (defun get-g-object-lisp-type (g-type)
+  (setf g-type (ensure-g-type g-type))
   (loop
      while (not (zerop g-type))
      for lisp-type = (gethash (g-type-name g-type) *registered-object-types*)
      when lisp-type do (return lisp-type)
-     do (setf g-type (g-type-parent g-type))))
+     do (setf g-type (ensure-g-type (g-type-parent g-type)))))
 
 (defun make-g-object-from-pointer (pointer)
   (let* ((g-type (g-type-from-instance pointer))
@@ -189,6 +187,9 @@
 (register-object-type "GObject" 'g-object)
 
 (defun ensure-g-type (type)
+  "Returns the GType value for a given type. If type is an integer, it is returned. If type is a string, GType corresponding to this type name is looked up and returned.
+@arg[type]{a string or and integer}
+@return{integer equal to GType of @code{type}}"
   (etypecase type
     (integer type)
     (string (or (g-type-from-name type)
@@ -227,7 +228,7 @@
              (not (member :readable
                           (foreign-slot-value param-spec
                                               'g-param-spec
-                                              'flags))))
+                                              :flags))))
     (error 'property-unreadable-error
            :property-name property-name
            :class-name (g-type-name object-type)))
@@ -235,11 +236,11 @@
              (not (member :writable
                           (foreign-slot-value param-spec
                                               'g-param-spec
-                                              'flags))))
+                                              :flags))))
     (error 'property-unwritable-error
            :property-name property-name
            :class-name (g-type-name object-type)))
-  (foreign-slot-value param-spec 'g-param-spec 'value-type))
+  (foreign-slot-value param-spec 'g-param-spec :value-type))
 
 (defun g-object-type-property-type (object-type property-name
                                     &key assert-readable assert-writable)
@@ -258,7 +259,6 @@
 
 (defun g-object-call-constructor (object-type args-names args-values
                                   &optional args-types)
-  (setf object-type (ensure-g-type object-type))
   (unless args-types
     (setf args-types
           (mapcar (lambda (name)
@@ -273,8 +273,8 @@
          for arg-type in args-types
          for arg-g-type = (if arg-type (ensure-g-type arg-type) (g-object-type-property-type object-type arg-name))
          for parameter = (mem-aref parameters 'g-parameter i)
-         do (setf (foreign-slot-value parameter 'g-parameter 'name) arg-name)
-         do (set-g-value (foreign-slot-value parameter 'g-parameter 'value)
+         do (setf (foreign-slot-value parameter 'g-parameter :name) arg-name)
+         do (set-g-value (foreign-slot-value parameter 'g-parameter :value)
                          arg-value arg-g-type
                          :zero-g-value t))
       (unwind-protect
@@ -282,11 +282,8 @@
         (loop
            for i from 0 below args-count
            for parameter = (mem-aref parameters 'g-parameter i)
-           do (foreign-free
-               (mem-ref (foreign-slot-pointer parameter 'g-parameter 'name)
-                        :pointer))
-           do (g-value-unset
-               (foreign-slot-pointer parameter 'g-parameter 'value)))))))
+           do (foreign-free (mem-ref (foreign-slot-pointer parameter 'g-parameter :name) :pointer))
+           do (g-value-unset (foreign-slot-pointer parameter 'g-parameter :value)))))))
 
 (defun g-object-call-get-property (object property-name &optional property-type)
   (restart-case