X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/clg/blobdiff_plain/34c336c496a5eb1ef2ed5517963eae2982075d6c..db7a1e771d6aec41d0489b07c546d99ebbbc1019:/glib/gcallback.lisp diff --git a/glib/gcallback.lisp b/glib/gcallback.lisp index 9e2c8fc..b2fd8cb 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.45 2007-06-25 13:49:05 espen Exp $ +;; $Id: gcallback.lisp,v 1.48 2007-10-18 10:39:32 espen Exp $ (in-package "GLIB") @@ -36,6 +36,17 @@ (defun register-callback-function (function) (check-type function (or null symbol function)) (register-user-data function)) +(deftype user-callback () '(or function symbol)) + +(define-type-method alien-type ((type user-callback)) + (declare (ignore type)) + (alien-type 'pointer-data)) + +(define-type-method to-alien-form ((type user-callback) func &optional copy-p) + (declare (ignore type copy-p)) + `(register-callback-function ,func)) + + ;; Callback marshaller for regular signal handlers (define-callback signal-handler-marshal nil ((gclosure gclosure) (return-value gvalue) (n-params unsigned-int) @@ -90,9 +101,9 @@ (defun invoke-signal-handler (callback-id return-type &rest args) (disconnect () :report "Disconnect and exit signal handler" (when (signal-handler-is-connected-p instance handler-id) (signal-handler-disconnect instance handler-id)) - (values nil t)))) + (values nil t))) (when (signal-handler-is-connected-p instance handler-id) - (signal-handler-unblock instance handler-id)))) + (signal-handler-unblock instance handler-id))))) (defun invoke-callback (callback-id return-type &rest args) (restart-case (apply (find-user-data callback-id) args) @@ -233,6 +244,8 @@ (defun describe-signal (signal-id &optional type) ;;;; Signal connecting and controlling +(define-flags-type connect-flags :after :swapped) + (defvar *overridden-signals* (make-hash-table :test 'equalp)) (defbinding %signal-override-class-closure () nil @@ -493,7 +506,7 @@ (defun create-signal-emit-function (signal-id) finally (if return-type (return - (with-gvalue (return-value) + (with-gvalue (return-value return-type) (%signal-emitv params signal-id detail return-value))) (%signal-emitv params signal-id detail (make-pointer 0)))) (loop