From: Chris Hanson <org/chris-hanson/cph>
Date: Sun, 31 Aug 2008 07:36:21 +0000 (+0000)
Subject: Implement WRITE-MIME-TYPE.
X-Git-Tag: 20090517-FFI~197
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=05b7a63fad5f89664be9511356056aa45ac78dc5;p=mit-scheme.git

Implement WRITE-MIME-TYPE.
---

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index 30320cad1..872008c63 100644
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.668 2008/08/31 07:33:07 cph Exp $
+$Id: runtime.pkg,v 14.669 2008/08/31 07:36:17 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -494,7 +494,8 @@ USA.
 	  soft-link-file
 	  string->mime-type
 	  string-is-mime-token?
-	  string-is-mime-type?)
+	  string-is-mime-type?
+	  write-mime-type)
   (initialization (initialize-package!)))
 
 (define-package (runtime symbol)
diff --git a/v7/src/runtime/sfile.scm b/v7/src/runtime/sfile.scm
index a0afa4f6d..23e2f3d8d 100644
--- a/v7/src/runtime/sfile.scm
+++ b/v7/src/runtime/sfile.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: sfile.scm,v 14.45 2008/07/27 04:24:26 cph Exp $
+$Id: sfile.scm,v 14.46 2008/08/31 07:36:21 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -329,10 +329,15 @@ USA.
   unspecific)
 
 (define (mime-type->string mime-type)
-  (guarantee-mime-type mime-type 'MIME-TYPE->STRING)
-  (string-append (symbol-name (mime-type/top-level mime-type))
-		 "/"
-		 (symbol-name (mime-type/subtype mime-type))))
+  (call-with-output-string
+    (lambda (port)
+      (write-mime-type mime-type port))))
+
+(define (write-mime-type mime-type port)
+  (guarantee-mime-type mime-type 'WRITE-MIME-TYPE)
+  (write-string (symbol-name (mime-type/top-level mime-type)) port)
+  (write-string "/" port)
+  (write-string (symbol-name (mime-type/subtype mime-type)) port))
 
 (define (string->mime-type string #!optional start end)
   (vector-ref (or (*parse-string parser:mime-type string start end)