Fixed accidental damage to INSERT-DISRECTORY!

diff --git a/v7/src/edwin/dos.scm b/v7/src/edwin/dos.scm
index 0bbff9eaf97092fb7f34c4dc46ce4fed47cd2f97..00d5bad98db54313a2368a4d31d5e81493257c9f 100644 (file)
--- a/v7/src/edwin/dos.scm
+++ b/v7/src/edwin/dos.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Id: dos.scm,v 1.17 1994/10/25 01:44:33 adams Exp $
+;;;    $Id: dos.scm,v 1.18 1994/10/26 20:12:23 adams Exp $
 ;;;
 ;;;    Copyright (c) 1992-1994 Massachusetts Institute of Technology
 ;;;
@@ -418,22 +418,26 @@ Includes the new backup.  Must be > 0."
   #f
   false?)
 
-(define (read-directory pathname switches mark)
+(define (insert-directory! file switches mark type)
   switches                             ; ignored
-  (if (file-directory? pathname)
-      (generate-dired-listing!
-       (string-append (->namestring (pathname-as-directory pathname))
-                     "*.*")
-       mark)
-      (generate-dired-listing! pathname mark)))
-
-(define (insert-dired-entry! pathname directory lstart)
-  directory                            ; ignored
-  (let ((start (mark-left-inserting lstart)))
-    (insert-string "  " start)
-    (generate-dired-entry! pathname start)))
-\f
-;;;; Scheme version of ls
+  ;; Insert directory listing for FILE at MARK.
+  ;; TYPE can have one of three values:
+  ;;   'WILDCARD means treat FILE as shell wildcard.
+  ;;   'DIRECTORY means FILE is a directory and a full listing is expected.
+  ;;   'FILE means FILE itself should be listed, and not its contents.
+  ;; SWITCHES are ignored.
+  (case type
+    ((WILDCARD)
+     (generate-dired-listing! file mark))
+    ((DIRECTORY)
+     (generate-dired-listing!
+      (string-append (->namestring (pathname-as-directory file))
+                    "*.*")
+      mark))
+    (else
+     (generate-dired-entry! file mark))))
+
+;;; Scheme version of ls
 
 (define (generate-dired-listing! pathname point)
   (let ((files (directory-read (->namestring (merge-pathnames pathname)))))
@@ -464,8 +468,10 @@ Includes the new backup.  Must be > 0."
                  (string-pad-right   ; Mod time
                   (file-attributes/ls-time-string attr) 26 #\Space)
                  name)))
-      (insert-string entry point)
-      (insert-newline point))))
+      (let ((point (mark-left-inserting-copy point)))
+       (insert-string entry point)
+       (insert-newline point)
+       (mark-temporary! point)))))
 
 (define-integrable (dummy-file-attributes)
   '#(#f 0 0 0 0 0 0 0 "----------" 0))
@@ -494,4 +500,4 @@ Includes the new backup.  Must be > 0."
                      (working-directory-pathname))))
        ((ucode-primitive set-working-directory-pathname! 1) outside)
        (set-working-directory-pathname! outside)
-       (start-thread-timer)))))
\ No newline at end of file
+       (start-thread-timer)))))