From 74f040f15d0d9ad344b2a3ac910728b5fcf6e663 Mon Sep 17 00:00:00 2001 From: Dmitry Kalyanov Date: Sun, 12 Jul 2009 15:54:01 +0400 Subject: [PATCH] Moved code --- glib/cl-gtk2-glib.asd | 6 +++--- glib/gobject.foreign-gobject.lisp | 43 +++++++++++++++++++++++++++++++++++++ glib/gobject.signals.lisp | 29 ------------------------- glib/gobject.structs.lisp | 18 ---------------- 4 files changed, 46 insertions(+), 50 deletions(-) delete mode 100644 glib/gobject.signals.lisp delete mode 100644 glib/gobject.structs.lisp diff --git a/glib/cl-gtk2-glib.asd b/glib/cl-gtk2-glib.asd index 292fdb1..011d6eb 100644 --- a/glib/cl-gtk2-glib.asd +++ b/glib/cl-gtk2-glib.asd @@ -8,25 +8,25 @@ (:file "glib.gstrv") (:file "glib.string") (:file "glib.quark") + (:file "gobject.init") - (:file "gobject.ffi.package") (:file "gobject.type-designator") (:file "gobject.ffi") + (:file "gobject.type-info") (:file "gobject.type-info.object") (:file "gobject.type-info.enum") (:file "gobject.type-info.signals") (:file "gobject.package") - (:file "gobject.structs") (:file "gobject.gvalue") - (:file "gobject.signals") (:file "gobject.foreign") (:file "gobject.stable-pointer") (:file "gobject.foreign-gobject") (:file "gobject.foreign-closures") (:file "gobject.foreign-gboxed") + (:file "gobject.meta") (:file "gobject.generating") (:file "gobject.object-defs") diff --git a/glib/gobject.foreign-gobject.lisp b/glib/gobject.foreign-gobject.lisp index 6b56e89..15fa956 100644 --- a/glib/gobject.foreign-gobject.lisp +++ b/glib/gobject.foreign-gobject.lisp @@ -1,5 +1,21 @@ (in-package :gobject) +(defun g-type-from-object (object) + "Returns the GType of an @code{object} + +@arg[object]{C pointer to an object} +@return{GType designator (see @class{g-type-designator})}" + (g-type-from-instance object)) + +(defun g-type-from-class (g-class) + (g-type-name (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))) + (defclass g-object () ((pointer :type cffi:foreign-pointer @@ -326,3 +342,30 @@ (defmethod set-gvalue-for-type (gvalue-ptr (type-numeric (eql +g-type-interface+)) value) (set-gvalue-object gvalue-ptr value)) +(defun emit-signal (object signal-name &rest args) + "Emits the signal. +@arg[object]{an instance of @class{g-object}. Signal is emitted on this object} +@arg[signal-name]{a string specifying the signal} +@arg[args]{arguments for the signal} +@return{none}" + (let* ((object-type (g-type-from-object (pointer object))) + (signal-info (parse-signal-name object-type signal-name))) + (unless signal-info + (error "Signal ~A not found on object ~A" signal-name object)) + (let ((params-count (length (signal-info-param-types signal-info)))) + (with-foreign-object (params 'g-value (1+ params-count)) + (set-g-value (mem-aref params 'g-value 0) object object-type :zero-g-value t) + (iter (for i from 0 below params-count) + (for arg in args) + (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+) + (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-value-init return-value (signal-info-return-type signal-info)) + (prog1 (parse-gvalue return-value) + (g-value-unset return-value)))) + (iter (for i from 0 below (1+ params-count)) + (g-value-unset (mem-aref params 'g-value i)))))))) diff --git a/glib/gobject.signals.lisp b/glib/gobject.signals.lisp deleted file mode 100644 index d4a46ef..0000000 --- a/glib/gobject.signals.lisp +++ /dev/null @@ -1,29 +0,0 @@ -(in-package :gobject) - -(defun emit-signal (object signal-name &rest args) - "Emits the signal. -@arg[object]{an instance of @class{g-object}. Signal is emitted on this object} -@arg[signal-name]{a string specifying the signal} -@arg[args]{arguments for the signal} -@return{none}" - (let* ((object-type (g-type-from-object (pointer object))) - (signal-info (parse-signal-name object-type signal-name))) - (unless signal-info - (error "Signal ~A not found on object ~A" signal-name object)) - (let ((params-count (length (signal-info-param-types signal-info)))) - (with-foreign-object (params 'g-value (1+ params-count)) - (set-g-value (mem-aref params 'g-value 0) object object-type :zero-g-value t) - (iter (for i from 0 below params-count) - (for arg in args) - (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+) - (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-value-init return-value (signal-info-return-type signal-info)) - (prog1 (parse-gvalue return-value) - (g-value-unset return-value)))) - (iter (for i from 0 below (1+ params-count)) - (g-value-unset (mem-aref params 'g-value i)))))))) \ No newline at end of file diff --git a/glib/gobject.structs.lisp b/glib/gobject.structs.lisp deleted file mode 100644 index 1af1e69..0000000 --- a/glib/gobject.structs.lisp +++ /dev/null @@ -1,18 +0,0 @@ -(in-package :gobject) - -(defun g-type-from-object (object) - "Returns the GType of an @code{object} - -@arg[object]{C pointer to an object} -@return{GType designator (see @class{g-type-designator})}" - (g-type-from-instance object)) - -(defun g-type-from-class (g-class) - (g-type-name (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))) - -- 1.7.10.4