From 140e8f22e7a58c7b1eef05124b2929e73388c5f6 Mon Sep 17 00:00:00 2001 From: Dmitry Kalyanov Date: Wed, 3 Feb 2010 03:17:08 +0300 Subject: [PATCH] Use new GType designators --- glib/gobject.boxed.lisp | 8 +- glib/gobject.ffi.package.lisp | 9 +- glib/gobject.foreign-gobject-subclassing.lisp | 62 +++++++------- glib/gobject.generating.lisp | 90 ++++++++++---------- glib/gobject.gvalue.lisp | 112 +++++++++++++------------ glib/gobject.meta.lisp | 10 +-- glib/gobject.object.high.lisp | 27 ++---- glib/gobject.object.low.lisp | 8 +- glib/gobject.package.lisp | 8 +- glib/gobject.signals.lisp | 2 +- glib/gobject.type-designator.lisp | 57 ++----------- glib/gobject.type-info.object.lisp | 2 +- glib/gobject.type-info.signals.lisp | 6 +- gtk-glext/demo.lisp | 4 +- gtk/gtk.child-properties.lisp | 14 ++-- gtk/gtk.widget.lisp | 4 +- 16 files changed, 187 insertions(+), 236 deletions(-) diff --git a/glib/gobject.boxed.lisp b/glib/gobject.boxed.lisp index e5ba0c5..1445389 100644 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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) -- 1.7.10.4