From 515fed58b06c4203162daffff5a8135b09151607 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Wed, 15 Mar 1989 19:10:20 +0000 Subject: [PATCH] A number of changes to accomodate the unix environment. --- v7/src/edwin/dired.scm | 60 +++++++++++++++++++++++++----------------- 1 file changed, 36 insertions(+), 24 deletions(-) diff --git a/v7/src/edwin/dired.scm b/v7/src/edwin/dired.scm index fbdc85e4f..d2ba72e33 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.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))))) (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")) +(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*" -- 2.25.1