From: Stephen Adams <edu/mit/csail/zurich/adams>
Date: Wed, 26 Oct 1994 20:12:23 +0000 (+0000)
Subject: Fixed accidental damage to INSERT-DISRECTORY!
X-Git-Tag: 20090517-FFI~7048
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=b1cb19caff8cd2b0708a105b4b33cc02232526be;p=mit-scheme.git

Fixed accidental damage to INSERT-DISRECTORY!
---

diff --git a/v7/src/edwin/dos.scm b/v7/src/edwin/dos.scm
index 0bbff9eaf..00d5bad98 100644
--- 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)))
-
-;;;; 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)))))