From 5b7d2104f0d5ac3b2d2aa17a27522028ed990fff Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Sun, 6 Sep 1998 04:45:15 +0000
Subject: [PATCH] Implement FILE-EXECUTABLE?, used by command-completion code
 in Edwin. Rearrange file somewhat to make it better correspond to OS/2 file.

---
 v7/src/runtime/ntprm.scm | 137 ++++++++++++++++++++-------------------
 1 file changed, 69 insertions(+), 68 deletions(-)

diff --git a/v7/src/runtime/ntprm.scm b/v7/src/runtime/ntprm.scm
index c19388e57..bde3f75cf 100644
--- a/v7/src/runtime/ntprm.scm
+++ b/v7/src/runtime/ntprm.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: ntprm.scm,v 1.22 1998/05/31 03:19:56 cph Exp $
+$Id: ntprm.scm,v 1.23 1998/09/06 04:45:15 cph Exp $
 
 Copyright (c) 1992-98 Massachusetts Institute of Technology
 
@@ -42,8 +42,28 @@ MIT in each case. |#
    (->namestring (merge-pathnames filename))))
 
 (define (file-symbolic-link? filename)
-  filename				; ignored
-  false)
+  ((ucode-primitive file-symlink? 1)
+   (->namestring (merge-pathnames filename))))
+
+(define (file-access filename amode)
+  ((ucode-primitive file-access 2)
+   (->namestring (merge-pathnames filename))
+   amode))
+
+(define (file-readable? filename)
+  (file-access filename 4))
+
+(define (file-writable? filename)
+  ((ucode-primitive file-access 2)
+   (let ((pathname (merge-pathnames filename)))
+     (let ((filename (->namestring pathname)))
+       (if ((ucode-primitive file-exists? 1) filename)
+	   filename
+	   (directory-namestring pathname))))
+   2))
+
+(define (file-executable? filename)
+  (file-access filename 1))
 
 (define (file-modes filename)
   ((ucode-primitive file-modes 1) (->namestring (merge-pathnames filename))))
@@ -62,61 +82,6 @@ MIT in each case. |#
 (define-integrable nt-file-mode/temporary  #x100)
 (define-integrable nt-file-mode/compressed #x800)
 
-(define (file-access filename amode)
-  ((ucode-primitive file-access 2) (->namestring (merge-pathnames filename))
-				   amode))
-
-;; upwards compatability
-(define dos/file-access file-access)
-
-(define (file-readable? filename)
-  (file-access filename 4))
-
-(define (file-writable? filename)
-  (let ((pathname (merge-pathnames filename)))
-    (let ((filename (->namestring pathname)))
-      (or ((ucode-primitive file-access 2) filename 2)
-	  (and (not ((ucode-primitive file-exists? 1) filename))
-	       ((ucode-primitive file-access 2)
-		(directory-namestring pathname)
-		2))))))
-
-(define (temporary-file-pathname #!optional directory)
-  (let ((root
-	 (merge-pathnames "_scm_tmp"
-			  (if (or (default-object? directory) (not directory))
-			      (temporary-directory-pathname)
-			      (pathname-as-directory directory)))))
-    (let loop ((ext 0))
-      (let ((pathname (pathname-new-type root (number->string ext))))
-	(if (allocate-temporary-file pathname)
-	    pathname
-	    (begin
-	      (if (> ext 999)
-		  (error "Can't find unique temporary pathname:" root))
-	      (loop (+ ext 1))))))))
-
-(define (temporary-directory-pathname)
-  (let ((try-directory
-	 (lambda (directory)
-	   (let ((directory
-		  (pathname-as-directory (merge-pathnames directory))))
-	     (and (file-directory? directory)
-		  (file-writable? directory)
-		  directory)))))
-    (let ((try-variable
-	   (lambda (name)
-	     (let ((value (get-environment-variable name)))
-	       (and value
-		    (try-directory value))))))
-      (or (try-variable "TEMP")
-	  (try-variable "TMP")
-	  (try-directory "/tmp")
-	  (try-directory "c:/")
-	  (try-directory ".")
-	  (try-directory "/")
-	  (error "Can't find temporary directory.")))))
-
 (define (file-attributes filename)
   ((ucode-primitive file-attributes 1)
    (->namestring (merge-pathnames filename))))
@@ -142,7 +107,7 @@ MIT in each case. |#
   (let ((attr (file-attributes namestring)))
     (and attr
 	 (file-attributes/length attr))))
-
+
 (define (file-modification-time filename)
   ((ucode-primitive file-mod-time 1)
    (->namestring (merge-pathnames filename))))
@@ -171,6 +136,10 @@ MIT in each case. |#
 
 (define (file-time->universal-time time) (+ time epoch))
 (define (universal-time->file-time time) (- time epoch))
+
+(define (file-touch filename)
+  ((ucode-primitive file-touch 1)
+   (->namestring (merge-pathnames filename))))
 
 (define get-environment-variable)
 (define set-environment-variable!)
@@ -180,9 +149,9 @@ MIT in each case. |#
 (let ((environment-variables '())
       (environment-defaults '()))
 
-  ;; Kludge: since getenv returns false for unbound,
+  ;; Kludge: since getenv returns #f for unbound,
   ;; that can also be the marker for a deleted variable
-  (define-integrable *variable-deleted* false)
+  (define-integrable *variable-deleted* #f)
 
   (define (env-error proc var)
     (error "Variable must be a string:" var proc))
@@ -241,7 +210,7 @@ MIT in each case. |#
 			 (cons (cons var val) environment-defaults))))
 	    (default-variable! var val))))
 
-)				; End LET
+  )
 
 (define current-user-name)
 (define current-home-directory)
@@ -329,15 +298,11 @@ MIT in each case. |#
 		(let ((rootdir (%system-root-directory)))
 		  (or (trydir (merge-pathnames user-name rootdir))
 		      rootdir)))))))
-
+
 (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 (file-touch filename)
-  ((ucode-primitive file-touch 1)
-   (->namestring (merge-pathnames filename))))
-
+
 (define (make-directory name)
   ((ucode-primitive directory-make 1)
    (->namestring (directory-pathname-as-file (merge-pathnames name)))))
@@ -346,6 +311,42 @@ MIT in each case. |#
   ((ucode-primitive directory-delete 1)
    (->namestring (directory-pathname-as-file (merge-pathnames name)))))
 
+(define (temporary-file-pathname #!optional directory)
+  (let ((root
+	 (merge-pathnames "_scm_tmp"
+			  (if (or (default-object? directory) (not directory))
+			      (temporary-directory-pathname)
+			      (pathname-as-directory directory)))))
+    (let loop ((ext 0))
+      (let ((pathname (pathname-new-type root (number->string ext))))
+	(if (allocate-temporary-file pathname)
+	    pathname
+	    (begin
+	      (if (> ext 999)
+		  (error "Can't find unique temporary pathname:" root))
+	      (loop (+ ext 1))))))))
+
+(define (temporary-directory-pathname)
+  (let ((try-directory
+	 (lambda (directory)
+	   (let ((directory
+		  (pathname-as-directory (merge-pathnames directory))))
+	     (and (file-directory? directory)
+		  (file-writable? directory)
+		  directory)))))
+    (let ((try-variable
+	   (lambda (name)
+	     (let ((value (get-environment-variable name)))
+	       (and value
+		    (try-directory value))))))
+      (or (try-variable "TEMP")
+	  (try-variable "TMP")
+	  (try-directory "/tmp")
+	  (try-directory "c:/")
+	  (try-directory ".")
+	  (try-directory "/")
+	  (error "Can't find temporary directory.")))))
+
 (define (os/file-end-of-line-translation pathname)
   (if (let ((type (dos/fs-drive-type pathname)))
 	(or (string=? "NFS" (car type))
-- 
2.25.1