Implement WRITE-MIME-TYPE.

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index 30320cad1ecf396f1ab938ea4c7f034eff7c2f3d..872008c637ec8179cd6503167e89fcbab33ed67e 100644 (file)
--- 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 a0afa4f6d6b2d586b23c07db3535053e9c8f3865..23e2f3d8daabae96a8d228ac1c422715bc15f4de 100644 (file)
--- 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)
 \f
 (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)