From: s5451066@titan.ucc.umass.edu (Eric Ludlam)
Subject: zip mode
Organization: University Computing Services
Distribution: gnu
Date: Fri, 21 Aug 1992 16:32:21 GMT
X-Posted-From: titan.ucc.umass.edu
X-Posted-Through: sol.ctr.columbia.edu

Hello,
  A while back someone asked "Is there a zip mode for emacs to browse
zip files?"  and someone later wrote something to do that.
Unfortunatly I didn't pick it up at the time, and as I recall, it was
a fairly straightforward implementation.
  Well, one day I was using ange-ftp, and was greatly enjoying the
combination of tar-mode and z-mode (from elisp-archive) to view unix
files.  I thought it would be nice to do the same for zip files.  So,
the following hunk of code does just that.  It works fine outside of
ange-ftp (so far) and works quite well within ange-ftp solving the
problem around unzip not unziping from stdin by using /tmp.  Let me
know how it goes.

Tally ho 
Eric
------------8<---------------8<----------------8<--------------
 ;; -*- Emacs lisp -*-
 ;;
 ;; Copyright (C) 1992 Eric M. Ludlam
 ;;
 ;; 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 2, 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.
 ;;
 ;; You should have received a copy of the GNU General Public License
 ;; along with this program; if not, you can either send email to this
 ;; program's author (see below) or write to:
 ;;
 ;;              The Free Software Foundation, Inc.
 ;;              675 Mass Ave.
 ;;              Cambridge, MA 02139, USA. 
 ;;
 ;; Please send bug reports, etc. to s5451066@titan.ucc.umass.edu
 ;;                               or zappo@gnu.ai.mit.edu
 ;;
 ;; ZIP mode ----------------------------------------------
 ;;
 ;; Some of the procedure names are a little innocuous, like
 ;; zip-buffer really means to unzip the buffer... cest la vie'
 ;; Anyways, this was designed not to manipulate zip files, but
 ;; instead, to browse them.  Making manipulatory functions would, of
 ;; course, be moderatly easy I suppose, but that wasn't what I wanted
 ;; this program for. 
 ;;
 ;; This program was specifically designed for use with ange-ftp.
 ;; When auto-mode is used, zip-buffer is called, but all it does is
 ;; zorch the current buffer and replace it with an unzip -v of the
 ;; file you loaded in.  If the buffer is an ange-ftp'ed file, it
 ;; saves it to a temporary file and works from there.  On quit, "q",
 ;; it deletes the temp file.  Thus the command "m" to move the tmp file
 ;; to a safer location in case you don't feel like doing another get
 ;; on the file.
 ;; 
 ;; The only other really usefull command is "v" which loads a file
 ;; under the cursor into a view buffer from the zip file using 
 ;; "unzip -p zipfile extractfile" and using view to look at the file.
 ;; 
 ;; As you might have noticed.. you need unzip to use this on your
 ;; machine.
(provide 'zip)

(setq auto-mode-alist (nconc '(("\\.zip$" . zip-buffer)) auto-mode-alist))

(defvar zip-mode-map nil
  "Keymap used in zip-mode")
(if zip-mode-map
    ()
  (setq zip-mode-map (make-sparse-keymap))
  (define-key zip-mode-map " "   'zip-next-line)
  (define-key zip-mode-map "g"   'zip-re-zip)
  (define-key zip-mode-map "h"   'describe-mode)
  (define-key zip-mode-map "m"   'zip-move-tmp-file)
  (define-key zip-mode-map "n"   'zip-next-line)
  (define-key zip-mode-map "p"   'zip-prev-line)
  (define-key zip-mode-map "q"   'zip-quit)
  (define-key zip-mode-map "r"   'isearch-backward)
  (define-key zip-mode-map "s"   'isearch-forward)
  (define-key zip-mode-map "v"   'zip-view)
  (define-key zip-mode-map "x"   'zip-quit)
  (define-key zip-mode-map "\177" 'zip-prev-line))

(defvar zip-clear-before-zip t
  "Non-nil means delete the zip buffer before conducting a zip")

(defun zip (zfile)
  "Major mode for looking at zip information."

  (interactive (cons (save-excursion
		       (setq onewindow (one-window-p t))
		       (setq fw (zip-blurb-buffer))
		       (read-file-name "Zip what file: "))
		     '()))
  (if (setq tmp (zip-make-list zfile))
      (progn
	(switch-to-buffer tmp)
	(zip-mode)
	))
  (setq buffer-read-only t)
  (if onewindow 
      (delete-window fw))
  (if (get-buffer "Your Rights with zip.el")
      (kill-buffer "Your Rights with zip.el")))

(defun zip-buffer ()
  "Unzip current buffer into the list thing."

  (interactive)
  (zip-mode)
  (if (string-match "@[a-zA-Z0-9.]+:" (buffer-file-name))
      (progn
	(setq zip-zorch-on-quit t)
	(setq rf (concat "/tmp/" (getenv "USER") "+" (buffer-name)))
	(write-region (point-min) (point-max) rf)
	(setq tmp (zip-make-list rf (buffer-file-name))))
    (setq tmp (zip-make-list (buffer-file-name))))
  (set-buffer-modified-p nil)
  (setq buffer-read-only t)
  (switch-to-buffer tmp))

(defun zip-mode ()
  "Defines a major mode for processing zip information.
   n,SPC - next
   p,DEL - prev
   h     - help
   v     - view file from zip archive
   m     - move the zip file (useful for ange-ftp use)
   q,x   - quit.
"

  (interactive)
  (use-local-map zip-mode-map)
  (set-buffer-modified-p nil)
  (setq mode-name "Ziped")
  (setq major-mode 'zip-mode)
  (make-local-variable 'zip-zorch-on-quit)
  (setq zip-zorch-on-quit nil)
  (run-hooks 'zip-mode-hooks))

(defun zip-view (&optional file)
  "unzip a file into a view buffer...."

  (interactive)
  (require 'view)
  (setq buff
	(if file
	    (zip-unzip-to-buffer file)
	  (zip-unzip-to-buffer (zip-file-this-line))))
  (switch-to-buffer buff)
  (read-msdos)
  (view-buffer buff)
  (kill-buffer buff))

(defun zip-unzip-to-buffer (file)
  "Unzip a file from in the predefined zip file (in zip mode) and put
it into a buffer."
  
  (setq tf zip-tmp-file)
  (set-buffer (get-buffer-create (concat tf "->" file)))
  (call-process "unzip" nil (current-buffer) nil "-p" tf file)
  (goto-char 1)
  (current-buffer))

(defun zip-move-tmp-file (newname)
  "Move the ange-ftp temporary file into a new location.  Will work on
non-anged files as well."

  (interactive "FRename to: ")
  (setq zip-zorch-on-quit nil)
  (rename-file zip-tmp-file  newname))


(defun zip-file-this-line ()
  "Get the file from this line..."
  (beginning-of-line)
  (forward-char 58)
  (buffer-substring (point) (save-excursion (end-of-line) (point))))

(defun zip-re-zip ()
  "Update the current zip list."
  (interactive)
  (zip-make-list (buffer-name))
  (set-buffer-modified-p nil)
  (setq buffer-read-only t))

(defun zip-quit ()
  "Quit the current zip buffer."

  (interactive)
  (if zip-zorch-on-quit
      (if (y-or-n-p (format "Zorch %s on exit?" zip-tmp-file))
	  (delete-file zip-tmp-file)))
  (if (equal major-mode 'zip-mode)
      (kill-buffer (current-buffer))))

(defun zip-next-line ()
  "Move zip cursor to next line."
  (interactive)
  (next-line 1)
  (beginning-of-line)
  (forward-char 58))

(defun zip-prev-line ()
  "Move zip cursor to prev line."
  (interactive)
  (previous-line 1)
  (beginning-of-line)
  (forward-char 58))

(defun zip-make-list (zfile &optional realfile)
  "Generate a zip directory listing."

  (interactive "fFile: ")

  (message "Checking %s for zip information." zfile)

  (make-local-variable 'zip-tmp-file)
  (setq zip-tmp-file zfile)

  (setq buffer-read-only nil)
  (if zip-clear-before-zip
      (delete-region (point-min) (point-max)))
  (call-process "unzip" nil (current-buffer) nil "-v" zfile)
  (goto-char 1)
  (current-buffer))

(defun zip-blurb-buffer ()
  "You have the right to remain silent, anything you say can and will
be typecast against you."

  (save-excursion
    (get-buffer-create "Your Rights with zip.el")
    (set-buffer (get-buffer "Your Rights with zip.el"))
    (delete-region (point-min) (point-max))
    (insert "
     Thanks for using Emacs Zip!

     This program is free under the GNU general public license.
     See the GNU COPYING file for more details.

     Please report Bugs/Problems/Suggestions to:
                                             s5451066@titan.ucc.umass.edu
                                                zappo@gnu.ai.mit.edu")
    (display-buffer "Your Rights with zip.el")))
;;
;; read-msdos/write-msdos
;;
;; Try to find and handle PC files - Here are two funtions that are bound to
;; the read and write file hooks.  The first read-msdos checks to see if a file
;; contains a <cr> character. If so it is assumed that all lines are terminated
;; by a <cr><lf> sequence.  The <cr>'s are removed from the buffer and a 
;; buffer-local flag is set to indicate that this was done.  When the file is
;; written out, the flag is checked and if it is set, all line feeds are 
;; replaced with <cr><lf> sequences.
;;
(defvar msdos-file nil "*Variable to indicate if a file was an MS-DOS file or not")
(defun read-msdos ()
  "Function to strip <cr><lf> sequence out of a file when read"
  (interactive)
  (make-local-variable 'msdos-file)
  (save-excursion (goto-char (point-min))
		  (if (search-forward "\r" nil t)
		      (progn (setq msdos-file t)
			     (goto-char (point-min))
			     (replace-string "\r" "")
			     (setq msdos-file t)
			     (not-modified)))))

(defun write-msdos ()
  "Function to change <lf> to <cr><lf> for MS-DOS files"
  (if msdos-file
      (save-excursion (goto-char (point-min))
		      (replace-string "\n" "\r\n")
		      (write-region (point-min) (point-max) (buffer-file-name))
		      (goto-char (point-min))
		      (replace-string "\r" "")
		      (not-modified)
		      (clear-visited-file-modtime)
		      t)))
;; the MSDOS functions above were taken from code by:
;   ___  ___  ___ ___  _  _ ___
;  /__/ /  / /__   /  /\ / /  _   Stephen Martin, Boeing Canada, Toronto.
; /__/ /__/ /__  _/_ /  / /__/             
;                                           Nuke the Raisins
;UUCP: smartin@iemisi.UUCP
;      {uunet|suncan}!jtsv16!marsal1!iemisi!smartin
Newsgroups: gnu.emacs.sources