X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/919a07bb1d628890cbd729285d9b307bb9fe471f..3b7f63b13fde224c5b0cf76a9dea51e820f1d93e:/lisp/jka-compr.el diff --git a/lisp/jka-compr.el b/lisp/jka-compr.el index 5c139c865d..caa0711081 100644 --- a/lisp/jka-compr.el +++ b/lisp/jka-compr.el @@ -1,99 +1,128 @@ -;;; jka-compr.el - reading/writing/loading compressed files. -;;; Copyright (C) 1993, 1994 Free Software Foundation, Inc. +;;; jka-compr.el --- reading/writing/loading compressed files + +;; Copyright (C) 1993, 1994, 1995, 1997 Free Software Foundation, Inc. ;; Author: jka@ece.cmu.edu (Jay K. Adams) +;; Maintainer: FSF ;; Keywords: data +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; 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. + ;;; Commentary: -;;; This package implements low-level support for reading, writing, -;;; and loading compressed files. It hooks into the low-level file -;;; I/O functions (including write-region and insert-file-contents) so -;;; that they automatically compress or uncompress a file if the file -;;; appears to need it (based on the extension of the file name). -;;; Packages like Rmail, VM, GNUS, and Info should be able to work -;;; with compressed files without modification. - - -;;; 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). -;;; -;;; The variable, jka-compr-compression-info-list can be used to -;;; customize jka-compr to work with other compression programs. -;;; The default value of this variable allows jka-compr to work with -;;; Unix compress and gzip. -;;; -;;; If you are concerned about the stderr output of gzip and other -;;; compression/decompression programs showing up in your buffers, you -;;; should set the discard-error flag in the compression-info-list. -;;; This will cause the stderr of all programs to be discarded. -;;; However, it also causes emacs to call compression/uncompression -;;; programs through a shell (which is specified by jka-compr-shell). -;;; This may be a drag if, on your system, starting up a shell is -;;; slow. -;;; -;;; If you don't want messages about compressing and decompressing -;;; to show up in the echo area, you can set the compress-name and -;;; decompress-name fields of the jka-compr-compression-info-list to -;;; nil. - - -;;; APPLICATION NOTES: -;;; -;;; crypt++ -;;; jka-compr can coexist with crpyt++ 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 -;;; decode encrypted compressed files--that is, files that have been -;;; compressed then encrypted (in that order). Theoretically, crypt++ and -;;; jka-compr could properly handle a file that has been encrypted then -;;; compressed, but there is little point in trying to compress an encrypted -;;; file. -;;; - - -;;; 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 -;;; jka-compr. I recall the following people as being particularly helpful. -;;; -;;; Jean-loup Gailly -;;; David Hughes -;;; Richard Pieri -;;; Daniel Quinlan -;;; Chris P. Ross -;;; Rick Sladkey -;;; -;;; Andy Norman's ange-ftp was the inspiration for the original jka-compr for -;;; Version 18 of Emacs. -;;; -;;; After I had made progress on the original jka-compr for V18, I learned of a -;;; package written by Kazushi Jam Marukawa, called jam-zcat, that did exactly -;;; what I was trying to do. I looked over the jam-zcat source code and -;;; probably got some ideas from it. -;;; +;; This package implements low-level support for reading, writing, +;; and loading compressed files. It hooks into the low-level file +;; I/O functions (including write-region and insert-file-contents) so +;; that they automatically compress or uncompress a file if the file +;; appears to need it (based on the extension of the file name). +;; Packages like Rmail, VM, GNUS, and Info should be able to work +;; with compressed files without modification. + + +;; 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). +;; +;; The variable, jka-compr-compression-info-list can be used to +;; customize jka-compr to work with other compression programs. +;; The default value of this variable allows jka-compr to work with +;; Unix compress and gzip. +;; +;; If you are concerned about the stderr output of gzip and other +;; compression/decompression programs showing up in your buffers, you +;; should set the discard-error flag in the compression-info-list. +;; This will cause the stderr of all programs to be discarded. +;; However, it also causes emacs to call compression/uncompression +;; programs through a shell (which is specified by jka-compr-shell). +;; This may be a drag if, on your system, starting up a shell is +;; slow. +;; +;; If you don't want messages about compressing and decompressing +;; to show up in the echo area, you can set the compress-name and +;; decompress-name fields of the jka-compr-compression-info-list to +;; nil. + + +;; APPLICATION NOTES: +;; +;; crypt++ +;; jka-compr can coexist with crpyt++ 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 +;; decode encrypted compressed files--that is, files that have been +;; compressed then encrypted (in that order). Theoretically, crypt++ and +;; jka-compr could properly handle a file that has been encrypted then +;; compressed, but there is little point in trying to compress an encrypted +;; file. +;; + + +;; 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 +;; jka-compr. I recall the following people as being particularly helpful. +;; +;; Jean-loup Gailly +;; David Hughes +;; Richard Pieri +;; Daniel Quinlan +;; Chris P. Ross +;; Rick Sladkey +;; +;; Andy Norman's ange-ftp was the inspiration for the original jka-compr for +;; Version 18 of Emacs. +;; +;; After I had made progress on the original jka-compr for V18, I learned of a +;; package written by Kazushi Jam Marukawa, called jam-zcat, that did exactly +;; what I was trying to do. I looked over the jam-zcat source code and +;; probably got some ideas from it. +;; ;;; Code: -(defvar jka-compr-shell "sh" +(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 stderr of a compression/decompression program (see the documentation -for `jka-compr-compression-info-list').") - - -(defvar jka-compr-use-shell t) +for `jka-compr-compression-info-list')." + :type 'string + :group 'jka-compr) +(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. -(defvar jka-compr-compression-info-list +;;; 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 @@ -102,6 +131,13 @@ for `jka-compr-compression-info-list').") "compressing" "compress" ("-c") "uncompressing" "uncompress" ("-c") nil t] + ;; 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] ["\\.tgz\\'" "zipping" "gzip" ("-c" "-q") "unzipping" "gzip" ("-c" "-q" "-d") @@ -142,17 +178,34 @@ APPEND-FLAG EXTENSION], where: 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.") +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.") + "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.") -;;; Functions for accessing the return value of jka-get-compression-info +;;; 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-compress-message (info) (aref info 1)) (defun jka-compr-info-compress-program (info) (aref info 2)) @@ -181,27 +234,26 @@ based on the filename itself and `jka-compr-compression-info-list'." (put 'compression-error 'error-conditions '(compression-error file-error error)) -(defvar jka-compr-acceptable-retval-list '(0 141)) +(defvar jka-compr-acceptable-retval-list '(0 2 141)) (defun jka-compr-error (prog args infile message &optional errfile) (let ((errbuf (get-buffer-create " *jka-compr-error*")) (curbuf (current-buffer))) - (set-buffer errbuf) - (widen) (erase-buffer) - (insert (format "Error while executing \"%s %s < %s\"\n\n" - prog - (mapconcat 'identity args " ") - infile)) - - (and errfile - (insert-file-contents errfile)) - - (set-buffer curbuf) + (with-current-buffer errbuf + (widen) (erase-buffer) + (insert (format "Error while executing \"%s %s < %s\"\n\n" + prog + (mapconcat 'identity args " ") + infile)) + + (and errfile + (insert-file-contents errfile))) (display-buffer errbuf)) - (signal 'compression-error (list "Opening input file" (format "error %s" message) infile))) + (signal 'compression-error + (list "Opening input file" (format "error %s" message) infile))) (defvar jka-compr-dd-program @@ -255,8 +307,10 @@ to keep: LEN chars starting BEG chars from the beginning." (defun jka-compr-call-process (prog message infile output temp args) (if jka-compr-use-shell - (let ((err-file (jka-compr-make-temp-name))) - + (let ((err-file (jka-compr-make-temp-name)) + (coding-system-for-read (or coding-system-for-read 'undecided)) + (coding-system-for-write 'no-conversion)) + (unwind-protect (or (memq @@ -287,20 +341,20 @@ to keep: LEN chars starting BEG chars from the beginning." (jka-compr-error prog args infile message)) (and (stringp output) - (let ((cbuf (current-buffer))) - (set-buffer temp) + (with-current-buffer temp (write-region (point-min) (point-max) output) - (erase-buffer) - (set-buffer cbuf))))) + (erase-buffer))))) ;;; Support for temp files. Much of this was inspired if not lifted ;;; from ange-ftp. -(defvar jka-compr-temp-name-template - "/tmp/jka-com" +(defcustom jka-compr-temp-name-template + (expand-file-name "jka-com" temporary-file-directory) "Prefix added to all temp files created by jka-compr. -There should be no more than seven characters after the final `/'") +There should be no more than seven characters after the final `/'." + :type 'string + :group 'jka-compr) (defvar jka-compr-temp-name-table (make-vector 31 nil)) @@ -361,68 +415,57 @@ There should be no more than seven characters after the final `/'") (uncompress-message (jka-compr-info-uncompress-message info)) (compress-args (jka-compr-info-compress-args info)) (uncompress-args (jka-compr-info-uncompress-args info)) - (temp-file (jka-compr-make-temp-name)) (base-name (file-name-nondirectory visit-file)) - cbuf temp-buffer) - - (setq cbuf (current-buffer) - temp-buffer (get-buffer-create " *jka-compr-temp*")) - (set-buffer temp-buffer) - (widen) (erase-buffer) - (set-buffer cbuf) - - (and append - (not can-append) - (file-exists-p filename) - (let* ((local-copy (file-local-copy filename)) - (local-file (or local-copy filename))) - - (unwind-protect - - (progn - - (and - uncompress-message - (message "%s %s..." uncompress-message base-name)) - - (jka-compr-call-process uncompress-program - (concat uncompress-message - " " base-name) - local-file - temp-file - temp-buffer - uncompress-args) - (and - uncompress-message - (message "%s %s...done" uncompress-message base-name))) - - (and - local-copy - (file-exists-p local-copy) - (delete-file local-copy))))) + 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)) - - (jka-compr-call-process compress-program - (concat compress-message - " " base-name) - temp-file - temp-buffer - nil - compress-args) - - (set-buffer temp-buffer) - (jka-compr-run-real-handler 'write-region - (list (point-min) (point-max) - filename - (and append can-append) 'dont)) - (erase-buffer) - (set-buffer cbuf) + ;; 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) @@ -444,6 +487,9 @@ There should be no more than seven characters after the final `/'") (stringp visit)) (message "Wrote %s" visit-file)) + ;; ensure `last-coding-system-used' has an appropriate value + (setq last-coding-system-used coding-system-used) + nil) (jka-compr-run-real-handler 'write-region @@ -470,7 +516,18 @@ 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) + 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 ((coding (find-operation-coding-system + 'insert-file-contents + (jka-compr-byte-compiler-base-file-name file)))) + (and (consp coding) (car coding))) + 'undecided)) ) (setq local-file (or local-copy filename)) @@ -502,13 +559,18 @@ There should be no more than seven characters after the final `/'") (if (and beg end) (- end beg) end)) - (jka-compr-call-process uncompress-program - (concat uncompress-message - " " base-name) - local-file - t - nil - uncompress-args)) + ;; If visiting, bind off buffer-file-name so that + ;; file-locking will not ask whether we should + ;; really edit the buffer. + (let ((buffer-file-name + (if visit nil buffer-file-name))) + (jka-compr-call-process uncompress-program + (concat uncompress-message + " " base-name) + local-file + t + nil + uncompress-args))) (setq size (- (point) start)) (if replace (let* ((del-beg (point)) @@ -548,18 +610,22 @@ There should be no more than seven characters after the final `/'") (signal 'file-error (cons "Opening input file" (nth 2 notfound)))) - ;; Run the functions that insert-file-contents would. - (let ((p after-insert-file-functions) - (insval size)) - (while p - (setq insval (funcall (car p) size)) - (if insval - (progn - (or (integerp insval) - (signal 'wrong-type-argument - (list 'integerp insval))) - (setq size insval))) - (setq p (cdr p)))) + ;; This is done in insert-file-contents after we return. + ;; That is a little weird, but better to go along with it now + ;; than to change it now. + +;;; ;; Run the functions that insert-file-contents would. +;;; (let ((p after-insert-file-functions) +;;; (insval size)) +;;; (while p +;;; (setq insval (funcall (car p) size)) +;;; (if insval +;;; (progn +;;; (or (integerp insval) +;;; (signal 'wrong-type-argument +;;; (list 'integerp insval))) +;;; (setq size insval))) +;;; (setq p (cdr p)))) (list filename size)) @@ -580,44 +646,48 @@ There should be no more than seven characters after the final `/'") (local-copy (jka-compr-run-real-handler 'file-local-copy (list filename))) (temp-file (jka-compr-make-temp-name t)) - (temp-buffer (get-buffer-create " *jka-compr-temp*")) + (temp-buffer (get-buffer-create " *jka-compr-flc-temp*")) (notfound nil) - (cbuf (current-buffer)) local-file) (setq local-file (or local-copy filename)) (unwind-protect - (progn + (with-current-buffer temp-buffer (and uncompress-message (message "%s %s..." uncompress-message base-name)) - - (set-buffer temp-buffer) - (jka-compr-call-process uncompress-program - (concat uncompress-message - " " base-name) - local-file - t - nil - uncompress-args) - - (and - uncompress-message - (message "%s %s...done" uncompress-message base-name)) - - (write-region - (point-min) (point-max) temp-file nil 'dont)) + ;; Here we must read the output of uncompress program + ;; and write it to TEMP-FILE without any code + ;; conversion. An appropriate code conversion (if + ;; necessary) is done by the later I/O operation + ;; (e.g. load). + (let ((coding-system-for-read 'no-conversion) + (coding-system-for-write 'no-conversion)) + + (jka-compr-call-process uncompress-program + (concat uncompress-message + " " base-name) + local-file + t + nil + uncompress-args) + + (and + uncompress-message + (message "%s %s...done" uncompress-message base-name)) + + (write-region + (point-min) (point-max) temp-file nil 'dont))) (and local-copy (file-exists-p local-copy) (delete-file local-copy)) - (set-buffer cbuf) (kill-buffer temp-buffer)) temp-file) @@ -639,7 +709,8 @@ There should be no more than seven characters after the final `/'") (or nomessage (message "Loading %s..." file)) - (load load-file noerror t t) + (let ((load-force-doc-strings t)) + (load load-file noerror t t)) (or nomessage (message "Loading %s...done." file))) @@ -647,16 +718,30 @@ There should be no more than seven characters after the final `/'") (jka-compr-delete-temp-file local-copy)) t)) + +(defun jka-compr-byte-compiler-base-file-name (file) + (let ((info (jka-compr-get-compression-info file))) + (if (and info (jka-compr-info-strip-extension info)) + (save-match-data + (substring file 0 (string-match (jka-compr-info-regexp info) file))) + file))) (put 'write-region 'jka-compr 'jka-compr-write-region) (put 'insert-file-contents 'jka-compr 'jka-compr-insert-file-contents) (put 'file-local-copy 'jka-compr 'jka-compr-file-local-copy) (put 'load 'jka-compr 'jka-compr-load) +(put 'byte-compiler-base-file-name 'jka-compr + 'jka-compr-byte-compiler-base-file-name) + +(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.") (defun jka-compr-handler (operation &rest args) (save-match-data (let ((jka-op (get operation 'jka-compr))) - (if jka-op + (if (and jka-op (not jka-compr-inhibit)) (apply jka-op args) (jka-compr-run-real-handler operation args))))) @@ -672,11 +757,26 @@ There should be no more than seven characters after the final `/'") (inhibit-file-name-operation operation)) (apply operation args))) -(defun toggle-auto-compression (arg) - "Toggle automatic file compression and decompression. +;;;###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)." - (interactive "P") +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) @@ -694,14 +794,13 @@ Returns the new status of auto compression (non-nil means on)." (jka-compr-uninstall))) - (and (interactive-p) + (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 "\\(" @@ -723,8 +822,18 @@ and `inhibit-first-line-modes-suffixes'." (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 @@ -782,7 +891,19 @@ by `jka-compr-installed'." (setcdr last (cdr (cdr last))) (setq last (cdr last)))) - (setq auto-mode-alist (cdr ama)))) + (setq auto-mode-alist (cdr ama))) + + (let* ((ama (cons nil file-coding-system-alist)) + (last ama) + entry) + + (while (cdr last) + (setq entry (car (cdr last))) + (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 ()