+(defun register-callback-function (function)
+ (check-type function (or null symbol function))
+ (register-user-data function))
+
+(def-callback closure-callback-marshal (c-call:void
+ (gclosure system-area-pointer)
+ (return-value system-area-pointer)
+ (n-params c-call:unsigned-int)
+ (param-values system-area-pointer)
+ (invocation-hint system-area-pointer)
+ (callback-id c-call:unsigned-int))
+ (callback-trampoline callback-id n-params param-values return-value))
+
+(def-callback %destroy-user-data (c-call:void (id c-call:unsigned-int))
+ (destroy-user-data id))
+
+(defun make-callback-closure (function)
+ (callback-closure-new
+ (register-callback-function function)
+ (callback closure-callback-marshal) (callback %destroy-user-data)))
+
+
+(defun callback-trampoline (callback-id n-params param-values return-value)
+ (let* ((return-type (unless (null-pointer-p return-value)
+ (gvalue-type return-value)))
+ (args (loop
+ for n from 0 below n-params
+ collect (gvalue-get (sap+ param-values (* n +gvalue-size+))))))
+ (let ((result (apply #'invoke-callback callback-id return-type args)))
+ (when return-type
+ (gvalue-set return-value result)))))