From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 18 Oct 1995 05:27:16 +0000 (+0000)
Subject: Implement M-x dired-create-directory and bind it to #\+.
X-Git-Tag: 20090517-FFI~5883
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=82e897b93db52a5e6d4d1253e18e9db4ffb2151c;p=mit-scheme.git

Implement M-x dired-create-directory and bind it to #\+.
---

diff --git a/v7/src/edwin/dired.scm b/v7/src/edwin/dired.scm
index 09c36dfe1..f0c4b28a0 100644
--- a/v7/src/edwin/dired.scm
+++ b/v7/src/edwin/dired.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Id: dired.scm,v 1.157 1995/10/06 21:01:06 cph Exp $
+;;;	$Id: dired.scm,v 1.158 1995/10/18 05:27:16 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989-95 Massachusetts Institute of Technology
 ;;;
@@ -105,6 +105,7 @@ Space and Rubout can be used to move down and up by lines."
     (event-distributor/invoke! (ref-variable dired-mode-hook buffer) buffer)))
 
 (define-key 'dired #\# 'dired-flag-auto-save-files)
+(define-key 'dired #\+ 'dired-create-directory)
 (define-key 'dired #\. 'dired-clean-directory)
 (define-key 'dired #\? 'dired-summary)
 (define-key 'dired #\d 'dired-flag-file-deletion)
@@ -506,6 +507,18 @@ Type \\[help-command] at that time for help."
 
 ;;;; File Operation Commands
 
+(define-command dired-create-directory
+  "Create a directory named DIRECTORY."
+  "DCreate directory"
+  (lambda (directory)
+    (make-directory directory)
+    (let ((lstart (mark-right-inserting-copy (line-start (current-point) 0))))
+      (with-read-only-defeated lstart
+	(lambda ()
+	  (insert-dired-entry! directory lstart)))
+      (set-dired-point! lstart)
+      (mark-temporary! lstart))))
+
 (define-command dired-do-copy
   "Copy all marked (or next ARG) files, or copy the current file.
 This normally preserves the last-modified date when copying.