From 3e9df598518673d90fcc40a25a6ec0e02f31503b Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Sat, 28 Oct 1995 03:00:09 +0000
Subject: [PATCH] Change support for user-name and home directory so that it
 uses the environment variables that are being set in our NT configuration.
 Also, add better heuristic methods for discovering this information when it
 is not supplied in the environment variables.

---
 v7/src/runtime/ntprm.scm | 41 ++++++++++++++++++++++++++++------------
 1 file changed, 29 insertions(+), 12 deletions(-)

diff --git a/v7/src/runtime/ntprm.scm b/v7/src/runtime/ntprm.scm
index e8cd3d984..aedc2ee7d 100644
--- a/v7/src/runtime/ntprm.scm
+++ b/v7/src/runtime/ntprm.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: ntprm.scm,v 1.1 1995/10/28 01:14:05 cph Exp $
+$Id: ntprm.scm,v 1.2 1995/10/28 03:00:09 cph Exp $
 
 Copyright (c) 1992-95 Massachusetts Institute of Technology
 
@@ -238,25 +238,42 @@ MIT in each case. |#
 )				; End LET
 
 (define (current-home-directory)
-  (let ((home (get-environment-variable "HOME")))
-    (if home
-	(pathname-as-directory (merge-pathnames home))
-	(user-home-directory (current-user-name)))))
+  (or (nt/current-home-directory)
+      (user-home-directory (current-user-name))))
 
 (define (current-user-name)
-  (or (get-environment-variable "USER")
+  (or (get-environment-variable "USERNAME")
+      (get-environment-variable "USER")
+      (let ((homedir (nt/current-home-directory)))
+	(and homedir
+	     (pathname-name
+	      (directory-pathname-as-file (directory-pathname homedir)))))
       "nouser"))
 
 (define (user-home-directory user-name)
   (or (and user-name
-	   (let ((directory (get-environment-variable "USERDIR")))
-	     (and directory
-		  (pathname-as-directory
-		   (pathname-new-name
-		    (pathname-as-directory (merge-pathnames directory))
-		    user-name)))))
+	   (let ((try
+		  (lambda (directory)
+		    (pathname-as-directory
+		     (merge-pathnames user-name directory)))))
+	     (cond ((get-environment-variable "USERDIR")
+		    => (lambda (userdir)
+			 (try (pathname-as-directory
+			       (merge-pathnames userdir)))))
+		   ((nt/current-home-directory)
+		    => (lambda (homedir)
+			 (try (directory-pathname-as-file homedir))))
+		   (else #f))))
       (merge-pathnames "\\")))
 
+(define (nt/current-home-directory)
+  (let ((homedrive (get-environment-variable "HOMEDRIVE"))
+	(homepath (get-environment-variable "HOMEPATH"))
+	(home (get-environment-variable "HOME")))
+    (and (or homepath home)
+	 (pathname-as-directory
+	  (merge-pathnames (or homepath home) homedrive)))))
+
 (define file-time->string
   (ucode-primitive file-time->string 1))
 
-- 
2.25.1