Use new GType designators

diff --git a/glib/gobject.boxed.lisp b/glib/gobject.boxed.lisp
index e5ba0c5..1445389 100644 (file)
--- a/glib/gobject.boxed.lisp
+++ b/glib/gobject.boxed.lisp
@@ -21,8 +21,8 @@
 (defvar *g-type-name->g-boxed-foreign-info* (make-hash-table :test 'equal))
 
 (defun get-g-boxed-foreign-info-for-gtype (g-type-designator)
-  (or (gethash (g-type-string g-type-designator) *g-type-name->g-boxed-foreign-info*)
-      (error "Unknown GBoxed type '~A'" (g-type-string g-type-designator))))
+  (or (gethash (gtype-name (gtype g-type-designator)) *g-type-name->g-boxed-foreign-info*)
+      (error "Unknown GBoxed type '~A'" (gtype-name (gtype g-type-designator)))))
 
 (defgeneric make-foreign-type (info &key return-p))
 
@@ -555,14 +555,14 @@
 
 (defgeneric boxed-set-g-value (gvalue-ptr info proxy))
 
-(defmethod parse-g-value-for-type (gvalue-ptr (type-numeric (eql +g-type-boxed+)) parse-kind)
+(defmethod parse-g-value-for-type (gvalue-ptr (type-numeric (eql (gtype +g-type-boxed+))) parse-kind)
   (declare (ignore parse-kind))
   (if (g-type= (g-value-type gvalue-ptr) (g-strv-get-type))
       (convert-from-foreign (g-value-get-boxed gvalue-ptr) '(glib:gstrv :free-from-foreign nil))
       (let ((boxed-type (get-g-boxed-foreign-info-for-gtype (g-value-type gvalue-ptr))))
         (boxed-parse-g-value gvalue-ptr boxed-type))))
 
-(defmethod set-gvalue-for-type (gvalue-ptr (type-numeric (eql +g-type-boxed+)) value)
+(defmethod set-gvalue-for-type (gvalue-ptr (type-numeric (eql (gtype +g-type-boxed+))) value)
   (if (g-type= (g-value-type gvalue-ptr) (g-strv-get-type))
       (g-value-set-boxed gvalue-ptr (convert-to-foreign value '(glib:gstrv :free-from-foreign nil)))
       (let ((boxed-type (get-g-boxed-foreign-info-for-gtype (g-value-type gvalue-ptr))))

diff --git a/glib/gobject.ffi.package.lisp b/glib/gobject.ffi.package.lisp
index a2af983..67721f9 100644 (file)
--- a/glib/gobject.ffi.package.lisp
+++ b/glib/gobject.ffi.package.lisp
@@ -2,13 +2,12 @@
   (:use :cl :cffi :glib :trivial-garbage :iter)
   (:export #:g-type
            #:g-type-designator
-           #:g-type-name
-           #:g-type-from-name
+           #:gtype
+           #:gtype-id
+           #:gtype-name
            #:g-type
            #:g-type-fundamental
            #:%g-type-init
-           #:g-type-name
-           #:g-type-from-name
            #:g-type-parent
            #:g-type-depth
            #:g-type-next-base
@@ -195,8 +194,6 @@
            #:lisp-closure
            #:g-object-struct
            #:g-signal-list-ids
-           #:g-type-string
-           #:g-type-numeric
            #:g-signal-parse-name
            #:g-type=
            #:g-type/=))

diff --git a/glib/gobject.foreign-gobject-subclassing.lisp b/glib/gobject.foreign-gobject-subclassing.lisp
index da188c5..9edba2c 100644 (file)
--- a/glib/gobject.foreign-gobject-subclassing.lisp
+++ b/glib/gobject.foreign-gobject-subclassing.lisp
@@ -6,14 +6,14 @@
 
 (defun instance-init (instance class)
   (log-for :subclass "(instance-init ~A ~A)~%" instance class)
-  (log-for :subclass "Initializing instance ~A for type ~A (creating ~A)~%" instance (g-type-name (foreign-slot-value class 'g-type-class :type)) *current-creating-object*)
+  (log-for :subclass "Initializing instance ~A for type ~A (creating ~A)~%" instance (gtype-name (foreign-slot-value class 'g-type-class :type)) *current-creating-object*)
   (unless (or *current-creating-object*
               *currently-making-object-p*
               (gethash (pointer-address instance) *foreign-gobjects-strong*)
               (gethash (pointer-address instance) *foreign-gobjects-weak*))
     (log-for :subclass "Proceeding with initialization...~%")
     (let* ((g-type (foreign-slot-value class 'g-type-class :type))
-           (type-name (g-type-name g-type))
+           (type-name (gtype-name g-type))
            (lisp-type-info (gethash type-name *registered-types*))
            (lisp-class (object-type-class lisp-type-info)))
       (make-instance lisp-class :pointer instance))))
@@ -37,35 +37,35 @@
 (defun property->param-spec (property)
   (destructuring-bind (property-name property-type accessor property-get-fn property-set-fn) property
     (declare (ignore accessor))
-    (let ((property-g-type (ensure-g-type property-type))
+    (let ((property-g-type (gtype property-type))
           (flags (append (when property-get-fn (list :readable))
                          (when property-set-fn (list :writable)))))
       (ev-case (g-type-fundamental property-g-type)
-        (+g-type-invalid+ (error "GValue is of invalid type ~A (~A)" property-g-type (g-type-name property-g-type)))
-        (+g-type-void+ nil)
-        (+g-type-char+ (g-param-spec-char property-name property-name property-name (minimum-foreign-integer :char) (maximum-foreign-integer :char) 0 flags))
-        (+g-type-uchar+ (g-param-spec-uchar property-name property-name property-name (minimum-foreign-integer :uchar nil) (maximum-foreign-integer :uchar nil) 0 flags))
-        (+g-type-boolean+ (g-param-spec-boolean property-name property-name property-name nil flags))
-        (+g-type-int+ (g-param-spec-int property-name property-name property-name (minimum-foreign-integer :int) (maximum-foreign-integer :int) 0 flags))
-        (+g-type-uint+ (g-param-spec-uint property-name property-name property-name (minimum-foreign-integer :uint nil) (maximum-foreign-integer :uint nil) 0 flags))
-        (+g-type-long+ (g-param-spec-long property-name property-name property-name (minimum-foreign-integer :long) (maximum-foreign-integer :long) 0 flags))
-        (+g-type-ulong+ (g-param-spec-ulong property-name property-name property-name (minimum-foreign-integer :ulong nil) (maximum-foreign-integer :ulong nil) 0 flags))
-        (+g-type-int64+ (g-param-spec-int64 property-name property-name property-name (minimum-foreign-integer :int64) (maximum-foreign-integer :int64) 0 flags))
-        (+g-type-uint64+ (g-param-spec-uint64 property-name property-name property-name (minimum-foreign-integer :uint64 nil) (maximum-foreign-integer :uint64 t) 0 flags))
-        (+g-type-enum+ (g-param-spec-enum property-name property-name property-name property-g-type (enum-item-value (first (get-enum-items property-g-type))) flags))
-        (+g-type-flags+ (g-param-spec-enum property-name property-name property-name property-g-type (flags-item-value (first (get-flags-items property-g-type))) flags))
-        (+g-type-float+ (g-param-spec-float property-name property-name property-name most-negative-single-float most-positive-single-float 0.0 flags))
-        (+g-type-double+ (g-param-spec-double property-name property-name property-name most-negative-double-float most-positive-double-float 0.0d0 flags))
-        (+g-type-string+ (g-param-spec-string property-name property-name property-name "" flags))
-        (+g-type-pointer+ (g-param-spec-pointer property-name property-name property-name flags))
-        (+g-type-boxed+ (g-param-spec-boxed property-name property-name property-name property-g-type flags))
+        ((gtype +g-type-invalid+) (error "GValue is of invalid type ~A (~A)" property-g-type (gtype-name property-g-type)))
+        ((gtype +g-type-void+) nil)
+        ((gtype +g-type-char+) (g-param-spec-char property-name property-name property-name (minimum-foreign-integer :char) (maximum-foreign-integer :char) 0 flags))
+        ((gtype +g-type-uchar+) (g-param-spec-uchar property-name property-name property-name (minimum-foreign-integer :uchar nil) (maximum-foreign-integer :uchar nil) 0 flags))
+        ((gtype +g-type-boolean+) (g-param-spec-boolean property-name property-name property-name nil flags))
+        ((gtype +g-type-int+) (g-param-spec-int property-name property-name property-name (minimum-foreign-integer :int) (maximum-foreign-integer :int) 0 flags))
+        ((gtype +g-type-uint+) (g-param-spec-uint property-name property-name property-name (minimum-foreign-integer :uint nil) (maximum-foreign-integer :uint nil) 0 flags))
+        ((gtype +g-type-long+) (g-param-spec-long property-name property-name property-name (minimum-foreign-integer :long) (maximum-foreign-integer :long) 0 flags))
+        ((gtype +g-type-ulong+) (g-param-spec-ulong property-name property-name property-name (minimum-foreign-integer :ulong nil) (maximum-foreign-integer :ulong nil) 0 flags))
+        ((gtype +g-type-int64+) (g-param-spec-int64 property-name property-name property-name (minimum-foreign-integer :int64) (maximum-foreign-integer :int64) 0 flags))
+        ((gtype +g-type-uint64+) (g-param-spec-uint64 property-name property-name property-name (minimum-foreign-integer :uint64 nil) (maximum-foreign-integer :uint64 t) 0 flags))
+        ((gtype +g-type-enum+) (g-param-spec-enum property-name property-name property-name property-g-type (enum-item-value (first (get-enum-items property-g-type))) flags))
+        ((gtype +g-type-flags+) (g-param-spec-enum property-name property-name property-name property-g-type (flags-item-value (first (get-flags-items property-g-type))) flags))
+        ((gtype +g-type-float+) (g-param-spec-float property-name property-name property-name most-negative-single-float most-positive-single-float 0.0 flags))
+        ((gtype +g-type-double+) (g-param-spec-double property-name property-name property-name most-negative-double-float most-positive-double-float 0.0d0 flags))
+        ((gtype +g-type-string+) (g-param-spec-string property-name property-name property-name "" flags))
+        ((gtype +g-type-pointer+) (g-param-spec-pointer property-name property-name property-name flags))
+        ((gtype +g-type-boxed+) (g-param-spec-boxed property-name property-name property-name property-g-type flags))
                                         ;(+g-type-param+ (parse-g-value-param gvalue))
-        (+g-type-object+ (g-param-spec-object property-name property-name property-name property-g-type flags))
+        ((gtype +g-type-object+) (g-param-spec-object property-name property-name property-name property-g-type flags))
                                         ;(+g-type-interface+ )
-        (t (error "Unknown type: ~A (~A)" property-g-type (g-type-name property-g-type)))))))
+        (t (error "Unknown type: ~A (~A)" property-g-type (gtype-name property-g-type)))))))
 
 (defun install-properties (class)
-  (let* ((name (g-type-name (foreign-slot-value class 'g-type-class :type)))
+  (let* ((name (gtype-name (foreign-slot-value class 'g-type-class :type)))
          (lisp-type-info (gethash name *registered-types*)))
     (iter (for property in (object-type-properties lisp-type-info))
           (for param-spec = (property->param-spec property))
@@ -152,7 +152,7 @@
     (with-foreign-object (info 'g-interface-info)
       (setf (foreign-slot-value info 'g-interface-info :interface-init) (callback c-interface-init)
             (foreign-slot-value info 'g-interface-info :interface-data) interface-info-ptr)
-      (g-type-add-interface-static (g-type-from-name name) (ensure-g-type interface) info))))
+      (g-type-add-interface-static (gtype name) (gtype interface) info))))
 
 (defun add-interfaces (name)
   (let* ((lisp-type-info (gethash name *registered-types*))
@@ -162,7 +162,7 @@
 
 (defun class-init (class data)
   (declare (ignore data))
-  (log-for :subclass "class-init for ~A~%" (g-type-name (g-type-from-class class)))
+  (log-for :subclass "class-init for ~A~%" (gtype-name (g-type-from-class class)))
   (setf (foreign-slot-value class 'g-object-class :get-property)
         (callback c-object-property-get)
         (foreign-slot-value class 'g-object-class :set-property)
@@ -176,7 +176,7 @@
                           (gethash (pointer-address object) *foreign-gobjects-weak*)))
          (property-name (foreign-slot-value pspec 'g-param-spec :name))
          (property-type (foreign-slot-value pspec 'g-param-spec :value-type))
-         (type-name (g-type-name (foreign-slot-value pspec 'g-param-spec :owner-type)))
+         (type-name (gtype-name (foreign-slot-value pspec 'g-param-spec :owner-type)))
          (lisp-type-info (gethash type-name *registered-types*))
          (property-info (find property-name (object-type-properties lisp-type-info) :test 'string= :key 'first))
          (property-get-fn (fourth property-info)))
@@ -194,7 +194,7 @@
   (let* ((lisp-object (or (gethash (pointer-address object) *foreign-gobjects-strong*)
                           (gethash (pointer-address object) *foreign-gobjects-weak*)))
          (property-name (foreign-slot-value pspec 'g-param-spec :name))
-         (type-name (g-type-name (foreign-slot-value pspec 'g-param-spec :owner-type)))
+         (type-name (gtype-name (foreign-slot-value pspec 'g-param-spec :owner-type)))
          (lisp-type-info (gethash type-name *registered-types*))
          (property-info (find property-name (object-type-properties lisp-type-info) :test 'string= :key 'first))
          (property-set-fn (fifth property-info))
@@ -209,14 +209,14 @@
 
 (defmacro register-object-type-implementation (name class parent interfaces properties)
   (unless (stringp parent)
-    (setf parent (g-type-name (ensure-g-type parent))))
+    (setf parent (gtype-name (gtype parent))))
   `(progn
      (setf (gethash ,name *registered-types*) (make-object-type :name ,name :class ',class :parent ,parent :interfaces ',interfaces :properties ',properties))
      (at-init (',class)
        (log-for :subclass "Registering GObject type implementation ~A for type ~A~%" ',class ,name)
        (with-foreign-object (query 'g-type-query)
-         (g-type-query (g-type-from-name ,parent) query)
-         (g-type-register-static-simple (g-type-from-name ,parent)
+         (g-type-query (gtype ,parent) query)
+         (g-type-register-static-simple (gtype ,parent)
                                         ,name
                                         (foreign-slot-value query 'g-type-query :class-size)
                                         (callback c-class-init)

diff --git a/glib/gobject.generating.lisp b/glib/gobject.generating.lisp
index 2035784..0560ddb 100644 (file)
--- a/glib/gobject.generating.lisp
+++ b/glib/gobject.generating.lisp
@@ -222,7 +222,7 @@
   (let ((name (g-name->name (g-class-property-definition-name property)))
         (accessor-name (accessor-name class-name (g-class-property-definition-name property)))
         (g-name (g-class-property-definition-name property))
-        (type (g-type-name (g-class-property-definition-type property)))
+        (type (gtype-name (g-class-property-definition-type property)))
         (readable (g-class-property-definition-readable property))
         (writable (and (g-class-property-definition-writable property)
                        (not (g-class-property-definition-constructor-only property)))))
@@ -241,18 +241,18 @@
     (write-string "_get_type" stream)))
 
 (defun get-g-class-definition (type &optional lisp-name-package)
-  (when (and (stringp type) (zerop (g-type-numeric type)))
+  (when (and (stringp type) (null (ignore-errors (gtype type))))
     (let ((type-init-name (probable-type-init-name type)))
       (when (foreign-symbol-pointer type-init-name)
         (foreign-funcall-pointer (foreign-symbol-pointer type-init-name) () :int))))
   (when *generated-types*
-    (setf (gethash (g-type-string type) *generated-types*) t))
+    (setf (gethash (gtype-name (gtype type)) *generated-types*) t))
   (let* ((*lisp-name-package* (or lisp-name-package *lisp-name-package* *package*))
-         (g-type (ensure-g-type type))
-         (g-name (g-type-name g-type))
+         (g-type (gtype type))
+         (g-name (gtype-name g-type))
          (name (g-name->name g-name))
          (superclass-g-type (g-type-parent g-type))
-         (superclass-name (g-name->name (g-type-name superclass-g-type)))
+         (superclass-name (g-name->name (gtype-name superclass-g-type)))
          (interfaces (g-type-interfaces g-type))
          (properties (class-properties g-type))
          (type-init-name (probable-type-init-name g-name))
@@ -262,7 +262,7 @@
     `(define-g-object-class ,g-name ,name 
          (:superclass ,superclass-name
                       :export t
-                      :interfaces (,@(sort (mapcar #'g-type-name interfaces) 'string<))
+                      :interfaces (,@(sort (mapcar #'gtype-name interfaces) 'string<))
                       ,@(when (and (foreign-symbol-pointer type-init-name)
                                    (not (null-pointer-p (foreign-symbol-pointer type-init-name))))
                               `(:type-initializer ,type-init-name)))
@@ -272,15 +272,15 @@
           ,@(cdr (find g-name *additional-properties* :key 'car :test 'string=))))))
 
 (defun get-g-interface-definition (interface &optional lisp-name-package)
-  (when (and (stringp interface) (zerop (g-type-numeric interface)))
+  (when (and (stringp interface) (null (ignore-errors (gtype interface))))
     (let ((type-init-name (probable-type-init-name interface)))
       (when (foreign-symbol-pointer type-init-name)
         (foreign-funcall-pointer (foreign-symbol-pointer type-init-name) () :int))))
   (when *generated-types*
-    (setf (gethash (g-type-string interface) *generated-types*) t))
+    (setf (gethash (gtype-name (gtype interface)) *generated-types*) t))
   (let* ((*lisp-name-package* (or lisp-name-package *lisp-name-package* *package*))
-         (type (ensure-g-type interface))
-         (g-name (g-type-name type))
+         (type (gtype interface))
+         (g-name (gtype-name type))
          (name (g-name->name g-name))
          (properties (sort (copy-list (interface-properties type))
                            #'string< :key #'g-class-property-definition-name))
@@ -295,61 +295,61 @@
                  (cdr (find g-name *additional-properties* :key 'car :test 'string=))))))
 
 (defun get-g-class-definitions-for-root-1 (type)
-  (unless (member type *generation-exclusions* :test 'g-type=)
+  (unless (member (gtype type) *generation-exclusions* :test 'g-type=)
     (iter (when (first-iteration-p)
             (unless (and *generated-types*
-                         (gethash (g-type-string type) *generated-types*))
+                         (gethash (gtype-name (gtype type)) *generated-types*))
               (appending (list (get-g-class-definition type)))))
-          (for child-type in (sort (copy-list (g-type-children type)) #'string< :key #'g-type-string))
+          (for child-type in (sort (copy-list (g-type-children type)) #'string< :key #'gtype-name))
           (appending (get-g-class-definitions-for-root-1 child-type)))))
 
 (defun get-g-class-definitions-for-root (type)
-  (setf type (ensure-g-type type))
+  (setf type (gtype type))
   (get-g-class-definitions-for-root-1 type))
 
 (defvar *referenced-types*)
 
 (defun class-or-interface-properties (type)
-  (setf type (ensure-g-type type))
+  (setf type (gtype type))
   (cond 
-    ((g-type= (g-type-fundamental type) +g-type-object+) (class-properties type))
-    ((g-type= (g-type-fundamental type) +g-type-interface+) (interface-properties type))))
+    ((g-type= (g-type-fundamental type) (gtype +g-type-object+)) (class-properties type))
+    ((g-type= (g-type-fundamental type) (gtype +g-type-interface+)) (interface-properties type))))
 
 (defun get-shallow-referenced-types (type)
-  (setf type (ensure-g-type type))
+  (setf type (gtype type))
   (remove-duplicates (sort (loop
                               for property in (class-or-interface-properties type)
                               when (g-type= type (g-class-property-definition-owner-type property))
                               collect (g-class-property-definition-type property))
                            #'string<
-                           :key #'g-type-string)
+                           :key #'gtype-name)
                      :test 'equal))
 
 (defun get-referenced-types-1 (type)
-  (setf type (ensure-g-type type))
+  (setf type (gtype type))
   (loop
-     for property-type in (sort (copy-list (get-shallow-referenced-types type)) #'string> :key #'g-type-string)
+     for property-type in (sort (copy-list (get-shallow-referenced-types type)) #'string> :key #'gtype-name)
      do (pushnew property-type *referenced-types* :test 'g-type=))
   (loop
-     for type in (sort (copy-list (g-type-children type)) #'string< :key #'g-type-string)
+     for type in (sort (copy-list (g-type-children type)) #'string< :key #'gtype-name)
      do (get-referenced-types-1 type)))
 
 (defun get-referenced-types (root-type)
   (let (*referenced-types*)
-    (get-referenced-types-1 (ensure-g-type root-type))
+    (get-referenced-types-1 (gtype root-type))
     *referenced-types*))
 
 (defun filter-types-by-prefix (types prefix)
   (remove-if-not
    (lambda (type)
-     (starts-with (g-type-name (ensure-g-type type)) prefix))
+     (starts-with (gtype-name (gtype type)) prefix))
    types))
 
 (defun filter-types-by-fund-type (types fund-type)
-  (setf fund-type (ensure-g-type fund-type))
+  (setf fund-type (gtype fund-type))
   (remove-if-not
    (lambda (type)
-     (equal (g-type-fundamental (ensure-g-type type)) fund-type))
+     (equal (g-type-fundamental (gtype type)) fund-type))
    types))
 
 (defmacro define-g-enum (g-name name (&key (export t) type-initializer) &body values)
@@ -383,15 +383,15 @@ If non-@code{NIL}, specifies the function that initializes the type: string spec
     `(,value-name ,numeric-value)))
 
 (defun get-g-enum-definition (type &optional lisp-name-package)
-  (when (and (stringp type) (zerop (g-type-numeric type)))
+  (when (and (stringp type) (null (gtype type)))
     (let ((type-init-name (probable-type-init-name type)))
       (when (foreign-symbol-pointer type-init-name)
         (foreign-funcall-pointer (foreign-symbol-pointer type-init-name) () :int))))
   (when *generated-types*
-    (setf (gethash (g-type-string type) *generated-types*) t))
+    (setf (gethash (gtype-name (gtype type)) *generated-types*) t))
   (let* ((*lisp-name-package* (or lisp-name-package *lisp-name-package* *package*))
-         (g-type (ensure-g-type type))
-         (g-name (g-type-name g-type))
+         (g-type (gtype type))
+         (g-name (gtype-name g-type))
          (name (g-name->name g-name))
          (items (get-enum-items g-type))
          (probable-type-initializer (probable-type-init-name g-name)))
@@ -434,15 +434,15 @@ If non-@code{NIL}, specifies the function that initializes the type: string spec
     `(,value-name ,numeric-value)))
 
 (defun get-g-flags-definition (type &optional lisp-name-package)
-  (when (and (stringp type) (zerop (g-type-numeric type)))
+  (when (and (stringp type) (null (gtype type)))
     (let ((type-init-name (probable-type-init-name type)))
       (when (foreign-symbol-pointer type-init-name)
         (foreign-funcall-pointer (foreign-symbol-pointer type-init-name) () :int))))
   (when *generated-types*
-    (setf (gethash (g-type-string type) *generated-types*) t))
+    (setf (gethash (gtype-name (gtype type)) *generated-types*) t))
   (let* ((*lisp-name-package* (or lisp-name-package *lisp-name-package* *package*))
-         (g-type (ensure-g-type type))
-         (g-name (g-type-name g-type))
+         (g-type (gtype type))
+         (g-name (gtype-name g-type))
          (name (g-name->name g-name))
          (items (get-flags-items g-type))
          (probable-type-initializer (probable-type-init-name g-name)))
@@ -454,7 +454,7 @@ If non-@code{NIL}, specifies the function that initializes the type: string spec
        ,@(mapcar #'flags-value->definition items))))
 
 (defun maybe-call-type-init (type)
-  (when (and (stringp type) (zerop (g-type-numeric type)))
+  (when (and (stringp type) (null (gtype type)))
     (let ((type-init-name (probable-type-init-name type)))
       (when (foreign-symbol-pointer type-init-name)
         (foreign-funcall-pointer (foreign-symbol-pointer type-init-name) () :int)))))
@@ -462,13 +462,13 @@ If non-@code{NIL}, specifies the function that initializes the type: string spec
 (defun get-g-type-definition (type &optional lisp-name-package)
   (maybe-call-type-init type)
   (cond
-    ((g-type-is-a type +g-type-enum+) (get-g-enum-definition type lisp-name-package))
-    ((g-type-is-a type +g-type-flags+) (get-g-flags-definition type lisp-name-package))
-    ((g-type-is-a type +g-type-interface+) (get-g-interface-definition type lisp-name-package))
-    ((g-type-is-a type +g-type-object+) (get-g-class-definition type lisp-name-package))
+    ((g-type-is-a type (gtype +g-type-enum+)) (get-g-enum-definition type lisp-name-package))
+    ((g-type-is-a type (gtype +g-type-flags+)) (get-g-flags-definition type lisp-name-package))
+    ((g-type-is-a type (gtype +g-type-interface+)) (get-g-interface-definition type lisp-name-package))
+    ((g-type-is-a type (gtype +g-type-object+)) (get-g-class-definition type lisp-name-package))
     (t (error "Do not know how to automatically generate type definition for ~A type ~A"
-              (g-type-string (g-type-fundamental type))
-              (or (g-type-string type) type)))))
+              (gtype-name (g-type-fundamental type))
+              (or (ignore-errors (gtype-name (gtype type))) type)))))
 
 (defun generate-types-hierarchy-to-file (file root-type &key include-referenced prefix package exceptions prologue interfaces enums flags objects exclusions additional-properties)
   (if (not (streamp file))
@@ -485,7 +485,7 @@ If non-@code{NIL}, specifies the function that initializes the type: string spec
                                           :objects objects
                                           :exclusions exclusions
                                           :additional-properties additional-properties))
-      (let* ((*generation-exclusions* (mapcar #'ensure-g-type exclusions))
+      (let* ((*generation-exclusions* (mapcar #'gtype exclusions))
              (*lisp-name-package* (or package *package*))
              (*package* *lisp-name-package*)
              (*strip-prefix* (or prefix ""))
@@ -497,7 +497,7 @@ If non-@code{NIL}, specifies the function that initializes the type: string spec
                                     (filter-types-by-prefix
                                      (get-referenced-types root-type)
                                      prefix))))
-        (setf exclusions (mapcar #'ensure-g-type exclusions))
+        (setf exclusions (mapcar #'gtype exclusions))
         (when prologue
           (write-string prologue file)
           (terpri file))
@@ -549,6 +549,6 @@ If non-@code{NIL}, specifies the function that initializes the type: string spec
            for def in (get-g-class-definitions-for-root root-type)
            do (format file "~S~%~%" def))
         (iter (for object in objects)
-              (unless (gethash (g-type-string object) *generated-types*)
+              (unless (gethash (gtype-name (gtype object)) *generated-types*)
                 (for def = (get-g-class-definition object))
                 (format file "~S~%~%" def))))))
\ No newline at end of file

diff --git a/glib/gobject.gvalue.lisp b/glib/gobject.gvalue.lisp
index f7922fa..a353c9a 100644 (file)
--- a/glib/gobject.gvalue.lisp
+++ b/glib/gobject.gvalue.lisp
@@ -23,53 +23,61 @@
                     `(t ,@forms)
                     `((equalp ,key ,value) ,@forms)))))))
 
-(defgeneric parse-g-value-for-type (gvalue-ptr type-numeric parse-kind))
+(defgeneric parse-g-value-for-type (gvalue-ptr gtype parse-kind))
 
-(defmethod parse-g-value-for-type (gvalue-ptr type-numeric parse-kind)
-  (if (g-type= type-numeric (g-type-fundamental type-numeric))
+(defmethod parse-g-value-for-type :around (gvalue-ptr gtype parse-kind)
+  (assert (typep gtype '(or gtype nil)))
+  (call-next-method))
+
+(defmethod parse-g-value-for-type (gvalue-ptr gtype parse-kind)
+  (if (eq gtype (g-type-fundamental gtype))
       (call-next-method)
-      (parse-g-value-for-type gvalue-ptr (g-type-numeric (g-type-fundamental type-numeric)) parse-kind)))
+      (parse-g-value-for-type gvalue-ptr (g-type-fundamental gtype) parse-kind)))
 
 (defun parse-g-value (gvalue &key (parse-kind :get-property))
   "Parses the GValue structure and returns the corresponding Lisp object.
 
 @arg[value]{a C pointer to the GValue structure}
 @return{value contained in the GValue structure. Type of value depends on GValue type}"
-  (let* ((type (g-type-numeric (g-value-type gvalue)))
-         (fundamental-type (g-type-numeric (g-type-fundamental type))))
+  (let* ((type (g-value-type gvalue))
+         (fundamental-type (g-type-fundamental type)))
     (ev-case fundamental-type
-      (+g-type-invalid+ (error "GValue is of invalid type (~A)" (g-type-name type)))
-      (+g-type-void+ nil)
-      (+g-type-char+ (g-value-get-char gvalue))
-      (+g-type-uchar+ (g-value-get-uchar gvalue))
-      (+g-type-boolean+ (g-value-get-boolean gvalue))
-      (+g-type-int+ (g-value-get-int gvalue))
-      (+g-type-uint+ (g-value-get-uint gvalue))
-      (+g-type-long+ (g-value-get-long gvalue))
-      (+g-type-ulong+ (g-value-get-ulong gvalue))
-      (+g-type-int64+ (g-value-get-int64 gvalue))
-      (+g-type-uint64+ (g-value-get-uint64 gvalue))
-      (+g-type-enum+ (parse-g-value-enum gvalue))
-      (+g-type-flags+ (parse-g-value-flags gvalue))
-      (+g-type-float+ (g-value-get-float gvalue))
-      (+g-type-double+ (g-value-get-double gvalue))
-      (+g-type-string+ (g-value-get-string gvalue))
+      ((gtype +g-type-invalid+) (error "GValue is of invalid type (~A)" (gtype-name type)))
+      ((gtype +g-type-void+) nil)
+      ((gtype +g-type-char+) (g-value-get-char gvalue))
+      ((gtype +g-type-uchar+) (g-value-get-uchar gvalue))
+      ((gtype +g-type-boolean+) (g-value-get-boolean gvalue))
+      ((gtype +g-type-int+) (g-value-get-int gvalue))
+      ((gtype +g-type-uint+) (g-value-get-uint gvalue))
+      ((gtype +g-type-long+) (g-value-get-long gvalue))
+      ((gtype +g-type-ulong+) (g-value-get-ulong gvalue))
+      ((gtype +g-type-int64+) (g-value-get-int64 gvalue))
+      ((gtype +g-type-uint64+) (g-value-get-uint64 gvalue))
+      ((gtype +g-type-enum+) (parse-g-value-enum gvalue))
+      ((gtype +g-type-flags+) (parse-g-value-flags gvalue))
+      ((gtype +g-type-float+) (g-value-get-float gvalue))
+      ((gtype +g-type-double+) (g-value-get-double gvalue))
+      ((gtype +g-type-string+) (g-value-get-string gvalue))
       (t (parse-g-value-for-type gvalue type parse-kind)))))
 
-(defmethod parse-g-value-for-type (gvalue-ptr (type-numeric (eql +g-type-pointer+)) parse-kind)
+(defmethod parse-g-value-for-type (gvalue-ptr (type (eql (gtype +g-type-pointer+))) parse-kind)
   (declare (ignore parse-kind))
   (g-value-get-pointer gvalue-ptr))
 
-(defmethod parse-g-value-for-type (gvalue-ptr (type-numeric (eql +g-type-param+)) parse-kind)
+(defmethod parse-g-value-for-type (gvalue-ptr (type (eql (gtype +g-type-param+))) parse-kind)
   (declare (ignore parse-kind))
   (parse-g-param-spec (g-value-get-param gvalue-ptr)))
 
-(defgeneric set-gvalue-for-type (gvalue-ptr type-numeric value))
+(defgeneric set-gvalue-for-type (gvalue-ptr type value))
+
+(defmethod set-gvalue-for-type :around (gvalue-ptr type value)
+  (assert (typep type '(or gtype null)))
+  (call-next-method))
 
-(defmethod set-gvalue-for-type (gvalue-ptr type-numeric value)
-  (if (g-type= type-numeric (g-type-fundamental type-numeric))
+(defmethod set-gvalue-for-type (gvalue-ptr type value)
+  (if (eq type (g-type-fundamental type))
       (call-next-method)
-      (set-gvalue-for-type gvalue-ptr (g-type-numeric (g-type-fundamental type-numeric)) value)))
+      (set-gvalue-for-type gvalue-ptr (g-type-fundamental type) value)))
 
 (defun set-g-value (gvalue value type &key zero-g-value unset-g-value (g-value-init t))
   "Assigns the GValue structure @code{gvalue} the value @code{value} of GType @code{type}.
@@ -80,35 +88,35 @@
 @arg[zero-g-value]{a boolean specifying whether GValue should be zero-initialized before assigning. See @fun{g-value-zero}}
 @arg[unset-g-value]{a boolean specifying whether GValue should be \"unset\" before assigning. See @fun{g-value-unset}. The \"true\" value should not be passed to both @code{zero-g-value} and @code{unset-g-value} arguments}
 @arg[g-value-init]{a boolean specifying where GValue should be initialized}"
-  (setf type (g-type-numeric type))
+  (setf type (gtype type))
   (cond
     (zero-g-value (g-value-zero gvalue))
     (unset-g-value (g-value-unset gvalue)))
   (when g-value-init (g-value-init gvalue type))
-  (let ((fundamental-type (ensure-g-type (g-type-fundamental type))))
+  (let ((fundamental-type (g-type-fundamental type)))
     (ev-case fundamental-type
-      (+g-type-invalid+ (error "Invalid type (~A)" type))
-      (+g-type-void+ nil)
-      (+g-type-char+ (g-value-set-char gvalue value))
-      (+g-type-uchar+ (g-value-set-uchar gvalue value))
-      (+g-type-boolean+ (g-value-set-boolean gvalue value))
-      (+g-type-int+ (g-value-set-int gvalue value))
-      (+g-type-uint+ (g-value-set-uint gvalue value))
-      (+g-type-long+ (g-value-set-long gvalue value))
-      (+g-type-ulong+ (g-value-set-ulong gvalue value))
-      (+g-type-int64+ (g-value-set-int64 gvalue value))
-      (+g-type-uint64+ (g-value-set-uint64 gvalue value))
-      (+g-type-enum+ (set-gvalue-enum gvalue value))
-      (+g-type-flags+ (set-gvalue-flags gvalue value))
-      (+g-type-float+ (unless (realp value) (error "~A is not a real number" value)) (g-value-set-float gvalue (coerce value 'single-float)))
-      (+g-type-double+ (unless (realp value) (error "~A is not a real number" value)) (g-value-set-double gvalue (coerce value 'double-float)))
-      (+g-type-string+ (g-value-set-string gvalue value))
+      ((gtype +g-type-invalid+) (error "Invalid type (~A)" type))
+      ((gtype +g-type-void+) nil)
+      ((gtype +g-type-char+) (g-value-set-char gvalue value))
+      ((gtype +g-type-uchar+) (g-value-set-uchar gvalue value))
+      ((gtype +g-type-boolean+) (g-value-set-boolean gvalue value))
+      ((gtype +g-type-int+) (g-value-set-int gvalue value))
+      ((gtype +g-type-uint+) (g-value-set-uint gvalue value))
+      ((gtype +g-type-long+) (g-value-set-long gvalue value))
+      ((gtype +g-type-ulong+) (g-value-set-ulong gvalue value))
+      ((gtype +g-type-int64+) (g-value-set-int64 gvalue value))
+      ((gtype +g-type-uint64+) (g-value-set-uint64 gvalue value))
+      ((gtype +g-type-enum+) (set-gvalue-enum gvalue value))
+      ((gtype +g-type-flags+) (set-gvalue-flags gvalue value))
+      ((gtype +g-type-float+) (unless (realp value) (error "~A is not a real number" value)) (g-value-set-float gvalue (coerce value 'single-float)))
+      ((gtype +g-type-double+) (unless (realp value) (error "~A is not a real number" value)) (g-value-set-double gvalue (coerce value 'double-float)))
+      ((gtype +g-type-string+) (g-value-set-string gvalue value))
       (t (set-gvalue-for-type gvalue type value)))))
 
-(defmethod set-gvalue-for-type (gvalue-ptr (type-numeric (eql +g-type-pointer+)) value)
+(defmethod set-gvalue-for-type (gvalue-ptr (type (eql (gtype +g-type-pointer+))) value)
   (g-value-set-pointer gvalue-ptr value))
 
-(defmethod set-gvalue-for-type (gvalue-ptr (type-numeric (eql +g-type-param+)) value)
+(defmethod set-gvalue-for-type (gvalue-ptr (type (eql (gtype +g-type-param+))) value)
   (declare (ignore gvalue-ptr value))
   (error "Setting of GParam is not implemented"))
 
@@ -122,7 +130,7 @@
 
 (defun parse-g-value-enum (gvalue)
   (let* ((g-type (g-value-type gvalue))
-         (type-name (g-type-name g-type))
+         (type-name (gtype-name g-type))
          (enum-type (registered-enum-type type-name)))
     (unless enum-type
       (error "Enum ~A is not registered" type-name))
@@ -130,7 +138,7 @@
 
 (defun set-gvalue-enum (gvalue value)
   (let* ((g-type (g-value-type gvalue))
-         (type-name (g-type-name g-type))
+         (type-name (gtype-name g-type))
          (enum-type (registered-enum-type type-name)))
     (unless enum-type
       (error "Enum ~A is not registered" type-name))
@@ -147,7 +155,7 @@
 
 (defun parse-g-value-flags (gvalue)
   (let* ((g-type (g-value-type gvalue))
-         (type-name (g-type-name g-type))
+         (type-name (gtype-name g-type))
          (flags-type (registered-flags-type type-name)))
     (unless flags-type
       (error "Flags ~A is not registered" type-name))
@@ -155,7 +163,7 @@
 
 (defun set-gvalue-flags (gvalue value)
   (let* ((g-type (g-value-type gvalue))
-         (type-name (g-type-name g-type))
+         (type-name (gtype-name g-type))
          (flags-type (registered-flags-type type-name)))
     (unless flags-type
       (error "Flags ~A is not registered" type-name))

diff --git a/glib/gobject.meta.lisp b/glib/gobject.meta.lisp
index 36599d7..adcb9d8 100644 (file)
--- a/glib/gobject.meta.lisp
+++ b/glib/gobject.meta.lisp
@@ -19,21 +19,21 @@
       (let* ((initializer-fn-ptr (foreign-symbol-pointer (gobject-class-g-type-initializer class)))
              (type (when initializer-fn-ptr
                      (foreign-funcall-pointer initializer-fn-ptr nil
-                                              g-type))))
+                                              g-type-designator))))
         (if (null initializer-fn-ptr)
             (warn "Type initializer for class '~A' (GType '~A') is invalid: foreign symbol '~A'"
                   (gobject-class-direct-g-type-name class) (class-name class) (gobject-class-g-type-initializer class))
             (progn
-              (when (g-type= +g-type-invalid+ type)
+              (when (eq (gtype +g-type-invalid+) type)
                 (warn "Declared GType name '~A' for class '~A' is invalid ('~A' returned 0)"
                       (gobject-class-direct-g-type-name class) (class-name class)
                       (gobject-class-g-type-initializer class)))
-              (unless (g-type= (gobject-class-direct-g-type-name class) type)
+              (unless (eq (gtype (gobject-class-direct-g-type-name class)) type)
                 (warn "Declared GType name '~A' for class '~A' does not match actual GType name '~A'"
                       (gobject-class-direct-g-type-name class)
                       (class-name class)
-                      (g-type-name type))))))
-      (unless (g-type-from-name (gobject-class-direct-g-type-name class))
+                      (gtype-name type))))))
+      (unless (gtype (gobject-class-direct-g-type-name class))
         (warn "Declared GType name '~A' for class '~A' is invalid (g_type_name returned 0)"
               (gobject-class-direct-g-type-name class) (class-name class)))))
 

diff --git a/glib/gobject.object.high.lisp b/glib/gobject.object.high.lisp
index f1cca2e..db156d1 100644 (file)
--- a/glib/gobject.object.high.lisp
+++ b/glib/gobject.object.high.lisp
@@ -160,19 +160,19 @@
 (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))
+  (setf g-type (gtype g-type))
   (loop
-     while (not (zerop g-type))
-     for lisp-type = (gethash (g-type-name g-type) *registered-object-types*)
+     while (not (null g-type))
+     for lisp-type = (gethash (gtype-name g-type) *registered-object-types*)
      when lisp-type do (return lisp-type)
-     do (setf g-type (ensure-g-type (g-type-parent g-type)))))
+     do (setf g-type (g-type-parent g-type))))
 
 (defun make-g-object-from-pointer (pointer)
   (let* ((g-type (g-type-from-instance pointer))
          (lisp-type (get-g-object-lisp-type g-type)))
     (unless lisp-type
       (error "Type ~A is not registered with REGISTER-OBJECT-TYPE"
-             (g-type-name g-type)))
+             (gtype-name g-type)))
     (let ((*current-object-from-pointer* pointer))
       (make-instance lisp-type :pointer pointer))))
 
@@ -217,15 +217,6 @@
 
 (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)
-                (error "Type ~A is invalid" type)))))
-
 (defun ensure-object-pointer (object)
   (if (pointerp object)
       object
@@ -238,16 +229,16 @@
 (defun set-gvalue-object (gvalue value)
   (g-value-set-object gvalue (if value (pointer value) (null-pointer))))
 
-(defmethod parse-g-value-for-type (gvalue-ptr (type-numeric (eql +g-type-object+)) parse-kind)
+(defmethod parse-g-value-for-type (gvalue-ptr (type (eql (gtype +g-type-object+))) parse-kind)
   (declare (ignore parse-kind))
   (parse-g-value-object gvalue-ptr))
 
-(defmethod parse-g-value-for-type (gvalue-ptr (type-numeric (eql +g-type-interface+)) parse-kind)
+(defmethod parse-g-value-for-type (gvalue-ptr (type (eql (gtype +g-type-interface+))) parse-kind)
   (declare (ignore parse-kind))
   (parse-g-value-object gvalue-ptr))
 
-(defmethod set-gvalue-for-type (gvalue-ptr (type-numeric (eql +g-type-object+)) value)
+(defmethod set-gvalue-for-type (gvalue-ptr (type (eql (gtype +g-type-object+))) value)
   (set-gvalue-object gvalue-ptr value))
 
-(defmethod set-gvalue-for-type (gvalue-ptr (type-numeric (eql +g-type-interface+)) value)
+(defmethod set-gvalue-for-type (gvalue-ptr (type (eql (gtype +g-type-interface+))) value)
   (set-gvalue-object gvalue-ptr value))

diff --git a/glib/gobject.object.low.lisp b/glib/gobject.object.low.lisp
index 560b1fd..bac29ec 100644 (file)
--- a/glib/gobject.object.low.lisp
+++ b/glib/gobject.object.low.lisp
@@ -8,13 +8,13 @@
   (g-type-from-instance object-ptr))
 
 (defun g-type-from-class (g-class)
-  (g-type-name (foreign-slot-value g-class 'g-type-class :type)))
+  (foreign-slot-value g-class 'g-type-class :type))
 
 (defun g-type-from-instance (type-instance)
   (g-type-from-class (foreign-slot-value type-instance 'g-type-instance :class)))
 
 (defun g-type-from-interface (type-interface)
-  (g-type-name (foreign-slot-value type-interface 'g-type-interface :type)))
+  (foreign-slot-value type-interface 'g-type-interface :type))
 
 (define-condition property-access-error (error)
   ((property-name :initarg :property-name :reader property-access-error-property-name)
@@ -40,11 +40,11 @@
     (when (and assert-readable (not (g-class-property-definition-readable property)))
       (error 'property-unreadable-error
              :property-name property-name
-             :class-name (g-type-string object-type)))
+             :class-name (gtype-name (gtype object-type))))
     (when (and assert-writable (not (g-class-property-definition-writable property)))
       (error 'property-unwritable-error
              :property-name property-name
-             :class-name (g-type-string object-type)))
+             :class-name (gtype-name (gtype object-type))))
     (g-class-property-definition-type property)))
 
 (defun g-object-property-type (object-ptr property-name &key assert-readable assert-writable)

diff --git a/glib/gobject.package.lisp b/glib/gobject.package.lisp
index b9be3e8..64e8764 100644 (file)
--- a/glib/gobject.package.lisp
+++ b/glib/gobject.package.lisp
@@ -1,8 +1,9 @@
 (defpackage :gobject
   (:use :c2cl :glib :cffi :tg :bordeaux-threads :iter :closer-mop :gobject.ffi)
   (:export #:g-type
-           #:g-type-string
-           #:g-type-numeric
+           #:gtype
+           #:gtype-name
+           #:gtype-id
            #:g-type-children
            #:g-type-parent
            #:g-type-designator
@@ -71,8 +72,6 @@
            #:g-object
            #:pointer
            #:g-type-from-object
-           #:g-type-name
-           #:g-type-from-name
            #:g-signal-connect
            #:define-g-object-class
            #:g-initially-unowned
@@ -125,7 +124,6 @@
            #:g-type-interfaces
            #:g-type-interface-prerequisites
            #:g-type-name
-           #:g-type-from-name
            #:g-type
            #:g-type-children
            #:g-type-parent

diff --git a/glib/gobject.signals.lisp b/glib/gobject.signals.lisp
index 46777c0..99d77e5 100644 (file)
--- a/glib/gobject.signals.lisp
+++ b/glib/gobject.signals.lisp
@@ -119,7 +119,7 @@ If @code{after} is true, then the function will be called after the default hand
               (for type in (signal-info-param-types signal-info))
               (set-g-value (mem-aref params 'g-value (1+ i)) arg type :zero-g-value t))
         (prog1
-            (if (g-type= (signal-info-return-type signal-info) +g-type-void+)
+            (if (eq (signal-info-return-type signal-info) (gtype +g-type-void+))
                 (g-signal-emitv params (signal-info-id signal-info) signal-name (null-pointer))
                 (with-foreign-object (return-value 'g-value)
                   (g-value-zero return-value)

diff --git a/glib/gobject.type-designator.lisp b/glib/gobject.type-designator.lisp
index 8546386..47b8d0d 100644 (file)
--- a/glib/gobject.type-designator.lisp
+++ b/glib/gobject.type-designator.lisp
@@ -107,60 +107,15 @@ Numeric identifier of GType may be different between different program runs. But
   (logxor g-type (ldb (byte 1 0) g-type)));;subtract the G_SIGNAL_TYPE_STATIC_SCOPE
 
 (defmethod translate-from-foreign (value (type g-type-designator))
-  (g-type-name (if (g-type-designator-mangled-p type)
-                   (unmangle-g-type value)
-                   value)))
+  (gtype (if (g-type-designator-mangled-p type)
+             (unmangle-g-type value)
+             value)))
 
 (defmethod translate-to-foreign (value (type g-type-designator))
-  (etypecase value
-    (string (g-type-from-name value))
-    (integer value)
-    (null 0)))
-
-(defun g-type-numeric (g-type-designator)
-  (etypecase g-type-designator
-    (string (g-type-from-name g-type-designator))
-    (integer g-type-designator)
-    (null 0)))
-
-(defun g-type-string (g-type-designator)
-  (etypecase g-type-designator
-    (string (g-type-name g-type-designator))
-    (integer (g-type-name g-type-designator))
-    (null nil)))
-
-(defcfun (g-type-name "g_type_name") :string
-  "Returns the name of a GType.@see{g-type-from-name}
-
-Example:
-@pre{
-\(g-type-from-name \"GtkLabel\")
-=> 7151952
-\(g-type-name 7151952)
-=> \"GtkLabel\"
-}
-@arg[type]{GType designator (see @class{g-type-designator})}
-@return{a string}"
-  (type g-type-designator))
-
-(defcfun (g-type-from-name "g_type_from_name") g-type
-  "Returns the numeric identifier of a GType by its name. @see{g-type-name}
-
-Example:
-@pre{
-\(g-type-from-name \"GtkLabel\")
-=> 7151952
-\(g-type-name 7151952)
-=> \"GtkLabel\"
-}
-@arg[name]{a string - name of GType}
-@return{an integer}"
-  (name :string))
+  (gtype-id (gtype value)))
 
 (defun g-type= (type-1 type-2)
-  (= (g-type-numeric type-1)
-     (g-type-numeric type-2)))
+  (eq (gtype type-1) (gtype type-2)))
 
 (defun g-type/= (type-1 type-2)
-  (/= (g-type-numeric type-1)
-      (g-type-numeric type-2)))
+  (not (eq (gtype type-1) (gtype type-2))))

diff --git a/glib/gobject.type-info.object.lisp b/glib/gobject.type-info.object.lisp
index 27b7db0..94f95f1 100644 (file)
--- a/glib/gobject.type-info.object.lisp
+++ b/glib/gobject.type-info.object.lisp
@@ -28,7 +28,7 @@ See accessor functions:
       (print-unreadable-object (instance stream)
         (format stream
                 "PROPERTY ~A ~A.~A (flags:~@[~* readable~]~@[~* writable~]~@[~* constructor~]~@[~* constructor-only~])"
-                (g-class-property-definition-type instance)
+                (gtype-name (g-class-property-definition-type instance))
                 (g-class-property-definition-owner-type instance)
                 (g-class-property-definition-name instance)
                 (g-class-property-definition-readable instance)

diff --git a/glib/gobject.type-info.signals.lisp b/glib/gobject.type-info.signals.lisp
index 22c1e3a..4c093d6 100644 (file)
--- a/glib/gobject.type-info.signals.lisp
+++ b/glib/gobject.type-info.signals.lisp
@@ -16,11 +16,11 @@
         (format stream
                 "Signal [#~A] ~A ~A.~A~@[::~A~](~{~A~^, ~})~@[ [~{~A~^, ~}]~]"
                 (signal-info-id instance)
-                (g-type-string (signal-info-return-type instance))
-                (g-type-string (signal-info-owner-type instance))
+                (gtype-name (signal-info-return-type instance))
+                (gtype-name (signal-info-owner-type instance))
                 (signal-info-name instance)
                 (signal-info-detail instance)
-                (mapcar #'g-type-string (signal-info-param-types instance))
+                (mapcar #'gtype-name (signal-info-param-types instance))
                 (signal-info-flags instance)))))
 
 (defun query-signal-info (signal-id)

diff --git a/gtk-glext/demo.lisp b/gtk-glext/demo.lisp
index 1efbde7..d2c1fe7 100644 (file)
--- a/gtk-glext/demo.lisp
+++ b/gtk-glext/demo.lisp
@@ -71,7 +71,9 @@
                                  :default-height 500))
           (area (make-instance 'gl-drawing-area :on-expose #'planet-draw :on-resize #'planet-resize)))
       (container-add window area)
-      (pushnew :key-press-mask (gdk:gdk-window-events (widget-window window)))
+      (connect-signal window "realize"
+                      (lambda (w)
+                        (pushnew :key-press-mask (gdk:gdk-window-events (widget-window window)))))
       (connect-signal window "key-press-event"
                       (lambda (w e)
                         (declare (ignore w))

diff --git a/gtk/gtk.child-properties.lisp b/gtk/gtk.child-properties.lisp
index 8930e97..29302df 100644 (file)
--- a/gtk/gtk.child-properties.lisp
+++ b/gtk/gtk.child-properties.lisp
@@ -28,14 +28,14 @@
 (defun container-call-get-property (container child property-name type)
   (with-foreign-object (gvalue 'g-value)
     (g-value-zero gvalue)
-    (g-value-init gvalue (ensure-g-type type))
+    (g-value-init gvalue (gtype type))
     (gtk-container-child-get-property container child property-name gvalue)
     (prog1 (parse-g-value gvalue)
       (g-value-unset gvalue))))
 
 (defun container-call-set-property (container child property-name new-value type)
   (with-foreign-object (gvalue 'g-value)
-    (set-g-value gvalue new-value (ensure-g-type type) :zero-g-value t)
+    (set-g-value gvalue new-value (gtype type) :zero-g-value t)
     (gtk-container-child-set-property container child property-name gvalue)
     (g-value-unset gvalue)
     (values)))
@@ -61,7 +61,7 @@
   (n-properties (:pointer :int)))
 
 (defun container-class-child-properties (g-type)
-  (setf g-type (ensure-g-type g-type))
+  (setf g-type (gtype g-type))
   (let ((g-class (g-type-class-ref g-type)))
     (unwind-protect
          (with-foreign-object (n-properties :uint)
@@ -78,15 +78,15 @@
   (intern (format nil "~A-CHILD-~A" (symbol-name (registered-object-type-by-name type-name)) (string-upcase property-name)) (find-package package-name)))
 
 (defun generate-child-properties (&optional (type-root "GtkContainer") (package-name "GTK"))
-  (setf type-root (ensure-g-type type-root))
+  (setf type-root (gtype type-root))
   (append (loop
              for property in (container-class-child-properties type-root)
              collect
                `(define-child-property
-                    ,(g-type-name type-root)
-                    ,(child-property-name (g-type-name type-root) (g-class-property-definition-name property) package-name)
+                    ,(gtype-name type-root)
+                    ,(child-property-name (gtype-name type-root) (g-class-property-definition-name property) package-name)
                   ,(g-class-property-definition-name property)
-                  ,(g-type-name (g-class-property-definition-type property))
+                  ,(gtype-name (g-class-property-definition-type property))
                   ,(g-class-property-definition-readable property)
                   ,(g-class-property-definition-writable property)
                   t))

diff --git a/gtk/gtk.widget.lisp b/gtk/gtk.widget.lisp
index 2239db3..bc4b75c 100644 (file)
--- a/gtk/gtk.widget.lisp
+++ b/gtk/gtk.widget.lisp
@@ -500,7 +500,7 @@
   (n-properties (:pointer :int)))
 
 (defun widget-get-style-properties (type)
-  (setf type (ensure-g-type type))
+  (setf type (gtype type))
   (let ((class (g-type-class-ref type)))
     (unwind-protect
          (with-foreign-object (np :int)
@@ -531,7 +531,7 @@
 
 (defun widget-style-property-value (widget property-name &optional property-type)
   (unless property-type (setf property-type (widget-style-property-type widget property-name)))
-  (setf property-type (ensure-g-type property-type))
+  (setf property-type (gtype property-type))
   (with-foreign-object (gvalue 'g-value)
     (g-value-zero gvalue)
     (g-value-init gvalue property-type)