;;; jka-compr.el --- reading/writing/loading compressed files
-;; Copyright (C) 1993, 1994, 1995, 1997 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1994, 1995, 1997, 1999, 2000, 2003, 2004 Free Software Foundation, Inc.
;; Author: jka@ece.cmu.edu (Jay K. Adams)
;; Maintainer: FSF
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
-;;; Commentary:
+;;; Commentary:
;; This package implements low-level support for reading, writing,
;; and loading compressed files. It hooks into the low-level file
;; INSTRUCTIONS:
;;
-;; To use jka-compr, simply load this package, and edit as usual.
-;; Its operation should be transparent to the user (except for
-;; messages appearing when a file is being compressed or
-;; uncompressed).
+;; To use jka-compr, invoke the command `auto-compression-mode' (which
+;; see), or customize the variable of the same name. Its operation
+;; should be transparent to the user (except for messages appearing when
+;; a file is being compressed or uncompressed).
;;
;; The variable, jka-compr-compression-info-list can be used to
;; customize jka-compr to work with other compression programs.
;; APPLICATION NOTES:
;;
;; crypt++
-;; jka-compr can coexist with crpyt++ if you take all the decompression
+;; jka-compr can coexist with crypt++ if you take all the decompression
;; entries out of the crypt-encoding-list. Clearly problems will arise if
;; you have two programs trying to compress/decompress files. jka-compr
;; will not "work with" crypt++ in the following sense: you won't be able to
;; ACKNOWLEDGMENTS
-;;
+;;
;; jka-compr is a V19 adaptation of jka-compr for V18 of Emacs. Many people
-;; have made helpful suggestions, reported bugs, and even fixed bugs in
+;; have made helpful suggestions, reported bugs, and even fixed bugs in
;; jka-compr. I recall the following people as being particularly helpful.
;;
;; Jean-loup Gailly
:type 'string
:group 'jka-compr)
-(defvar jka-compr-use-shell
+(defvar jka-compr-use-shell
(not (memq system-type '(ms-dos windows-nt))))
;;; I have this defined so that .Z files are assumed to be in unix
;;[regexp
;; compr-message compr-prog compr-args
;; uncomp-message uncomp-prog uncomp-args
- ;; can-append auto-mode-flag]
+ ;; can-append auto-mode-flag strip-extension-flag file-magic-bytes]
'(["\\.Z\\(~\\|\\.~[0-9]+~\\)?\\'"
"compressing" "compress" ("-c")
"uncompressing" "uncompress" ("-c")
- nil t]
+ 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" ("-c")
- "bunzip2ing" "bzip2" ("-d" "-c")
- nil t]
+ "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]
- ["\\.gz\\(~\\|\\.~[0-9]+~\\)?\\'"
+ t nil "\037\213"]
+ ["\\.g?z\\(~\\|\\.~[0-9]+~\\)?\\'"
"zipping" "gzip" ("-c" "-q")
"unzipping" "gzip" ("-c" "-q" "-d")
- t t])
+ 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 EXTENSION], where:
+APPEND-FLAG STRIP-EXTENSION-FLAG FILE-MAGIC-CHARS], where:
regexp is a regexp that matches filenames that are
compressed with this format
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
append-flag is non-nil if this compression technique can be
appended
- auto-mode flag non-nil means strip the regexp from file names
+ 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."
(string :tag "Uncompress Program")
(repeat :tag "Uncompress Arguments" string)
(boolean :tag "Append")
- (boolean :tag "Auto Mode")))
+ (boolean :tag "Strip Extension")
+ (string :tag "Magic Bytes")))
:group 'jka-compr)
-(defvar jka-compr-mode-alist-additions
- (list (cons "\\.tgz\\'" 'tar-mode))
- "A list of pairs to add to `auto-mode-alist' when jka-compr is installed.")
+(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.")
+
+(defvar jka-compr-really-do-compress nil
+ "Non-nil in a buffer whose visited file was uncompressed on visiting it.")
+(put 'jka-compr-really-do-compress 'permanent-local t)
\f
;;; Functions for accessing the return value of jka-compr-get-compression-info
(defun jka-compr-info-regexp (info) (aref info 0))
(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)
(signal 'compression-error
(list "Opening input file" (format "error %s" message) infile)))
-
-
-(defvar jka-compr-dd-program
- "/bin/dd")
+
+
+(defcustom jka-compr-dd-program "/bin/dd"
+ "How to invoke `dd'."
+ :type 'string
+ :group 'jka-compr)
(defvar jka-compr-dd-blocksize 256)
"Call program PROG with ARGS args taking input from INFILE.
Fourth and fifth args, BEG and LEN, specify which part of the output
to keep: LEN chars starting BEG chars from the beginning."
- (let* ((skip (/ beg jka-compr-dd-blocksize))
- (prefix (- beg (* skip jka-compr-dd-blocksize)))
- (count (and len (1+ (/ (+ len prefix) jka-compr-dd-blocksize))))
- (start (point))
- (err-file (jka-compr-make-temp-name))
- (run-string (format "%s %s 2> %s | %s bs=%d skip=%d %s 2> /dev/null"
- prog
- (mapconcat 'identity args " ")
- err-file
- jka-compr-dd-program
- jka-compr-dd-blocksize
- skip
- ;; dd seems to be unreliable about
- ;; providing the last block. So, always
- ;; read one more than you think you need.
- (if count (concat "count=" (1+ count)) ""))))
-
- (unwind-protect
- (or (memq (call-process jka-compr-shell
- infile t nil "-c"
- run-string)
- jka-compr-acceptable-retval-list)
-
- (jka-compr-error prog args infile message err-file))
-
- (jka-compr-delete-temp-file err-file))
+ (let ((start (point))
+ (prefix beg))
+ (if (and jka-compr-use-shell jka-compr-dd-program)
+ ;; Put the uncompression output through dd
+ ;; to discard the part we don't want.
+ (let ((skip (/ beg jka-compr-dd-blocksize))
+ (err-file (jka-compr-make-temp-name))
+ count)
+ ;; Update PREFIX based on the text that we won't read in.
+ (setq prefix (- beg (* skip jka-compr-dd-blocksize))
+ count (and len (1+ (/ (+ len prefix) jka-compr-dd-blocksize))))
+ (unwind-protect
+ (or (memq (call-process
+ jka-compr-shell infile t nil "-c"
+ (format
+ "%s %s 2> %s | %s bs=%d skip=%d %s 2> %s"
+ prog
+ (mapconcat 'identity args " ")
+ err-file
+ jka-compr-dd-program
+ jka-compr-dd-blocksize
+ skip
+ ;; dd seems to be unreliable about
+ ;; providing the last block. So, always
+ ;; read one more than you think you need.
+ (if count (format "count=%d" (1+ count)) "")
+ null-device))
+ jka-compr-acceptable-retval-list)
+ (jka-compr-error prog args infile message err-file))
+ (jka-compr-delete-temp-file err-file)))
+ ;; Run the uncompression program directly.
+ ;; We get the whole file and must delete what we don't want.
+ (jka-compr-call-process prog message infile t nil args))
;; Delete the stuff after what we want, if there is any.
(and
(jka-compr-delete-temp-file err-file)))
- (or (zerop
+ (or (eq 0
(apply 'call-process
prog
infile
:type 'string
:group 'jka-compr)
-(defvar jka-compr-temp-name-table (make-vector 31 nil))
-
(defun jka-compr-make-temp-name (&optional local-copy)
"This routine will return the name of a new file."
- (let* ((lastchar ?a)
- (prevchar ?a)
- (template (concat jka-compr-temp-name-template "aa"))
- (lastpos (1- (length template)))
- (not-done t)
- file
- entry)
+ (make-temp-file jka-compr-temp-name-template))
- (while not-done
- (aset template lastpos lastchar)
- (setq file (concat (make-temp-name template) "#"))
- (setq entry (intern file jka-compr-temp-name-table))
- (if (or (get entry 'active)
- (file-exists-p file))
-
- (progn
- (setq lastchar (1+ lastchar))
- (if (> lastchar ?z)
- (progn
- (setq prevchar (1+ prevchar))
- (setq lastchar ?a)
- (if (> prevchar ?z)
- (error "Can't allocate temp file.")
- (aset template (1- lastpos) prevchar)))))
-
- (put entry 'active (not local-copy))
- (setq not-done nil)))
-
- file))
-
-
-(defun jka-compr-delete-temp-file (temp)
-
- (put (intern temp jka-compr-temp-name-table)
- 'active nil)
-
- (condition-case ()
- (delete-file temp)
- (error nil)))
+(defalias 'jka-compr-delete-temp-file 'delete-file)
(defun jka-compr-write-region (start end file &optional append visit)
(let* ((filename (expand-file-name file))
(visit-file (if (stringp visit) (expand-file-name visit) filename))
- (info (jka-compr-get-compression-info visit-file)))
-
- (if info
-
- (let ((can-append (jka-compr-info-can-append info))
- (compress-program (jka-compr-info-compress-program info))
- (compress-message (jka-compr-info-compress-message info))
- (uncompress-program (jka-compr-info-uncompress-program info))
- (uncompress-message (jka-compr-info-uncompress-message info))
- (compress-args (jka-compr-info-compress-args info))
- (uncompress-args (jka-compr-info-uncompress-args info))
- (base-name (file-name-nondirectory visit-file))
- temp-file temp-buffer
- ;; we need to leave `last-coding-system-used' set to its
- ;; value after calling write-region the first time, so
- ;; that `basic-save-buffer' sees the right value.
- (coding-system-used last-coding-system-used))
-
- (setq temp-buffer (get-buffer-create " *jka-compr-wr-temp*"))
- (with-current-buffer temp-buffer
- (widen) (erase-buffer))
-
- (if (and append
- (not can-append)
- (file-exists-p filename))
-
- (let* ((local-copy (file-local-copy filename))
- (local-file (or local-copy filename)))
-
- (setq temp-file local-file))
-
- (setq temp-file (jka-compr-make-temp-name)))
-
- (and
- compress-message
- (message "%s %s..." compress-message base-name))
-
- (jka-compr-run-real-handler 'write-region
- (list start end temp-file t 'dont))
- ;; save value used by the real write-region
- (setq coding-system-used last-coding-system-used)
-
- ;; Here we must read the output of compress program as is
- ;; without any code conversion.
- (let ((coding-system-for-read 'no-conversion))
- (jka-compr-call-process compress-program
- (concat compress-message
- " " base-name)
- temp-file
- temp-buffer
- nil
- compress-args))
-
- (with-current-buffer temp-buffer
- (let ((coding-system-for-write 'no-conversion))
- (if (memq system-type '(ms-dos windows-nt))
- (setq buffer-file-type t) )
- (jka-compr-run-real-handler 'write-region
- (list (point-min) (point-max)
- filename
- (and append can-append) 'dont))
- (erase-buffer)) )
-
- (jka-compr-delete-temp-file temp-file)
+ (info (jka-compr-get-compression-info visit-file))
+ (magic (and info (jka-compr-info-file-magic-bytes info))))
+
+ ;; If START is nil, use the whole buffer.
+ (if (null start)
+ (setq start 1 end (1+ (buffer-size))))
+
+ ;; If we uncompressed this file when visiting it,
+ ;; then recompress it when writing it
+ ;; even if the contents look compressed already.
+ (if (and jka-compr-really-do-compress
+ (eq start 1)
+ (eq end (1+ (buffer-size))))
+ (setq magic nil))
+
+ (if (and info
+ ;; If the contents to be written out
+ ;; are properly compressed already,
+ ;; don't try to compress them over again.
+ (not (and magic
+ (equal (if (stringp start)
+ (substring start 0 (min (length start)
+ (length magic)))
+ (buffer-substring start
+ (min end
+ (+ start (length magic)))))
+ magic))))
+ (let ((can-append (jka-compr-info-can-append info))
+ (compress-program (jka-compr-info-compress-program info))
+ (compress-message (jka-compr-info-compress-message info))
+ (compress-args (jka-compr-info-compress-args info))
+ (base-name (file-name-nondirectory visit-file))
+ temp-file temp-buffer
+ ;; we need to leave `last-coding-system-used' set to its
+ ;; value after calling write-region the first time, so
+ ;; that `basic-save-buffer' sees the right value.
+ (coding-system-used last-coding-system-used))
+
+ (or compress-program
+ (error "No compression program defined"))
+
+ (setq temp-buffer (get-buffer-create " *jka-compr-wr-temp*"))
+ (with-current-buffer temp-buffer
+ (widen) (erase-buffer))
+
+ (if (and append
+ (not can-append)
+ (file-exists-p filename))
+
+ (let* ((local-copy (file-local-copy filename))
+ (local-file (or local-copy filename)))
+
+ (setq temp-file local-file))
+
+ (setq temp-file (jka-compr-make-temp-name)))
- (and
- compress-message
- (message "%s %s...done" compress-message base-name))
+ (and
+ compress-message
+ (message "%s %s..." compress-message base-name))
+
+ (jka-compr-run-real-handler 'write-region
+ (list start end temp-file t 'dont))
+ ;; save value used by the real write-region
+ (setq coding-system-used last-coding-system-used)
+
+ ;; Here we must read the output of compress program as is
+ ;; without any code conversion.
+ (let ((coding-system-for-read 'no-conversion))
+ (jka-compr-call-process compress-program
+ (concat compress-message
+ " " base-name)
+ temp-file
+ temp-buffer
+ nil
+ compress-args))
+
+ (with-current-buffer temp-buffer
+ (let ((coding-system-for-write 'no-conversion))
+ (if (memq system-type '(ms-dos windows-nt))
+ (setq buffer-file-type t) )
+ (jka-compr-run-real-handler 'write-region
+ (list (point-min) (point-max)
+ filename
+ (and append can-append) 'dont))
+ (erase-buffer)) )
+
+ (jka-compr-delete-temp-file temp-file)
+
+ (and
+ compress-message
+ (message "%s %s...done" compress-message base-name))
+
+ (cond
+ ((eq visit t)
+ (setq buffer-file-name filename)
+ (setq jka-compr-really-do-compress t)
+ (set-visited-file-modtime))
+ ((stringp visit)
+ (setq buffer-file-name visit)
+ (let ((buffer-file-name filename))
+ (set-visited-file-modtime))))
- (cond
- ((eq visit t)
- (setq buffer-file-name filename)
- (set-visited-file-modtime))
- ((stringp visit)
- (setq buffer-file-name visit)
- (let ((buffer-file-name filename))
- (set-visited-file-modtime))))
+ (and (or (eq visit t)
+ (eq visit nil)
+ (stringp visit))
+ (message "Wrote %s" visit-file))
- (and (or (eq visit t)
- (eq visit nil)
- (stringp visit))
- (message "Wrote %s" visit-file))
+ ;; ensure `last-coding-system-used' has an appropriate value
+ (setq last-coding-system-used coding-system-used)
- ;; ensure `last-coding-system-used' has an appropriate value
- (setq last-coding-system-used coding-system-used)
+ nil)
- nil)
-
- (jka-compr-run-real-handler 'write-region
- (list start end filename append visit)))))
+ (jka-compr-run-real-handler 'write-region
+ (list start end filename append visit)))))
(defun jka-compr-insert-file-contents (file &optional visit beg end replace)
(local-copy
(jka-compr-run-real-handler 'file-local-copy (list filename)))
local-file
- size start
- (coding-system-for-read
- (or coding-system-for-read
- ;; If multibyte characters are disabled,
- ;; don't do that conversion.
- (and (null enable-multibyte-characters)
- 'raw-text)
- (let ((tail file-coding-system-alist)
- (newfile
- (jka-compr-byte-compiler-base-file-name file))
- result)
- (while tail
- (if (string-match (car (car tail)) newfile)
- (setq result (car (cdr (car tail)))
- tail nil))
- (setq tail (cdr tail)))
- result)
- 'undecided)) )
+ size start)
(setq local-file (or local-copy filename))
(unwind-protect ; to make sure local-copy gets deleted
(progn
-
+
(and
uncompress-message
(message "%s %s..." uncompress-message base-name))
(condition-case error-code
- (progn
+ (let ((coding-system-for-read 'no-conversion))
(if replace
(goto-char (point-min)))
(setq start (point))
uncompress-args)))
(setq size (- (point) start))
(if replace
- (let* ((del-beg (point))
- (del-end (+ del-beg size)))
- (delete-region del-beg
- (min del-end (point-max)))))
+ (delete-region (point) (point-max)))
(goto-char start))
(error
(if (and (eq (car error-code) 'file-error)
(eq (nth 3 error-code) local-file))
(if visit
(setq notfound error-code)
- (signal 'file-error
+ (signal 'file-error
(cons "Opening input file"
(nthcdr 2 error-code))))
(signal (car error-code) (cdr error-code))))))
(file-exists-p local-copy)
(delete-file local-copy)))
+ (unless notfound
+ (decode-coding-inserted-region
+ (point) (+ (point) size)
+ (jka-compr-byte-compiler-base-file-name file)
+ visit beg end replace))
+
(and
visit
(progn
(unlock-buffer)
(setq buffer-file-name filename)
+ (setq jka-compr-really-do-compress t)
(set-visited-file-modtime)))
-
+
(and
uncompress-message
(message "%s %s...done" uncompress-message base-name))
;;; (setq size insval)))
;;; (setq p (cdr p))))
+ (or (jka-compr-info-compress-program info)
+ (message "You can't save this buffer because compression program is not defined"))
+
(list filename size))
(jka-compr-run-real-handler 'insert-file-contents
(unwind-protect
(with-current-buffer temp-buffer
-
+
(and
uncompress-message
(message "%s %s..." uncompress-message base-name))
-
+
;; Here we must read the output of uncompress program
;; and write it to TEMP-FILE without any code
;; conversion. An appropriate code conversion (if
(kill-buffer temp-buffer))
temp-file)
-
+
(jka-compr-run-real-handler 'file-local-copy (list filename)))))
(let ((load-force-doc-strings t))
(load load-file noerror t t))
-
(or nomessage
- (message "Loading %s...done." file)))
+ (message "Loading %s...done." file))
+ ;; Fix up the load history to point at the right library.
+ (let ((l (assoc load-file load-history)))
+ ;; Remove .gz and .elc?.
+ (while (file-name-extension file)
+ (setq file (file-name-sans-extension file)))
+ (setcar l file)))
(jka-compr-delete-temp-file local-copy))
Lisp programs can bind this to t to do that.
It is not recommended to set this variable permanently to anything but nil.")
+(put 'jka-compr-handler 'safe-magic t)
(defun jka-compr-handler (operation &rest args)
(save-match-data
(let ((jka-op (get operation 'jka-compr)))
(inhibit-file-name-operation operation))
(apply operation args)))
-;;;###autoload(defun auto-compression-mode (&optional arg)
-;;;###autoload "\
-;;;###autoloadToggle automatic file compression and uncompression.
-;;;###autoloadWith prefix argument ARG, turn auto compression on if positive, else off.
-;;;###autoloadReturns the new status of auto compression (non-nil means on)."
-;;;###autoload (interactive "P")
-;;;###autoload (if (not (fboundp 'jka-compr-installed-p))
-;;;###autoload (progn
-;;;###autoload (require 'jka-compr)
-;;;###autoload ;; That turned the mode on, so make it initially off.
-;;;###autoload (toggle-auto-compression)))
-;;;###autoload (toggle-auto-compression arg t))
-
-(defun toggle-auto-compression (&optional arg message)
- "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).
-If the argument MESSAGE is non-nil, it means to print a message
-saying whether the mode is now on or off."
- (interactive "P\np")
- (let* ((installed (jka-compr-installed-p))
- (flag (if (null arg)
- (not installed)
- (or (eq arg t) (listp arg) (and (integerp arg) (> arg 0))))))
-
- (cond
- ((and flag installed) t) ; already installed
-
- ((and (not flag) (not installed)) nil) ; already not installed
-
- (flag
- (jka-compr-install))
-
- (t
- (jka-compr-uninstall)))
-
-
- (and message
- (if flag
- (message "Automatic file (de)compression is now ON.")
- (message "Automatic file (de)compression is now OFF.")))
-
- flag))
(defun jka-compr-build-file-regexp ()
- (concat
- "\\("
- (mapconcat
- 'jka-compr-info-regexp
- jka-compr-compression-info-list
- "\\)\\|\\(")
- "\\)"))
+ (mapconcat
+ 'jka-compr-info-regexp
+ jka-compr-compression-info-list
+ "\\|"))
(defun jka-compr-install ()
inhibit-first-line-modes-suffixes)))))
jka-compr-compression-info-list)
(setq auto-mode-alist
- (append auto-mode-alist jka-compr-mode-alist-additions)))
+ (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))))
(defun jka-compr-uninstall ()
(eq (nth 2 entry) 'jka-compr)))
(setcdr last (cdr (cdr last)))
(setq last (cdr last))))
-
+
(setq auto-mode-alist (cdr ama)))
(let* ((ama (cons nil file-coding-system-alist))
(if (member entry jka-compr-added-to-file-coding-system-alist)
(setcdr last (cdr (cdr last)))
(setq last (cdr last))))
-
- (setq file-coding-system-alist (cdr ama))))
-
+ (setq file-coding-system-alist (cdr ama)))
+
+ ;; Remove the suffixes that were added by jka-compr.
+ (let ((suffixes nil)
+ (re (jka-compr-build-file-regexp)))
+ (dolist (suffix load-suffixes)
+ (unless (string-match re suffix)
+ (push suffix suffixes)))
+ (setq load-suffixes (nreverse suffixes))))
+
+
(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."
(and (jka-compr-installed-p)
(jka-compr-uninstall))
-(jka-compr-install)
+
+;;;###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)
(provide 'jka-compr)
-;; jka-compr.el ends here.
+;;; arch-tag: 3f15b630-e9a7-46c4-a22a-94afdde86ebc
+;;; jka-compr.el ends here