Mercurial > hg > xemacs
comparison 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 |
comparison
equal
deleted
inserted
replaced
| -1:000000000000 | 0:107d592c5f4a |
|---|---|
| 1 ;;; Last edited: Thu Oct 3 12:28:00 1991 | |
| 2 ;;; Handle compressed files | |
| 3 ;;; adapted by Henry S. Thompson from Miles Bader from ??? | |
| 4 (provide 'compress) | |
| 5 | |
| 6 (defun uncompress-while-visiting () | |
| 7 "Temporary \"major mode\" used for .[gzZ] files, to uncompress the contents. | |
| 8 It then selects a major mode from the uncompressed file name and contents." | |
| 9 (if (and (not (null buffer-file-name)) | |
| 10 (string-match "\\.g?[zZ]$" buffer-file-name)) | |
| 11 (set-visited-file-name | |
| 12 (substring buffer-file-name 0 (match-beginning 0)))) | |
| 13 (message "Uncompressing...") | |
| 14 (let ((buffer-read-only nil)) | |
| 15 (shell-command-on-region (point-min) (point-max) "zcat" t)) | |
| 16 (message "Uncompressing...done") | |
| 17 (set-buffer-modified-p nil) | |
| 18 (normal-mode)) | |
| 19 | |
| 20 (setq auto-mode-alist | |
| 21 (cons '("\\.g?[zZ]$" . uncompress-while-visiting) auto-mode-alist)) | |
| 22 | |
| 23 (defun find-compressed-version () | |
| 24 "Hook to read and uncompress the compressed version of a file." | |
| 25 ;; Just pretend we had visited the compressed file, | |
| 26 ;; and uncompress-while-visiting will do the rest. | |
| 27 (let ((exts '("gz" "z" "Z")) ext found) | |
| 28 (while (and exts (setq ext (car exts)) (not found)) | |
| 29 (if (file-exists-p (concat buffer-file-name "." ext)) | |
| 30 (progn | |
| 31 (setq buffer-file-name (concat buffer-file-name "." ext)) | |
| 32 (insert-file-contents buffer-file-name t) | |
| 33 (goto-char (point-min)) | |
| 34 (setq error nil) | |
| 35 t) | |
| 36 (setq exts (cdr exts)))))) | |
| 37 | |
| 38 (setq find-file-not-found-hooks | |
| 39 (cons 'find-compressed-version find-file-not-found-hooks)) | |
| 40 | |
| 41 (defun compress-again () | |
| 42 "Hook to compress the uncompressed version of a file." | |
| 43 (let ((exts '("gz" "z" "Z")) ext found) | |
| 44 (while (and exts (setq ext (car exts)) (not found)) | |
| 45 (if (file-exists-p (concat buffer-file-name "." ext)) | |
| 46 (let ((here (current-buffer)) | |
| 47 (fake-buffer-file-name (concat buffer-file-name "." ext)) | |
| 48 (require-final-newline nil)) | |
| 49 (set-buffer (get-buffer-create " *compress*")) | |
| 50 (erase-buffer) | |
| 51 (insert-buffer here) | |
| 52 (message "Compressing...") | |
| 53 (shell-command-on-region (point-min) (point-max) | |
| 54 (if (equal "Z" ext) | |
| 55 "compress" | |
| 56 "gzip") t) | |
| 57 (message "Compressing...done") | |
| 58 (write-region (point-min)(point-max) fake-buffer-file-name) | |
| 59 (bury-buffer (current-buffer)) | |
| 60 (set-buffer here) | |
| 61 (set-buffer-modified-p nil) | |
| 62 (setq found t) | |
| 63 t) | |
| 64 (setq exts (cdr exts)))) | |
| 65 found)) | |
| 66 | |
| 67 | |
| 68 (setq write-file-hooks (cons 'compress-again write-file-hooks)) | |
| 69 |