X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=glib%2Fgobject.gvalue.lisp;h=a353c9a34ebbf6bef473d5aac417d3083de7bf56;hb=96aa7293addaacdfe29ce32e60e2feac7df6ffce;hp=9f0063f1a7fc2a9a81e4c2d37f9ad6b07048876e;hpb=98d3022bd45e03ddf06c4cf4bac2fba5d40f59ae;p=cl-gtk2.git diff --git a/glib/gobject.gvalue.lisp b/glib/gobject.gvalue.lisp index 9f0063f..a353c9a 100644 --- a/glib/gobject.gvalue.lisp +++ b/glib/gobject.gvalue.lisp @@ -8,7 +8,7 @@ for i from 0 below (foreign-type-size 'g-value) do (setf (mem-ref g-value :uchar i) 0))) -(defun gvalue-type (gvalue) +(defun g-value-type (gvalue) (foreign-slot-value gvalue 'g-value :type)) (defmacro ev-case (keyform &body clauses) @@ -23,51 +23,61 @@ `(t ,@forms) `((equalp ,key ,value) ,@forms))))))) -(defgeneric parse-gvalue-for-type (gvalue-ptr type-numeric)) +(defgeneric parse-g-value-for-type (gvalue-ptr gtype parse-kind)) -(defmethod parse-gvalue-for-type (gvalue-ptr type-numeric) - (if (= type-numeric (g-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-gvalue-for-type gvalue-ptr (g-type-numeric (g-type-fundamental type-numeric))))) + (parse-g-value-for-type gvalue-ptr (g-type-fundamental gtype) parse-kind))) -(defun parse-gvalue (gvalue) +(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 (gvalue-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-gvalue-enum gvalue)) - (+g-type-flags+ (parse-gvalue-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)) - (t (parse-gvalue-for-type gvalue type))))) - -(defmethod parse-gvalue-for-type (gvalue-ptr (type-numeric (eql +g-type-pointer+))) + ((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 (eql (gtype +g-type-pointer+))) parse-kind) + (declare (ignore parse-kind)) (g-value-get-pointer gvalue-ptr)) -(defmethod parse-gvalue-for-type (gvalue-ptr (type-numeric (eql +g-type-param+))) +(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 (= type-numeric (g-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}. @@ -78,35 +88,36 @@ @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")) ;;Enums @@ -117,17 +128,17 @@ (defun registered-enum-type (name) (gethash name *registered-enum-types*)) -(defun parse-gvalue-enum (gvalue) - (let* ((g-type (gvalue-type gvalue)) - (type-name (g-type-name g-type)) +(defun parse-g-value-enum (gvalue) + (let* ((g-type (g-value-type gvalue)) + (type-name (gtype-name g-type)) (enum-type (registered-enum-type type-name))) (unless enum-type (error "Enum ~A is not registered" type-name)) (convert-from-foreign (g-value-get-enum gvalue) enum-type))) (defun set-gvalue-enum (gvalue value) - (let* ((g-type (gvalue-type gvalue)) - (type-name (g-type-name g-type)) + (let* ((g-type (g-value-type gvalue)) + (type-name (gtype-name g-type)) (enum-type (registered-enum-type type-name))) (unless enum-type (error "Enum ~A is not registered" type-name)) @@ -142,17 +153,17 @@ (defun registered-flags-type (name) (gethash name *registered-flags-types*)) -(defun parse-gvalue-flags (gvalue) - (let* ((g-type (gvalue-type gvalue)) - (type-name (g-type-name g-type)) +(defun parse-g-value-flags (gvalue) + (let* ((g-type (g-value-type gvalue)) + (type-name (gtype-name g-type)) (flags-type (registered-flags-type type-name))) (unless flags-type (error "Flags ~A is not registered" type-name)) (convert-from-foreign (g-value-get-flags gvalue) flags-type))) (defun set-gvalue-flags (gvalue value) - (let* ((g-type (gvalue-type gvalue)) - (type-name (g-type-name g-type)) + (let* ((g-type (g-value-type gvalue)) + (type-name (gtype-name g-type)) (flags-type (registered-flags-type type-name))) (unless flags-type (error "Flags ~A is not registered" type-name))