;;; jka-compr.el --- reading/writing/loading compressed files;; Copyright (C) 1993, 1994 Free Software Foundation, Inc.;; Author: jka@ece.cmu.edu (Jay K. Adams);; Maintainer: FSF;; Keywords: data;; This file is part of XEmacs.;; XEmacs 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.;; XEmacs 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 XEmacs; see the file COPYING. If not, write to the Free;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA;; 02111-1307, USA.;; Synched up with: FSF 20.3.10.1;;; 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 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;; 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:(defgroupcompressionnil"Data compression utilities":group'data)(defgroupjka-comprnil"jka-compr customization":group'compression)(defcustomjka-compr-shell"sh""*Shell to be used for calling compression programs.The value of this variable only matters if you want to discard thestderr of a compression/decompression program (see the documentationfor `jka-compr-compression-info-list').":type'string:group'jka-compr)(defvarjka-compr-use-shell(not(memqsystem-type'(ms-doswindows-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.(defcustomjka-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")nilt]["\\.bz2\\(~\\|\\.~[0-9]+~\\)?\\'"; XEmacs change"bzip2ing""bzip2"nil"unbzip2ing""bzip2"("-d")nilt]["\\.tgz\\'""zipping""gzip"("-c""-q")"unzipping""gzip"("-c""-q""-d")tnil]["\\.gz\\(~\\|\\.~[0-9]+~\\)?\\'""zipping""gzip"("-c""-q")"unzipping""gzip"("-c""-q""-d")tt])"List of vectors that describe available compression techniques.Each element, which describes a compression technique, is a vector ofthe form [REGEXP COMPRESS-MSG COMPRESS-PROGRAM COMPRESS-ARGSUNCOMPRESS-MSG UNCOMPRESS-PROGRAM UNCOMPRESS-ARGSAPPEND-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 ofa program adds the overhead of starting a shell each time the program isinvoked.":type'(repeat(vector:tag"Compression Technique"; XEmacs changeregexp(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)(defvarjka-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.(defvarjka-compr-added-to-file-coding-system-alistnil)(defvarjka-compr-file-name-handler-entrynil"The entry in `file-name-handler-alist' used by the jka-compr I/O functions.");;; Functions for accessing the return value of jka-compr-get-compression-info(defunjka-compr-info-regexp(info)(arefinfo0))(defunjka-compr-info-compress-message(info)(arefinfo1))(defunjka-compr-info-compress-program(info)(arefinfo2))(defunjka-compr-info-compress-args(info)(arefinfo3))(defunjka-compr-info-uncompress-message(info)(arefinfo4))(defunjka-compr-info-uncompress-program(info)(arefinfo5))(defunjka-compr-info-uncompress-args(info)(arefinfo6))(defunjka-compr-info-can-append(info)(arefinfo7))(defunjka-compr-info-strip-extension(info)(arefinfo8))(defunjka-compr-get-compression-info(filename)"Return information about the compression scheme of FILENAME.The determination as to which compression scheme, if any, to use isbased on the filename itself and `jka-compr-compression-info-list'."(catch'compression-info(let((case-fold-searchnil))(mapcar(function(lambda(x)(and(string-match(jka-compr-info-regexpx)filename)(throw'compression-infox))))jka-compr-compression-info-list)nil)));; XEmacs change(defmacrojka-value-if-bound(symbol)`(if(boundp(quote,symbol)),symbol));; XEmacs change(define-error'compression-error"Compression error"'file-error)(defvarjka-compr-acceptable-retval-list'(02141))(defunjka-compr-error(progargsinfilemessage&optionalerrfile)(let((errbuf(get-buffer-create" *jka-compr-error*"))(curbuf(current-buffer)))(with-current-buffererrbuf(widen)(erase-buffer)(insert(format"Error while executing \"%s %s < %s\"\n\n"prog(mapconcat'identityargs" ")infile))(anderrfile(insert-file-contentserrfile)))(display-buffererrbuf))(signal'compression-error(list"Opening input file"(format"error %s"message)infile)))(defvarjka-compr-dd-program"/bin/dd")(defvarjka-compr-dd-blocksize256)(defunjka-compr-partial-uncompress(progmessageargsinfilebeglen)"Call program PROG with ARGS args taking input from INFILE.Fourth and fifth args, BEG and LEN, specify which part of the outputto keep: LEN chars starting BEG chars from the beginning."(let*((skip(/begjka-compr-dd-blocksize))(prefix(-beg(*skipjka-compr-dd-blocksize)))(count(andlen(1+(/(+lenprefix)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'identityargs" ")err-filejka-compr-dd-programjka-compr-dd-blocksizeskip;; dd seems to be unreliable about;; providing the last block. So, always;; read one more than you think you need.;; XEmacs change -- de-ebolify(ifcount(concat"count="(number-to-string(1+count)))""))))(unwind-protect(or(memq(call-processjka-compr-shellinfiletnil"-c"run-string)jka-compr-acceptable-retval-list)(jka-compr-errorprogargsinfilemessageerr-file))(jka-compr-delete-temp-fileerr-file));; Delete the stuff after what we want, if there is any.(andlen(<(+startprefixlen)(point))(delete-region(+startprefixlen)(point)));; Delete the stuff before what we want.(delete-regionstart(+startprefix))))(defunjka-compr-call-process(progmessageinfileoutputtempargs)(ifjka-compr-use-shell(let((err-file(jka-compr-make-temp-name))(coding-system-for-read(or;; XEmacs Change(jka-value-if-boundcoding-system-for-read)'undecided))(coding-system-for-write'binary))(unwind-protect(or(memq(call-processjka-compr-shellinfile(if(stringpoutput)niloutput)nil"-c"(format"%s %s 2> %s %s"prog(mapconcat'identityargs" ")err-file(if(stringpoutput)(concat"> "output)"")))jka-compr-acceptable-retval-list)(jka-compr-errorprogargsinfilemessageerr-file))(jka-compr-delete-temp-fileerr-file)))(or(zerop(apply'call-processproginfile(if(stringpoutput)tempoutput)nilargs))(jka-compr-errorprogargsinfilemessage))(and(stringpoutput)(with-current-buffertemp(write-region(point-min)(point-max)output)(erase-buffer)))));;; Support for temp files. Much of this was inspired if not lifted;;; from ange-ftp.(defcustomjka-compr-temp-name-template(expand-file-name"jka-com"(temp-directory))"Prefix added to all temp files created by jka-compr.There should be no more than seven characters after the final `/'.":type'string:group'jka-compr)(defvarjka-compr-temp-name-table(make-vector31nil))(defunjka-compr-make-temp-name(&optionallocal-copy)"This routine will return the name of a new file."(let*((lastchar?a)(prevchar?a)(template(concatjka-compr-temp-name-template"aa"))(lastpos(1-(lengthtemplate)))(not-donet)fileentry)(whilenot-done(asettemplatelastposlastchar)(setqfile(concat(make-temp-nametemplate)"#"))(setqentry(internfilejka-compr-temp-name-table))(if(or(getentry'active)(file-exists-pfile))(progn(setqlastchar(1+lastchar))(if(>lastchar?z)(progn(setqprevchar(1+prevchar))(setqlastchar?a)(if(>prevchar?z)(error"Can't allocate temp file.")(asettemplate(1-lastpos)prevchar)))))(putentry'active(notlocal-copy))(setqnot-donenil)))file))(defunjka-compr-delete-temp-file(temp)(put(interntempjka-compr-temp-name-table)'activenil)(condition-case()(delete-filetemp)(errornil)));;; 20.0-b92 change;;; Now receives both `lockname' and `codesys' from Fwrite_region_internal;;; what makes it compatible with write-region(defunjka-compr-write-region(startendfile&optionalappendvisitlocknamecoding-system)(let*((filename(expand-file-namefile))(visit-file(if(stringpvisit)(expand-file-namevisit)filename))(info(jka-compr-get-compression-infovisit-file)))(ifinfo(let((can-append(jka-compr-info-can-appendinfo))(compress-program(jka-compr-info-compress-programinfo))(compress-message(jka-compr-info-compress-messageinfo))(uncompress-program(jka-compr-info-uncompress-programinfo))(uncompress-message(jka-compr-info-uncompress-messageinfo))(compress-args(jka-compr-info-compress-argsinfo))(uncompress-args(jka-compr-info-uncompress-argsinfo))(base-name(file-name-nondirectoryvisit-file))temp-filetemp-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.;; XEmacs change: we don't have `last-coding-system-used'.;; (coding-system-used last-coding-system-used))(setqtemp-buffer(get-buffer-create" *jka-compr-wr-temp*"))(with-current-buffertemp-buffer(widen)(erase-buffer))(if(andappend(notcan-append)(file-exists-pfilename))(let*((local-copy(file-local-copyfilename))(local-file(orlocal-copyfilename)))(setqtemp-filelocal-file))(setqtemp-file(jka-compr-make-temp-name)))(andcompress-message(message"%s %s..."compress-messagebase-name))(jka-compr-run-real-handler'write-region;; XEmacs change: add lockname, c-s(liststartendtemp-filet'dontlocknamecoding-system));; save value used by the real write-region;; without any code conversion.(let((coding-system-for-read'binary))(jka-compr-call-processcompress-program(concatcompress-message" "base-name)temp-filetemp-buffernilcompress-args))(with-current-buffertemp-buffer(let((coding-system-for-write'binary))(if(memqsystem-type'(ms-doswindows-nt))(setqbuffer-file-typet))(jka-compr-run-real-handler'write-region(list(point-min)(point-max)filename(andappendcan-append)'dontlocknamecoding-system))(erase-buffer)))(jka-compr-delete-temp-filetemp-file)(andcompress-message(message"%s %s...done"compress-messagebase-name))(cond((eqvisitt)(setqbuffer-file-namefilename)(set-visited-file-modtime))((stringpvisit)(setqbuffer-file-namevisit)(let((buffer-file-namefilename))(set-visited-file-modtime))))(and(or(eqvisitt)(eqvisitnil)(stringpvisit))(message"Wrote %s"visit-file));; ensure `last-coding-system-used' has an appropriate value;; XEmacs change: don't have `last-coding-system-used';; (setq last-coding-system-used coding-system-used)nil)(jka-compr-run-real-handler'write-region(liststartendfilenameappendvisit;; XEmacs changelocknamecoding-system)))))(defunjka-compr-insert-file-contents(file&optionalvisitbegendreplace)(barf-if-buffer-read-only)(and(orbegend)visit(error"Attempt to visit less than an entire file"))(let*((filename(expand-file-namefile))(info(jka-compr-get-compression-infofilename)))(ifinfo(let((uncompress-message(jka-compr-info-uncompress-messageinfo))(uncompress-program(jka-compr-info-uncompress-programinfo))(uncompress-args(jka-compr-info-uncompress-argsinfo))(base-name(file-name-nondirectoryfilename))(notfoundnil)(local-copy(jka-compr-run-real-handler'file-local-copy(listfilename)))local-filesizestart(coding-system-for-read(or;; XEmacs change(jka-value-if-boundcoding-system-for-read)'undecided)));; XEmacs change; skip multibyte-mode crap; (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)) )(setqlocal-file(orlocal-copyfilename))(andvisit(setqbuffer-file-namefilename))(unwind-protect; to make sure local-copy gets deleted(progn(anduncompress-message(message"%s %s..."uncompress-messagebase-name))(condition-caseerror-code(progn(ifreplace(goto-char(point-min)))(setqstart(point))(if(orbegend)(jka-compr-partial-uncompressuncompress-program(concatuncompress-message" "base-name)uncompress-argslocal-file(orbeg0)(if(andbegend)(-endbeg)end));; 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(ifvisitnilbuffer-file-name)))(jka-compr-call-processuncompress-program(concatuncompress-message" "base-name)local-filetniluncompress-args)))(setqsize(-(point)start))(ifreplace(let*((del-beg(point))(del-end(+del-begsize)))(delete-regiondel-beg(mindel-end(point-max)))))(goto-charstart))(error(if(and(eq(carerror-code)'file-error)(eq(nth3error-code)local-file))(ifvisit(setqnotfounderror-code)(signal'file-error(cons"Opening input file"(nthcdr2error-code))))(signal(carerror-code)(cdrerror-code))))))(andlocal-copy(file-exists-plocal-copy)(delete-filelocal-copy)))(andvisit(progn(unlock-buffer)(setqbuffer-file-namefilename)(set-visited-file-modtime)))(anduncompress-message(message"%s %s...done"uncompress-messagebase-name))(andvisitnotfound(signal'file-error(cons"Opening input file"(nth2notfound))));; 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))))(listfilenamesize))(jka-compr-run-real-handler'insert-file-contents(listfilevisitbegendreplace)))))(defunjka-compr-file-local-copy(file)(let*((filename(expand-file-namefile))(info(jka-compr-get-compression-infofilename)))(ifinfo(let((uncompress-message(jka-compr-info-uncompress-messageinfo))(uncompress-program(jka-compr-info-uncompress-programinfo))(uncompress-args(jka-compr-info-uncompress-argsinfo))(base-name(file-name-nondirectoryfilename))(local-copy(jka-compr-run-real-handler'file-local-copy(listfilename)))(temp-file(jka-compr-make-temp-namet))(temp-buffer(get-buffer-create" *jka-compr-flc-temp*"))(notfoundnil)local-file)(setqlocal-file(orlocal-copyfilename))(unwind-protect(with-current-buffertemp-buffer(anduncompress-message(message"%s %s..."uncompress-messagebase-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;; necessary) is done by the later I/O operation;; (e.g. load).(let((coding-system-for-read'binary)(coding-system-for-write'binary))(jka-compr-call-processuncompress-program(concatuncompress-message" "base-name)local-filetniluncompress-args)(anduncompress-message(message"%s %s...done"uncompress-messagebase-name))(write-region(point-min)(point-max)temp-filenil'dont)))(andlocal-copy(file-exists-plocal-copy)(delete-filelocal-copy))(kill-buffertemp-buffer))temp-file)(jka-compr-run-real-handler'file-local-copy(listfilename)))));;; Support for loading compressed files.;;; XEmacs: autoload this function;;;###autoload(defunjka-compr-load(file&optionalnoerrornomessagenosuffix)"Documented as original."(let*((local-copy(jka-compr-file-local-copyfile))(load-file(orlocal-copyfile)))(unwind-protect(let(inhibit-file-name-operationinhibit-file-name-handlers)(ornomessage(message"Loading %s..."file))(let((load-force-doc-stringst))(loadload-filenoerrortt))(ornomessage(message"Loading %s...done."file)))(jka-compr-delete-temp-filelocal-copy))t))(defunjka-compr-byte-compiler-base-file-name(file)(let((info(jka-compr-get-compression-infofile)))(if(andinfo(jka-compr-info-strip-extensioninfo))(save-match-data(substringfile0(string-match(jka-compr-info-regexpinfo)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)(defvarjka-compr-inhibitnil"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.")(defunjka-compr-handler(operation&restargs)(save-match-data(let((jka-op(getoperation'jka-compr)))(if(andjka-op(notjka-compr-inhibit))(applyjka-opargs)(jka-compr-run-real-handleroperationargs)))));; If we are given an operation that we don't handle,;; call the Emacs primitive for that operation,;; and manipulate the inhibit variables;; to prevent the primitive from calling our handler again.(defunjka-compr-run-real-handler(operationargs)(let((inhibit-file-name-handlers(cons'jka-compr-handler(and(eqinhibit-file-name-operationoperation)inhibit-file-name-handlers)))(inhibit-file-name-operationoperation))(applyoperationargs)));;;###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 (require 'jka-compr));;;###autoload (toggle-auto-compression arg t));; XEmacs: autoload this function;;;###autoload(defuntoggle-auto-compression(&optionalargmessage)"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 messagesaying whether the mode is now on or off."(interactive"P\np")(let*((installed(jka-compr-installed-p))(flag(if(nullarg)(notinstalled)(or(eqargt)(listparg)(and(integerparg)(>arg0))))))(cond((andflaginstalled)t); already installed((and(notflag)(notinstalled))nil); already not installed(flag(jka-compr-install))(t(jka-compr-uninstall)))(andmessage(ifflag(message"Automatic file (de)compression is now ON.")(message"Automatic file (de)compression is now OFF.")))flag))(defunjka-compr-build-file-regexp()(concat"\\("(mapconcat'jka-compr-info-regexpjka-compr-compression-info-list"\\)\\|\\(")"\\)"));;; XEmacs:;;;###autoload(defunjka-compr-install()"Install jka-compr.This adds entries to `file-name-handler-alist' and `auto-mode-alist'and `inhibit-first-line-modes-suffixes'."(setqjka-compr-file-name-handler-entry(cons(jka-compr-build-file-regexp)'jka-compr-handler))(setqfile-name-handler-alist(consjka-compr-file-name-handler-entryfile-name-handler-alist))(when(boundp'file-coding-system-alist)(setqjka-compr-added-to-file-coding-system-alistnil))(mapcar(function(lambda(x);; Don't do multibyte encoding on the compressed files.(when(boundp'file-coding-system-alist)(let((elt(cons(jka-compr-info-regexpx)'(binary.binary))))(setqfile-coding-system-alist(conseltfile-coding-system-alist))(setqjka-compr-added-to-file-coding-system-alist(conseltjka-compr-added-to-file-coding-system-alist))))(and(jka-compr-info-strip-extensionx);; Make entries in auto-mode-alist so that modes;; are chosen right according to the file names;; sans `.gz'.(setqauto-mode-alist(cons(list(jka-compr-info-regexpx)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.;; XEmacs: the (now)superfluous conditional doesn't hurt(and(boundp'inhibit-first-line-modes-suffixes)(setqinhibit-first-line-modes-suffixes(cons(jka-compr-info-regexpx)inhibit-first-line-modes-suffixes))))))jka-compr-compression-info-list)(setqauto-mode-alist(appendauto-mode-alistjka-compr-mode-alist-additions)))(defunjka-compr-uninstall()"Uninstall jka-compr.This removes the entries in `file-name-handler-alist' and `auto-mode-alist'and `inhibit-first-line-modes-suffixes' that were addedby `jka-compr-installed'.";; Delete from inhibit-first-line-modes-suffixes;; what jka-compr-install added.(mapcar(function(lambda(x)(and(jka-compr-info-strip-extensionx);; XEmacs: the (now)superfluous conditional doesn't hurt(and(boundp'inhibit-first-line-modes-suffixes)(setqinhibit-first-line-modes-suffixes(delete(jka-compr-info-regexpx)inhibit-first-line-modes-suffixes))))))jka-compr-compression-info-list)(let*((fnha(consnilfile-name-handler-alist))(lastfnha))(while(cdrlast)(if(eq(cdr(car(cdrlast)))'jka-compr-handler)(setcdrlast(cdr(cdrlast)))(setqlast(cdrlast))))(setqfile-name-handler-alist(cdrfnha)))(let*((ama(consnilauto-mode-alist))(lastama)entry)(while(cdrlast)(setqentry(car(cdrlast)))(if(or(memberentryjka-compr-mode-alist-additions)(and(consp(cdrentry))(eq(nth2entry)'jka-compr)))(setcdrlast(cdr(cdrlast)))(setqlast(cdrlast))))(setqauto-mode-alist(cdrama)))(when(boundp'file-coding-system-alist)(let*((ama(consnilfile-coding-system-alist))(lastama)entry)(while(cdrlast)(setqentry(car(cdrlast)))(if(memberentryjka-compr-added-to-file-coding-system-alist)(setcdrlast(cdr(cdrlast)))(setqlast(cdrlast))))(setqfile-coding-system-alist(cdrama)))))(defunjka-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((fnhafile-name-handler-alist)(installednil))(while(andfnha(notinstalled))(and(eq(cdr(carfnha))'jka-compr-handler)(setqinstalled(carfnha)))(setqfnha(cdrfnha)))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.;; No no no no!;(and (jka-compr-installed-p); (jka-compr-uninstall));; No no no no!;(jka-compr-install)(provide'jka-compr);; jka-compr.el ends here.