From: Chris Hanson <org/chris-hanson/cph>
Date: Sat, 28 Oct 1995 03:00:09 +0000 (+0000)
Subject: Change support for user-name and home directory so that it uses the
X-Git-Tag: 20090517-FFI~5825
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=3e9df598518673d90fcc40a25a6ec0e02f31503b;p=mit-scheme.git

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.
---

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))