From: Dmitry Kalyanov Date: Fri, 17 Jul 2009 22:16:09 +0000 (+0400) Subject: Introduce g-type= and g-type/= X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=8f0e8ac54c6c9e6e0febeae3d0dab204402e6026;p=cl-gtk2.git Introduce g-type= and g-type/= --- diff --git a/glib/gobject.ffi.package.lisp b/glib/gobject.ffi.package.lisp index fd28c63..7cfcc34 100644 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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))