;;; Last edited: Thu Oct  3 12:28:00 1991
;;; Handle compressed files
;;; adapted by Henry S. Thompson from Miles Bader from ???
(provide 'compress)

(defun uncompress-while-visiting ()
  "Temporary \"major mode\" used for .[gzZ] files, to uncompress the contents.
It then selects a major mode from the uncompressed file name and contents."
  (if (and (not (null buffer-file-name))
	   (string-match "\\.g?[zZ]$" buffer-file-name))
      (set-visited-file-name
       (substring buffer-file-name 0 (match-beginning 0))))
  (message "Uncompressing...")
  (let ((buffer-read-only nil))
    (shell-command-on-region (point-min) (point-max) "zcat" t))
  (message "Uncompressing...done")
  (set-buffer-modified-p nil)
  (normal-mode))

(setq auto-mode-alist
      (cons '("\\.g?[zZ]$" . uncompress-while-visiting) auto-mode-alist))

(defun find-compressed-version ()
  "Hook to read and uncompress the compressed version of a file."
  ;; Just pretend we had visited the compressed file,
  ;; and uncompress-while-visiting will do the rest.
  (let ((exts '("gz" "z" "Z")) ext found)
    (while (and exts (setq ext (car exts)) (not found))
      (if (file-exists-p (concat buffer-file-name "." ext))
	  (progn
	    (setq buffer-file-name (concat buffer-file-name "." ext))
	    (insert-file-contents buffer-file-name t)
	    (goto-char (point-min))
	    (setq error nil)
	    t)
	(setq exts (cdr exts))))))

(setq find-file-not-found-hooks
      (cons 'find-compressed-version find-file-not-found-hooks))

(defun compress-again ()
  "Hook to compress the uncompressed version of a file."
  (let ((exts '("gz" "z" "Z")) ext found)
    (while (and exts (setq ext (car exts)) (not found))
      (if (file-exists-p (concat buffer-file-name "." ext))
	  (let ((here (current-buffer))
		(fake-buffer-file-name (concat buffer-file-name "." ext))
		(require-final-newline nil))
	    (set-buffer (get-buffer-create " *compress*"))
	    (erase-buffer)
	    (insert-buffer here)
	    (message "Compressing...")
	    (shell-command-on-region (point-min) (point-max)
				     (if (equal "Z" ext)
					 "compress"
				       "gzip") t)
	    (message "Compressing...done")
	    (write-region (point-min)(point-max) fake-buffer-file-name)
	    (bury-buffer (current-buffer))
	    (set-buffer here)
	    (set-buffer-modified-p nil)
	    (setq found t)
	    t)
	(setq exts (cdr exts))))
    found))


(setq write-file-hooks (cons 'compress-again write-file-hooks))