+ CASE-RETURNED-VIA from mainzelm added
+ RETURNED-VIA alias for RETURNED-VIA? added
This commit is contained in:
parent
98f0da38c6
commit
bd613946d0
|
@ -186,7 +186,9 @@
|
|||
|
||||
make-address
|
||||
make-annotated-address
|
||||
returned-via
|
||||
returned-via?
|
||||
(case-returned-via :syntax)
|
||||
make-callback
|
||||
|
||||
set-surflet-data!
|
||||
|
|
|
@ -1,5 +1,6 @@
|
|||
;; utilities for surflet
|
||||
;; Copyright 2002, Andreas Bernauer
|
||||
;; Copyright 2002,2003, Andreas Bernauer
|
||||
;; Copyright 2003, Martin Gasbichler
|
||||
|
||||
(define (send-html/suspend html-tree-maker)
|
||||
(send/suspend
|
||||
|
@ -670,7 +671,7 @@
|
|||
(error "annotated-address: unknown message/bad argument(s)"
|
||||
message (address-name address)))))))
|
||||
|
||||
(define (returned-via? return-object bindings)
|
||||
(define (returned-via return-object bindings)
|
||||
(if (input-field? return-object)
|
||||
(input-field-binding return-object bindings)
|
||||
;; We assume we have a return-address-object instead.
|
||||
|
@ -683,3 +684,25 @@
|
|||
#t)))
|
||||
(else #f)))))
|
||||
|
||||
;; It depends on the object, if returned-via returns only boolean
|
||||
;; values or string values as well. So let us have both names.
|
||||
(define returned-via? returned-via)
|
||||
|
||||
;; This is from Martin Gasbichler
|
||||
(define-syntax case-returned-via
|
||||
(syntax-rules (else)
|
||||
((case-returned-via (%bindings ...) clauses ...)
|
||||
(let ((bindings (%bindings ...)))
|
||||
(case-returned-via bindings clauses ...)))
|
||||
((case-returned-via bindings (else body ...))
|
||||
(begin body ...))
|
||||
((case-returned-via bindings
|
||||
((%return-object ...) %body ...))
|
||||
(if (or (returned-via? %return-object bindings) ...)
|
||||
(begin %body ...)))
|
||||
((case-returned-via bindings
|
||||
((%return-object ...) %body ...)
|
||||
%clause %clauses ...)
|
||||
(if (or (returned-via? %return-object bindings) ...)
|
||||
(begin %body ...)
|
||||
(case-returned-via bindings %clause %clauses ...)))))
|
||||
|
|
Loading…
Reference in New Issue