From 4f73287215ad3505e983cbba73670ac15e200d9f Mon Sep 17 00:00:00 2001 From: Chris Hanson <org/chris-hanson/cph> Date: Tue, 14 Feb 1995 00:30:59 +0000 Subject: [PATCH] Initial revision --- v7/src/edwin/diros2.scm | 80 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 80 insertions(+) create mode 100644 v7/src/edwin/diros2.scm 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 -- 2.25.1