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.

diff --git a/v7/src/edwin/dired.scm b/v7/src/edwin/dired.scm
index 0df3b00c8562e03cb63137b6a1b8f7872d0069b3..4582d0ed045a5e7174924fa54b6bec5dd9e43cbf 100644 (file)
--- 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 d7d23d8f8e29264425b4f08406187a0967bf6d47..1babfd304ba218fe5a39fe4fc7abca43122ad92e 100644 (file)
--- 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)))))
+\f
 (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?))