X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/7391213dad65c9df9d9e5209f0b672973a79f27c..1eedd2f11f54db9ccc9a9b6cae639f65750b8baf:/lisp/jka-compr.el diff --git a/lisp/jka-compr.el b/lisp/jka-compr.el index fa8cb54405..b25d386566 100644 --- a/lisp/jka-compr.el +++ b/lisp/jka-compr.el @@ -1,6 +1,7 @@ ;;; jka-compr.el --- reading/writing/loading compressed files -;; Copyright (C) 1993, 1994, 1995, 1997, 1999, 2000 Free Software Foundation, Inc. +;; Copyright (C) 1993, 1994, 1995, 1997, 1999, 2000, 2002, 2003, +;; 2004, 2005 Free Software Foundation, Inc. ;; Author: jka@ece.cmu.edu (Jay K. Adams) ;; Maintainer: FSF @@ -20,10 +21,10 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. -;;; Commentary: +;;; Commentary: ;; This package implements low-level support for reading, writing, ;; and loading compressed files. It hooks into the low-level file @@ -64,7 +65,7 @@ ;; 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 @@ -77,9 +78,9 @@ ;; 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 @@ -100,15 +101,6 @@ ;;; Code: -(defgroup compression nil - "Data compression utilities" - :group 'data) - -(defgroup jka-compr nil - "jka-compr customization" - :group 'compression) - - (defcustom jka-compr-shell "sh" "*Shell to be used for calling compression programs. The value of this variable only matters if you want to discard the @@ -117,99 +109,14 @@ for `jka-compr-compression-info-list')." :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 -;;; 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"] - ["\\.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"]) - - "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 - - 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)) - (string :tag "Compress Program") - (repeat :tag "Compress Arguments" string) - (choice :tag "Uncompress Message" - (string :format "%v") - (const :tag "No Message" nil)) - (string :tag "Uncompress Program") - (repeat :tag "Uncompress Arguments" string) - (boolean :tag "Append") - (boolean :tag "Auto Mode"))) - :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.") - -;; 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.") + "Non-nil in a buffer whose visited file was uncompressed on visiting it. +This means compress the data on writing the file, even if the +data appears to be compressed already.") +(make-variable-buffer-local 'jka-compr-really-do-compress) (put 'jka-compr-really-do-compress 'permanent-local t) ;;; Functions for accessing the return value of jka-compr-get-compression-info @@ -262,10 +169,12 @@ based on the filename itself and `jka-compr-compression-info-list'." (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) @@ -275,32 +184,39 @@ based on the filename itself and `jka-compr-compression-info-list'." "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 @@ -339,7 +255,7 @@ to keep: LEN chars starting BEG chars from the beginning." (jka-compr-delete-temp-file err-file))) - (or (zerop + (or (eq 0 (apply 'call-process prog infile @@ -377,6 +293,10 @@ There should be no more than seven characters after the final `/'." (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. @@ -400,10 +320,7 @@ There should be no more than seven characters after the final `/'." (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 @@ -411,6 +328,9 @@ There should be no more than seven characters after the final `/'." ;; 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)) @@ -426,7 +346,7 @@ There should be no more than seven characters after the final `/'." (setq temp-file (jka-compr-make-temp-name))) - (and + (and compress-message (message "%s %s..." compress-message base-name)) @@ -481,7 +401,7 @@ There should be no more than seven characters after the final `/'." (setq last-coding-system-used coding-system-used) nil) - + (jka-compr-run-real-handler 'write-region (list start end filename append visit))))) @@ -506,20 +426,7 @@ There should be no more than seven characters after the final `/'." (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) - (or (auto-coding-alist-lookup - (jka-compr-byte-compiler-base-file-name file)) - 'raw-text)) - (let ((coding (find-operation-coding-system - 'insert-file-contents - (jka-compr-byte-compiler-base-file-name file)))) - (and (consp coding) (car coding))) - 'undecided)) ) + size start) (setq local-file (or local-copy filename)) @@ -530,14 +437,14 @@ There should be no more than seven characters after the final `/'." (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)) @@ -565,19 +472,26 @@ There should be no more than seven characters after the final `/'." 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 the file we wanted to uncompress does not exist, + ;; handle that according to VISIT as `insert-file-contents' + ;; would, maybe signaling the same error it normally would. (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)))) + ;; If the uncompression program can't be found, + ;; signal that as a non-file error + ;; so that find-file-noselect-1 won't handle it. + (if (and (eq (car error-code) 'file-error) + (equal (cadr error-code) "Searching for program")) + (error "Uncompression program `%s' not found" + (nth 3 error-code))) (signal (car error-code) (cdr error-code)))))) (and @@ -585,6 +499,12 @@ There should be no more than seven characters after the final `/'." (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 @@ -592,7 +512,7 @@ There should be no more than seven characters after the final `/'." (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)) @@ -620,6 +540,9 @@ There should be no more than seven characters after the final `/'." ;;; (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 @@ -648,11 +571,11 @@ There should be no more than seven characters after the final `/'." (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 @@ -684,7 +607,7 @@ There should be no more than seven characters after the final `/'." (kill-buffer temp-buffer)) temp-file) - + (jka-compr-run-real-handler 'file-local-copy (list filename))))) @@ -731,11 +654,13 @@ There should be no more than seven characters after the final `/'." (put 'byte-compiler-base-file-name 'jka-compr 'jka-compr-byte-compiler-base-file-name) +;;;###autoload (defvar jka-compr-inhibit nil "Non-nil means inhibit automatic uncompression temporarily. Lisp programs can bind this to t to do that. It is not recommended to set this variable permanently to anything but nil.") +;;;###autoload (defun jka-compr-handler (operation &rest args) (save-match-data (let ((jka-op (get operation 'jka-compr))) @@ -755,57 +680,7 @@ It is not recommended to set this variable permanently to anything but nil.") (inhibit-file-name-operation operation)) (apply operation args))) - -(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))) - - +;;;###autoload (defun jka-compr-uninstall () "Uninstall jka-compr. This removes the entries in `file-name-handler-alist' and `auto-mode-alist' @@ -842,7 +717,7 @@ by `jka-compr-installed'." (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)) @@ -854,66 +729,18 @@ by `jka-compr-installed'." (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)))) - - -(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)) - - -;;; Note this definition must be at the end of the file, because -;;; `define-minor-mode' actually calls the mode-function if the -;;; associated variable is non-nil, which requires that all needed -;;; functions be already defined. [This is arguably a bug in d-m-m] -;;;###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)." - nil nil nil :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) + (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)))) (provide 'jka-compr) -;; jka-compr.el ends here. +;;; arch-tag: 3f15b630-e9a7-46c4-a22a-94afdde86ebc +;;; jka-compr.el ends here