X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/7ec4806e71fd2b51f8925f6e4d60db3fbf946b7e..1eedd2f11f54db9ccc9a9b6cae639f65750b8baf:/lisp/jka-compr.el diff --git a/lisp/jka-compr.el b/lisp/jka-compr.el index fc53a0b329..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 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 @@ -36,10 +37,10 @@ ;; 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. @@ -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,90 +109,15 @@ 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] - '(["\\.Z\\(~\\|\\.~[0-9]+~\\)?\\'" - "compressing" "compress" ("-c") - "uncompressing" "uncompress" ("-c") - nil t] - ["\\.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]) - - "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: - - 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 - - auto-mode flag non-nil means strip the regexp from file names - before attempting to set the mode. - -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. +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 (defun jka-compr-info-regexp (info) (aref info 0)) @@ -212,6 +129,7 @@ invoked." (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) @@ -251,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) @@ -264,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 @@ -328,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 @@ -353,144 +280,130 @@ 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)) - (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) - - (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) + (make-temp-file jka-compr-temp-name-template)) - (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) @@ -513,18 +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) - '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)) @@ -535,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)) @@ -570,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 @@ -590,13 +499,20 @@ 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 (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)) @@ -624,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 @@ -652,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 @@ -688,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))))) @@ -708,9 +627,14 @@ There should be no more than seven characters after the final `/'." (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)) @@ -730,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))) @@ -754,103 +680,7 @@ It is not recommended to set this variable permanently to anything but nil.") (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 - "\\)\\|\\(") - "\\)")) - - -(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' @@ -887,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)) @@ -899,34 +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)) -(jka-compr-install) + (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