From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 29 Oct 2004 16:30:25 +0000 (+0000)
Subject: Fix DISASSOCIATE-PATHNAME-TYPE-FROM-MIME-TYPE so that it can
X-Git-Tag: 20090517-FFI~1505
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=3463e5e9d15096c5420f1652f802a704bb48f8ff;p=mit-scheme.git

Fix DISASSOCIATE-PATHNAME-TYPE-FROM-MIME-TYPE so that it can
disassociate system-defined types as well as user-defined ones.
---

diff --git a/v7/src/runtime/sfile.scm b/v7/src/runtime/sfile.scm
index 839ceeeac..e4771805d 100644
--- a/v7/src/runtime/sfile.scm
+++ b/v7/src/runtime/sfile.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: sfile.scm,v 14.38 2004/10/28 22:53:28 cph Exp $
+$Id: sfile.scm,v 14.39 2004/10/29 16:30:25 cph Exp $
 
 Copyright 1986,1987,1988,1989,1990,1991 Massachusetts Institute of Technology
 Copyright 1999,2001,2003,2004 Massachusetts Institute of Technology
@@ -258,10 +258,13 @@ USA.
 
 (define (pathname-type->mime-type type)
   (and (string? type)
-       (or (hash-table/get local-type-map type #f)
-	   (let ((string (os/suffix-mime-type type)))
-	     (and string
-		  (string->mime-type string))))))
+       (let ((mime-type (hash-table/get local-type-map type #f)))
+	 (if mime-type
+	     (and (mime-type? mime-type)
+		  mime-type)
+	     (let ((string (os/suffix-mime-type type)))
+	       (and string
+		    (string->mime-type string)))))))
 
 (define (associate-pathname-type-with-mime-type type mime-type)
   (guarantee-string type 'ASSOCIATE-PATHNAME-TYPE-WITH-MIME-TYPE)
@@ -270,7 +273,7 @@ USA.
 
 (define (disassociate-pathname-type-from-mime-type type)
   (guarantee-string type 'DISASSOCIATE-PATHNAME-TYPE-FROM-MIME-TYPE)
-  (hash-table/remove! local-type-map type))
+  (hash-table/put! local-type-map type 'DISASSOCIATED))
 
 (define-record-type <mime-type>
     (%%make-mime-type top-level subtype)