(defgroup compression nil
"Data compression utilities."
:group 'data)
(defgroup jka-compr nil
"jka-compr customization."
:group 'compression)
(defvar jka-compr-added-to-file-coding-system-alist nil)
(defvar jka-compr-file-name-handler-entry
nil
"`file-name-handler-alist' entry used by jka-compr I/O functions.")
(defvar jka-compr-compression-info-list)
(defvar jka-compr-mode-alist-additions)
(defvar jka-compr-load-suffixes)
(defvar jka-compr-compression-info-list--internal nil
"Stored value of `jka-compr-compression-info-list'.
If Auto Compression mode is enabled, this is the value of
`jka-compr-compression-info-list' when `jka-compr-install' was last called.
Otherwise, it is nil.")
(defvar jka-compr-mode-alist-additions--internal nil
"Stored value of `jka-compr-mode-alist-additions'.
If Auto Compression mode is enabled, this is the value of
`jka-compr-mode-alist-additions' when `jka-compr-install' was last called.
Otherwise, it is nil.")
(defvar jka-compr-load-suffixes--internal nil
"Stored value of `jka-compr-load-suffixes'.
If Auto Compression mode is enabled, this is the value of
`jka-compr-load-suffixes' when `jka-compr-install' was last called.
Otherwise, it is nil.")
(defun jka-compr-build-file-regexp ()
(mapconcat
'jka-compr-info-regexp
jka-compr-compression-info-list
"\\|"))
(defun jka-compr-info-regexp (info) (aref info 0))
(defun jka-compr-info-compress-message (info) (aref info 1))
(defun jka-compr-info-compress-program (info) (aref info 2))
(defun jka-compr-info-compress-args (info) (aref info 3))
(defun jka-compr-info-uncompress-message (info) (aref info 4))
(defun jka-compr-info-uncompress-program (info) (aref info 5))
(defun jka-compr-info-uncompress-args (info) (aref info 6))
(defun jka-compr-info-can-append (info) (aref info 7))
(defun jka-compr-info-strip-extension (info) (aref info 8))
(defun jka-compr-info-file-magic-bytes (info) (aref info 9))
(defun jka-compr-get-compression-info (filename)
"Return information about the compression scheme of FILENAME.
The determination as to which compression scheme, if any, to use is
based on the filename itself and `jka-compr-compression-info-list'."
(catch 'compression-info
(let ((case-fold-search nil))
(mapcar
(function (lambda (x)
(and (string-match (jka-compr-info-regexp x) filename)
(throw 'compression-info x))))
jka-compr-compression-info-list)
nil)))
(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))
(push jka-compr-file-name-handler-entry file-name-handler-alist)
(setq jka-compr-compression-info-list--internal
jka-compr-compression-info-list
jka-compr-mode-alist-additions--internal
jka-compr-mode-alist-additions
jka-compr-load-suffixes--internal
jka-compr-load-suffixes)
(dolist (x jka-compr-compression-info-list)
(let ((elt (cons (jka-compr-info-regexp x)
'(no-conversion . no-conversion))))
(push elt file-coding-system-alist)
(push elt jka-compr-added-to-file-coding-system-alist))
(and (jka-compr-info-strip-extension x)
(push (list (jka-compr-info-regexp x) nil 'jka-compr) auto-mode-alist)
(push (jka-compr-info-regexp x)
inhibit-first-line-modes-suffixes)))
(setq auto-mode-alist
(append auto-mode-alist jka-compr-mode-alist-additions))
(setq load-file-rep-suffixes
(append load-file-rep-suffixes jka-compr-load-suffixes nil)))
(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))
(defun jka-compr-update ()
"Update Auto Compression mode for changes in option values.
If you change the options `jka-compr-compression-info-list',
`jka-compr-mode-alist-additions' or `jka-compr-load-suffixes'
outside Custom, while Auto Compression mode is already enabled
\(as it is by default), then you have to call this function
afterward to properly update other variables. Setting these
options through Custom does this automatically."
(when (jka-compr-installed-p)
(jka-compr-uninstall)
(jka-compr-install)))
(defun jka-compr-set (variable value)
"Internal Custom :set function."
(set-default variable value)
(jka-compr-update))
(defcustom jka-compr-compression-info-list
'(["\\.Z\\(~\\|\\.~[0-9]+~\\)?\\'"
"compressing" "compress" ("-c")
"uncompressing" "uncompress" ("-c")
nil t "\037\235"]
["\\.bz2\\(~\\|\\.~[0-9]+~\\)?\\'"
"bzip2ing" "bzip2" nil
"bunzip2ing" "bzip2" ("-d")
nil t "BZh"]
["\\.tbz\\'"
"bzip2ing" "bzip2" nil
"bunzip2ing" "bzip2" ("-d")
nil nil "BZh"]
["\\.tgz\\'"
"compressing" "gzip" ("-c" "-q")
"uncompressing" "gzip" ("-c" "-q" "-d")
t nil "\037\213"]
["\\.g?z\\(~\\|\\.~[0-9]+~\\)?\\'"
"compressing" "gzip" ("-c" "-q")
"uncompressing" "gzip" ("-c" "-q" "-d")
t t "\037\213"]
["\\.dz\\'"
nil nil nil
"uncompressing" "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.
If you set this outside Custom while Auto Compression mode is
already enabled \(as it is by default), you have to call
`jka-compr-update' after setting it to properly update other
variables. Setting this through Custom does that automatically."
: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")))
:set 'jka-compr-set
:group 'jka-compr)
(defcustom jka-compr-mode-alist-additions
(list (cons "\\.tgz\\'" 'tar-mode) (cons "\\.tbz\\'" 'tar-mode))
"List of pairs added to `auto-mode-alist' when installing jka-compr.
Uninstalling jka-compr removes all pairs from `auto-mode-alist' that
installing added.
If you set this outside Custom while Auto Compression mode is
already enabled \(as it is by default), you have to call
`jka-compr-update' after setting it to properly update other
variables. Setting this through Custom does that automatically."
:type '(repeat (cons string symbol))
:set 'jka-compr-set
:group 'jka-compr)
(defcustom jka-compr-load-suffixes '(".gz")
"List of compression related suffixes to try when loading files.
Enabling Auto Compression mode appends this list to `load-file-rep-suffixes',
which see. Disabling Auto Compression mode removes all suffixes
from `load-file-rep-suffixes' that enabling added.
If you set this outside Custom while Auto Compression mode is
already enabled \(as it is by default), you have to call
`jka-compr-update' after setting it to properly update other
variables. Setting this through Custom does that automatically."
:type '(repeat string)
:set 'jka-compr-set
:group 'jka-compr)
(define-minor-mode auto-compression-mode
"Toggle automatic file compression and uncompression.
With prefix argument ARG, turn auto compression on if positive, else off.
Return the new status of auto compression (non-nil means on)."
:global t :init-value t :group 'jka-compr :version "22.1"
(let* ((installed (jka-compr-installed-p))
(flag auto-compression-mode))
(cond
((and flag installed) t) ((and (not flag) (not installed)) nil) (flag (jka-compr-install))
(t (jka-compr-uninstall)))))
(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)
(put 'jka-compr-handler 'safe-magic t)
(put 'jka-compr-handler 'operations '(byte-compiler-base-file-name
write-region insert-file-contents
file-local-copy load))
(when auto-compression-mode (auto-compression-mode 1))
(provide 'jka-cmpr-hook)