From 964ff1f5303e41b539ad5678e245c120b2008a26 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 11 Nov 1999 20:59:28 +0000
Subject: [PATCH] Fix bug: don't signal error for filenames with ":" in them,
 which can occur on Samba servers.

---
 v7/src/runtime/dospth.scm | 21 +++++++++------------
 1 file changed, 9 insertions(+), 12 deletions(-)

diff --git a/v7/src/runtime/dospth.scm b/v7/src/runtime/dospth.scm
index fb0e3cd9b..e267be0c3 100644
--- a/v7/src/runtime/dospth.scm
+++ b/v7/src/runtime/dospth.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: dospth.scm,v 1.39 1999/01/02 06:11:34 cph Exp $
+$Id: dospth.scm,v 1.40 1999/11/11 20:59:28 cph Exp $
 
 Copyright (c) 1992-1999 Massachusetts Institute of Technology
 
@@ -80,6 +80,9 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 		       (cons 'ABSOLUTE
 			     (if (and (pair? (cdr components))
 				      (string-null? (cadr components)))
+				 ;; Handle "\\foo\bar" notation here:
+				 ;; the "\\foo" isn't part of the
+				 ;; directory path.
 				 (cons (cadr components)
 				       (parse-directory-components
 					(cddr components)))
@@ -131,17 +134,11 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 
 (define (parse-device-and-path components)
   (let ((string (car components)))
-    (let ((colon (string-find-next-char string #\:)))
-      (if (not colon)
-	  (values #f components)
-	  (begin
-	    (if (not (and (= colon 1)
-			  (char-alphabetic? (string-ref string 0))
-			  (= (string-length string) 2)))
-		(error "Device specification must be a single letter:" string))
-	    (values (string-head string colon)
-		    (cons (string-tail string (+ colon 1))
-			  (cdr components))))))))
+    (if (and (fix:= (string-length string) 2)
+	     (char=? #\: (string-ref string 1))
+	     (char-alphabetic? (string-ref string 0)))
+	(values (string-head string 1) (cons "" (cdr components)))
+	(values #f components))))
 
 (define (simplify-directory directory)
   (cond ((and (eq? (car directory) 'RELATIVE) (null? (cdr directory))) #f)
-- 
2.25.1