From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 14 Feb 1995 00:30:59 +0000 (+0000)
Subject: Initial revision
X-Git-Tag: 20090517-FFI~6649
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=4f73287215ad3505e983cbba73670ac15e200d9f;p=mit-scheme.git

Initial revision
---

diff --git a/v7/src/edwin/diros2.scm b/v7/src/edwin/diros2.scm
new file mode 100644
index 000000000..417b226ad
--- /dev/null
+++ b/v7/src/edwin/diros2.scm
@@ -0,0 +1,80 @@
+;;; -*-Scheme-*-
+;;;
+;;;	$Id: diros2.scm,v 1.1 1995/02/14 00:30:59 cph Exp $
+;;;
+;;;	Copyright (c) 1992-95 Massachusetts Institute of Technology
+;;;
+;;;	This material was developed by the Scheme project at the
+;;;	Massachusetts Institute of Technology, Department of
+;;;	Electrical Engineering and Computer Science.  Permission to
+;;;	copy this software, to redistribute it, and to use it for any
+;;;	purpose is granted, subject to the following restrictions and
+;;;	understandings.
+;;;
+;;;	1. Any copy made of this software must include this copyright
+;;;	notice in full.
+;;;
+;;;	2. Users of this software agree to make their best efforts (a)
+;;;	to return to the MIT Scheme project any improvements or
+;;;	extensions that they make, so that these may be included in
+;;;	future releases; and (b) to inform MIT of noteworthy uses of
+;;;	this software.
+;;;
+;;;	3. All materials developed as a consequence of the use of this
+;;;	software shall duly acknowledge such use, in accordance with
+;;;	the usual standards of acknowledging credit in academic
+;;;	research.
+;;;
+;;;	4. MIT has made no warrantee or representation that the
+;;;	operation of this software will be error-free, and MIT is
+;;;	under no obligation to provide any services, by way of
+;;;	maintenance, update, or otherwise.
+;;;
+;;;	5. In conjunction with products arising from the use of this
+;;;	material, there shall be no use of the name of the
+;;;	Massachusetts Institute of Technology nor of any adaptation
+;;;	thereof in any advertising, promotional, or sales literature
+;;;	without prior written consent from MIT in each case.
+;;;
+;;; NOTE: Parts of this program (Edwin) were created by translation
+;;; from corresponding parts of GNU Emacs.  Users should be aware that
+;;; the GNU GENERAL PUBLIC LICENSE may apply to these parts.  A copy
+;;; of that license should have been included along with this file.
+;;;
+
+;;;; Directory Editor (OS/2 Customizations)
+;;; package: (edwin dired)
+
+(declare (usual-integrations))
+
+(define-key 'dired #\Z 'dired-do-compress)
+
+(define-command dired-do-compress
+  "Compress or uncompress marked (or next ARG) files.
+The files are compressed or uncompressed using gzip."
+  "P"
+  (lambda (argument)
+    (let ((n
+	   (dired-change-files "compress" argument
+	     (let ((gzip (os/find-program "gzip" #f))
+		   (directory (buffer-default-directory (current-buffer))))
+	       (lambda (pathname lstart)
+		 (let ((type (pathname-type pathname))
+		       (namestring (->namestring pathname)))
+		   (let ((decompress? (equal? type "gz")))
+		     (message (if decompress? "Unc" "C")
+			      "ompressing file `" namestring "'...")
+		     (run-synchronous-process #f #f directory #f
+					      gzip
+					      (if decompress? "-d" "")
+					      namestring)
+		     (dired-redisplay
+		      (pathname-new-type
+		       pathname
+		       (and (not decompress?)
+			    (if (string? type)
+				(string-append type ".gz")
+				"gz")))
+		      lstart))))))))
+      (if (positive? n)
+	  (message "Compressed or uncompressed " n " files.")))))
\ No newline at end of file