From 3f14891e4d7cce1e293662edc9f96fb97b83909c Mon Sep 17 00:00:00 2001
From: "Guillermo J. Rozas" <edu/mit/csail/zurich/gjr>
Date: Thu, 8 Oct 1992 18:20:25 +0000
Subject: [PATCH] Add hook/dos/end-of-line-string. Allow empty string as the
 first component of an absolute pathname to kludge shared network file
 systems.

---
 v7/src/runtime/dospth.scm | 35 +++++++++++++++++++++++++++--------
 1 file changed, 27 insertions(+), 8 deletions(-)

diff --git a/v7/src/runtime/dospth.scm b/v7/src/runtime/dospth.scm
index 004f3feae..db08ccc40 100644
--- a/v7/src/runtime/dospth.scm
+++ b/v7/src/runtime/dospth.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/dospth.scm,v 1.15 1992/09/26 16:03:18 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/dospth.scm,v 1.16 1992/10/08 18:20:25 jinx Exp $
 
 Copyright (c) 1992 Massachusetts Institute of Technology
 
@@ -37,6 +37,8 @@ MIT in each case. |#
 
 (declare (usual-integrations))
 
+(define hook/dos/end-of-line-string)
+
 (define sub-directory-delimiters
   ;; Allow forward slashes as well as backward slashes so that
   ;; - improperly-written scripts (e.g. compiler/comp.sf) will work
@@ -66,6 +68,7 @@ MIT in each case. |#
 		  dos/canonicalize))
 
 (define (initialize-package!)
+  (set! hook/dos/end-of-line-string default/dos/end-of-line-string)
   (add-pathname-host-type! 'DOS make-dos-host-type))
 
 ;;;; Pathname Parser
@@ -256,6 +259,13 @@ MIT in each case. |#
 ;;;; Pathname Constructors
 
 (define (dos/make-pathname host device directory name type version)
+  (define (check-directory-components components)
+    (for-all? components
+      (lambda (element)
+	(if (string? element)
+	    (not (string-null? element))
+	    (eq? element 'UP)))))
+    
   (%make-pathname
    host
    (cond ((string? device) device)
@@ -266,12 +276,17 @@ MIT in each case. |#
 	  directory)
 	 ((and (list? directory)
 	       (not (null? directory))
-	       (memq (car directory) '(RELATIVE ABSOLUTE))
-	       (for-all? (cdr directory)
-		 (lambda (element)
-		   (if (string? element)
-		       (not (string-null? element))
-		       (eq? element 'UP)))))
+	       (case (car directory)
+		 ((RELATIVE)
+		  (check-directory-components (cdr directory)))
+		 ((ABSOLUTE)
+		  ;; This should handle share network drives (\\machine\...)
+		  (let ((rest (cdr directory)))
+		    (or (null? rest)
+			(and (string? (car rest))
+			     (check-directory-components (cdr rest))))))
+		 (else
+		  false)))
 	  (simplify-directory directory))
 	 (else
 	  (error:wrong-type-argument directory "pathname directory"
@@ -286,7 +301,8 @@ MIT in each case. |#
        (error:wrong-type-argument type "pathname type" 'MAKE-PATHNAME))
    (if (memq version '(#F UNSPECIFIC WILD NEWEST))
        'UNSPECIFIC
-       (error:wrong-type-argument version "pathname version" 'MAKE-PATHNAME))))
+       (error:wrong-type-argument version "pathname version"
+				  'MAKE-PATHNAME))))
 
 (define (dos/pathname-as-directory pathname)
   (let ((name (%pathname-name pathname))
@@ -382,5 +398,8 @@ MIT in each case. |#
       pathname))
 
 (define (dos/end-of-line-string pathname)
+  (hook/dos/end-of-line-string pathname))
+
+(define (default/dos/end-of-line-string pathname)
   pathname				; ignored
   "\r\n")
\ No newline at end of file
-- 
2.25.1