mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-29 08:20:20 +02:00
Code Activity

add extend-response.

Browse source 
* module/web/response.scm (extend-response): New utility.
This commit is contained in:
Andy Wingo 2010-11-13 18:30:27 +01:00
parent 7aa54882cf
commit 3d95977991
1 changed files with 13 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

13
module/web/response.scm
View file

@ -33,6 +33,7 @@
response-port response-port
read-response read-response
build-response build-response
extend-response
write-response write-response
read-response-body/latin-1 read-response-body/latin-1
@ -95,6 +96,18 @@
(headers '()) port) (headers '()) port)
(make-response version code reason-phrase headers port)) (make-response version code reason-phrase headers port))
(define (extend-response r k v . additional)
(let ((r (build-response #:version (response-version r)
#:code (response-code r)
#:reason-phrase (%response-reason-phrase r)
#:headers
(assoc-set! (copy-tree (response-headers r))
k v)
#:port (response-port r))))
(if (null? additional)
r
(apply extend-response r additional))))
(define *reason-phrases* (define *reason-phrases*
'((100 . "Continue") '((100 . "Continue")
(101 . "Switching Protocols") (101 . "Switching Protocols")