100 |
|
|
101 |
;;; Code: |
;;; Code: |
102 |
|
|
|
(defgroup compression nil |
|
|
"Data compression utilities" |
|
|
:group 'data) |
|
|
|
|
|
(defgroup jka-compr nil |
|
|
"jka-compr customization" |
|
|
:group 'compression) |
|
|
|
|
|
|
|
103 |
(defcustom jka-compr-shell "sh" |
(defcustom jka-compr-shell "sh" |
104 |
"*Shell to be used for calling compression programs. |
"*Shell to be used for calling compression programs. |
105 |
The value of this variable only matters if you want to discard the |
The value of this variable only matters if you want to discard the |
111 |
(defvar jka-compr-use-shell |
(defvar jka-compr-use-shell |
112 |
(not (memq system-type '(ms-dos windows-nt)))) |
(not (memq system-type '(ms-dos windows-nt)))) |
113 |
|
|
|
;;; I have this defined so that .Z files are assumed to be in unix |
|
|
;;; compress format; and .gz files, in gzip format, and .bz2 files in bzip fmt. |
|
|
(defcustom jka-compr-compression-info-list |
|
|
;;[regexp |
|
|
;; compr-message compr-prog compr-args |
|
|
;; uncomp-message uncomp-prog uncomp-args |
|
|
;; can-append auto-mode-flag strip-extension-flag file-magic-bytes] |
|
|
'(["\\.Z\\(~\\|\\.~[0-9]+~\\)?\\'" |
|
|
"compressing" "compress" ("-c") |
|
|
"uncompressing" "uncompress" ("-c") |
|
|
nil t "\037\235"] |
|
|
;; Formerly, these had an additional arg "-c", but that fails with |
|
|
;; "Version 0.1pl2, 29-Aug-97." (RedHat 5.1 GNU/Linux) and |
|
|
;; "Version 0.9.0b, 9-Sept-98". |
|
|
["\\.bz2\\'" |
|
|
"bzip2ing" "bzip2" nil |
|
|
"bunzip2ing" "bzip2" ("-d") |
|
|
nil t "BZh"] |
|
|
["\\.tbz\\'" |
|
|
"bzip2ing" "bzip2" nil |
|
|
"bunzip2ing" "bzip2" ("-d") |
|
|
nil nil "BZh"] |
|
|
["\\.tgz\\'" |
|
|
"zipping" "gzip" ("-c" "-q") |
|
|
"unzipping" "gzip" ("-c" "-q" "-d") |
|
|
t nil "\037\213"] |
|
|
["\\.g?z\\(~\\|\\.~[0-9]+~\\)?\\'" |
|
|
"zipping" "gzip" ("-c" "-q") |
|
|
"unzipping" "gzip" ("-c" "-q" "-d") |
|
|
t t "\037\213"] |
|
|
;; dzip is gzip with random access. Its compression program can't |
|
|
;; read/write stdin/out, so .dz files can only be viewed without |
|
|
;; saving, having their contents decompressed with gzip. |
|
|
["\\.dz\\'" |
|
|
nil nil nil |
|
|
"unzipping" "gzip" ("-c" "-q" "-d") |
|
|
nil t "\037\213"]) |
|
|
|
|
|
"List of vectors that describe available compression techniques. |
|
|
Each element, which describes a compression technique, is a vector of |
|
|
the form [REGEXP COMPRESS-MSG COMPRESS-PROGRAM COMPRESS-ARGS |
|
|
UNCOMPRESS-MSG UNCOMPRESS-PROGRAM UNCOMPRESS-ARGS |
|
|
APPEND-FLAG STRIP-EXTENSION-FLAG FILE-MAGIC-CHARS], where: |
|
|
|
|
|
regexp is a regexp that matches filenames that are |
|
|
compressed with this format |
|
|
|
|
|
compress-msg is the message to issue to the user when doing this |
|
|
type of compression (nil means no message) |
|
|
|
|
|
compress-program is a program that performs this compression |
|
|
(nil means visit file in read-only mode) |
|
|
|
|
|
compress-args is a list of args to pass to the compress program |
|
|
|
|
|
uncompress-msg is the message to issue to the user when doing this |
|
|
type of uncompression (nil means no message) |
|
|
|
|
|
uncompress-program is a program that performs this compression |
|
|
|
|
|
uncompress-args is a list of args to pass to the uncompress program |
|
|
|
|
|
append-flag is non-nil if this compression technique can be |
|
|
appended |
|
|
|
|
|
strip-extension-flag non-nil means strip the regexp from file names |
|
|
before attempting to set the mode. |
|
|
|
|
|
file-magic-chars is a string of characters that you would find |
|
|
at the beginning of a file compressed in this way. |
|
|
|
|
|
Because of the way `call-process' is defined, discarding the stderr output of |
|
|
a program adds the overhead of starting a shell each time the program is |
|
|
invoked." |
|
|
:type '(repeat (vector regexp |
|
|
(choice :tag "Compress Message" |
|
|
(string :format "%v") |
|
|
(const :tag "No Message" nil)) |
|
|
(choice :tag "Compress Program" |
|
|
(string) |
|
|
(const :tag "None" nil)) |
|
|
(repeat :tag "Compress Arguments" string) |
|
|
(choice :tag "Uncompress Message" |
|
|
(string :format "%v") |
|
|
(const :tag "No Message" nil)) |
|
|
(choice :tag "Uncompress Program" |
|
|
(string) |
|
|
(const :tag "None" nil)) |
|
|
(repeat :tag "Uncompress Arguments" string) |
|
|
(boolean :tag "Append") |
|
|
(boolean :tag "Strip Extension") |
|
|
(string :tag "Magic Bytes"))) |
|
|
:group 'jka-compr) |
|
|
|
|
|
(defcustom jka-compr-mode-alist-additions |
|
|
(list (cons "\\.tgz\\'" 'tar-mode) (cons "\\.tbz\\'" 'tar-mode)) |
|
|
"A list of pairs to add to `auto-mode-alist' when jka-compr is installed." |
|
|
:type '(repeat (cons string symbol)) |
|
|
:group 'jka-compr) |
|
|
|
|
|
(defcustom jka-compr-load-suffixes '(".gz") |
|
|
"List of suffixes to try when loading files." |
|
|
:type '(repeat string) |
|
|
:group 'jka-compr) |
|
|
|
|
|
;; List of all the elements we actually added to file-coding-system-alist. |
|
|
(defvar jka-compr-added-to-file-coding-system-alist nil) |
|
|
|
|
|
(defvar jka-compr-file-name-handler-entry |
|
|
nil |
|
|
"The entry in `file-name-handler-alist' used by the jka-compr I/O functions.") |
|
|
|
|
114 |
(defvar jka-compr-really-do-compress nil |
(defvar jka-compr-really-do-compress nil |
115 |
"Non-nil in a buffer whose visited file was uncompressed on visiting it. |
"Non-nil in a buffer whose visited file was uncompressed on visiting it. |
116 |
This means compress the data on writing the file, even if the |
This means compress the data on writing the file, even if the |
643 |
(put 'byte-compiler-base-file-name 'jka-compr |
(put 'byte-compiler-base-file-name 'jka-compr |
644 |
'jka-compr-byte-compiler-base-file-name) |
'jka-compr-byte-compiler-base-file-name) |
645 |
|
|
646 |
|
;;;###autoload |
647 |
(defvar jka-compr-inhibit nil |
(defvar jka-compr-inhibit nil |
648 |
"Non-nil means inhibit automatic uncompression temporarily. |
"Non-nil means inhibit automatic uncompression temporarily. |
649 |
Lisp programs can bind this to t to do that. |
Lisp programs can bind this to t to do that. |
650 |
It is not recommended to set this variable permanently to anything but nil.") |
It is not recommended to set this variable permanently to anything but nil.") |
651 |
|
|
652 |
(put 'jka-compr-handler 'safe-magic t) |
;;;###autoload |
653 |
(defun jka-compr-handler (operation &rest args) |
(defun jka-compr-handler (operation &rest args) |
654 |
(save-match-data |
(save-match-data |
655 |
(let ((jka-op (get operation 'jka-compr))) |
(let ((jka-op (get operation 'jka-compr))) |
670 |
(apply operation args))) |
(apply operation args))) |
671 |
|
|
672 |
|
|
|
(defun jka-compr-build-file-regexp () |
|
|
(mapconcat |
|
|
'jka-compr-info-regexp |
|
|
jka-compr-compression-info-list |
|
|
"\\|")) |
|
|
|
|
|
|
|
|
(defun jka-compr-install () |
|
|
"Install jka-compr. |
|
|
This adds entries to `file-name-handler-alist' and `auto-mode-alist' |
|
|
and `inhibit-first-line-modes-suffixes'." |
|
|
|
|
|
(setq jka-compr-file-name-handler-entry |
|
|
(cons (jka-compr-build-file-regexp) 'jka-compr-handler)) |
|
|
|
|
|
(setq file-name-handler-alist (cons jka-compr-file-name-handler-entry |
|
|
file-name-handler-alist)) |
|
|
|
|
|
(setq jka-compr-added-to-file-coding-system-alist nil) |
|
|
|
|
|
(mapcar |
|
|
(function (lambda (x) |
|
|
;; Don't do multibyte encoding on the compressed files. |
|
|
(let ((elt (cons (jka-compr-info-regexp x) |
|
|
'(no-conversion . no-conversion)))) |
|
|
(setq file-coding-system-alist |
|
|
(cons elt file-coding-system-alist)) |
|
|
(setq jka-compr-added-to-file-coding-system-alist |
|
|
(cons elt jka-compr-added-to-file-coding-system-alist))) |
|
|
|
|
|
(and (jka-compr-info-strip-extension x) |
|
|
;; Make entries in auto-mode-alist so that modes |
|
|
;; are chosen right according to the file names |
|
|
;; sans `.gz'. |
|
|
(setq auto-mode-alist |
|
|
(cons (list (jka-compr-info-regexp x) |
|
|
nil 'jka-compr) |
|
|
auto-mode-alist)) |
|
|
;; Also add these regexps to |
|
|
;; inhibit-first-line-modes-suffixes, so that a |
|
|
;; -*- line in the first file of a compressed tar |
|
|
;; file doesn't override tar-mode. |
|
|
(setq inhibit-first-line-modes-suffixes |
|
|
(cons (jka-compr-info-regexp x) |
|
|
inhibit-first-line-modes-suffixes))))) |
|
|
jka-compr-compression-info-list) |
|
|
(setq auto-mode-alist |
|
|
(append auto-mode-alist jka-compr-mode-alist-additions)) |
|
|
|
|
|
;; Make sure that (load "foo") will find /bla/foo.el.gz. |
|
|
(setq load-suffixes |
|
|
(apply 'append |
|
|
(mapcar (lambda (suffix) |
|
|
(cons suffix |
|
|
(mapcar (lambda (ext) (concat suffix ext)) |
|
|
jka-compr-load-suffixes))) |
|
|
load-suffixes)))) |
|
|
|
|
|
|
|
673 |
(defun jka-compr-uninstall () |
(defun jka-compr-uninstall () |
674 |
"Uninstall jka-compr. |
"Uninstall jka-compr. |
675 |
This removes the entries in `file-name-handler-alist' and `auto-mode-alist' |
This removes the entries in `file-name-handler-alist' and `auto-mode-alist' |
729 |
(push suffix suffixes))) |
(push suffix suffixes))) |
730 |
(setq load-suffixes (nreverse suffixes)))) |
(setq load-suffixes (nreverse suffixes)))) |
731 |
|
|
|
|
|
|
(defun jka-compr-installed-p () |
|
|
"Return non-nil if jka-compr is installed. |
|
|
The return value is the entry in `file-name-handler-alist' for jka-compr." |
|
|
|
|
|
(let ((fnha file-name-handler-alist) |
|
|
(installed nil)) |
|
|
|
|
|
(while (and fnha (not installed)) |
|
|
(and (eq (cdr (car fnha)) 'jka-compr-handler) |
|
|
(setq installed (car fnha))) |
|
|
(setq fnha (cdr fnha))) |
|
|
|
|
|
installed)) |
|
|
|
|
|
|
|
|
;;; Add the file I/O hook if it does not already exist. |
|
|
;;; Make sure that jka-compr-file-name-handler-entry is eq to the |
|
|
;;; entry for jka-compr in file-name-handler-alist. |
|
|
(and (jka-compr-installed-p) |
|
|
(jka-compr-uninstall)) |
|
|
|
|
|
|
|
|
;;;###autoload |
|
|
(define-minor-mode auto-compression-mode |
|
|
"Toggle automatic file compression and uncompression. |
|
|
With prefix argument ARG, turn auto compression on if positive, else off. |
|
|
Returns the new status of auto compression (non-nil means on)." |
|
|
:global t :group 'jka-compr |
|
|
(let* ((installed (jka-compr-installed-p)) |
|
|
(flag auto-compression-mode)) |
|
|
(cond |
|
|
((and flag installed) t) ; already installed |
|
|
((and (not flag) (not installed)) nil) ; already not installed |
|
|
(flag (jka-compr-install)) |
|
|
(t (jka-compr-uninstall))))) |
|
|
|
|
|
|
|
|
;;;###autoload |
|
|
(defmacro with-auto-compression-mode (&rest body) |
|
|
"Evalute BODY with automatic file compression and uncompression enabled." |
|
|
(let ((already-installed (make-symbol "already-installed"))) |
|
|
`(let ((,already-installed (jka-compr-installed-p))) |
|
|
(unwind-protect |
|
|
(progn |
|
|
(unless ,already-installed |
|
|
(jka-compr-install)) |
|
|
,@body) |
|
|
(unless ,already-installed |
|
|
(jka-compr-uninstall)))))) |
|
|
(put 'with-auto-compression-mode 'lisp-indent-function 0) |
|
|
|
|
|
|
|
732 |
(provide 'jka-compr) |
(provide 'jka-compr) |
733 |
|
|
734 |
;;; arch-tag: 3f15b630-e9a7-46c4-a22a-94afdde86ebc |
;;; arch-tag: 3f15b630-e9a7-46c4-a22a-94afdde86ebc |