projects
/
cl-gtk2.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
glib: use copy-slots-to-{native,proxy} in variant-cstruct
[cl-gtk2.git]
/
glib
/
gobject.generating.lisp
diff --git
a/glib/gobject.generating.lisp
b/glib/gobject.generating.lisp
index
0b7ebeb
..
cac7f48
100644
(file)
--- a/
glib/gobject.generating.lisp
+++ b/
glib/gobject.generating.lisp
@@
-1,6
+1,6
@@
(in-package :gobject)
(in-package :gobject)
-(defvar *lisp-name-package* (find-package :gobject)
+(defvar *lisp-name-package* nil
"For internal use (used by class definitions generator). Specifies the package in which symbols are interned.")
(defvar *strip-prefix* "")
(defvar *lisp-name-exceptions* nil)
"For internal use (used by class definitions generator). Specifies the package in which symbols are interned.")
(defvar *strip-prefix* "")
(defvar *lisp-name-exceptions* nil)
@@
-136,7
+136,9
@@
(defun type-initializer-call (type-initializer)
(etypecase type-initializer
(defun type-initializer-call (type-initializer)
(etypecase type-initializer
- (string `(foreign-funcall ,type-initializer g-type))
+ (string `(if (foreign-symbol-pointer ,type-initializer)
+ (foreign-funcall ,type-initializer g-type)
+ (warn "Type initializer '~A' is not available" ,type-initializer)))
(symbol `(funcall ',type-initializer))))
(defun meta-property->slot (class-name property)
(symbol `(funcall ',type-initializer))))
(defun meta-property->slot (class-name property)
@@
-231,8
+233,9
@@
(write-char (char-downcase c) stream))
(write-string "_get_type" stream)))
(write-char (char-downcase c) stream))
(write-string "_get_type" stream)))
-(defun get-g-class-definition (type)
- (let* ((g-type (ensure-g-type type))
+(defun get-g-class-definition (type &optional lisp-name-package)
+ (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))
(name (g-name->name g-name))
(superclass-g-type (g-type-parent g-type))
(g-name (g-type-name g-type))
(name (g-name->name g-name))
(superclass-g-type (g-type-parent g-type))
@@
-242,8
+245,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-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
@@
-257,8
+259,9
@@
own-properties)
,@(cdr (find g-name *additional-properties* :key 'car :test 'string=))))))
own-properties)
,@(cdr (find g-name *additional-properties* :key 'car :test 'string=))))))
-(defun get-g-interface-definition (interface)
- (let* ((type (ensure-g-type interface))
+(defun get-g-interface-definition (interface &optional lisp-name-package)
+ (let* ((*lisp-name-package* (or lisp-name-package *lisp-name-package* *package*))
+ (type (ensure-g-type interface))
(g-name (g-type-name type))
(name (g-name->name g-name))
(properties (interface-properties type))
(g-name (g-type-name type))
(name (g-name->name g-name))
(properties (interface-properties type))
@@
-273,7
+276,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
@@
-288,23
+291,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-fundamental type) +g-type-object+) (class-properties type))
- ((= (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 (= type (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)))
@@
-349,7
+353,7
@@
If non-@code{NIL}, specifies the function that initializes the type: string spec
,@(when export
(list `(export ',name (find-package ,(package-name (symbol-package name))))))
,@(when type-initializer
,@(when export
(list `(export ',name (find-package ,(package-name (symbol-package name))))))
,@(when type-initializer
- (list (type-initializer-call type-initializer)))))
+ (list `(at-init () ,(type-initializer-call type-initializer))))))
(defun enum-value->definition (enum-value)
(let ((value-name (intern (lispify-name (enum-item-nick enum-value))
(defun enum-value->definition (enum-value)
(let ((value-name (intern (lispify-name (enum-item-nick enum-value))
@@
-357,8
+361,9
@@
If non-@code{NIL}, specifies the function that initializes the type: string spec
(numeric-value (enum-item-value enum-value)))
`(,value-name ,numeric-value)))
(numeric-value (enum-item-value enum-value)))
`(,value-name ,numeric-value)))
-(defun get-g-enum-definition (type)
- (let* ((g-type (ensure-g-type type))
+(defun get-g-enum-definition (type &optional lisp-name-package)
+ (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))
(name (g-name->name g-name))
(items (get-enum-items g-type))
(g-name (g-type-name g-type))
(name (g-name->name g-name))
(items (get-enum-items g-type))
@@
-393,7
+398,7
@@
If non-@code{NIL}, specifies the function that initializes the type: string spec
,@(when export
(list `(export ',name (find-package ,(package-name (symbol-package name))))))
,@(when type-initializer
,@(when export
(list `(export ',name (find-package ,(package-name (symbol-package name))))))
,@(when type-initializer
- (list (type-initializer-call type-initializer)))))
+ (list `(at-init () ,(type-initializer-call type-initializer))))))
(defun flags-value->definition (flags-value)
(let ((value-name (intern (lispify-name (flags-item-nick flags-value))
(defun flags-value->definition (flags-value)
(let ((value-name (intern (lispify-name (flags-item-nick flags-value))
@@
-401,8
+406,9
@@
If non-@code{NIL}, specifies the function that initializes the type: string spec
(numeric-value (flags-item-value flags-value)))
`(,value-name ,numeric-value)))
(numeric-value (flags-item-value flags-value)))
`(,value-name ,numeric-value)))
-(defun get-g-flags-definition (type)
- (let* ((g-type (ensure-g-type type))
+(defun get-g-flags-definition (type &optional lisp-name-package)
+ (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))
(name (g-name->name g-name))
(items (get-flags-items g-type))
(g-name (g-type-name g-type))
(name (g-name->name g-name))
(items (get-flags-items g-type))
@@
-449,24
+455,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
@@
-474,7
+480,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
@@
-482,7
+488,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