diff options
| author | Gerd Moellmann | 2001-09-04 13:21:08 +0000 |
|---|---|---|
| committer | Gerd Moellmann | 2001-09-04 13:21:08 +0000 |
| commit | 8d1fcd004ff6582e87b658da8e1d0d637e46fc0e (patch) | |
| tree | fbbf6f0431b37c142d2568173f28b422200e437c /lisp/obsolete | |
| parent | 8d4f05f8e70ac39dd40dfe64727f7b2c6432072a (diff) | |
| download | emacs-8d1fcd004ff6582e87b658da8e1d0d637e46fc0e.tar.gz emacs-8d1fcd004ff6582e87b658da8e1d0d637e46fc0e.zip | |
*** empty log message ***
Diffstat (limited to 'lisp/obsolete')
| -rw-r--r-- | lisp/obsolete/uncompress.el | 115 |
1 files changed, 115 insertions, 0 deletions
diff --git a/lisp/obsolete/uncompress.el b/lisp/obsolete/uncompress.el new file mode 100644 index 00000000000..9f9f4478aec --- /dev/null +++ b/lisp/obsolete/uncompress.el | |||
| @@ -0,0 +1,115 @@ | |||
| 1 | ;;; uncompress.el --- auto-decompression hook for visiting .Z files | ||
| 2 | |||
| 3 | ;; Copyright (C) 1992, 1994, 2001 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Maintainer: FSF | ||
| 6 | ;; Keywords: files | ||
| 7 | |||
| 8 | ;; This file is part of GNU Emacs. | ||
| 9 | |||
| 10 | ;; GNU Emacs is free software; you can redistribute it and/or modify | ||
| 11 | ;; it under the terms of the GNU General Public License as published by | ||
| 12 | ;; the Free Software Foundation; either version 2, or (at your option) | ||
| 13 | ;; any later version. | ||
| 14 | |||
| 15 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 18 | ;; GNU General Public License for more details. | ||
| 19 | |||
| 20 | ;; You should have received a copy of the GNU General Public License | ||
| 21 | ;; along with GNU Emacs; see the file COPYING. If not, write to the | ||
| 22 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | ||
| 23 | ;; Boston, MA 02111-1307, USA. | ||
| 24 | |||
| 25 | ;;; Commentary: | ||
| 26 | |||
| 27 | ;; This package can be used to arrange for automatic uncompress of | ||
| 28 | ;; compressed files when they are visited. | ||
| 29 | ;; All that's necessary is to load it. This can conveniently be done from | ||
| 30 | ;; your .emacs file. | ||
| 31 | |||
| 32 | ;; M-x auto-compression-mode is a more modern replacement for this package. | ||
| 33 | |||
| 34 | ;;; Code: | ||
| 35 | |||
| 36 | ;; When we are about to make a backup file, | ||
| 37 | ;; uncompress the file we visited | ||
| 38 | ;; so that making the backup can work properly. | ||
| 39 | ;; This is used as a write-file-hook. | ||
| 40 | |||
| 41 | (defvar uncompress-program "gunzip" | ||
| 42 | "Program to use for uncompression.") | ||
| 43 | |||
| 44 | (defun uncompress-backup-file () | ||
| 45 | (and buffer-file-name make-backup-files (not buffer-backed-up) | ||
| 46 | (not (file-exists-p buffer-file-name)) | ||
| 47 | (call-process uncompress-program nil nil nil buffer-file-name)) | ||
| 48 | nil) | ||
| 49 | |||
| 50 | (or (assoc "\\.Z$" auto-mode-alist) | ||
| 51 | (setq auto-mode-alist | ||
| 52 | (cons '("\\.Z$" . uncompress-while-visiting) auto-mode-alist))) | ||
| 53 | (or (assoc "\\.gz$" auto-mode-alist) | ||
| 54 | (setq auto-mode-alist | ||
| 55 | (cons '("\\.gz$" . uncompress-while-visiting) auto-mode-alist))) | ||
| 56 | (or (assoc "\\.tgz$" auto-mode-alist) | ||
| 57 | (setq auto-mode-alist | ||
| 58 | (cons '("\\.tgz$" . uncompress-while-visiting) auto-mode-alist))) | ||
| 59 | |||
| 60 | (defun uncompress-while-visiting () | ||
| 61 | "Temporary \"major mode\" used for .Z and .gz files, to uncompress them. | ||
| 62 | It then selects a major mode from the uncompressed file name and contents." | ||
| 63 | (if (and (not (null buffer-file-name)) | ||
| 64 | (string-match "\\.Z$" buffer-file-name)) | ||
| 65 | (set-visited-file-name | ||
| 66 | (substring buffer-file-name 0 (match-beginning 0))) | ||
| 67 | (if (and (not (null buffer-file-name)) | ||
| 68 | (string-match "\\.gz$" buffer-file-name)) | ||
| 69 | (set-visited-file-name | ||
| 70 | (substring buffer-file-name 0 (match-beginning 0))) | ||
| 71 | (if (and (not (null buffer-file-name)) | ||
| 72 | (string-match "\\.tgz$" buffer-file-name)) | ||
| 73 | (set-visited-file-name | ||
| 74 | (concat (substring buffer-file-name 0 (match-beginning 0)) ".tar"))))) | ||
| 75 | (message "Uncompressing...") | ||
| 76 | (let ((buffer-read-only nil) | ||
| 77 | (coding-system-for-write 'no-conversion) | ||
| 78 | (coding-system-for-read | ||
| 79 | (car (find-operation-coding-system | ||
| 80 | 'insert-file-contents | ||
| 81 | buffer-file-name t)))) | ||
| 82 | (shell-command-on-region (point-min) (point-max) uncompress-program t)) | ||
| 83 | (goto-char (point-min)) | ||
| 84 | (message "Uncompressing...done") | ||
| 85 | (set-buffer-modified-p nil) | ||
| 86 | (make-local-variable 'write-file-hooks) | ||
| 87 | (or (memq 'uncompress-backup-file write-file-hooks) | ||
| 88 | (setq write-file-hooks (cons 'uncompress-backup-file write-file-hooks))) | ||
| 89 | (normal-mode)) | ||
| 90 | |||
| 91 | (or (memq 'find-compressed-version find-file-not-found-hooks) | ||
| 92 | (setq find-file-not-found-hooks | ||
| 93 | (cons 'find-compressed-version find-file-not-found-hooks))) | ||
| 94 | |||
| 95 | (defun find-compressed-version () | ||
| 96 | "Hook to read and uncompress the compressed version of a file." | ||
| 97 | ;; Just pretend we had visited the compressed file, | ||
| 98 | ;; and uncompress-while-visiting will do the rest. | ||
| 99 | (let (name) | ||
| 100 | (if (file-exists-p (setq name (concat buffer-file-name ".Z"))) | ||
| 101 | (setq buffer-file-name name) | ||
| 102 | (if (file-exists-p (setq name (concat buffer-file-name ".gz"))) | ||
| 103 | (setq buffer-file-name name))) | ||
| 104 | (if (eq name buffer-file-name) | ||
| 105 | (progn | ||
| 106 | (insert-file-contents buffer-file-name t) | ||
| 107 | (goto-char (point-min)) | ||
| 108 | ;; No need for this, because error won't be set to t | ||
| 109 | ;; if this function returns t. | ||
| 110 | ;; (setq error nil) | ||
| 111 | t)))) | ||
| 112 | |||
| 113 | (provide 'uncompress) | ||
| 114 | |||
| 115 | ;;; uncompress.el ends here | ||