X-Git-Url: https://git.distorted.org.uk/~mdw/clg/blobdiff_plain/75689fea8b73ccc1e8cb32b671b7fd881da40cf3..fbd2b3d930cb52c23a91e15f3fb81215d099a456:/glib/ginterface.lisp diff --git a/glib/ginterface.lisp b/glib/ginterface.lisp index a0fde4d..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.15 2006-02-26 15:30:01 espen Exp $ +;; $Id: ginterface.lisp,v 1.17 2006-04-25 22:02:34 espen Exp $ (in-package "GLIB") @@ -61,15 +61,13 @@ (defmethod shared-initialize ((class ginterface-class) names &key name gtype) (declare (ignore names)) - (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) - ) + (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)) (call-next-method)) @@ -81,37 +79,37 @@ (declare (ignore type)) (alien-type 'gobject)) -(define-type-method size-of ((type ginterface)) - (declare (ignore type)) +(define-type-method size-of ((type ginterface) &key inlined) + (assert-not-inlined type inlined) (size-of 'gobject)) -(define-type-method from-alien-form ((type ginterface) location) +(define-type-method from-alien-form ((type ginterface) location &key (ref :copy)) (declare (ignore type)) - (from-alien-form 'gobject location)) + (from-alien-form 'gobject location :ref ref)) -(define-type-method from-alien-function ((type ginterface)) +(define-type-method from-alien-function ((type ginterface) &key (ref :copy)) (declare (ignore type)) - (from-alien-function 'gobject)) + (from-alien-function 'gobject :ref ref)) -(define-type-method to-alien-form ((type ginterface) instance) +(define-type-method to-alien-form ((type ginterface) instance &optional copy-p) (declare (ignore type)) - (to-alien-form 'gobject instance)) + (to-alien-form 'gobject instance copy-p)) -(define-type-method to-alien-function ((type ginterface)) +(define-type-method to-alien-function ((type ginterface) &optional copy-p) (declare (ignore type)) - (to-alien-function 'gobject)) + (to-alien-function 'gobject copy-p)) -(define-type-method reader-function ((type ginterface)) - (declare (ignore type)) - (reader-function 'gobject)) +(define-type-method reader-function ((type ginterface) &key ref inlined) + (assert-not-inlined type inlined) + (reader-function 'gobject :ref ref)) -(define-type-method writer-function ((type ginterface)) - (declare (ignore type)) - (writer-function 'gobject)) +(define-type-method writer-function ((type ginterface) &key temp inlined) + (assert-not-inlined type inlined) + (writer-function 'gobject :temp temp)) -(define-type-method destroy-function ((type ginterface)) - (declare (ignore type)) - (destroy-function 'gobject)) +(define-type-method destroy-function ((type ginterface) &key temp inlined) + (assert-not-inlined type inlined) + (destroy-function 'gobject :temp temp)) ;;;; @@ -120,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)) @@ -140,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) @@ -154,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)