Introduce g-type= and g-type/=

diff --git a/glib/gobject.ffi.package.lisp b/glib/gobject.ffi.package.lisp
index fd28c63..7cfcc34 100644 (file)
--- a/glib/gobject.ffi.package.lisp
+++ b/glib/gobject.ffi.package.lisp
@@ -197,4 +197,6 @@
            #:g-signal-list-ids
            #:g-type-string
            #:g-type-numeric
-           #:g-signal-parse-name))
+           #:g-signal-parse-name
+           #:g-type=
+           #:g-type/=))

diff --git a/glib/gobject.foreign-gboxed.lisp b/glib/gobject.foreign-gboxed.lisp
index 83d81bc..a19ef24 100644 (file)
--- a/glib/gobject.foreign-gboxed.lisp
+++ b/glib/gobject.foreign-gboxed.lisp
@@ -489,12 +489,12 @@ If it is a function designator then it specifies a function that accepts the new
         (t (parse-g-boxed (g-value-get-boxed gvalue) boxed-type))))))
 
 (defmethod parse-g-value-for-type (gvalue-ptr (type-numeric (eql +g-type-boxed+)))
-  (if (= (g-type-numeric (g-value-type gvalue-ptr)) type-numeric)
+  (if (g-type= (g-value-type gvalue-ptr) type-numeric)
       (convert-from-foreign (g-value-get-boxed gvalue-ptr) '(glib:gstrv :free-from-foreign nil))
       (parse-g-value-boxed gvalue-ptr)))
 
 (defmethod set-gvalue-for-type (gvalue-ptr (type-numeric (eql +g-type-boxed+)) value)
-  (if (= (g-type-numeric (g-value-type gvalue-ptr)) type-numeric)
+  (if (g-type= (g-value-type gvalue-ptr) type-numeric)
       (g-value-set-boxed gvalue-ptr (convert-to-foreign value '(glib:gstrv :free-from-foreign nil)))
       (set-gvalue-boxed gvalue-ptr value)))
 

diff --git a/glib/gobject.generating.lisp b/glib/gobject.generating.lisp
index 9ce8175..06bf496 100644 (file)
--- a/glib/gobject.generating.lisp
+++ b/glib/gobject.generating.lisp
@@ -243,8 +243,7 @@
          (type-init-name (probable-type-init-name g-name))
          (own-properties
           (remove-if-not (lambda (property)
-                           (= g-type
-                              (g-type-numeric (g-class-property-definition-owner-type property))))
+                           (g-type= g-type (g-class-property-definition-owner-type property)))
                          properties)))
     `(define-g-object-class ,g-name ,name 
          (:superclass ,superclass-name
@@ -275,7 +274,7 @@
                  (cdr (find g-name *additional-properties* :key 'car :test 'string=))))))
 
 (defun get-g-class-definitions-for-root-1 (type)
-  (unless (member (ensure-g-type type) *generation-exclusions* :test '=)
+  (unless (member type *generation-exclusions* :test 'g-type=)
     (cons (get-g-class-definition type)
           (reduce #'append
                   (mapcar #'get-g-class-definitions-for-root-1
@@ -290,23 +289,24 @@
 (defun class-or-interface-properties (type)
   (setf type (ensure-g-type type))
   (cond 
-    ((= (g-type-numeric (g-type-fundamental type)) +g-type-object+) (class-properties type))
-    ((= (g-type-numeric (g-type-fundamental type)) +g-type-interface+) (interface-properties type))))
+    ((g-type= (g-type-fundamental type) +g-type-object+) (class-properties type))
+    ((g-type= (g-type-fundamental type) +g-type-interface+) (interface-properties type))))
 
 (defun get-shallow-referenced-types (type)
   (setf type (ensure-g-type type))
   (remove-duplicates (sort (loop
                               for property in (class-or-interface-properties type)
-                              when (= (g-type-numeric type) (g-type-numeric (g-class-property-definition-owner-type property)))
+                              when (g-type= type (g-class-property-definition-owner-type property))
                               collect (g-class-property-definition-type property))
-                           #'<)
+                           #'<
+                           :key #'g-type-numeric)
                      :test 'equal))
 
 (defun get-referenced-types-1 (type)
   (setf type (ensure-g-type type))
   (loop
      for property-type in (get-shallow-referenced-types type)
-     do (pushnew property-type *referenced-types* :test '=))
+     do (pushnew property-type *referenced-types* :test 'g-type=))
   (loop
      for type in (g-type-children type)
      do (get-referenced-types-1 type)))
@@ -453,24 +453,24 @@ If non-@code{NIL}, specifies the function that initializes the type: string spec
              for interface in interfaces
              do (loop
                    for referenced-type in (get-shallow-referenced-types interface)
-                   do (pushnew referenced-type referenced-types :test 'equal)))
+                   do (pushnew referenced-type referenced-types :test 'g-type=)))
           (loop
              for object in objects
              do (loop
                    for referenced-type in (get-shallow-referenced-types object)
-                   do (pushnew referenced-type referenced-types :test 'equal)))
+                   do (pushnew referenced-type referenced-types :test 'g-type=)))
           (loop
              for enum-type in (filter-types-by-fund-type
                                referenced-types "GEnum")
              for def = (get-g-enum-definition enum-type)
-             unless (member (ensure-g-type enum-type) exclusions :test '=)
+             unless (member enum-type exclusions :test 'g-type=)
              do (format file "~S~%~%" def))
             
           (loop
              for flags-type in (filter-types-by-fund-type
                                 referenced-types "GFlags")
              for def = (get-g-flags-definition flags-type)
-             unless (member (ensure-g-type flags-type) exclusions :test '=)
+             unless (member flags-type exclusions :test 'g-type=)
              do (format file "~S~%~%" def)))
         (loop
            with auto-enums = (and include-referenced
@@ -478,7 +478,7 @@ If non-@code{NIL}, specifies the function that initializes the type: string spec
                                    referenced-types "GEnum"))
            for enum in enums
            for def = (get-g-enum-definition enum)
-           unless (find (ensure-g-type enum) auto-enums :test 'equal)
+           unless (find enum auto-enums :test 'g-type=)
            do (format file "~S~%~%" def))
         (loop
            with auto-flags = (and include-referenced
@@ -486,7 +486,7 @@ If non-@code{NIL}, specifies the function that initializes the type: string spec
                                    referenced-types "GFlags"))
            for flags-type in flags
            for def = (get-g-flags-definition flags-type)
-           unless (find (ensure-g-type flags-type) auto-flags :test 'equal)
+           unless (find flags-type auto-flags :test 'g-type=)
            do (format file "~S~%~%" def))
         (loop
            for interface in interfaces

diff --git a/glib/gobject.gvalue.lisp b/glib/gobject.gvalue.lisp
index 78fcfbe..efd3ebe 100644 (file)
--- a/glib/gobject.gvalue.lisp
+++ b/glib/gobject.gvalue.lisp
@@ -26,7 +26,7 @@
 (defgeneric parse-g-value-for-type (gvalue-ptr type-numeric))
 
 (defmethod parse-g-value-for-type (gvalue-ptr type-numeric)
-  (if (= type-numeric (g-type-numeric (g-type-fundamental type-numeric)))
+  (if (g-type= type-numeric (g-type-fundamental type-numeric))
       (call-next-method)
       (parse-g-value-for-type gvalue-ptr (g-type-numeric (g-type-fundamental type-numeric)))))
 
@@ -65,7 +65,7 @@
 (defgeneric set-gvalue-for-type (gvalue-ptr type-numeric value))
 
 (defmethod set-gvalue-for-type (gvalue-ptr type-numeric value)
-  (if (= type-numeric (g-type-numeric (g-type-fundamental type-numeric)))
+  (if (g-type= type-numeric (g-type-fundamental type-numeric))
       (call-next-method)
       (set-gvalue-for-type gvalue-ptr (g-type-numeric (g-type-fundamental type-numeric)) value)))
 

diff --git a/glib/gobject.meta.lisp b/glib/gobject.meta.lisp
index 22aab83..91ae58b 100644 (file)
--- a/glib/gobject.meta.lisp
+++ b/glib/gobject.meta.lisp
@@ -22,12 +22,11 @@
             (warn "Type initializer for class '~A' (GType '~A') is invalid: foreign symbol '~A'"
                   (gobject-class-g-type-name class) (class-name class) (gobject-class-g-type-initializer class))
             (progn
-              (when (= +g-type-invalid+ type)
+              (when (g-type= +g-type-invalid+ type)
                 (warn "Declared GType name '~A' for class '~A' is invalid ('~A' returned 0)"
                       (gobject-class-g-type-name class) (class-name class)
                       (gobject-class-g-type-initializer class)))
-              (unless (string= (gobject-class-g-type-name class)
-                               (g-type-name type))
+              (unless (g-type= (gobject-class-g-type-name class) type)
                 (warn "Declared GType name '~A' for class '~A' does not match actual GType name '~A'"
                       (gobject-class-g-type-name class)
                       (class-name class)

diff --git a/glib/gobject.object.high.lisp b/glib/gobject.object.high.lisp
index 2bf900f..d8f83e2 100644 (file)
--- a/glib/gobject.object.high.lisp
+++ b/glib/gobject.object.high.lisp
@@ -254,7 +254,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-numeric (signal-info-return-type signal-info)) +g-type-void+)
+            (if (g-type= (signal-info-return-type signal-info) +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.package.lisp b/glib/gobject.package.lisp
index 02da4f6..f0131f3 100644 (file)
--- a/glib/gobject.package.lisp
+++ b/glib/gobject.package.lisp
@@ -177,7 +177,9 @@
            #:get-g-class-definition
            #:*strip-prefix*
            #:*lisp-name-exceptions*
-           #:*additional-properties*)
+           #:*additional-properties*
+           #:g-type=
+           #:g-type/=)
   (:documentation
    "CL-GTK2-GOBJECT is a binding to GObject type system.
 For information on GObject, see its @a[http://library.gnome.org/devel/gobject/stable/]{documentation}.

diff --git a/glib/gobject.type-designator.lisp b/glib/gobject.type-designator.lisp
index d95e9b2..5468403 100644 (file)
--- a/glib/gobject.type-designator.lisp
+++ b/glib/gobject.type-designator.lisp
@@ -65,4 +65,12 @@ Example:
 }
 @arg[name]{a string - name of GType}
 @return{an integer}"
-  (name :string))
\ No newline at end of file
+  (name :string))
+
+(defun g-type= (type-1 type-2)
+  (= (g-type-numeric type-1)
+     (g-type-numeric type-2)))
+
+(defun g-type/= (type-1 type-2)
+  (/= (g-type-numeric type-1)
+      (g-type-numeric type-2)))

diff --git a/glib/gobject.type-info.signals.lisp b/glib/gobject.type-info.signals.lisp
index 2a11587..22c1e3a 100644 (file)
--- a/glib/gobject.type-info.signals.lisp
+++ b/glib/gobject.type-info.signals.lisp
@@ -47,7 +47,7 @@
         signal-info))))
 
 (defun type-signals (type &key include-inherited)
-  (unless (= (g-type-numeric type) +g-type-invalid+)
+  (unless (g-type= type +g-type-invalid+)
     (let ((signals (with-foreign-object (n-ids :uint)
                      (with-unwind (ids (g-signal-list-ids type n-ids) g-free)
                        (iter (for i from 0 below (mem-ref n-ids :uint))