From: Chris Hanson <org/chris-hanson/cph>
Date: Sun, 18 Nov 2001 04:53:04 +0000 (+0000)
Subject: Change file naming for cache files, so that it satisfies more
X-Git-Tag: 20090517-FFI~2434
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=abff75b5716655dc6e2e67d9e7207682139c4974;p=mit-scheme.git

Change file naming for cache files, so that it satisfies more
stringent Windows requirements.  Make sure that directory structure
exists before locking a folder.
---

diff --git a/v7/src/imail/imail-imap.scm b/v7/src/imail/imail-imap.scm
index 6ef597aa3..5dfca30d6 100644
--- a/v7/src/imail/imail-imap.scm
+++ b/v7/src/imail/imail-imap.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-imap.scm,v 1.192 2001/11/06 05:01:50 cph Exp $
+;;; $Id: imail-imap.scm,v 1.193 2001/11/18 04:53:04 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2001 Massachusetts Institute of Technology
 ;;;
@@ -1623,6 +1623,7 @@
   (let ((if-not-locked (if (default-object? if-not-locked) #f if-not-locked))
 	(pathname (imap-folder-lock-pathname folder))
 	(locked? #f))
+    (guarantee-init-file-directory pathname)
     (dynamic-wind
      (lambda () unspecific)
      (lambda ()
@@ -1656,7 +1657,10 @@
 (define (message-item-pathname message keyword)
   (init-file-specifier->pathname
    `(,@(imap-message-cache-specifier message)
-     ,(if (symbol? keyword) (symbol-name keyword) keyword))))
+     ,(encode-cache-namestring
+       (if (symbol? keyword)
+	   (symbol-name keyword)
+	   keyword)))))
 
 (define (imap-message-cache-pathname message)
   (pathname-as-directory
@@ -1680,9 +1684,9 @@
   (let ((url (resource-locator folder)))
     (list "imail-cache"
 	  (string-append (encode-cache-namestring (imap-url-user-id url))
-			 "@"
+			 "_"
 			 (string-downcase (imap-url-host url))
-			 ":"
+			 "_"
 			 (number->string (imap-url-port url)))
 	  (encode-cache-namestring (imap-url-mailbox url)))))
 
@@ -1698,7 +1702,7 @@
 		  ((char=? char #\/)
 		   (write-char #\. port))
 		  (else
-		   (write-char #\= port)
+		   (write-char #\% port)
 		   (let ((n (char->integer char)))
 		     (if (fix:< n #x10)
 			 (write-char #\0 port))