A number of changes to accomodate the unix environment.

diff --git a/v7/src/edwin/dired.scm b/v7/src/edwin/dired.scm
index fbdc85e4feb065e3aaefe1ab397d28f66f193b2e..d2ba72e338546f3d57ce58049dca7e609cddb58b 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.97 1989/03/14 08:00:23 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/dired.scm,v 1.98 1989/03/15 19:10:20 cph Exp $
 ;;;
 ;;;    Copyright (c) 1986, 1989 Massachusetts Institute of Technology
 ;;;
@@ -50,11 +50,7 @@
   (select-buffer-other-window (make-dired-buffer "Dired Other Window")))
 
 (define (make-dired-buffer prompt)
-  (let ((pathname
-        (prompt-for-pathname prompt
-                             (pathname-directory-path
-                              (or (buffer-pathname (current-buffer))
-                                  (working-directory-pathname))))))
+  (let ((pathname (prompt-for-directory prompt (current-default-pathname))))
     (let ((buffer (get-dired-buffer pathname)))
       (set-buffer-major-mode! buffer dired-mode)
       (set-buffer-truename! buffer pathname)
@@ -67,7 +63,7 @@
        (lambda (buffer)
          (and (eq? dired-mode (buffer-major-mode buffer))
               (pathname=? pathname (buffer-truename buffer)))))
-      (new-buffer (pathname-name-string pathname))))
+      (new-buffer (pathname->buffer-name pathname))))
 
 (define (revert-dired-buffer argument)
   argument                             ;ignore
@@ -77,6 +73,10 @@
   (set-buffer-writeable! buffer)
   (region-delete! (buffer-region buffer))
   (let ((pathname (buffer-truename buffer)))
+    (temporary-message
+     (string-append "Reading directory "
+                   (pathname->string pathname)
+                   "..."))
     (with-output-to-mark (buffer-point buffer)
       (lambda ()
        (write-string "Directory ")
@@ -86,12 +86,13 @@
        (for-each (lambda (pathname)
                    (write-string (os/make-dired-line pathname))
                    (newline))
-                 (directory-read pathname)))))
+                 (directory-read pathname))))
+    (append-message "done"))
   (buffer-not-modified! buffer)
   (set-buffer-read-only! buffer)
   (add-buffer-initialization! buffer
     (lambda ()
-      (set-current-point! (line-start (buffer-start (current-buffer)) 2)))))
+      (set-dired-point! (line-start (buffer-start (current-buffer)) 2)))))
 \f
 (define-major-mode "Dired" "Fundamental"
   "Major mode for editing a list of files.
@@ -111,6 +112,7 @@ C-] -- abort Dired; this is like \\[Kill Buffer] on this buffer."
 
 (define-key "Dired" #\F "^R Dired Find File")
 (define-key "Dired" #\O "^R Dired Find File Other Window")
+(define-key "Dired" #\G "^R Dired Revert")
 (define-key "Dired" #\D "^R Dired Kill")
 (define-key "Dired" #\K "^R Dired Kill")
 (define-key "Dired" #\C-D "^R Dired Kill")
@@ -118,6 +120,8 @@ C-] -- abort Dired; this is like \\[Kill Buffer] on this buffer."
 (define-key "Dired" #\U "^R Dired Unmark")
 (define-key "Dired" #\Rubout "^R Dired Backup Unmark")
 (define-key "Dired" #\Space "^R Dired Next")
+(define-key "Dired" #\C-N "^R Dired Next")
+(define-key "Dired" #\C-P "^R Dired Previous")
 (define-key "Dired" #\X "^R Dired Execute")
 (define-key "Dired" #\Q "^R Dired Quit")
 (define-key "Dired" #\C-\] "^R Dired Abort")
@@ -131,6 +135,10 @@ C-] -- abort Dired; this is like \\[Kill Buffer] on this buffer."
   "Read the current file into a buffer in another window."
   (find-file-other-window (dired-current-pathname)))
 
+(define-command ("^R Dired Revert")
+  "Read the current buffer."
+  (revert-buffer (current-buffer) true true))
+
 (define-command ("^R Dired Kill" (argument 1))
   "Mark the current file to be killed."
   (dired-mark #\D argument))
@@ -141,13 +149,17 @@ C-] -- abort Dired; this is like \\[Kill Buffer] on this buffer."
 
 (define-command ("^R Dired Backup Unmark" (argument 1))
   "Cancel the kill requested for the file on the previous line."
-  (set-current-point! (line-start (current-point) -1 'ERROR))
+  (set-dired-point! (line-start (current-point) -1 'ERROR))
   (dired-mark #\Space argument)
-  (set-current-point! (line-start (current-point) -1 'ERROR)))
+  (set-dired-point! (line-start (current-point) -1 'ERROR)))
 
 (define-command ("^R Dired Next" (argument 1))
   "Move down to the next line."
-  (set-current-point! (line-start (current-point) argument 'BEEP)))
+  (set-dired-point! (line-start (current-point) argument 'BEEP)))
+
+(define-command ("^R Dired Previous" (argument 1))
+  "Move up to the previous line."
+  (set-dired-point! (line-start (current-point) (- argument) 'BEEP)))
 
 (define-command ("^R Dired Execute")
   "Kill all marked files."
@@ -166,6 +178,13 @@ C-] -- abort Dired; this is like \\[Kill Buffer] on this buffer."
   "Summarize the Dired commands in the typein window."
   (message "d-elete, u-ndelete, x-ecute, q-uit, f-ind, o-ther window"))
 \f
+(define (set-dired-point! mark)
+  (set-current-point!
+   (let ((lstart (line-start mark 0)))
+     (if (dired-filename-line? lstart)
+        (region-start (os/dired-filename-region lstart))
+        lstart))))
+
 (define (dired-current-pathname)
   (let ((lstart (line-start (current-point) 0)))
     (guarantee-dired-filename-line lstart)
@@ -181,13 +200,9 @@ C-] -- abort Dired; this is like \\[Kill Buffer] on this buffer."
         (not (match-forward "Directory" lstart)))))
 
 (define (dired-pathname lstart)
-  (merge-pathnames (pathname-directory-path (buffer-truename (current-buffer)))
-                  (string->pathname (dired-filename lstart))))
-
-(define (dired-filename lstart)
-  (let ((start (mark+ lstart 2)))
-    (char-search-forward #\Space start (line-end start 0))
-    (extract-string start (re-match-start 0))))
+  (merge-pathnames
+   (pathname-directory-path (buffer-truename (current-buffer)))
+   (string->pathname (region->string (os/dired-filename-region lstart)))))
 
 (define (dired-mark char n)
   (with-read-only-defeated (current-point)
@@ -199,7 +214,7 @@ C-] -- abort Dired; this is like \\[Kill Buffer] on this buffer."
            (guarantee-dired-filename-line lstart)
            (delete-right-char lstart)
            (insert-chars char 1 lstart)
-           (set-current-point! (line-start lstart 1))))))))
+           (set-dired-point! (line-start lstart 1))))))))
 
 (define (dired-kill-files)
   (let ((filenames (dired-killable-filenames)))
@@ -244,10 +259,7 @@ C-] -- abort Dired; this is like \\[Kill Buffer] on this buffer."
 (define-command ("List Directory" argument)
   "Generate a directory listing."
   (let ((pathname
-        (prompt-for-pathname "List Directory"
-                             (pathname-directory-path
-                              (or (buffer-pathname (current-buffer))
-                                  (working-directory-pathname))))))
+        (prompt-for-directory "List Directory" (current-default-pathname))))
     (let ((pathnames (directory-read pathname))
          (directory (pathname->string pathname)))
       (with-output-to-temporary-buffer "*Directory*"