;;; jka-compr.el --- reading/writing/loading compressed files
-;; Copyright (C) 1993, 1994, 1995, 1997, 1999 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1994, 1995, 1997, 1999, 2000 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
"zipping" "gzip" ("-c" "-q")
"unzipping" "gzip" ("-c" "-q" "-d")
t nil "\037\213"]
- ["\\.gz\\(~\\|\\.~[0-9]+~\\)?\\'"
+ ["\\.g?z\\(~\\|\\.~[0-9]+~\\)?\\'"
"zipping" "gzip" ("-c" "-q")
"unzipping" "gzip" ("-c" "-q" "-d")
t t "\037\213"])
(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
+(defcustom 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.")
+ "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)
(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
(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.
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
-(defcustom auto-compression-mode nil
- "Toggle automatic file compression and uncompression.
-Setting this variable directly does not take effect;
-use either \\[customize] or the function `auto-compression-mode'."
- :set (lambda (symbol value)
- (auto-compression-mode (or value 0)))
- :initialize 'custom-initialize-default
- :group 'jka-compr
- :version "21.1"
- :type 'boolean
- :require 'jka-compr)
-
-;;;###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 ()
(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 ()
(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.
+;;; jka-compr.el ends here
HCoop / bpt / emacs.git / blobdiff