X-Git-Url: https://git.distorted.org.uk/~mdw/clg/blobdiff_plain/b19bbc943eecd2655a0e3f32eefada102f51142f..fa30048e45d3d71f09ac0b963f7cc7d1c7769475:/glib/ginterface.lisp diff --git a/glib/ginterface.lisp b/glib/ginterface.lisp index 0e89408..858fab8 100644 --- a/glib/ginterface.lisp +++ b/glib/ginterface.lisp @@ -20,7 +20,7 @@ ;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE ;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -;; $Id: ginterface.lisp,v 1.14 2006-02-15 09:45:41 espen Exp $ +;; $Id: ginterface.lisp,v 1.17 2006-04-25 22:02:34 espen Exp $ (in-package "GLIB") @@ -61,14 +61,13 @@ (defmethod shared-initialize ((class ginterface-class) names &key name gtype) (declare (ignore names)) - (let* ((class-name (or name (class-name class))) + (let* ((class-name (or name (class-name class))) (type-number (or (find-type-number class-name) (register-type class-name (or (first gtype) (default-type-init-name class-name)))))) -; (type-default-interface-ref type-number) - ) + (type-default-interface-ref type-number)) (call-next-method)) @@ -76,41 +75,41 @@ (subtypep (class-name super) 'ginterface)) -(defmethod alien-type ((class ginterface-class) &rest args) - (declare (ignore class args)) +(define-type-method alien-type ((type ginterface)) + (declare (ignore type)) (alien-type 'gobject)) -(defmethod size-of ((class ginterface-class) &rest args) - (declare (ignore class args)) +(define-type-method size-of ((type ginterface) &key inlined) + (assert-not-inlined type inlined) (size-of 'gobject)) -(defmethod from-alien-form (location (class ginterface-class) &rest args) - (declare (ignore class args)) - (from-alien-form location 'gobject)) +(define-type-method from-alien-form ((type ginterface) location &key (ref :copy)) + (declare (ignore type)) + (from-alien-form 'gobject location :ref ref)) -(defmethod from-alien-function ((class ginterface-class) &rest args) - (declare (ignore class args)) - (from-alien-function 'gobject)) +(define-type-method from-alien-function ((type ginterface) &key (ref :copy)) + (declare (ignore type)) + (from-alien-function 'gobject :ref ref)) -(defmethod to-alien-form (instance (class ginterface-class) &rest args) - (declare (ignore class args)) - (to-alien-form instance 'gobject)) +(define-type-method to-alien-form ((type ginterface) instance &optional copy-p) + (declare (ignore type)) + (to-alien-form 'gobject instance copy-p)) -(defmethod to-alien-function ((class ginterface-class) &rest args) - (declare (ignore class args)) - (to-alien-function 'gobject)) +(define-type-method to-alien-function ((type ginterface) &optional copy-p) + (declare (ignore type)) + (to-alien-function 'gobject copy-p)) -(defmethod reader-function ((class ginterface-class) &rest args) - (declare (ignore class args)) - (reader-function 'gobject)) +(define-type-method reader-function ((type ginterface) &key ref inlined) + (assert-not-inlined type inlined) + (reader-function 'gobject :ref ref)) -(defmethod writer-function ((class ginterface-class) &rest args) - (declare (ignore class args)) - (writer-function 'gobject)) +(define-type-method writer-function ((type ginterface) &key temp inlined) + (assert-not-inlined type inlined) + (writer-function 'gobject :temp temp)) -(defmethod destroy-function ((class ginterface-class) &rest args) - (declare (ignore class args)) - (destroy-function 'gobject)) +(define-type-method destroy-function ((type ginterface) &key temp inlined) + (assert-not-inlined type inlined) + (destroy-function 'gobject :temp temp)) ;;;; @@ -119,8 +118,8 @@ (defbinding type-default-interface-ref (type) pointer ((find-type-number type t) type-number)) -(defbinding type-default-interface-unref (type) nil - ((find-type-number type t) type-number)) +(defbinding type-default-interface-unref () nil + (iface pointer)) (defbinding type-default-interface-peek (type) pointer ((find-type-number type t) type-number)) @@ -139,8 +138,7 @@ (unwind-protect (%map-params array length type-number inherited-p) (deallocate-memory array)))) -; (type-default-interface-unref type-number) - ))) + (type-default-interface-unref iface)))) (defun expand-ginterface-type (type forward-p options &rest args) @@ -153,10 +151,17 @@ (:metaclass ginterface-class) (:gtype ,(register-type-as type))))) -(defun ginterface-dependencies (type) +(defun ginterface-dependencies (type options) (delete-duplicates (cons (supertype type) - (mapcar #'param-value-type (query-object-interface-properties type))))) + (append + (mapcar #'param-value-type (query-object-interface-properties type)) + (loop + for slot in (getf options :slots) + as type = (getf (rest slot) :type) + when (and type (symbolp type) (find-type-number type)) + collect (find-type-number type)))))) + (register-derivable-type 'ginterface "GInterface" 'expand-ginterface-type 'ginterface-dependencies)