X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/ee139ed38ba8d3b1f78c5253cd003b3d62bced3d..66236b772af493888a34148662dca58561958a6f:/lisp/jka-compr.el diff --git a/lisp/jka-compr.el b/lisp/jka-compr.el index 3247042eb7..fc53a0b329 100644 --- a/lisp/jka-compr.el +++ b/lisp/jka-compr.el @@ -1,138 +1,145 @@ -;;; 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) -;; Version: 0.11 +;; 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: -;;; -;;; rmail, vm, gnus, etc. -;;; To use compressed mail folders, .newsrc files, etc., you need -;;; only compress the file. Since jka-compr searches for .gz -;;; versions of the files it's finding, you need not change -;;; variables within rmail, gnus, etc. -;;; -;;; -;;; 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. -;;; -;;; -;;; tar-mode -;;; Some people like to use extensions like .trz for compressed tar files. -;;; To handle these sorts of files, you have to add an entry to -;;; jka-compr-compression-info-list that looks something like this: -;;; -;;; ["\\.trz\\'" "\037\213" -;;; "zip" "gzip" nil ("-q") -;;; "unzip" "gzip" nil ("-q" "-d") -;;; t -;;; nil] -;;; -;;; The last nil in the vector (the "extension" field) prevents jka-compr -;;; from attempting to add .trz to an ordinary file name when it is looking -;;; for a compressed version of that file (i.e. don't look for things like -;;; foobar.c.trz). -;;; -;;; Finally, to make tar-mode start up automatically, you have to add an -;;; entry to auto-mode-alist that looks like this -;;; -;;; ("\\.trz\\'" . tar-mode) -;;; - - -;;; 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 ;; can-append auto-mode-flag] - '(["\\.Z~?\\'" + '(["\\.Z\\(~\\|\\.~[0-9]+~\\)?\\'" "compressing" "compress" ("-c") "uncompressing" "uncompress" ("-c") nil t] - ["\\.gz~?\\'" + ["\\.bz2\\'" + "bzip2ing" "bzip2" ("-c") + "bunzip2ing" "bzip2" ("-d" "-c") + nil t] + ["\\.tgz\\'" + "zipping" "gzip" ("-c" "-q") + "unzipping" "gzip" ("-c" "-q" "-d") + t nil] + ["\\.gz\\(~\\|\\.~[0-9]+~\\)?\\'" "zipping" "gzip" ("-c" "-q") "unzipping" "gzip" ("-c" "-q" "-d") t t]) @@ -168,14 +175,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.") + +;; 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)) @@ -204,27 +231,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 @@ -278,8 +304,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 @@ -310,20 +338,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)) @@ -384,68 +412,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) @@ -467,6 +484,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 @@ -493,7 +513,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)) @@ -512,6 +543,8 @@ There should be no more than seven characters after the final `/'") (condition-case error-code (progn + (if replace + (goto-char (point-min))) (setq start (point)) (if (or beg end) (jka-compr-partial-uncompress uncompress-program @@ -523,17 +556,25 @@ 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)) + (del-end (+ del-beg size))) + (delete-region del-beg + (min del-end (point-max))))) (goto-char start)) - - (error (if (and (eq (car error-code) 'file-error) (eq (nth 3 error-code) local-file)) @@ -566,6 +607,23 @@ There should be no more than seven characters after the final `/'") (signal 'file-error (cons "Opening input file" (nth 2 notfound)))) + ;; 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)) (jka-compr-run-real-handler 'insert-file-contents @@ -585,44 +643,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) @@ -644,7 +706,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))) @@ -652,16 +715,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))))) @@ -677,11 +754,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) @@ -699,14 +791,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 "\\(" @@ -719,7 +810,8 @@ Returns the new status of auto compression (non-nil means on)." (defun jka-compr-install () "Install jka-compr. -This adds entries to `file-name-handler-alist' and `auto-mode-alist'." +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)) @@ -727,23 +819,52 @@ This adds entries to `file-name-handler-alist' and `auto-mode-alist'." (setq file-name-handler-alist (cons jka-compr-file-name-handler-entry file-name-handler-alist)) - ;; Make entries in auto-mode-alist so that modes are chosen right - ;; according to the file names sans `.gz'. + (setq jka-compr-added-to-file-coding-system-alist nil) + (mapcar (function (lambda (x) - (and - (jka-compr-info-strip-extension x) - (setq auto-mode-alist (cons (list (jka-compr-info-regexp x) - nil 'jka-compr) - auto-mode-alist))))) - - jka-compr-compression-info-list)) + ;; 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))) (defun jka-compr-uninstall () "Uninstall jka-compr. This removes the entries in `file-name-handler-alist' and `auto-mode-alist' -that were created by `jka-compr-installed'." +and `inhibit-first-line-modes-suffixes' that were added +by `jka-compr-installed'." + ;; Delete from inhibit-first-line-modes-suffixes + ;; what jka-compr-install added. + (mapcar + (function (lambda (x) + (and (jka-compr-info-strip-extension x) + (setq inhibit-first-line-modes-suffixes + (delete (jka-compr-info-regexp x) + inhibit-first-line-modes-suffixes))))) + jka-compr-compression-info-list) (let* ((fnha (cons nil file-name-handler-alist)) (last fnha)) @@ -761,12 +882,25 @@ that were created by `jka-compr-installed'." (while (cdr last) (setq entry (car (cdr last))) - (if (and (consp (cdr entry)) - (eq (nth 2 entry) 'jka-compr)) + (if (or (member entry jka-compr-mode-alist-additions) + (and (consp (cdr entry)) + (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)) + (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 auto-mode-alist (cdr ama)))) + (setq file-coding-system-alist (cdr ama)))) (defun jka-compr-installed-p ()