From f9f9a4a8e1dee0ffd258b0f66f3be2e1a3007863 Mon Sep 17 00:00:00 2001 From: Dmitry Kalyanov Date: Mon, 14 Sep 2009 00:02:25 +0400 Subject: [PATCH] Add define-cb-methods and create-fn-ref (Object-bound closures) --- doc/gobject.ref.texi | 47 ++++++++++++++++++++++++++++++++++++- doc/gobject.texi | 5 ++++ glib/cl-gtk2-glib.asd | 5 ++-- glib/gobject.object-function.lisp | 35 +++++++++++++++++++++++++++ glib/gobject.package.lisp | 4 +++- 5 files changed, 92 insertions(+), 4 deletions(-) create mode 100644 glib/gobject.object-function.lisp diff --git a/doc/gobject.ref.texi b/doc/gobject.ref.texi index 6df156d..73eb95e 100644 --- a/doc/gobject.ref.texi +++ b/doc/gobject.ref.texi @@ -1074,11 +1074,18 @@ Example: @node Closures @chapter Closures +@menu +* create-signal-handler-closure:: +* Object-bound foreign functions:: +@end menu Closure are anonymous functions that capture their lexical environment. GObject supports using closures (as instances of type GClosure) as signal handlers and in some other places where a function is expected. Function @code{create-signal-handler-closure} create closure from lisp function that can be used a signal handler. The GClosure is finalized automatically when GObject no longer needs it (e.g., when GClosure is disconnected from signal). +(TODO: GObject defines finer closure API: g_closure_ref, g_closure_unref, g_closure_invoke. It should be bound.) + +@node create-signal-handler-closure @section create-signal-handler-closure @Function create-signal-handler-closure @lisp @@ -1112,7 +1119,45 @@ Example of usage from GObject binding code: after)) @end lisp -(TODO: GObject defines finer closure API: g_closure_ref, g_closure_unref, g_closure_invoke. It should be bound.) +@node Object-bound foreign functions +@section Object-bound foreign functions + +A common idiom for Gtk+ for passing user-defined function is as follows. Callback function has (besides its 'useful' arguments) an additional argument at the end - the 'data' pointer. This 'data' pointer, along with the pointer to 'destroy-notify' function is specified when passing the function. Destroy-notify function allows to free the function object (the Lisp closure) when it is not used by an object. + +@RMacro define-cb-methods +@lisp +(define-cb-methods name return-type ((arg-1 type-1) ... (arg-n type-n))) +@end lisp + +Defines two CFFI callbacks assosiated with the callback function type @var{name}. Creates @var{name}-cb - a callback to be passed as an function and create @var{name}-destroy-notify - a callback to be passed as 'destroy-notify' function. These callbacks are intended to work together with @ref{create-fn-ref}. + +Arguments and return-type are the same as CFFI arguments and return-type for callbacks. Arguments do not include the last 'data' pointer. + +@RFunction create-fn-ref +@lisp +(create-fn-ref object function) @result{} foreign-pointer +@end lisp + +This function creates a foreign structure containing the data neccesary for callbacks defined by @ref{define-cb-methods} to call and dispose of the @var{function}. The @var{function} is bound to the @var{object}. This is neccesary for correct work of garbage collector. The created structure is freed by 'destroy-notify' function. + +Example: +@lisp +(defcfun gtk-assistant-set-forward-page-func :void + (assistant (g-object assistant)) + (page-func :pointer) + (data :pointer) + (destroy-notify :pointer)) + +(define-cb-methods assistant-page-func :int ((current-page :int))) + +(defun set-assistant-forward-page-function (assistant function) + (if function + (gtk-assistant-set-forward-page-func assistant + (callback assistant-page-func-cb) + (create-fn-ref assistant function) + (callback assistant-page-func-destroy-notify)) + (gtk-assistant-set-forward-page-func assistant (null-pointer) (null-pointer) (null-pointer)))) +@end lisp @node GObject low-level @chapter GObject low-level diff --git a/doc/gobject.texi b/doc/gobject.texi index 4ae0c56..2a00eca 100644 --- a/doc/gobject.texi +++ b/doc/gobject.texi @@ -21,6 +21,11 @@ @end defmac @end macro +@macro RMacro {args} +@anchor{\args\}@defmac \args\ +@end defmac +@end macro + @macro Struct {args} @deftp {Structure} \args\ @end deftp diff --git a/glib/cl-gtk2-glib.asd b/glib/cl-gtk2-glib.asd index 88a1241..0007491 100644 --- a/glib/cl-gtk2-glib.asd +++ b/glib/cl-gtk2-glib.asd @@ -33,6 +33,7 @@ (:file "gobject.object-defs") (:file "gobject.cffi-callbacks") (:file "gobject.foreign-gobject-subclassing") - - (:file "gobject.boxed")) + + (:file "gobject.boxed") + (:file "gobject.object-function")) :depends-on (:cffi :trivial-garbage :iterate :bordeaux-threads :iterate :closer-mop)) \ No newline at end of file diff --git a/glib/gobject.object-function.lisp b/glib/gobject.object-function.lisp new file mode 100644 index 0000000..7c17faf --- /dev/null +++ b/glib/gobject.object-function.lisp @@ -0,0 +1,35 @@ +(in-package :gobject) + +(defcstruct object-func-ref + (:object :pointer) + (:fn-id :int)) + +(defmacro define-cb-methods (name return-type (&rest args)) + (flet ((make-name (control-string) (intern (format nil control-string (symbol-name name)) (symbol-package name)))) + (let ((call-cb (make-name "~A-CB")) + (destroy-cb (make-name "~A-DESTROY-NOTIFY")) + (object (gensym "OBJECT")) + (fn-id (gensym "FN-ID")) + (fn (gensym "FN")) + (data (gensym "DATA")) + (arg-names (mapcar #'first args))) + `(progn + (defcallback ,call-cb ,return-type (,@args (,data :pointer)) + (let* ((,object (convert-from-foreign (foreign-slot-value ,data 'object-func-ref :object) 'g-object)) + (,fn-id (foreign-slot-value ,data 'object-func-ref :fn-id)) + (,fn (retrieve-handler-from-object ,object ,fn-id))) + (funcall ,fn ,@arg-names))) + (defcallback ,destroy-cb :void ((,data :pointer)) + (let* ((,object (convert-from-foreign (foreign-slot-value ,data 'object-func-ref :object) 'g-object)) + (,fn-id (foreign-slot-value ,data 'object-func-ref :fn-id))) + (delete-handler-from-object ,object ,fn-id)) + (foreign-free ,data)))))) + +(defun create-fn-ref (object function) + (let ((ref (foreign-alloc 'object-func-ref)) + (fn-id (save-handler-to-object object function))) + (setf (foreign-slot-value ref 'object-func-ref :object) + (pointer object) + (foreign-slot-value ref 'object-func-ref :fn-id) + fn-id) + ref)) diff --git a/glib/gobject.package.lisp b/glib/gobject.package.lisp index 92401a5..cad6804 100644 --- a/glib/gobject.package.lisp +++ b/glib/gobject.package.lisp @@ -191,7 +191,9 @@ #:save-handler-to-object #:retrieve-handler-from-object #:delete-handler-from-object - #:disconnect-signal) + #:disconnect-signal + #:define-cb-methods + #:create-fn-ref) (:documentation "CL-GTK2-GOBJECT is a binding to GObject type system. For information on GObject, see its @a[http://library.gnome.org/devel/gobject/stable/]{documentation}. -- 1.7.10.4