1995-10-30 17:35:01 +00:00
|
|
|
|
;;; jka-compr.el --- reading/writing/loading compressed files
|
|
|
|
|
|
2011-01-25 04:08:28 +00:00
|
|
|
|
;; Copyright (C) 1993-1995, 1997, 1999-2011 Free Software Foundation, Inc.
|
1994-02-18 22:50:05 +00:00
|
|
|
|
|
|
|
|
|
;; Author: jka@ece.cmu.edu (Jay K. Adams)
|
1997-05-27 17:46:19 +00:00
|
|
|
|
;; Maintainer: FSF
|
1994-02-18 22:50:05 +00:00
|
|
|
|
;; Keywords: data
|
|
|
|
|
|
1995-11-11 20:29:31 +00:00
|
|
|
|
;; This file is part of GNU Emacs.
|
|
|
|
|
|
2008-05-06 08:06:51 +00:00
|
|
|
|
;; GNU Emacs is free software: you can redistribute it and/or modify
|
1995-11-11 20:29:31 +00:00
|
|
|
|
;; it under the terms of the GNU General Public License as published by
|
2008-05-06 08:06:51 +00:00
|
|
|
|
;; the Free Software Foundation, either version 3 of the License, or
|
|
|
|
|
;; (at your option) any later version.
|
1995-11-11 20:29:31 +00:00
|
|
|
|
|
|
|
|
|
;; 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
|
2008-05-06 08:06:51 +00:00
|
|
|
|
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
1995-11-11 20:29:31 +00:00
|
|
|
|
|
2001-07-15 16:15:35 +00:00
|
|
|
|
;;; Commentary:
|
1994-02-18 22:50:05 +00:00
|
|
|
|
|
1996-01-14 07:34:30 +00:00
|
|
|
|
;; 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:
|
|
|
|
|
;;
|
2000-10-15 11:21:33 +00:00
|
|
|
|
;; 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).
|
1996-01-14 07:34:30 +00:00
|
|
|
|
;;
|
|
|
|
|
;; 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 don't want messages about compressing and decompressing
|
2007-01-27 11:55:59 +00:00
|
|
|
|
;; to show up in the echo area, you can set the compress-msg and
|
|
|
|
|
;; decompress-msg fields of the jka-compr-compression-info-list to
|
1996-01-14 07:34:30 +00:00
|
|
|
|
;; nil.
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;; APPLICATION NOTES:
|
|
|
|
|
;;
|
|
|
|
|
;; crypt++
|
2002-06-09 17:13:56 +00:00
|
|
|
|
;; jka-compr can coexist with crypt++ if you take all the decompression
|
1996-01-14 07:34:30 +00:00
|
|
|
|
;; 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
|
2003-02-04 12:29:42 +00:00
|
|
|
|
;;
|
1996-01-14 07:34:30 +00:00
|
|
|
|
;; jka-compr is a V19 adaptation of jka-compr for V18 of Emacs. Many people
|
2003-02-04 12:29:42 +00:00
|
|
|
|
;; have made helpful suggestions, reported bugs, and even fixed bugs in
|
1996-01-14 07:34:30 +00:00
|
|
|
|
;; 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.
|
|
|
|
|
;;
|
1994-02-18 22:50:05 +00:00
|
|
|
|
|
|
|
|
|
;;; Code:
|
|
|
|
|
|
2005-11-11 02:54:08 +00:00
|
|
|
|
(require 'jka-cmpr-hook)
|
|
|
|
|
|
1997-04-12 03:18:33 +00:00
|
|
|
|
(defcustom jka-compr-shell "sh"
|
2008-12-03 05:48:14 +00:00
|
|
|
|
"Shell to be used for calling compression programs.
|
2007-01-27 11:55:59 +00:00
|
|
|
|
NOTE: Not used in MS-DOS and Windows systems."
|
1997-04-12 03:18:33 +00:00
|
|
|
|
:type 'string
|
|
|
|
|
:group 'jka-compr)
|
1994-02-18 22:50:05 +00:00
|
|
|
|
|
2011-07-13 13:25:29 +00:00
|
|
|
|
(defcustom jka-compr-verbose t
|
|
|
|
|
"If non-nil, output messages whenever compressing or uncompressing files."
|
|
|
|
|
:type 'boolean
|
|
|
|
|
:group 'jka-compr)
|
|
|
|
|
|
2003-02-04 12:29:42 +00:00
|
|
|
|
(defvar jka-compr-use-shell
|
1998-04-17 21:17:21 +00:00
|
|
|
|
(not (memq system-type '(ms-dos windows-nt))))
|
1994-02-18 22:50:05 +00:00
|
|
|
|
|
1999-12-25 23:00:57 +00:00
|
|
|
|
(defvar jka-compr-really-do-compress nil
|
2005-03-21 17:44:27 +00:00
|
|
|
|
"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)
|
1999-12-25 23:00:57 +00:00
|
|
|
|
(put 'jka-compr-really-do-compress 'permanent-local t)
|
1994-05-22 07:59:39 +00:00
|
|
|
|
|
1994-02-18 22:50:05 +00:00
|
|
|
|
|
|
|
|
|
(put 'compression-error 'error-conditions '(compression-error file-error error))
|
|
|
|
|
|
|
|
|
|
|
1995-05-01 05:23:49 +00:00
|
|
|
|
(defvar jka-compr-acceptable-retval-list '(0 2 141))
|
1994-02-18 22:50:05 +00:00
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun jka-compr-error (prog args infile message &optional errfile)
|
|
|
|
|
|
2005-11-11 02:54:08 +00:00
|
|
|
|
(let ((errbuf (get-buffer-create " *jka-compr-error*")))
|
1997-01-27 02:40:00 +00:00
|
|
|
|
(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)))
|
1994-02-18 22:50:05 +00:00
|
|
|
|
(display-buffer errbuf))
|
|
|
|
|
|
1997-01-27 02:40:00 +00:00
|
|
|
|
(signal 'compression-error
|
|
|
|
|
(list "Opening input file" (format "error %s" message) infile)))
|
2003-02-04 12:29:42 +00:00
|
|
|
|
|
|
|
|
|
|
2001-11-06 17:14:53 +00:00
|
|
|
|
(defcustom jka-compr-dd-program "/bin/dd"
|
|
|
|
|
"How to invoke `dd'."
|
|
|
|
|
:type 'string
|
|
|
|
|
:group 'jka-compr)
|
1994-02-18 22:50:05 +00:00
|
|
|
|
|
|
|
|
|
|
1994-02-23 16:18:10 +00:00
|
|
|
|
(defvar jka-compr-dd-blocksize 256)
|
1994-02-18 22:50:05 +00:00
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun jka-compr-partial-uncompress (prog message args infile beg len)
|
|
|
|
|
"Call program PROG with ARGS args taking input from INFILE.
|
|
|
|
|
Fourth and fifth args, BEG and LEN, specify which part of the output
|
1994-06-26 16:10:41 +00:00
|
|
|
|
to keep: LEN chars starting BEG chars from the beginning."
|
2001-11-06 17:14:53 +00:00
|
|
|
|
(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))
|
2007-01-29 02:51:41 +00:00
|
|
|
|
;; call-process barfs if default-directory is inaccessible.
|
|
|
|
|
(default-directory
|
|
|
|
|
(if (and default-directory
|
|
|
|
|
(file-accessible-directory-p default-directory))
|
|
|
|
|
default-directory
|
|
|
|
|
(file-name-directory infile)))
|
2001-11-06 17:14:53 +00:00
|
|
|
|
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"
|
2011-01-15 20:03:38 +00:00
|
|
|
|
;; Windows shells need the program file name
|
|
|
|
|
;; after the pipe symbol be quoted if they use
|
|
|
|
|
;; forward slashes as directory separators.
|
2001-11-06 17:14:53 +00:00
|
|
|
|
(format
|
2011-01-15 20:03:38 +00:00
|
|
|
|
"%s %s 2> %s | \"%s\" bs=%d skip=%d %s 2> %s"
|
2001-11-06 17:14:53 +00:00
|
|
|
|
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.
|
2001-12-21 12:43:55 +00:00
|
|
|
|
(if count (format "count=%d" (1+ count)) "")
|
|
|
|
|
null-device))
|
2001-11-06 17:14:53 +00:00
|
|
|
|
jka-compr-acceptable-retval-list)
|
|
|
|
|
(jka-compr-error prog args infile message err-file))
|
Change delete-by-moving-to-trash so Lisp calls explicitly request trashing.
* src/fileio.c (Fdelete_file): Change meaning of optional arg to mean
whether to trash.
(internal_delete_file, Frename_file): Callers changed.
(delete_by_moving_to_trash): Doc fix.
(Fdelete_directory_internal): Don't move to trash.
* src/callproc.c (delete_temp_file):
* src/buffer.c (Fkill_buffer): Callers changed.
* src/lisp.h: Update prototype.
* lisp/diff.el (diff-sentinel):
* lisp/epg.el (epg--make-temp-file, epg-decrypt-string)
(epg-verify-string, epg-sign-string, epg-encrypt-string):
* lisp/jka-compr.el (jka-compr-partial-uncompress)
(jka-compr-call-process, jka-compr-write-region):
* lisp/server.el (server-sentinel): Remove optional arg from
delete-file, reverting 2010-05-03 change.
* lisp/dired.el (dired-delete-file): New arg TRASH.
(dired-internal-do-deletions): New arg TRASH. Use progress
reporter.
(dired-do-flagged-delete, dired-do-delete): Use trash.
* lisp/files.el (delete-directory): New arg TRASH.
* lisp/speedbar.el (speedbar-item-delete): Allow trashing.
* lisp/net/ange-ftp.el (ange-ftp-del-tmp-name, ange-ftp-delete-file)
(ange-ftp-rename-remote-to-remote)
(ange-ftp-rename-local-to-remote)
(ange-ftp-rename-remote-to-local, ange-ftp-load)
(ange-ftp-compress, ange-ftp-uncompress): Remove optional arg from
`delete-file'.
(ange-ftp-delete-directory): Add optional arg to `delete-file', to
allow trashing.
* lisp/net/tramp-compat.el (tramp-compat-delete-file): Rewrite to
handle new TRASH arg of `delete-file'.
* lisp/net/tramp-fish.el (tramp-fish-handle-delete-directory)
(tramp-fish-handle-delete-file)
(tramp-fish-handle-make-symbolic-link)
(tramp-fish-handle-process-file): Use null TRASH arg in
`tramp-compat-delete-file' call.
* lisp/net/tramp-ftp.el (tramp-ftp-file-name-handler): Use null TRASH
arg in `tramp-compat-delete-file' call.
* lisp/net/tramp-gvfs.el (tramp-gvfs-handle-delete-file): Rename arg.
(tramp-gvfs-handle-write-region): Use null TRASH arg in
`tramp-compat-delete-file' call.
* lisp/net/tramp-imap.el (tramp-imap-handle-delete-file): Rename arg.
(tramp-imap-do-copy-or-rename-file): Use null TRASH arg in
`tramp-compat-delete-file' call.
* lisp/net/tramp-smb.el (tramp-smb-handle-copy-file)
(tramp-smb-handle-file-local-copy, tramp-smb-handle-rename-file)
(tramp-smb-handle-write-region): Use null TRASH arg in
tramp-compat-delete-file call.
(tramp-smb-handle-delete-directory): Use tramp-compat-delete-file.
(tramp-smb-handle-delete-file): Rename arg.
* lisp/net/tramp.el (tramp-handle-delete-file): Change FORCE arg to TRASH.
(tramp-handle-make-symbolic-link, tramp-handle-load)
(tramp-do-copy-or-rename-file-via-buffer)
(tramp-do-copy-or-rename-file-directly)
(tramp-do-copy-or-rename-file-out-of-band)
(tramp-handle-process-file, tramp-handle-call-process-region)
(tramp-handle-shell-command, tramp-handle-file-local-copy)
(tramp-handle-insert-file-contents, tramp-handle-write-region)
(tramp-delete-temp-file-function): Use null TRASH arg in
tramp-compat-delete-file call.
2010-05-27 23:30:11 +00:00
|
|
|
|
(delete-file err-file)))
|
2010-05-01 02:19:40 +00:00
|
|
|
|
|
2001-11-06 17:14:53 +00:00
|
|
|
|
;; 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))
|
1994-02-18 22:50:05 +00:00
|
|
|
|
|
1994-06-26 16:10:41 +00:00
|
|
|
|
;; Delete the stuff after what we want, if there is any.
|
1994-02-18 22:50:05 +00:00
|
|
|
|
(and
|
1994-02-23 16:18:10 +00:00
|
|
|
|
len
|
1994-06-26 16:10:41 +00:00
|
|
|
|
(< (+ start prefix len) (point))
|
1994-02-23 16:18:10 +00:00
|
|
|
|
(delete-region (+ start prefix len) (point)))
|
1994-02-18 22:50:05 +00:00
|
|
|
|
|
1994-06-26 16:10:41 +00:00
|
|
|
|
;; Delete the stuff before what we want.
|
1994-02-18 22:50:05 +00:00
|
|
|
|
(delete-region start (+ start prefix))))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun jka-compr-call-process (prog message infile output temp args)
|
2007-01-29 02:51:41 +00:00
|
|
|
|
;; call-process barfs if default-directory is inaccessible.
|
|
|
|
|
(let ((default-directory
|
|
|
|
|
(if (and default-directory
|
|
|
|
|
(file-accessible-directory-p default-directory))
|
|
|
|
|
default-directory
|
|
|
|
|
(file-name-directory infile))))
|
|
|
|
|
(if jka-compr-use-shell
|
|
|
|
|
(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
|
|
|
|
|
(call-process jka-compr-shell infile
|
|
|
|
|
(if (stringp output) nil output)
|
|
|
|
|
nil
|
|
|
|
|
"-c"
|
|
|
|
|
(format "%s %s 2> %s %s"
|
|
|
|
|
prog
|
|
|
|
|
(mapconcat 'identity args " ")
|
|
|
|
|
err-file
|
|
|
|
|
(if (stringp output)
|
|
|
|
|
(concat "> " output)
|
|
|
|
|
"")))
|
|
|
|
|
jka-compr-acceptable-retval-list)
|
|
|
|
|
(jka-compr-error prog args infile message err-file))
|
Change delete-by-moving-to-trash so Lisp calls explicitly request trashing.
* src/fileio.c (Fdelete_file): Change meaning of optional arg to mean
whether to trash.
(internal_delete_file, Frename_file): Callers changed.
(delete_by_moving_to_trash): Doc fix.
(Fdelete_directory_internal): Don't move to trash.
* src/callproc.c (delete_temp_file):
* src/buffer.c (Fkill_buffer): Callers changed.
* src/lisp.h: Update prototype.
* lisp/diff.el (diff-sentinel):
* lisp/epg.el (epg--make-temp-file, epg-decrypt-string)
(epg-verify-string, epg-sign-string, epg-encrypt-string):
* lisp/jka-compr.el (jka-compr-partial-uncompress)
(jka-compr-call-process, jka-compr-write-region):
* lisp/server.el (server-sentinel): Remove optional arg from
delete-file, reverting 2010-05-03 change.
* lisp/dired.el (dired-delete-file): New arg TRASH.
(dired-internal-do-deletions): New arg TRASH. Use progress
reporter.
(dired-do-flagged-delete, dired-do-delete): Use trash.
* lisp/files.el (delete-directory): New arg TRASH.
* lisp/speedbar.el (speedbar-item-delete): Allow trashing.
* lisp/net/ange-ftp.el (ange-ftp-del-tmp-name, ange-ftp-delete-file)
(ange-ftp-rename-remote-to-remote)
(ange-ftp-rename-local-to-remote)
(ange-ftp-rename-remote-to-local, ange-ftp-load)
(ange-ftp-compress, ange-ftp-uncompress): Remove optional arg from
`delete-file'.
(ange-ftp-delete-directory): Add optional arg to `delete-file', to
allow trashing.
* lisp/net/tramp-compat.el (tramp-compat-delete-file): Rewrite to
handle new TRASH arg of `delete-file'.
* lisp/net/tramp-fish.el (tramp-fish-handle-delete-directory)
(tramp-fish-handle-delete-file)
(tramp-fish-handle-make-symbolic-link)
(tramp-fish-handle-process-file): Use null TRASH arg in
`tramp-compat-delete-file' call.
* lisp/net/tramp-ftp.el (tramp-ftp-file-name-handler): Use null TRASH
arg in `tramp-compat-delete-file' call.
* lisp/net/tramp-gvfs.el (tramp-gvfs-handle-delete-file): Rename arg.
(tramp-gvfs-handle-write-region): Use null TRASH arg in
`tramp-compat-delete-file' call.
* lisp/net/tramp-imap.el (tramp-imap-handle-delete-file): Rename arg.
(tramp-imap-do-copy-or-rename-file): Use null TRASH arg in
`tramp-compat-delete-file' call.
* lisp/net/tramp-smb.el (tramp-smb-handle-copy-file)
(tramp-smb-handle-file-local-copy, tramp-smb-handle-rename-file)
(tramp-smb-handle-write-region): Use null TRASH arg in
tramp-compat-delete-file call.
(tramp-smb-handle-delete-directory): Use tramp-compat-delete-file.
(tramp-smb-handle-delete-file): Rename arg.
* lisp/net/tramp.el (tramp-handle-delete-file): Change FORCE arg to TRASH.
(tramp-handle-make-symbolic-link, tramp-handle-load)
(tramp-do-copy-or-rename-file-via-buffer)
(tramp-do-copy-or-rename-file-directly)
(tramp-do-copy-or-rename-file-out-of-band)
(tramp-handle-process-file, tramp-handle-call-process-region)
(tramp-handle-shell-command, tramp-handle-file-local-copy)
(tramp-handle-insert-file-contents, tramp-handle-write-region)
(tramp-delete-temp-file-function): Use null TRASH arg in
tramp-compat-delete-file call.
2010-05-27 23:30:11 +00:00
|
|
|
|
(delete-file err-file)))
|
2007-01-29 02:51:41 +00:00
|
|
|
|
(or (eq 0
|
|
|
|
|
(apply 'call-process
|
|
|
|
|
prog infile (if (stringp output) temp output)
|
|
|
|
|
nil args))
|
|
|
|
|
(jka-compr-error prog args infile message))
|
|
|
|
|
(and (stringp output)
|
|
|
|
|
(with-current-buffer temp
|
|
|
|
|
(write-region (point-min) (point-max) output)
|
|
|
|
|
(erase-buffer))))))
|
1994-02-18 22:50:05 +00:00
|
|
|
|
|
|
|
|
|
|
2005-11-11 02:54:08 +00:00
|
|
|
|
;; Support for temp files. Much of this was inspired if not lifted
|
|
|
|
|
;; from ange-ftp.
|
1994-02-18 22:50:05 +00:00
|
|
|
|
|
1997-04-12 03:18:33 +00:00
|
|
|
|
(defcustom jka-compr-temp-name-template
|
1998-05-16 17:50:00 +00:00
|
|
|
|
(expand-file-name "jka-com" temporary-file-directory)
|
1997-04-13 23:43:42 +00:00
|
|
|
|
"Prefix added to all temp files created by jka-compr.
|
1997-04-12 03:18:33 +00:00
|
|
|
|
There should be no more than seven characters after the final `/'."
|
|
|
|
|
:type 'string
|
|
|
|
|
:group 'jka-compr)
|
1994-02-18 22:50:05 +00:00
|
|
|
|
|
2011-04-19 13:44:55 +00:00
|
|
|
|
(defun jka-compr-make-temp-name (&optional _local-copy)
|
1994-02-18 22:50:05 +00:00
|
|
|
|
"This routine will return the name of a new file."
|
1999-10-15 16:03:59 +00:00
|
|
|
|
(make-temp-file jka-compr-temp-name-template))
|
|
|
|
|
|
1994-02-18 22:50:05 +00:00
|
|
|
|
(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))
|
1999-12-25 23:00:57 +00:00
|
|
|
|
(info (jka-compr-get-compression-info visit-file))
|
|
|
|
|
(magic (and info (jka-compr-info-file-magic-bytes info))))
|
|
|
|
|
|
|
|
|
|
;; 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
|
2008-05-28 17:35:34 +00:00
|
|
|
|
(or (null start)
|
|
|
|
|
(= (- end start) (buffer-size))))
|
1999-12-25 23:00:57 +00:00
|
|
|
|
(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)))
|
2008-05-28 17:37:04 +00:00
|
|
|
|
(let* ((from (or start (point-min)))
|
|
|
|
|
(to (min (or end (point-max))
|
|
|
|
|
(+ from (length magic)))))
|
2008-05-28 17:35:34 +00:00
|
|
|
|
(buffer-substring from to)))
|
1999-12-25 23:00:57 +00:00
|
|
|
|
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))
|
|
|
|
|
|
2004-03-23 07:38:04 +00:00
|
|
|
|
(or compress-program
|
|
|
|
|
(error "No compression program defined"))
|
|
|
|
|
|
1999-12-25 23:00:57 +00:00
|
|
|
|
(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)))
|
|
|
|
|
|
2003-02-04 12:29:42 +00:00
|
|
|
|
(and
|
1999-12-25 23:00:57 +00:00
|
|
|
|
compress-message
|
2011-07-13 13:25:29 +00:00
|
|
|
|
jka-compr-verbose
|
1999-12-25 23:00:57 +00:00
|
|
|
|
(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)) )
|
|
|
|
|
|
Change delete-by-moving-to-trash so Lisp calls explicitly request trashing.
* src/fileio.c (Fdelete_file): Change meaning of optional arg to mean
whether to trash.
(internal_delete_file, Frename_file): Callers changed.
(delete_by_moving_to_trash): Doc fix.
(Fdelete_directory_internal): Don't move to trash.
* src/callproc.c (delete_temp_file):
* src/buffer.c (Fkill_buffer): Callers changed.
* src/lisp.h: Update prototype.
* lisp/diff.el (diff-sentinel):
* lisp/epg.el (epg--make-temp-file, epg-decrypt-string)
(epg-verify-string, epg-sign-string, epg-encrypt-string):
* lisp/jka-compr.el (jka-compr-partial-uncompress)
(jka-compr-call-process, jka-compr-write-region):
* lisp/server.el (server-sentinel): Remove optional arg from
delete-file, reverting 2010-05-03 change.
* lisp/dired.el (dired-delete-file): New arg TRASH.
(dired-internal-do-deletions): New arg TRASH. Use progress
reporter.
(dired-do-flagged-delete, dired-do-delete): Use trash.
* lisp/files.el (delete-directory): New arg TRASH.
* lisp/speedbar.el (speedbar-item-delete): Allow trashing.
* lisp/net/ange-ftp.el (ange-ftp-del-tmp-name, ange-ftp-delete-file)
(ange-ftp-rename-remote-to-remote)
(ange-ftp-rename-local-to-remote)
(ange-ftp-rename-remote-to-local, ange-ftp-load)
(ange-ftp-compress, ange-ftp-uncompress): Remove optional arg from
`delete-file'.
(ange-ftp-delete-directory): Add optional arg to `delete-file', to
allow trashing.
* lisp/net/tramp-compat.el (tramp-compat-delete-file): Rewrite to
handle new TRASH arg of `delete-file'.
* lisp/net/tramp-fish.el (tramp-fish-handle-delete-directory)
(tramp-fish-handle-delete-file)
(tramp-fish-handle-make-symbolic-link)
(tramp-fish-handle-process-file): Use null TRASH arg in
`tramp-compat-delete-file' call.
* lisp/net/tramp-ftp.el (tramp-ftp-file-name-handler): Use null TRASH
arg in `tramp-compat-delete-file' call.
* lisp/net/tramp-gvfs.el (tramp-gvfs-handle-delete-file): Rename arg.
(tramp-gvfs-handle-write-region): Use null TRASH arg in
`tramp-compat-delete-file' call.
* lisp/net/tramp-imap.el (tramp-imap-handle-delete-file): Rename arg.
(tramp-imap-do-copy-or-rename-file): Use null TRASH arg in
`tramp-compat-delete-file' call.
* lisp/net/tramp-smb.el (tramp-smb-handle-copy-file)
(tramp-smb-handle-file-local-copy, tramp-smb-handle-rename-file)
(tramp-smb-handle-write-region): Use null TRASH arg in
tramp-compat-delete-file call.
(tramp-smb-handle-delete-directory): Use tramp-compat-delete-file.
(tramp-smb-handle-delete-file): Rename arg.
* lisp/net/tramp.el (tramp-handle-delete-file): Change FORCE arg to TRASH.
(tramp-handle-make-symbolic-link, tramp-handle-load)
(tramp-do-copy-or-rename-file-via-buffer)
(tramp-do-copy-or-rename-file-directly)
(tramp-do-copy-or-rename-file-out-of-band)
(tramp-handle-process-file, tramp-handle-call-process-region)
(tramp-handle-shell-command, tramp-handle-file-local-copy)
(tramp-handle-insert-file-contents, tramp-handle-write-region)
(tramp-delete-temp-file-function): Use null TRASH arg in
tramp-compat-delete-file call.
2010-05-27 23:30:11 +00:00
|
|
|
|
(delete-file temp-file)
|
1994-02-18 22:50:05 +00:00
|
|
|
|
|
1999-12-25 23:00:57 +00:00
|
|
|
|
(and
|
|
|
|
|
compress-message
|
2011-07-13 13:25:29 +00:00
|
|
|
|
jka-compr-verbose
|
1999-12-25 23:00:57 +00:00
|
|
|
|
(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))))
|
|
|
|
|
|
|
|
|
|
(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)
|
|
|
|
|
|
|
|
|
|
nil)
|
2003-02-04 12:29:42 +00:00
|
|
|
|
|
1999-12-25 23:00:57 +00:00
|
|
|
|
(jka-compr-run-real-handler 'write-region
|
|
|
|
|
(list start end filename append visit)))))
|
1994-02-18 22:50:05 +00:00
|
|
|
|
|
|
|
|
|
|
1994-03-05 23:28:35 +00:00
|
|
|
|
(defun jka-compr-insert-file-contents (file &optional visit beg end replace)
|
1994-02-18 22:50:05 +00:00
|
|
|
|
(barf-if-buffer-read-only)
|
|
|
|
|
|
|
|
|
|
(and (or beg end)
|
|
|
|
|
visit
|
|
|
|
|
(error "Attempt to visit less than an entire file"))
|
|
|
|
|
|
|
|
|
|
(let* ((filename (expand-file-name file))
|
|
|
|
|
(info (jka-compr-get-compression-info filename)))
|
|
|
|
|
|
2008-04-03 20:02:47 +00:00
|
|
|
|
(if (not info)
|
|
|
|
|
|
|
|
|
|
(jka-compr-run-real-handler 'insert-file-contents
|
|
|
|
|
(list file visit beg end replace))
|
|
|
|
|
|
|
|
|
|
(let ((uncompress-message (jka-compr-info-uncompress-message info))
|
|
|
|
|
(uncompress-program (jka-compr-info-uncompress-program info))
|
|
|
|
|
(uncompress-args (jka-compr-info-uncompress-args info))
|
|
|
|
|
(base-name (file-name-nondirectory filename))
|
|
|
|
|
(notfound nil)
|
|
|
|
|
(local-copy
|
|
|
|
|
(jka-compr-run-real-handler 'file-local-copy (list filename)))
|
|
|
|
|
local-file
|
|
|
|
|
size start)
|
|
|
|
|
|
|
|
|
|
(setq local-file (or local-copy filename))
|
|
|
|
|
|
|
|
|
|
(and
|
|
|
|
|
visit
|
|
|
|
|
(setq buffer-file-name filename))
|
|
|
|
|
|
|
|
|
|
(unwind-protect ; to make sure local-copy gets deleted
|
|
|
|
|
|
|
|
|
|
(progn
|
|
|
|
|
|
|
|
|
|
(and
|
|
|
|
|
uncompress-message
|
2011-07-13 13:25:29 +00:00
|
|
|
|
jka-compr-verbose
|
2008-04-03 20:02:47 +00:00
|
|
|
|
(message "%s %s..." uncompress-message base-name))
|
|
|
|
|
|
|
|
|
|
(condition-case error-code
|
|
|
|
|
|
|
|
|
|
(let ((coding-system-for-read 'no-conversion))
|
|
|
|
|
(if replace
|
|
|
|
|
(goto-char (point-min)))
|
|
|
|
|
(setq start (point))
|
|
|
|
|
(if (or beg end)
|
|
|
|
|
(jka-compr-partial-uncompress uncompress-program
|
|
|
|
|
(concat uncompress-message
|
|
|
|
|
" " base-name)
|
|
|
|
|
uncompress-args
|
|
|
|
|
local-file
|
|
|
|
|
(or beg 0)
|
|
|
|
|
(if (and beg end)
|
|
|
|
|
(- end beg)
|
|
|
|
|
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
|
|
|
|
|
(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
|
|
|
|
|
(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
|
|
|
|
|
(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
|
|
|
|
|
local-copy
|
|
|
|
|
(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
|
2011-07-13 13:25:29 +00:00
|
|
|
|
jka-compr-verbose
|
2008-04-03 20:02:47 +00:00
|
|
|
|
(message "%s %s...done" uncompress-message base-name))
|
|
|
|
|
|
|
|
|
|
(and
|
|
|
|
|
visit
|
|
|
|
|
notfound
|
|
|
|
|
(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))))
|
|
|
|
|
|
|
|
|
|
(or (jka-compr-info-compress-program info)
|
|
|
|
|
(message "You can't save this buffer because compression program is not defined"))
|
|
|
|
|
|
|
|
|
|
(list filename size)))))
|
1994-02-18 22:50:05 +00:00
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defun jka-compr-file-local-copy (file)
|
|
|
|
|
(let* ((filename (expand-file-name file))
|
|
|
|
|
(info (jka-compr-get-compression-info filename)))
|
|
|
|
|
|
|
|
|
|
(if info
|
|
|
|
|
|
|
|
|
|
(let ((uncompress-message (jka-compr-info-uncompress-message info))
|
|
|
|
|
(uncompress-program (jka-compr-info-uncompress-program info))
|
|
|
|
|
(uncompress-args (jka-compr-info-uncompress-args info))
|
|
|
|
|
(base-name (file-name-nondirectory filename))
|
1994-06-20 18:30:06 +00:00
|
|
|
|
(local-copy
|
|
|
|
|
(jka-compr-run-real-handler 'file-local-copy (list filename)))
|
1994-02-18 22:50:05 +00:00
|
|
|
|
(temp-file (jka-compr-make-temp-name t))
|
1995-05-01 05:23:49 +00:00
|
|
|
|
(temp-buffer (get-buffer-create " *jka-compr-flc-temp*"))
|
1994-02-18 22:50:05 +00:00
|
|
|
|
local-file)
|
|
|
|
|
|
|
|
|
|
(setq local-file (or local-copy filename))
|
|
|
|
|
|
|
|
|
|
(unwind-protect
|
|
|
|
|
|
1997-01-27 02:40:00 +00:00
|
|
|
|
(with-current-buffer temp-buffer
|
2003-02-04 12:29:42 +00:00
|
|
|
|
|
1994-02-18 22:50:05 +00:00
|
|
|
|
(and
|
|
|
|
|
uncompress-message
|
2011-07-13 13:25:29 +00:00
|
|
|
|
jka-compr-verbose
|
1994-02-18 22:50:05 +00:00
|
|
|
|
(message "%s %s..." uncompress-message base-name))
|
2003-02-04 12:29:42 +00:00
|
|
|
|
|
1997-07-22 03:45:44 +00:00
|
|
|
|
;; 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
|
2011-07-13 13:25:29 +00:00
|
|
|
|
jka-compr-verbose
|
1997-07-22 03:45:44 +00:00
|
|
|
|
(message "%s %s...done" uncompress-message base-name))
|
|
|
|
|
|
|
|
|
|
(write-region
|
|
|
|
|
(point-min) (point-max) temp-file nil 'dont)))
|
1994-02-18 22:50:05 +00:00
|
|
|
|
|
|
|
|
|
(and
|
|
|
|
|
local-copy
|
|
|
|
|
(file-exists-p local-copy)
|
|
|
|
|
(delete-file local-copy))
|
|
|
|
|
|
|
|
|
|
(kill-buffer temp-buffer))
|
|
|
|
|
|
|
|
|
|
temp-file)
|
2003-02-04 12:29:42 +00:00
|
|
|
|
|
1994-06-20 18:30:06 +00:00
|
|
|
|
(jka-compr-run-real-handler 'file-local-copy (list filename)))))
|
1994-02-18 22:50:05 +00:00
|
|
|
|
|
|
|
|
|
|
2005-11-11 02:54:08 +00:00
|
|
|
|
;; Support for loading compressed files.
|
2011-04-19 13:44:55 +00:00
|
|
|
|
(defun jka-compr-load (file &optional noerror nomessage _nosuffix)
|
1994-02-18 22:50:05 +00:00
|
|
|
|
"Documented as original."
|
|
|
|
|
|
|
|
|
|
(let* ((local-copy (jka-compr-file-local-copy file))
|
|
|
|
|
(load-file (or local-copy file)))
|
|
|
|
|
|
|
|
|
|
(unwind-protect
|
|
|
|
|
|
1994-06-20 18:30:06 +00:00
|
|
|
|
(let (inhibit-file-name-operation
|
|
|
|
|
inhibit-file-name-handlers)
|
1994-02-18 22:50:05 +00:00
|
|
|
|
(or nomessage
|
|
|
|
|
(message "Loading %s..." file))
|
|
|
|
|
|
1995-08-02 23:56:20 +00:00
|
|
|
|
(let ((load-force-doc-strings t))
|
|
|
|
|
(load load-file noerror t t))
|
1994-02-18 22:50:05 +00:00
|
|
|
|
(or nomessage
|
2000-01-30 17:52:18 +00:00
|
|
|
|
(message "Loading %s...done." file))
|
|
|
|
|
;; Fix up the load history to point at the right library.
|
2010-01-22 10:23:25 +00:00
|
|
|
|
(let ((l (or (assoc load-file load-history)
|
|
|
|
|
;; On MS-Windows, if load-file is in
|
|
|
|
|
;; temporary-file-directory, it will look like
|
|
|
|
|
;; "c:/DOCUME~1/USER/LOCALS~1/foo", whereas
|
|
|
|
|
;; readevalloop will record its truename in
|
|
|
|
|
;; load-history. Therefore try truename if the
|
|
|
|
|
;; original name is not in load-history.
|
|
|
|
|
(assoc (file-truename load-file) load-history))))
|
2000-01-30 17:52:18 +00:00
|
|
|
|
;; Remove .gz and .elc?.
|
|
|
|
|
(while (file-name-extension file)
|
|
|
|
|
(setq file (file-name-sans-extension file)))
|
|
|
|
|
(setcar l file)))
|
1994-02-18 22:50:05 +00:00
|
|
|
|
|
2010-05-03 15:01:21 +00:00
|
|
|
|
(delete-file local-copy))
|
1994-02-18 22:50:05 +00:00
|
|
|
|
|
|
|
|
|
t))
|
1995-08-22 16:46:45 +00:00
|
|
|
|
|
|
|
|
|
(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)))
|
1994-06-20 18:30:06 +00:00
|
|
|
|
|
|
|
|
|
(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)
|
1995-08-22 16:46:45 +00:00
|
|
|
|
(put 'byte-compiler-base-file-name 'jka-compr
|
|
|
|
|
'jka-compr-byte-compiler-base-file-name)
|
1994-02-18 22:50:05 +00:00
|
|
|
|
|
2005-04-30 20:18:10 +00:00
|
|
|
|
;;;###autoload
|
1997-10-23 07:00:59 +00:00
|
|
|
|
(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.")
|
|
|
|
|
|
2005-04-30 20:18:10 +00:00
|
|
|
|
;;;###autoload
|
1994-02-18 22:50:05 +00:00
|
|
|
|
(defun jka-compr-handler (operation &rest args)
|
1994-06-20 18:30:06 +00:00
|
|
|
|
(save-match-data
|
|
|
|
|
(let ((jka-op (get operation 'jka-compr)))
|
1997-10-23 07:00:59 +00:00
|
|
|
|
(if (and jka-op (not jka-compr-inhibit))
|
1994-06-20 18:30:06 +00:00
|
|
|
|
(apply jka-op args)
|
|
|
|
|
(jka-compr-run-real-handler operation args)))))
|
1994-02-18 22:50:05 +00:00
|
|
|
|
|
1994-04-24 08:02:11 +00:00
|
|
|
|
;; 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.
|
|
|
|
|
(defun jka-compr-run-real-handler (operation args)
|
|
|
|
|
(let ((inhibit-file-name-handlers
|
|
|
|
|
(cons 'jka-compr-handler
|
|
|
|
|
(and (eq inhibit-file-name-operation operation)
|
|
|
|
|
inhibit-file-name-handlers)))
|
|
|
|
|
(inhibit-file-name-operation operation))
|
|
|
|
|
(apply operation args)))
|
|
|
|
|
|
2005-05-06 11:22:21 +00:00
|
|
|
|
;;;###autoload
|
1994-02-18 22:50:05 +00:00
|
|
|
|
(defun jka-compr-uninstall ()
|
|
|
|
|
"Uninstall jka-compr.
|
1994-04-24 08:02:11 +00:00
|
|
|
|
This removes the entries in `file-name-handler-alist' and `auto-mode-alist'
|
1995-04-08 06:22:05 +00:00
|
|
|
|
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.
|
2006-02-27 01:51:17 +00:00
|
|
|
|
(mapc
|
1995-04-08 06:22:05 +00:00
|
|
|
|
(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)))))
|
2006-02-27 01:51:17 +00:00
|
|
|
|
jka-compr-compression-info-list--internal)
|
1994-02-18 22:50:05 +00:00
|
|
|
|
|
|
|
|
|
(let* ((fnha (cons nil file-name-handler-alist))
|
|
|
|
|
(last fnha))
|
|
|
|
|
|
|
|
|
|
(while (cdr last)
|
|
|
|
|
(if (eq (cdr (car (cdr last))) 'jka-compr-handler)
|
|
|
|
|
(setcdr last (cdr (cdr last)))
|
|
|
|
|
(setq last (cdr last))))
|
|
|
|
|
|
|
|
|
|
(setq file-name-handler-alist (cdr fnha)))
|
|
|
|
|
|
|
|
|
|
(let* ((ama (cons nil auto-mode-alist))
|
|
|
|
|
(last ama)
|
|
|
|
|
entry)
|
|
|
|
|
|
|
|
|
|
(while (cdr last)
|
|
|
|
|
(setq entry (car (cdr last)))
|
2006-02-27 01:51:17 +00:00
|
|
|
|
(if (or (member entry jka-compr-mode-alist-additions--internal)
|
1994-10-12 23:12:25 +00:00
|
|
|
|
(and (consp (cdr entry))
|
|
|
|
|
(eq (nth 2 entry) 'jka-compr)))
|
1994-02-18 22:50:05 +00:00
|
|
|
|
(setcdr last (cdr (cdr last)))
|
|
|
|
|
(setq last (cdr last))))
|
2003-02-04 12:29:42 +00:00
|
|
|
|
|
1997-07-27 00:06:20 +00:00
|
|
|
|
(setq auto-mode-alist (cdr ama)))
|
|
|
|
|
|
2005-11-11 02:54:08 +00:00
|
|
|
|
(while jka-compr-added-to-file-coding-system-alist
|
|
|
|
|
(setq file-coding-system-alist
|
|
|
|
|
(delq (car (member (pop jka-compr-added-to-file-coding-system-alist)
|
|
|
|
|
file-coding-system-alist))
|
|
|
|
|
file-coding-system-alist)))
|
2001-10-12 16:28:16 +00:00
|
|
|
|
|
|
|
|
|
;; Remove the suffixes that were added by jka-compr.
|
2006-02-27 01:51:17 +00:00
|
|
|
|
(dolist (suff jka-compr-load-suffixes--internal)
|
|
|
|
|
(setq load-file-rep-suffixes (delete suff load-file-rep-suffixes)))
|
|
|
|
|
|
|
|
|
|
(setq jka-compr-compression-info-list--internal nil
|
|
|
|
|
jka-compr-mode-alist-additions--internal nil
|
|
|
|
|
jka-compr-load-suffixes--internal nil))
|
1994-02-18 22:50:05 +00:00
|
|
|
|
|
|
|
|
|
(provide 'jka-compr)
|
|
|
|
|
|
2001-07-15 16:15:35 +00:00
|
|
|
|
;;; jka-compr.el ends here
|