Mercurial > hg > xemacs
diff shared/compress.el @ 0:107d592c5f4a
DICE versions, used by pers/common, recursive, I think/hope
author | Henry S. Thompson <ht@inf.ed.ac.uk> |
---|---|
date | Mon, 08 Feb 2021 11:44:37 +0000 |
parents | |
children |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/shared/compress.el Mon Feb 08 11:44:37 2021 +0000 @@ -0,0 +1,69 @@ +;;; 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)) +