X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=glib%2Fgobject.gvalue.lisp;h=f7922fa7312f1d8da57a72c9df375f2097a116e6;hb=02c0f62d617212f4e51224a2f7e76074dac1378e;hp=69f4a4b1491396748d49806dfa06b6b8b4ec3c6b;hpb=2d8fe8a9741bd87969a85fa016318c71cf82398f;p=cl-gtk2.git diff --git a/glib/gobject.gvalue.lisp b/glib/gobject.gvalue.lisp index 69f4a4b..f7922fa 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,19 +23,19 @@ `(t ,@forms) `((equalp ,key ,value) ,@forms))))))) -(defgeneric parse-gvalue-for-type (gvalue-ptr type-numeric)) +(defgeneric parse-g-value-for-type (gvalue-ptr type-numeric 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 (gvalue-ptr type-numeric parse-kind) + (if (g-type= type-numeric (g-type-fundamental type-numeric)) (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-numeric (g-type-fundamental type-numeric)) 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))) + (let* ((type (g-type-numeric (g-value-type gvalue))) (fundamental-type (g-type-numeric (g-type-fundamental type)))) (ev-case fundamental-type (+g-type-invalid+ (error "GValue is of invalid type (~A)" (g-type-name type))) @@ -49,34 +49,25 @@ (+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-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)) - (t (parse-gvalue-for-type gvalue type))))) + (t (parse-g-value-for-type gvalue type parse-kind))))) -(defmethod parse-gvalue-for-type (gvalue-ptr (type-numeric (eql +g-type-pointer+))) +(defmethod parse-g-value-for-type (gvalue-ptr (type-numeric (eql +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-boxed+))) - (if (= (g-type-numeric (gvalue-type gvalue-ptr)) type-numeric) - (convert-from-foreign (g-value-get-boxed gvalue-ptr) '(glib:gstrv :free-from-foreign nil)) - (parse-gvalue-boxed gvalue-ptr))) - -(defmethod parse-gvalue-for-type (gvalue-ptr (type-numeric (eql +g-type-param+))) +(defmethod parse-g-value-for-type (gvalue-ptr (type-numeric (eql +g-type-param+)) parse-kind) + (declare (ignore parse-kind)) (parse-g-param-spec (g-value-get-param gvalue-ptr))) -(defmethod parse-gvalue-for-type (gvalue-ptr (type-numeric (eql +g-type-object+))) - (parse-gvalue-object gvalue-ptr)) - -(defmethod parse-gvalue-for-type (gvalue-ptr (type-numeric (eql +g-type-interface+))) - (parse-gvalue-object gvalue-ptr)) - (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))) @@ -117,20 +108,10 @@ (defmethod set-gvalue-for-type (gvalue-ptr (type-numeric (eql +g-type-pointer+)) value) (g-value-set-pointer gvalue-ptr value)) -(defmethod set-gvalue-for-type (gvalue-ptr (type-numeric (eql +g-type-boxed+)) value) - (if (= (g-type-numeric (gvalue-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))) - (defmethod set-gvalue-for-type (gvalue-ptr (type-numeric (eql +g-type-param+)) value) + (declare (ignore gvalue-ptr value)) (error "Setting of GParam is not implemented")) -(defmethod set-gvalue-for-type (gvalue-ptr (type-numeric (eql +g-type-object+)) value) - (set-gvalue-object gvalue-ptr value)) - -(defmethod set-gvalue-for-type (gvalue-ptr (type-numeric (eql +g-type-interface+)) value) - (set-gvalue-object gvalue-ptr value)) - ;;Enums (defvar *registered-enum-types* (make-hash-table :test 'equal)) @@ -139,8 +120,8 @@ (defun registered-enum-type (name) (gethash name *registered-enum-types*)) -(defun parse-gvalue-enum (gvalue) - (let* ((g-type (gvalue-type gvalue)) +(defun parse-g-value-enum (gvalue) + (let* ((g-type (g-value-type gvalue)) (type-name (g-type-name g-type)) (enum-type (registered-enum-type type-name))) (unless enum-type @@ -148,7 +129,7 @@ (convert-from-foreign (g-value-get-enum gvalue) enum-type))) (defun set-gvalue-enum (gvalue value) - (let* ((g-type (gvalue-type gvalue)) + (let* ((g-type (g-value-type gvalue)) (type-name (g-type-name g-type)) (enum-type (registered-enum-type type-name))) (unless enum-type @@ -164,8 +145,8 @@ (defun registered-flags-type (name) (gethash name *registered-flags-types*)) -(defun parse-gvalue-flags (gvalue) - (let* ((g-type (gvalue-type gvalue)) +(defun parse-g-value-flags (gvalue) + (let* ((g-type (g-value-type gvalue)) (type-name (g-type-name g-type)) (flags-type (registered-flags-type type-name))) (unless flags-type @@ -173,17 +154,9 @@ (convert-from-foreign (g-value-get-flags gvalue) flags-type))) (defun set-gvalue-flags (gvalue value) - (let* ((g-type (gvalue-type gvalue)) + (let* ((g-type (g-value-type gvalue)) (type-name (g-type-name g-type)) (flags-type (registered-flags-type type-name))) (unless flags-type (error "Flags ~A is not registered" type-name)) (g-value-set-flags gvalue (convert-to-foreign value flags-type)))) - -;;Objects - -(defun parse-gvalue-object (gvalue) - (get-g-object-for-pointer (g-value-get-object gvalue))) - -(defun set-gvalue-object (gvalue value) - (g-value-set-object gvalue (if value (pointer value) (null-pointer))))