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))
+