From c6693e70fa088f4af84cffbfb72e38d6acc3f9ef Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Sun, 21 Sep 2008 22:20:18 +0000
Subject: [PATCH] Add unparser methods for HTTP datatypes.

---
 v7/src/runtime/http-syntax.scm |  7 ++++++-
 v7/src/runtime/httpio.scm      | 13 ++++++++++++-
 2 files changed, 18 insertions(+), 2 deletions(-)

diff --git a/v7/src/runtime/http-syntax.scm b/v7/src/runtime/http-syntax.scm
index e4e03a2e6..933f2213d 100644
--- a/v7/src/runtime/http-syntax.scm
+++ b/v7/src/runtime/http-syntax.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: http-syntax.scm,v 1.3 2008/09/21 07:35:03 cph Exp $
+$Id: http-syntax.scm,v 1.4 2008/09/21 22:20:14 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -103,6 +103,11 @@ USA.
 
 (define-guarantee http-header "HTTP header field")
 
+(set-record-type-unparser-method! <http-header>
+  (simple-unparser-method 'HTTP-HEADER
+    (lambda (header)
+      (list (http-header-name header)))))
+
 (define (make-http-header name value)
   (guarantee-http-token name 'MAKE-HTTP-HEADER)
   (let ((defn (header-value-defn name)))
diff --git a/v7/src/runtime/httpio.scm b/v7/src/runtime/httpio.scm
index 78a6bcfb3..e5b0c119f 100644
--- a/v7/src/runtime/httpio.scm
+++ b/v7/src/runtime/httpio.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: httpio.scm,v 14.10 2008/09/21 07:35:06 cph Exp $
+$Id: httpio.scm,v 14.11 2008/09/21 22:20:18 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -52,6 +52,12 @@ USA.
       (guarantee-headers&body headers body 'MAKE-HTTP-REQUEST)
     (%make-http-request method uri version headers body)))
 
+(set-record-type-unparser-method! <http-request>
+  (simple-unparser-method 'HTTP-REQUEST
+    (lambda (request)
+      (list (http-request-method request)
+	    (http-request-uri request)))))
+
 (define-record-type <http-response>
     (%make-http-response version status reason headers body)
     http-response?
@@ -71,6 +77,11 @@ USA.
       (guarantee-headers&body headers body 'MAKE-HTTP-RESPONSE)
     (%make-http-response version status reason headers body)))
 
+(set-record-type-unparser-method! <http-response>
+  (simple-unparser-method 'HTTP-RESPONSE
+    (lambda (response)
+      (list (http-response-status response)))))
+
 (define (guarantee-headers&body headers body caller)
   (guarantee-http-headers headers caller)
   (if body
-- 
2.25.1