From e84d161e5ebfd012bd6d1528ae16e1f5d3787404 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 4 Aug 1989 03:17:42 +0000
Subject: [PATCH] In Dired, sort files in standard unix fashion. Change
 directory readers to use new primitive `directory-close' to guarantee that
 the directory reader is cleaned up correctly.

---
 v7/src/edwin/dired.scm | 11 +++++++----
 v7/src/edwin/unix.scm  | 44 ++++++++++++++++++++++++++++--------------
 2 files changed, 37 insertions(+), 18 deletions(-)

diff --git a/v7/src/edwin/dired.scm b/v7/src/edwin/dired.scm
index 0df3b00c8..4582d0ed0 100644
--- a/v7/src/edwin/dired.scm
+++ b/v7/src/edwin/dired.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/dired.scm,v 1.102 1989/04/28 22:49:16 cph Rel $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/dired.scm,v 1.103 1989/08/04 03:17:42 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989 Massachusetts Institute of Technology
 ;;;
@@ -91,7 +91,7 @@ Type `h' after entering dired for more info."
      (string-append "Reading directory "
 		    (pathname->string pathname)
 		    "..."))
-    (let ((pathnames (directory-read pathname)))
+    (let ((pathnames (read&sort-directory pathname)))
       (let ((lines (map os/make-dired-line pathnames))
 	    (point (buffer-point buffer)))
 	(append-message "done")
@@ -308,7 +308,7 @@ C-] -- abort Dired; this is like \\[kill-buffer] on this buffer."
      (string-append "Reading directory "
 		    directory
 		    "..."))
-    (let ((pathnames (directory-read directory)))
+    (let ((pathnames (read&sort-directory directory)))
       (append-message "done")
       (with-output-to-temporary-buffer "*Directory*"
 	(lambda ()
@@ -328,4 +328,7 @@ C-] -- abort Dired; this is like \\[kill-buffer] on this buffer."
 			   pathnames))
 		(else
 		 (write-strings-densely
-		  (map pathname-name-string pathnames)))))))))
\ No newline at end of file
+		  (map pathname-name-string pathnames)))))))))
+
+(define (read&sort-directory pathname)
+  (or/dired-sort-pathnames (directory-read pathname false)))
\ No newline at end of file
diff --git a/v7/src/edwin/unix.scm b/v7/src/edwin/unix.scm
index d7d23d8f8..1babfd304 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.6 1989/04/28 22:54:18 cph Rel $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/unix.scm,v 1.7 1989/08/04 03:17:28 cph Exp $
 ;;;
 ;;;	Copyright (c) 1989 Massachusetts Institute of Technology
 ;;;
@@ -215,24 +215,40 @@ Includes the new backup.  Must be > 0"
   (let ((lend (line-end lstart 0)))
     (char-search-backward #\Space lend lstart 'LIMIT)    (make-region (re-match-end 0) lend)))
 
+(define (os/dired-sort-pathnames pathnames)
+  (sort pathnames
+    (lambda (x y)
+      (string<? (pathname-name-string x) (pathname-name-string y)))))
+
 (define (os/directory-list directory)
-  (let loop
-      ((name ((ucode-primitive open-directory) directory))
-       (result '()))
-    (if name
-	(loop ((ucode-primitive directory-read)) (cons name result))
-	result)))
+  (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)))
 
 (define (os/directory-list-completions directory prefix)
   (if (string-null? prefix)
       (os/directory-list directory)
-      (let loop
-	  ((name ((ucode-primitive open-directory) directory))
-	   (result '()))
-	(if name
-	    (loop ((ucode-primitive directory-read))
-		  (if (string-prefix? prefix name) (cons name result) result))
-	    result))))
+      (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))))
+
 (define-integrable os/file-directory?
   (ucode-primitive file-directory?))
 
-- 
2.25.1