Initial revision

diff --git a/v7/src/edwin/diros2.scm b/v7/src/edwin/diros2.scm
new file mode 100644 (file)
index 0000000..417b226
--- /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))
+\f
+(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