25 lines
708 B
Scheme
25 lines
708 B
Scheme
|
;; Copyright 2002, 2003 Andreas Bernauer
|
||
|
|
|
||
|
|
(define (make-callback function)
|
||
|
|
(call-with-current-continuation
|
||
|
|
(lambda (exit)
|
||
|
|
(let* ((req (send/suspend (lambda (new-url)
|
||
|
|
(exit new-url)))))
|
||
|
|
(function req)))))
|
||
|
|
|
||
|
|
|
||
|
|
(define (make-annotated-callback function)
|
||
|
|
(let* ((annotated-address (make-annotated-address))
|
||
|
|
(dispatch
|
||
|
|
(lambda (req)
|
||
|
|
(let ((bindings (get-bindings req)))
|
||
|
|
(cond
|
||
|
|
((returned-via annotated-address bindings) =>
|
||
|
|
(lambda (args)
|
||
|
|
(apply function (cons req args))))
|
||
|
|
(else
|
||
|
|
(error "annotated-callback:
|
||
|
|
unexpected return values from website"))))))
|
||
|
|
(callback (make-callback dispatch)))
|
||
|
|
(lambda args
|
||
|
|
(annotated-address callback args))))
|