Rewrite OS/2 and NT versions of CURRENT-USER-NAME,

CURRENT-HOME-DIRECTORY, and USER-HOME-DIRECTORY to use the same
heuristics in both systems.  Improve the heuristics so that these
procedures will work with a minimum number of environment bindings.

diff --git a/v7/src/runtime/ntprm.scm b/v7/src/runtime/ntprm.scm
index 8c6a4102d409e08c032fa0ed2ec5aa6ab0e0831c..2384b7e0ba75c80436cc759849fd8f3d4138c07d 100644 (file)
--- a/v7/src/runtime/ntprm.scm
+++ b/v7/src/runtime/ntprm.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: ntprm.scm,v 1.14 1997/11/11 13:20:21 cph Exp $
+$Id: ntprm.scm,v 1.15 1997/11/12 08:40:05 cph Exp $
 
 Copyright (c) 1992-97 Massachusetts Institute of Technology
 
@@ -241,43 +241,86 @@ MIT in each case. |#
 
 )                              ; End LET
 \f
-(define (current-home-directory)
-  (or (nt/current-home-directory)
-      (user-home-directory (current-user-name))))
-
-(define (current-user-name)
-  (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)))))
-      (error "Unable to determine current user name.")))
-
-(define (user-home-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)
-               (if (string=? user-name (current-user-name))
-                   homedir
-                   (try (directory-pathname-as-file homedir)))))
-         (else
-          (error "Can't find user's home directory:" user-name)))))
-
-(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 current-user-name)
+(define current-home-directory)
+(define user-home-directory)
+(letrec
+    ((trydir
+      (lambda (directory)
+       (and directory
+            (file-directory? directory)
+            (pathname-as-directory directory))))
+     (%current-user-name
+      (lambda ()
+       (or (get-environment-variable "USERNAME")
+           (get-environment-variable "USER"))))
+     (%current-home-directory
+      (lambda ()
+       (or (let ((homedrive (get-environment-variable "HOMEDRIVE"))
+                 (homepath (get-environment-variable "HOMEPATH")))
+             (and homedrive
+                  homepath
+                  (trydir (merge-pathnames homepath homedrive))))
+           (trydir (get-environment-variable "HOME")))))
+     (%users-directory
+      (lambda ()
+       (trydir (get-environment-variable "USERDIR"))))
+     (%system-root-directory
+      (lambda ()
+       (let ((sysdrive (get-environment-variable "SYSTEM_DRIVE")))
+         (if (not sysdrive)
+             (error "Unable to find Windows system drive."))
+         (trydir (string-append sysdrive "\\"))))))
+
+  (set! current-user-name
+       (lambda ()
+         (or (%current-user-name)
+             ;; If the home directory is defined, use the last part of the
+             ;; path as the user's name.  If the home directory is the root
+             ;; of a drive, this won't do anything.
+             (let ((homedir (%current-home-directory)))
+               (and homedir
+                    (pathname-name (directory-pathname-as-file homedir))))
+             (error "Unable to determine current user name."))))
+
+  (set! current-home-directory
+       (lambda ()
+         (or (%current-home-directory)
+             (let ((user-name (%current-user-name)))
+               ;; If home directory not defined, look for directory
+               ;; with user's name in users directory and in root
+               ;; directory of system drive.  If still nothing, use
+               ;; root directory of system drive.
+               (or (let ((usersdir (%users-directory)))
+                     (and usersdir
+                          (trydir (merge-pathnames user-name usersdir))))
+                   (let ((rootdir (%system-root-directory)))
+                     (or (trydir (merge-pathnames user-name rootdir))
+                         rootdir)))))))
+
+  (set! user-home-directory
+       (lambda (user-name)
+         (let ((homedir (%current-home-directory)))
+           ;; If USER-NAME is current user, use current home
+           ;; directory.
+           (or (let ((user-name* (%current-user-name)))
+                 (and user-name*
+                      (string=? user-name user-name*)
+                      homedir))
+               ;; Look for USER-NAME in users directory.
+               (let ((usersdir (%users-directory)))
+                 (and usersdir
+                      (trydir (merge-pathnames user-name usersdir))))
+               ;; Look for USER-NAME in same directory as current
+               ;; user's home directory.
+               (and homedir
+                    (trydir (merge-pathnames user-name homedir)))
+               ;; Look for USER-NAME in root directory of system
+               ;; drive.  Failing that, use root directory itself.
+               (let ((rootdir (%system-root-directory)))
+                 (or (trydir (merge-pathnames user-name rootdir))
+                     rootdir)))))))
+\f
 (define dos/user-home-directory user-home-directory)
 (define dos/current-user-name current-user-name)
 (define dos/current-home-directory current-home-directory)

diff --git a/v7/src/runtime/os2prm.scm b/v7/src/runtime/os2prm.scm
index 7075fb3ca3a5d39c066e07f2a5c3f6a4d0aafa7a..c529c1f8304eeccf44f8917f3c1a1ae78d47dd0d 100644 (file)
--- a/v7/src/runtime/os2prm.scm
+++ b/v7/src/runtime/os2prm.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: os2prm.scm,v 1.33 1997/11/11 13:20:29 cph Exp $
+$Id: os2prm.scm,v 1.34 1997/11/12 08:39:57 cph Exp $
 
 Copyright (c) 1994-97 Massachusetts Institute of Technology
 
@@ -204,31 +204,81 @@ MIT in each case. |#
 
 (define-integrable os2/current-pid
   (ucode-primitive current-pid 0))
-
-(define (current-home-directory)
-  (let ((home (get-environment-variable "HOME")))
-    (if home
-       (pathname-as-directory (merge-pathnames home))
-       (user-home-directory (current-user-name)))))
-
-(define (current-user-name)
-  (or (get-environment-variable "USER")
-      (error "Unable to determine current user name.")))
-
-(define (user-home-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)))))
-         ((get-environment-variable "HOME")
-          => (lambda (homedir)
-               (if (string=? user-name (current-user-name))
-                   homedir
-                   (try (directory-pathname-as-file homedir)))))
-         (else
-          (error "Can't find user's home directory:" user-name)))))
+\f
+(define current-user-name)
+(define current-home-directory)
+(define user-home-directory)
+(letrec
+    ((trydir
+      (lambda (directory)
+       (and directory
+            (file-directory? directory)
+            (pathname-as-directory directory))))
+     (%current-user-name
+      (lambda ()
+       (get-environment-variable "USER")))
+     (%current-home-directory
+      (lambda ()
+       (trydir (get-environment-variable "HOME"))))
+     (%users-directory
+      (lambda ()
+       (trydir (get-environment-variable "USERDIR"))))
+     (%system-root-directory
+      (lambda ()
+       (let ((system.ini (get-environment-variable "SYSTEM_INI")))
+         (if (not (file-exists? system.ini))
+             (error "Unable to find OS/2 system.ini file:" system.ini))
+         (pathname-new-directory (directory-pathname system.ini)
+                                 '(ABSOLUTE))))))
+
+  (set! current-user-name
+       (lambda ()
+         (or (%current-user-name)
+             ;; If the home directory is defined, use the last part of the
+             ;; path as the user's name.  If the home directory is the root
+             ;; of a drive, this won't do anything.
+             (let ((homedir (%current-home-directory)))
+               (and homedir
+                    (pathname-name (directory-pathname-as-file homedir))))
+             (error "Unable to determine current user name."))))
+
+  (set! current-home-directory
+       (lambda ()
+         (or (%current-home-directory)
+             (let ((user-name (%current-user-name)))
+               ;; If home directory not defined, look for directory
+               ;; with user's name in users directory and in root
+               ;; directory of system drive.  If still nothing, use
+               ;; root directory of system drive.
+               (or (let ((usersdir (%users-directory)))
+                     (and usersdir
+                          (trydir (merge-pathnames user-name usersdir))))
+                   (let ((rootdir (%system-root-directory)))
+                     (or (trydir (merge-pathnames user-name rootdir))
+                         rootdir)))))))
+
+  (set! user-home-directory
+       (lambda (user-name)
+         (let ((homedir (%current-home-directory)))
+           ;; If USER-NAME is current user, use current home
+           ;; directory.
+           (or (let ((user-name* (%current-user-name)))
+                 (and user-name*
+                      (string=? user-name user-name*)
+                      homedir))
+               ;; Look for USER-NAME in users directory.
+               (let ((usersdir (%users-directory)))
+                 (and usersdir
+                      (trydir (merge-pathnames user-name usersdir))))
+               ;; Look for USER-NAME in same directory as current
+               ;; user's home directory.
+               (and homedir
+                    (trydir (merge-pathnames user-name homedir)))
+               ;; Look for USER-NAME in root directory of system
+               ;; drive.  Failing that, use root directory itself.
+               (let ((rootdir (%system-root-directory)))
+                 (or (trydir (merge-pathnames user-name rootdir))
+                     rootdir)))))))
 \f
 (define (dos/fs-drive-type pathname)
   (let ((type