;; -*-Emacs-Lisp-*- ;;; Copyright (C) 1990 Andy Seaborne ;;; ;;; Author: Andy Seaborne (afs@hplb.hpl.hp.com) ;;; ;;; This program is free software; you can redistribute it and/or modify ;;; it under the terms of the GNU General Public License as published by ;;; the Free Software Foundation; either version 1, or (at your option) ;;; any later version. ;;; ;;; This program is distributed in the hope that it will be useful, ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;; GNU General Public License for more details. ;;; ;;; A copy of the GNU General Public License can be obtained from this ;;; program's author (send electronic mail to afs@hplb.hpl.hp.com) or from ;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA ;;; 02139, USA. ;; > Date: 7 Nov 90 11:37:23 GMT ;; > From: otter!afs@otter.hpl.hp.com ;; > Subject: File uncompress/compress package ;; > Sender: gnu-emacs-sources-request@prep.ai.mit.edu ;; > ;; > There have been several uncompress packages for emacs. Here is my ;; > uncompress/compress package. It will write in compressed form if the file ;; > read was compressed. I like it that way - you may not. ;; > ;; > This package does not completely work with tar-mode as applied to compressed ;; > tar files. It will not write back the compressed tar file - it is written ;; > back uncompressed I'm afraid. ;; > ;; > Please let me know if this does not work for you. ;; > ;; > Andy ;; > ;;===========================================================================;; ;; ;; ;; Z C A T ;; ;; ;; ;;===========================================================================;; ;; ;; Extensions to GNU emacs for compressed files. ;; This file is not part of GNU emacs. ;; ;; This is a replacement uncompress.el that allows writing ;; in compressed form as well as visiting. ;; ;; This package was inspired by one of the same name by Graham Gouch ;; (graham@uk.ac.man.cs). It was aimed mainly at visiting compressed files; ;; it did not write compressed files. ;; ;; zcat-insert-file comes from David N. Blank . ;; You may wish to bind this to the keys for insert-file or even ;; replace the function insert-file with this one. ;; ;; This package automatically puts its self on the auto-mode-alist. ;; If you want to autoload it then make sure the .Z extension stuff is ;; before uncompress.el (if that is already loaded into your emacs. ;; ;; (setq auto-mode-alist ;; (append (list '("\\.Z$".zcat-buffer)) auto-mode-alist ) ;; (autoload 'zcat-buffer "zcat") (provide 'zcat) (defconst zcat-file-ext ".Z" "Filename extension for compressed files.") ;;(defconst zcat-file-ext-re (concat "\\" zcat-file-ext "$")) (defconst zcat-file-ext-re "\\.[zZ]$") (defconst zcat-not-found-flag nil "If true, look for compressed files when a file is not found. If nil then do not look for compressed files.") (defvar zcat-buffer-always-read-only nil "*Controls read only status of a buffer visiting a compressed file. t means always set read-only (browse mode) nil means set the same as the file being visited") (defun zcat-init() "Initialize for the zcat package. Removes things used by uncompress.el" (let ((elt (assoc zcat-file-ext-re auto-mode-alist))) ;; We could just add on the front but I prefer to remove any old entries ;; for neatness and add to the end as compressed files are rarely visited. (if elt ;; In the list - edit in place. (rplacd elt 'zcat-buffer) ;; Not in list - add to end (setq auto-mode-alist (append auto-mode-alist (list (cons zcat-file-ext-re 'zcat-buffer)))))) (if (null zcat-not-found-flag) (setq find-file-not-found-hooks (delq 'find-compressed-version find-file-not-found-hooks)))) (zcat-init) ;; Like uncompress-while-visiting except it presevers read-only status, does ;; not change the file being visited and adds a write-file hook. (defun zcat-buffer () "Uncompress the contents of the buffer, respecting read-only status. Sets major mode for the uncompressed file name and contents." (interactive) (let ((buf-status buffer-read-only) (realname buffer-file-name) filename) (setq filename (if (string-match zcat-file-ext-re realname) (substring realname 0 (match-beginning 0)) nil)) (setq buffer-read-only nil) (message "Uncompressing %s ..." (buffer-name)) (call-process-region (point-min) (point-max) "zcat" t t nil "-c") (message "Uncompressing %s ... Done" (buffer-name)) ;; Change file name so that auto-mod'ing works. (if filename (progn ;; Is there a file of this name that is newer ? (if (file-newer-than-file-p filename realname) (progn (beep) (message "Warning : file '%s' is newer than '%s'" filename realname))) (setq buffer-file-name filename) (normal-mode t) (setq buffer-file-name realname))) ;; Do this or else (almost) ALL files will be compressed !! (make-local-variable 'write-file-hooks) (setq write-file-hooks (append write-file-hooks '(zcat-save-buffer-hook))) (if zcat-buffer-always-read-only (setq buffer-read-only t) (setq buffer-read-only buf-status)) (set-buffer-modified-p nil))) ;; This should be the last write file hook as it really does write the buffer ;; and it removes other write-file-hooks. This way the file hooks get called ;; on the uncompressed version, then this function writes the file. ;; ;; Calls basic-save-buffer to actually write the compressed contents out. ;; Backups will have already been created by save-buffer. ;; ;; The file is compressed in place, not into a temporary buffer, to preserve ;; buffer modtimes. If I could work out how to set the modified time on the ;; buffer without doing I/O I would compress into the temporary buffer and ;; write that, saving two buffer copies. ;; ;; Will reset the cursor and mark, but not other marks in the buffer. ;; Window can jump. (defun zcat-save-buffer-hook() "Save the current buffer in compressed form. Used as a hook when working on compressed files when the buffer is saved into the visited file." (interactive "") (let ( (temp (get-buffer-create "ZCAT")) (cbuff (current-buffer)) (hooks write-file-hooks) (p (point)) ;; (m (mark)) (m (marker-position (mark-marker)))) ; Save mark as character position ;; Check to see if there is a newer, uncompressed file (if (string-match zcat-file-ext-re buffer-file-name) (let ((fname (substring buffer-file-name 0 -2))) (if (file-newer-than-file-p fname buffer-file-name) (let ((s (format "'%s' is newer than '%s'. Continue ? " (file-name-nondirectory fname) (file-name-nondirectory buffer-file-name)))) (if (not (y-or-n-p s)) (error "File not written.")))))) ;; Save a copy of the uncompressed buffer to avoid uncompressing later. (set-buffer temp) (erase-buffer) (insert-buffer-substring cbuff) (set-buffer cbuff) ;; Compress in place (message "Compressing %s ... " (buffer-file-name)) (call-process-region (point-min) (point-max) "compress" t t nil "-c") ;; Gets lost to "Wrote file ... " in basic-save-buffer ;; (message "Compressing %s ... Done" (buffer-file-name)) ;; Call basic-save-buffer recursively and hence do exactly the ;; right thing including respecting the file-precious flag. ;; Remove file hooks to stop a recursion into a black hole. (setq write-file-hooks nil) ;; Clearing modtime stops basic-save-buffer asking again ;; about modified files. It asked before this hook was called. (clear-visited-file-modtime) (basic-save-buffer) (setq write-file-hooks hooks) ;; Put the uncompressed contents back. (erase-buffer) (insert-buffer-substring temp) (set-buffer-modified-p nil) (kill-buffer temp) (goto-char p) (set-marker (mark-marker) m) ;; Say we wrote the file. t)) ;; Insert file replacement that understands compressed files. ;; Thanks to David N. Blank for this. (defun zcat-insert-file (filename) "Insert contents of file FILENAME into buffer after point. Run input through zcat if FILENAME implies its compressed. Set mark after the inserted text." (interactive "fInsert file: ") (let ((endinsrt (insert-file-contents filename))) (if (and (not (null filename)) (string-match zcat-file-ext-re filename)) (let ((begofinsrt (point))) ; if we have a .Z (message "Uncompressing text from %s ..." filename) (call-process-region (point) (+ (point) (car (cdr endinsrt))) "zcat" t t nil "-c") (push-mark (point)) (goto-char begofinsrt) (message "Uncompressing text from %s ... Done" filename)) (push-mark (+ (point) (car (cdr endinsrt))))) ; else be normal )) ;; This function compresses into a temporary buffer, rather than taking a ;; copy, as it does not need to update the buffer's internal variables. (defun zcat-write-file(filename) "Write the current buffer to FILENAME. Adds the compression extension if the file name does not already include it." (interactive "FFile name: ") (let ( (temp (get-buffer-create "ZCAT")) (cbuff (current-buffer)) (p (point))) (if (string-match zcat-file-ext-re filename) nil (setq filename (concat filename zcat-file-ext))) (save-restriction (widen) (set-buffer temp) (erase-buffer) (set-buffer cbuff) ;; Compress into temporary buffer. (message "Compressing %s ... " filename) (call-process-region (point-min) (point-max) "compress" nil temp nil "-c") ;; Actually write the file (set-buffer temp) (write-region (point-min) (point-max) filename nil 1234) (message "Compressed and wrote %s" filename) (set-buffer cbuff) (kill-buffer temp) )))