From f219e1e4924e94a4e48ee5f1b7048c95883f50e9 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Sun, 9 Apr 1995 22:33:28 +0000
Subject: [PATCH] Make OS-independent bindings for the following procedures. 
 These procedure were previously defined for all OSs, but with different names
 in each OS:

    user-home-directory
    current-user-name
    current-home-directory

The old names have been aliased to the new, except for OS/2.
---
 v7/src/edwin/dos.scm      |  5 ++---
 v7/src/edwin/notify.scm   |  6 +++---
 v7/src/edwin/rmail.scm    |  8 ++++----
 v7/src/edwin/sendmail.scm |  8 ++++----
 v7/src/edwin/vc.scm       | 10 +++++-----
 v7/src/runtime/dosprm.scm | 17 +++++++++++------
 v7/src/runtime/dospth.scm |  8 ++++----
 v7/src/runtime/os2prm.scm | 17 +++++++----------
 v7/src/runtime/unxprm.scm | 14 +++++++++-----
 v7/src/runtime/unxpth.scm |  8 ++++----
 10 files changed, 53 insertions(+), 48 deletions(-)

diff --git a/v7/src/edwin/dos.scm b/v7/src/edwin/dos.scm
index 487fad17b..be6d21fec 100644
--- a/v7/src/edwin/dos.scm
+++ b/v7/src/edwin/dos.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Id: dos.scm,v 1.20 1995/01/23 20:05:12 cph Exp $
+;;;	$Id: dos.scm,v 1.21 1995/04/09 22:33:18 cph Exp $
 ;;;
 ;;;	Copyright (c) 1992-95 Massachusetts Institute of Technology
 ;;;
@@ -342,8 +342,7 @@ Includes the new backup.  Must be > 0."
 (define (os/init-file-name)
   (let ((user-init-file
 	 (merge-pathnames "edwin.ini"
-			  (pathname-as-directory
-			   (dos/current-home-directory)))))
+			  (pathname-as-directory (current-home-directory)))))
     (if (file-exists? user-init-file)
 	(->namestring user-init-file)
 	"/scheme/lib/edwin.ini")))
diff --git a/v7/src/edwin/notify.scm b/v7/src/edwin/notify.scm
index 9d3e6b9e0..eb67da4fe 100644
--- a/v7/src/edwin/notify.scm
+++ b/v7/src/edwin/notify.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Id: notify.scm,v 1.15 1994/11/20 05:18:03 cph Exp $
+;;;	$Id: notify.scm,v 1.16 1995/04/09 22:33:28 cph Exp $
 ;;;
-;;;	Copyright (c) 1992-94 Massachusetts Institute of Technology
+;;;	Copyright (c) 1992-95 Massachusetts Institute of Technology
 ;;;
 ;;;	This material was developed by the Scheme project at the
 ;;;	Massachusetts Institute of Technology, Department of
@@ -124,7 +124,7 @@ Ignored if notify-show-mail is false."
 (define (notifier:mail-present)
   (if (let ((pathname
 	     (merge-pathnames (ref-variable mail-notify-directory)
-			      (unix/current-user-name))))
+			      (current-user-name))))
 	(and (file-exists? pathname)
 	     (> (file-length pathname) 0)))
       (ref-variable notify-mail-present)
diff --git a/v7/src/edwin/rmail.scm b/v7/src/edwin/rmail.scm
index 4460bde60..6c5192d71 100644
--- a/v7/src/edwin/rmail.scm
+++ b/v7/src/edwin/rmail.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Id: rmail.scm,v 1.33 1994/05/04 22:55:54 cph Exp $
+;;;	$Id: rmail.scm,v 1.34 1995/04/09 22:33:06 cph Exp $
 ;;;
-;;;	Copyright (c) 1991-94 Massachusetts Institute of Technology
+;;;	Copyright (c) 1991-95 Massachusetts Institute of Technology
 ;;;
 ;;;	This material was developed by the Scheme project at the
 ;;;	Massachusetts Institute of Technology, Department of
@@ -205,7 +205,7 @@ together with two commands to return to regular RMAIL:
       (set-variable! rmail-primary-inbox-list
 		     (list "~/mbox"
 			   (string-append rmail-spool-directory
-					  (unix/current-user-name)))))
+					  (current-user-name)))))
   (if (not (ref-variable rmail-dont-reply-to-names))
       (set-variable!
        rmail-dont-reply-to-names
@@ -215,7 +215,7 @@ together with two commands to return to regular RMAIL:
 	  (if rmail-default-dont-reply-to-names
 	      (string-append rmail-default-dont-reply-to-names "\\|")
 	      ""))
-	(re-quote-string (unix/current-user-name))
+	(re-quote-string (current-user-name))
 	"\\>")))
   (if (not umail-message-end-regexp)
       (set! umail-message-end-regexp
diff --git a/v7/src/edwin/sendmail.scm b/v7/src/edwin/sendmail.scm
index a6e94824e..76bb6d545 100644
--- a/v7/src/edwin/sendmail.scm
+++ b/v7/src/edwin/sendmail.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Id: sendmail.scm,v 1.20 1995/01/23 20:06:00 cph Exp $
+;;;	$Id: sendmail.scm,v 1.21 1995/04/09 22:33:23 cph Exp $
 ;;;
 ;;;	Copyright (c) 1991-95 Massachusetts Institute of Technology
 ;;;
@@ -233,7 +233,7 @@ is inserted."
     (if (ref-variable mail-self-blind)
 	(begin
 	  (insert-string "BCC: " point)
-	  (insert-string (unix/current-user-name) point)
+	  (insert-string (current-user-name) point)
 	  (insert-newline point)))
     (let ((mail-archive-file-name (ref-variable mail-archive-file-name)))
       (if mail-archive-file-name
@@ -474,7 +474,7 @@ Numeric argument means justify as well."
 	      (temporary-buffer " sendmail errors")))
 	(temp-buffer (temporary-buffer " sendmail temp"))
 	(mail-buffer (current-buffer))
-	(user-name (unix/current-user-name)))
+	(user-name (current-user-name)))
     (let ((start (buffer-start temp-buffer))
 	  (end (buffer-end temp-buffer)))
       (insert-region (buffer-start mail-buffer)
@@ -548,7 +548,7 @@ Numeric argument means justify as well."
 	  (end (buffer-end temp-buffer)))
       (insert-newline end)
       (insert-string "From " end)
-      (insert-string (unix/current-user-name) end)
+      (insert-string (current-user-name) end)
       (insert-string " " end)
       (insert-string (unix/file-time->string (get-time)) end)
       (insert-newline end)
diff --git a/v7/src/edwin/vc.scm b/v7/src/edwin/vc.scm
index a023e3b47..8d7501f79 100644
--- a/v7/src/edwin/vc.scm
+++ b/v7/src/edwin/vc.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Id: vc.scm,v 1.17 1995/01/06 00:59:18 cph Exp $
+;;;	$Id: vc.scm,v 1.18 1995/04/09 22:33:12 cph Exp $
 ;;;
 ;;;	Copyright (c) 1994-95 Massachusetts Institute of Technology
 ;;;
@@ -167,7 +167,7 @@ Otherwise, the mod time of the file is the checkout time."
 	   (= 0 (unix/current-uid))
 	   (not (let ((locking-user (vc-locking-user master #f)))
 		  (and locking-user
-		       (string=? locking-user (unix/current-user-name))))))
+		       (string=? locking-user (current-user-name))))))
       (set-buffer-read-only! buffer)))
 
 ;;;; Primary Commands
@@ -250,7 +250,7 @@ lock steals will raise an error.
 	  (let ((owner (vc-locking-user master revision)))
 	    (cond ((not owner)
 		   (vc-checkout master revision))
-		  ((string=? owner (unix/current-user-name))
+		  ((string=? owner (current-user-name))
 		   (if (or (let ((buffer (vc-workfile-buffer workfile)))
 			     (and buffer
 				  (buffer-modified? buffer)))
@@ -1034,7 +1034,7 @@ the value of vc-log-mode-hook."
 	    (let ((locks (rcs-admin/locks admin)))
 	      (if (not (null? locks))
 		  (apply string-append
-			 (let ((user (unix/current-user-name)))
+			 (let ((user (current-user-name)))
 			   (map (lambda (lock)
 				  (string-append
 				   ":"
@@ -1154,7 +1154,7 @@ the value of vc-log-mode-hook."
     (vc-run-shell-command master 0 "rlog"
 			  "-L -R"
 			  (and (not all-lockers?)
-			       (string-append "-l" (unix/current-user-name)))
+			       (string-append "-l" (current-user-name)))
 			  (merge-pathnames
 			   "*,v"
 			   (directory-pathname (vc-master-pathname master))))))
diff --git a/v7/src/runtime/dosprm.scm b/v7/src/runtime/dosprm.scm
index bd9d0ecf9..402be6a4f 100644
--- a/v7/src/runtime/dosprm.scm
+++ b/v7/src/runtime/dosprm.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: dosprm.scm,v 1.25 1995/01/31 19:34:24 cph Exp $
+$Id: dosprm.scm,v 1.26 1995/04/09 22:32:00 cph Exp $
 
 Copyright (c) 1992-95 Massachusetts Institute of Technology
 
@@ -248,7 +248,7 @@ MIT in each case. |#
 
   unspecific)				; End LET
 
-(define (dos/user-home-directory user-name)
+(define (user-home-directory user-name)
   (or (and user-name
 	   (let ((directory (get-environment-variable "USERDIR")))
 	     (and directory
@@ -257,12 +257,17 @@ MIT in each case. |#
 		   user-name))))
       "\\"))
 
-(define (dos/current-user-name)
-  (get-environment-variable "USER"))
+(define (current-user-name)
+  (or (get-environment-variable "USER")
+      "nouser"))
 
-(define (dos/current-home-directory)
+(define (current-home-directory)
   (or (get-environment-variable "HOME")
-      (dos/user-home-directory (dos/current-user-name))))
+      (user-home-directory (current-user-name))))
+
+(define dos/user-home-directory user-home-directory)
+(define dos/current-user-name current-user-name)
+(define dos/current-home-directory current-home-directory)
 
 (define dos/file-time->string
   (ucode-primitive file-time->string 1))
diff --git a/v7/src/runtime/dospth.scm b/v7/src/runtime/dospth.scm
index 99b60fc3e..088c4f018 100644
--- a/v7/src/runtime/dospth.scm
+++ b/v7/src/runtime/dospth.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: dospth.scm,v 1.23 1995/02/14 00:33:54 cph Exp $
+$Id: dospth.scm,v 1.24 1995/04/09 22:32:25 cph Exp $
 
 Copyright (c) 1992-95 Massachusetts Institute of Technology
 
@@ -116,8 +116,8 @@ MIT in each case. |#
 				(directory-pathname-as-file
 				 (let ((user-name (string-tail string 1)))
 				   (if (string-null? user-name)
-				       (dos/current-home-directory)
-				       (dos/user-home-directory user-name)))))
+				       (current-home-directory)
+				       (user-home-directory user-name)))))
 			       sub-directory-delimiters)
 	    (cdr components)))
 	  (else components)))))
@@ -313,7 +313,7 @@ MIT in each case. |#
 
 (define (dos/user-homedir-pathname host)
   (and (eq? host local-host)
-       (pathname-as-directory (dos/current-home-directory))))
+       (pathname-as-directory (current-home-directory))))
 
 (define (dos/init-file-pathname host)
   (let ((pathname
diff --git a/v7/src/runtime/os2prm.scm b/v7/src/runtime/os2prm.scm
index eb2517044..031c0268c 100644
--- a/v7/src/runtime/os2prm.scm
+++ b/v7/src/runtime/os2prm.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: os2prm.scm,v 1.7 1995/02/21 23:12:47 cph Exp $
+$Id: os2prm.scm,v 1.8 1995/04/09 22:32:10 cph Exp $
 
 Copyright (c) 1994-95 Massachusetts Institute of Technology
 
@@ -209,16 +209,17 @@ MIT in each case. |#
 (define-integrable os2/current-pid
   (ucode-primitive current-pid 0))
 
-(define (os2/current-home-directory)
+(define (current-home-directory)
   (let ((home (get-environment-variable "HOME")))
     (if home
 	(pathname-as-directory (merge-pathnames home))
-	(os2/user-home-directory (os2/current-user-name)))))
+	(user-home-directory (current-user-name)))))
 
-(define (os2/current-user-name)
-  (get-environment-variable "USER"))
+(define (current-user-name)
+  (or (get-environment-variable "USER")
+      "nouser"))
 
-(define (os2/user-home-directory user-name)
+(define (user-home-directory user-name)
   (or (and user-name
 	   (let ((directory (get-environment-variable "USERDIR")))
 	     (and directory
@@ -228,10 +229,6 @@ MIT in each case. |#
 		    user-name)))))
       "\\"))
 
-;; These two aliases are needed by the DOS pathname parser.
-(define dos/current-home-directory os2/current-home-directory)
-(define dos/user-home-directory os2/user-home-directory)
-
 (define (os/default-end-of-line-translation)
   "\r\n")
 
diff --git a/v7/src/runtime/unxprm.scm b/v7/src/runtime/unxprm.scm
index 967fb1132..711234f49 100644
--- a/v7/src/runtime/unxprm.scm
+++ b/v7/src/runtime/unxprm.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: unxprm.scm,v 1.33 1995/01/31 19:34:50 cph Exp $
+$Id: unxprm.scm,v 1.34 1995/04/09 22:32:18 cph Exp $
 
 Copyright (c) 1988-95 Massachusetts Institute of Technology
 
@@ -217,19 +217,23 @@ MIT in each case. |#
 	(lambda () (set! environment-variables '())))
 ) ; End LET
 
-(define (unix/user-home-directory user-name)
+(define (user-home-directory user-name)
   (let ((directory ((ucode-primitive get-user-home-directory 1) user-name)))
     (if (not directory)
 	(error "Can't find user's home directory:" user-name))
     directory))
 
-(define (unix/current-home-directory)
+(define (current-home-directory)
   (or (get-environment-variable "HOME")
-      (unix/user-home-directory (unix/current-user-name))))
+      (user-home-directory (current-user-name))))
 
-(define-integrable unix/current-user-name
+(define-integrable current-user-name
   (ucode-primitive current-user-name 0))
 
+(define unix/user-home-directory user-home-directory)
+(define unix/current-home-directory current-home-directory)
+(define unix/current-user-name current-user-name)
+
 (define-integrable unix/current-uid
   (ucode-primitive current-uid 0))
 
diff --git a/v7/src/runtime/unxpth.scm b/v7/src/runtime/unxpth.scm
index 2f9b7a7d2..63a85340e 100644
--- a/v7/src/runtime/unxpth.scm
+++ b/v7/src/runtime/unxpth.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: unxpth.scm,v 14.17 1995/01/31 19:34:54 cph Exp $
+$Id: unxpth.scm,v 14.18 1995/04/09 22:32:33 cph Exp $
 
 Copyright (c) 1988-95 Massachusetts Institute of Technology
 
@@ -106,8 +106,8 @@ MIT in each case. |#
 	 (let ((user-name (substring string 1 (string-length string))))
 	   (string-components
 	    (if (string-null? user-name)
-		(unix/current-home-directory)
-		(unix/user-home-directory user-name))
+		(current-home-directory)
+		(user-home-directory user-name))
 	    #\/)))
 	(else (list string)))))
 
@@ -271,7 +271,7 @@ MIT in each case. |#
 
 (define (unix/user-homedir-pathname host)
   (and (eq? host local-host)
-       (pathname-as-directory (unix/current-home-directory))))
+       (pathname-as-directory (current-home-directory))))
 
 (define (unix/init-file-pathname host)
   (let ((pathname
-- 
2.25.1