From c417d123954faf574866d6ec4fe9bdf4c83d5d50 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 12 Apr 1991 23:21:24 +0000
Subject: [PATCH] Rewrite directory-listing procedures to use new primitives --
 REQUIRES MICROCODE VERSION 11.74 OR LATER.  Implement procedure
 `file-readable?'.

---
 v7/src/edwin/unix.scm | 50 ++++++++++++++++++++-----------------------
 1 file changed, 23 insertions(+), 27 deletions(-)

diff --git a/v7/src/edwin/unix.scm b/v7/src/edwin/unix.scm
index 2afb83c46..21fb8c06f 100644
--- a/v7/src/edwin/unix.scm
+++ b/v7/src/edwin/unix.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/unix.scm,v 1.12 1991/04/01 06:15:49 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/unix.scm,v 1.13 1991/04/12 23:21:24 cph Exp $
 ;;;
 ;;;	Copyright (c) 1989-91 Massachusetts Institute of Technology
 ;;;
@@ -254,33 +254,26 @@ Includes the new backup.  Must be > 0"
 	filename)))
 
 (define (os/directory-list directory)
-  (dynamic-wind
-   (lambda () unspecific)
-   (lambda ()
-     (let loop
-	 ((name ((ucode-primitive open-directory 1) directory))
-	  (result '()))
-       (if name
-	   (loop ((ucode-primitive directory-read 0)) (cons name result))
-	   result)))
-   (ucode-primitive directory-close 0)))
+  (ucode-primitive directory-close 0)
+  ((ucode-primitive directory-open-noread 1) directory)
+  (let loop ((result '()))
+    (let ((name ((ucode-primitive directory-read 0))))
+      (if name
+	  (loop (cons name result))
+	  (begin
+	    (ucode-primitive directory-close 0)
+	    result)))))
 
 (define (os/directory-list-completions directory prefix)
-  (if (string-null? prefix)
-      (os/directory-list directory)
-      (dynamic-wind
-       (lambda () unspecific)
-       (lambda ()
-	 (let loop
-	     ((name ((ucode-primitive open-directory 1) directory))
-	      (result '()))
-	   (if name
-	       (loop ((ucode-primitive directory-read 0))
-		     (if (string-prefix? prefix name)
-			 (cons name result)
-			 result))
-	       result)))
-       (ucode-primitive directory-close 0))))
+  (ucode-primitive directory-close 0)
+  ((ucode-primitive directory-open-noread 1) directory)
+  (let loop ((result '()))
+    (let ((name ((ucode-primitive directory-read-matching 1) prefix)))
+      (if name
+	  (loop (cons name result))
+	  (begin
+	    (ucode-primitive directory-close 0)
+	    result)))))
 
 (define-integrable os/file-directory?
   (ucode-primitive file-directory?))
@@ -327,4 +320,7 @@ Includes the new backup.  Must be > 0"
 		 (merge-pathnames name-path
 				  (pathname-directory-path pathname))))
 	    (and (file-exists? pathname)
-		 pathname))))))
\ No newline at end of file
+		 pathname))))))
+
+(define-integrable (file-readable? filename)
+  (unix/file-access filename 4))
\ No newline at end of file
-- 
2.25.1