From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 5 Jul 2000 19:17:58 +0000 (+0000)
Subject: Change file URL syntax to obey RFC 1738.
X-Git-Tag: 20090517-FFI~3381
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=5f8fdf756a4eb8b0aa574ea34b69570263db29bc;p=mit-scheme.git

Change file URL syntax to obey RFC 1738.
---

diff --git a/v7/src/imail/imail-file.scm b/v7/src/imail/imail-file.scm
index 1a72b7d7b..914c8af6b 100644
--- a/v7/src/imail/imail-file.scm
+++ b/v7/src/imail/imail-file.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-file.scm,v 1.53 2000/07/05 19:13:11 cph Exp $
+;;; $Id: imail-file.scm,v 1.54 2000/07/05 19:16:55 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -45,17 +45,12 @@
 (define (pathname->url-body pathname)
   (case (host/type-name (pathname-host pathname))
     ((UNIX)
-     (let ((string (->namestring pathname)))
-       (if (pathname-absolute? pathname)
-	   (string-append "//localhost" string)
-	   string)))
+     (->namestring pathname))
     ((DOS)
      (let ((string (string-replace (->namestring pathname) #\\ #\/)))
-       (cond ((pathname-device pathname)
-	      (string-append "//localhost/" string))
-	     ((pathname-absolute? pathname)
-	      (string-append "//localhost" string))
-	     (else string))))
+       (if (pathname-device pathname)
+	   (string-append "/" string)
+	   string)))
     (else (error "Unknown host type:" pathname))))
 
 (define (parse-file-url-body string default-pathname)
diff --git a/v7/src/imail/imail-rmail.scm b/v7/src/imail/imail-rmail.scm
index 4980cac69..b1a84caab 100644
--- a/v7/src/imail/imail-rmail.scm
+++ b/v7/src/imail/imail-rmail.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-rmail.scm,v 1.47 2000/06/30 02:59:55 cph Exp $
+;;; $Id: imail-rmail.scm,v 1.48 2000/07/05 19:13:12 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -33,7 +33,8 @@
       (intern-url (constructor (merge-pathnames pathname))))))
 
 (define-method parse-url-body ((string <string>) (default-url <rmail-url>))
-  (make-rmail-url (merge-pathnames string (file-url-pathname default-url))))
+  (make-rmail-url
+   (parse-file-url-body string (file-url-pathname default-url))))
 
 (define-method make-peer-url ((url <rmail-url>) name)
   (make-rmail-url
diff --git a/v7/src/imail/imail-umail.scm b/v7/src/imail/imail-umail.scm
index 6d59471b6..da1787b06 100644
--- a/v7/src/imail/imail-umail.scm
+++ b/v7/src/imail/imail-umail.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-umail.scm,v 1.36 2000/06/30 02:59:57 cph Exp $
+;;; $Id: imail-umail.scm,v 1.37 2000/07/05 19:13:13 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -33,7 +33,8 @@
       (intern-url (constructor (merge-pathnames pathname))))))
 
 (define-method parse-url-body ((string <string>) (default-url <umail-url>))
-  (make-umail-url (merge-pathnames string (file-url-pathname default-url))))
+  (make-umail-url
+   (parse-file-url-body string (file-url-pathname default-url))))
 
 (define-method make-peer-url ((url <umail-url>) name)
   (make-umail-url
diff --git a/v7/src/imail/todo.txt b/v7/src/imail/todo.txt
index fc660f816..e1d578eb9 100644
--- a/v7/src/imail/todo.txt
+++ b/v7/src/imail/todo.txt
@@ -1,5 +1,5 @@
 IMAIL To-Do List
-$Id: todo.txt,v 1.109 2000/07/02 05:09:07 cph Exp $
+$Id: todo.txt,v 1.110 2000/07/05 19:17:58 cph Exp $
 
 Bug fixes
 ---------
@@ -55,8 +55,3 @@ Design changes
 
 * Try to leverage IMAP MIME parser by building compatible
   interface for file-based folders.
-
-* Change file URLs to follow specification in RFC1738, which requires
-  the use of forward slashes and encoding.  Take advantage of relative
-  URLs as specified in RFC1808.  Maybe change URL representation to
-  have a heirarchical path structure so that we can write MERGE-URLS.