gtk/gtk.lisp: Apparently when you ask for a stock Button, you get a Bin.

[clg] / glib / gobject.lisp

diff --git a/glib/gobject.lisp b/glib/gobject.lisp
index a9d47359d1679b39287cd14ac2052f5c1713c82a..68ee82cb649549faec4b1d0e6d66258c737b2882 100644 (file)
--- 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.
 
 ;; 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.58 2008-10-09 18:20:52 espen Exp $
+;; $Id: gobject.lisp,v 1.59 2008-11-04 03:22:23 espen Exp $

 
 (in-package "GLIB")
 
 
 (in-package "GLIB")
 


@@ -152,12 +152,15 @@ (defmethod compute-slot-reader-function ((slotd effective-property-slot-definiti
   (declare (ignore signal-unbound-p))
   (let* ((type (slot-definition-type slotd))
         (pname (slot-definition-pname slotd))
   (declare (ignore signal-unbound-p))
   (let* ((type (slot-definition-type slotd))
         (pname (slot-definition-pname slotd))

-        (reader (reader-function type :ref :get)))
+        (get-reader (reader-function type :ref :get))
+        (peek-reader (reader-function type :ref :peek)))

     #'(lambda (object)
        (with-memory (gvalue +gvalue-size+)
          (%gvalue-init gvalue (find-type-number type))
          (%object-get-property object pname gvalue)
     #'(lambda (object)
        (with-memory (gvalue +gvalue-size+)
          (%gvalue-init gvalue (find-type-number type))
          (%object-get-property object pname gvalue)

-         (funcall reader gvalue +gvalue-value-offset+)))))
+         (if (gvalue-static-p gvalue)
+             (funcall peek-reader gvalue +gvalue-value-offset+)
+           (funcall get-reader gvalue +gvalue-value-offset+))))))

 
 (defmethod compute-slot-writer-function :around ((slotd effective-property-slot-definition))
   (if (construct-only-property-p slotd)
 
 (defmethod compute-slot-writer-function :around ((slotd effective-property-slot-definition))
   (if (construct-only-property-p slotd)


@@ -583,6 +586,10 @@ (defun expand-gobject-type (type forward-p options &optional (metaclass 'gobject
   (let ((supers (cons (supertype type) (implements type)))
        (class  (type-from-number type))
        (slots (getf options :slots)))
   (let ((supers (cons (supertype type) (implements type)))
        (class  (type-from-number type))
        (slots (getf options :slots)))

+    (when (member nil supers)
+      (error "Got NIL as a supertype for ~A (full list: ~A).~%~
+              This shouldn't happen - is the parent type correctly registered?"
+             (find-foreign-type-name type) supers))

     `(defclass ,class ,supers
         ,(unless forward-p
            (slot-definitions class (query-object-class-properties type) slots))
     `(defclass ,class ,supers
         ,(unless forward-p
            (slot-definitions class (query-object-class-properties type) slots))