projects
/
cl-gtk2.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
0d98253
)
Introduce g-type= and g-type/=
author
Dmitry Kalyanov
<Kalyanov.Dmitry@gmail.com>
Fri, 17 Jul 2009 22:16:09 +0000
(
02:16
+0400)
committer
Dmitry Kalyanov
<Kalyanov.Dmitry@gmail.com>
Fri, 17 Jul 2009 22:16:09 +0000
(
02:16
+0400)
glib/gobject.ffi.package.lisp
patch
|
blob
|
history
glib/gobject.foreign-gboxed.lisp
patch
|
blob
|
history
glib/gobject.generating.lisp
patch
|
blob
|
history
glib/gobject.gvalue.lisp
patch
|
blob
|
history
glib/gobject.meta.lisp
patch
|
blob
|
history
glib/gobject.object.high.lisp
patch
|
blob
|
history
glib/gobject.package.lisp
patch
|
blob
|
history
glib/gobject.type-designator.lisp
patch
|
blob
|
history
glib/gobject.type-info.signals.lisp
patch
|
blob
|
history
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-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+)))
(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)
(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)))
(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)
(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
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)
(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
(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
(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)
(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))
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)
: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)))
(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)
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)
(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)
(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)
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
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)
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
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)
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
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)
(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)))))
(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)
(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)))
(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
(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)))
(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)
(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
(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)
(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*
#: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}.
(: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}"
}
@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)
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))
(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))