From 2a8414c098a59081ed041fd764ea02a6d4620b08 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 11 Nov 1997 12:47:40 +0000
Subject: [PATCH] Reverse earlier decision: ignore errors that occur with "$"
 and "~" syntax in pathnames.

---
 v7/src/runtime/dospth.scm | 46 ++++++++++++++++++++++-----------------
 v7/src/runtime/unxpth.scm | 46 ++++++++++++++++++++++-----------------
 2 files changed, 52 insertions(+), 40 deletions(-)

diff --git a/v7/src/runtime/dospth.scm b/v7/src/runtime/dospth.scm
index e71d6bfe1..95cf9f32a 100644
--- a/v7/src/runtime/dospth.scm
+++ b/v7/src/runtime/dospth.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: dospth.scm,v 1.36 1996/03/01 08:53:41 cph Exp $
+$Id: dospth.scm,v 1.37 1997/11/11 12:47:40 cph Exp $
 
-Copyright (c) 1992-96 Massachusetts Institute of Technology
+Copyright (c) 1992-97 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -117,24 +117,30 @@ MIT in each case. |#
 			 (except-last-pair head)
 			 head)
 		     (cdr components))))))
-    (if (or (string-null? string)
-	    (not *expand-directory-prefixes?*))
-	components
-	(case (string-ref string 0)
-	  ((#\$)
-	   (let ((name (string-tail string 1)))
-	     (let ((value (get-environment-variable name)))
-	       (if (not value)
-		   (error "Unbound environment variable:" name))
-	       (replace-head value))))
-	  ((#\~)
-	   (replace-head
-	    (->namestring
-	     (let ((user-name (string-tail string 1)))
-	       (if (string-null? user-name)
-		   (current-home-directory)
-		   (user-home-directory user-name))))))
-	  (else components)))))
+    (let ((end (string-length string)))
+      (if (or (= 0 end)
+	      (not *expand-directory-prefixes?*))
+	  components
+	  (case (string-ref string 0)
+	    ((#\$)
+	     (if (= 1 end)
+		 components
+		 (let ((value
+			(get-environment-variable (substring string 1 end))))
+		   (if (not value)
+		       components
+		       (replace-head value)))))
+	    ((#\~)
+	     (let ((expansion
+		    (ignore-errors
+		     (lambda ()
+		       (if (= 1 end)
+			   (current-home-directory)
+			   (user-home-directory (substring string 1 end)))))))
+	       (if (condition? expansion)
+		   components
+		   (replace-head (->namestring expansion)))))
+	    (else components))))))
 
 (define (parse-device-and-path components)
   (let ((string (car components)))
diff --git a/v7/src/runtime/unxpth.scm b/v7/src/runtime/unxpth.scm
index 26c7132e3..2d2f00cfd 100644
--- a/v7/src/runtime/unxpth.scm
+++ b/v7/src/runtime/unxpth.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: unxpth.scm,v 14.23 1996/02/29 22:12:07 cph Exp $
+$Id: unxpth.scm,v 14.24 1997/11/11 12:45:49 cph Exp $
 
-Copyright (c) 1988-96 Massachusetts Institute of Technology
+Copyright (c) 1988-97 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -93,24 +93,30 @@ MIT in each case. |#
 			 (except-last-pair head)
 			 head)
 		     (cdr components))))))
-    (if (or (string-null? string)
-	    (not *expand-directory-prefixes?*))
-	components
-	(case (string-ref string 0)
-	  ((#\$)
-	   (let ((name (string-tail string 1)))
-	     (let ((value (get-environment-variable name)))
-	       (if (not value)
-		   (error "Unbound environment variable:" name))
-	       (replace-head value))))
-	  ((#\~)
-	   (replace-head
-	    (->namestring
-	     (let ((user-name (substring string 1 (string-length string))))
-	       (if (string-null? user-name)
-		   (current-home-directory)
-		   (user-home-directory user-name))))))
-	  (else components)))))
+    (let ((end (string-length string)))
+      (if (or (= 0 end)
+	      (not *expand-directory-prefixes?*))
+	  components
+	  (case (string-ref string 0)
+	    ((#\$)
+	     (if (= 1 end)
+		 components
+		 (let ((value
+			(get-environment-variable (substring string 1 end))))
+		   (if (not value)
+		       components
+		       (replace-head value)))))
+	    ((#\~)
+	     (let ((expansion
+		    (ignore-errors
+		     (lambda ()
+		       (if (= 1 end)
+			   (current-home-directory)
+			   (user-home-directory (substring string 1 end)))))))
+	       (if (condition? expansion)
+		   components
+		   (replace-head (->namestring expansion)))))
+	    (else components))))))
 
 (define (simplify-directory directory)
   (if (and (eq? (car directory) 'RELATIVE) (null? (cdr directory)))
-- 
2.25.1