X-Git-Url: https://git.distorted.org.uk/~mdw/clg/blobdiff_plain/ca5f64e957171127832a3ac1b849f59ab2d06e41..d1b6a54e578ad5b6980545e9132f90e3f3ebc95f:/glib/gcallback.lisp diff --git a/glib/gcallback.lisp b/glib/gcallback.lisp index b2fd8cb..c25f62b 100644 --- a/glib/gcallback.lisp +++ b/glib/gcallback.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: gcallback.lisp,v 1.48 2007-10-18 10:39:32 espen Exp $ +;; $Id: gcallback.lisp,v 1.50 2008-05-06 00:04:42 espen Exp $ (in-package "GLIB") @@ -170,7 +170,7 @@ ((signal-name-to-string name) string) ((find-type-number type t) type-number)) -(defbinding signal-name () (copy-of string) +(defbinding signal-name () (or null (copy-of string)) (signal-id unsigned-int)) (defbinding signal-list-ids (type) (vector unsigned-int n-ids) @@ -453,28 +453,34 @@ handler will be called after the default handler for the signal. If :REMOVE is non NIL, the handler will be removed after beeing invoked once. ARGS is a list of additional arguments passed to the callback function." -(let* ((signal-id (compute-signal-id gobject signal)) - (detail-quark (if detail (quark-intern detail) 0)) - (signal-stop-emission - #'(lambda () - (%signal-stop-emission gobject signal-id detail-quark))) - (callback (compute-signal-function gobject signal function object args)) - (wrapper #'(lambda (&rest args) - (let ((*signal-stop-emission* signal-stop-emission)) - (apply callback args))))) - (multiple-value-bind (closure-id callback-id) - (make-callback-closure wrapper signal-handler-marshal) - (let ((handler-id (%signal-connect-closure-by-id - gobject signal-id detail-quark closure-id after))) - (when remove - (update-user-data callback-id - #'(lambda (&rest args) + (let* ((signal-id (compute-signal-id gobject signal)) + (detail-quark (if detail (quark-intern detail) 0)) + (callback + (compute-signal-function gobject signal function object args)) + (wrapper + #'(lambda (&rest args) + (let ((*signal-stop-emission* + #'(lambda () + (%signal-stop-emission (first args) + signal-id detail-quark)))) + (apply callback args))))) + (multiple-value-bind (closure-id callback-id) + (make-callback-closure wrapper signal-handler-marshal) + (let ((handler-id (%signal-connect-closure-by-id + gobject signal-id detail-quark closure-id after))) + (when remove + (update-user-data callback-id + #'(lambda (&rest args) + (let ((gobject (first args))) (unwind-protect - (let ((*signal-stop-emission* signal-stop-emission)) - (apply callback args)) + (let ((*signal-stop-emission* + #'(lambda () + (%signal-stop-emission gobject + signal-id detail-quark)))) + (apply callback args)) (when (signal-handler-is-connected-p gobject handler-id) - (signal-handler-disconnect gobject handler-id)))))) - handler-id)))) + (signal-handler-disconnect gobject handler-id))))))) + handler-id)))) ;;;; Signal emission