;;; jka-compr.el --- reading/writing/loading compressed files
-;; Copyright (C) 1993, 1994, 1995, 1997, 1999, 2000, 2002, 2003,
-;; 2004, 2005 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1994, 1995, 1997, 1999, 2000, 2001, 2002, 2003,
+;; 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
;; Author: jka@ece.cmu.edu (Jay K. Adams)
;; Maintainer: FSF
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; 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
+;; 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
;; nil.
(defcustom jka-compr-shell "sh"
"*Shell to be used for calling compression programs.
-The value of this variable only matters if you want to discard the
-stderr of a compression/decompression program (see the documentation
-for `jka-compr-compression-info-list')."
+NOTE: Not used in MS-DOS and Windows systems."
:type 'string
:group 'jka-compr)
;; to discard the part we don't want.
(let ((skip (/ beg jka-compr-dd-blocksize))
(err-file (jka-compr-make-temp-name))
+ ;; 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)))
count)
;; Update PREFIX based on the text that we won't read in.
(setq prefix (- beg (* skip jka-compr-dd-blocksize))
(defun jka-compr-call-process (prog message infile output temp args)
- (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))
-
- (jka-compr-delete-temp-file err-file)))
-
- (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)))))
+ ;; 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))
+ (jka-compr-delete-temp-file err-file)))
+ (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))))))
;; Support for temp files. Much of this was inspired if not lifted
by `jka-compr-installed'."
;; Delete from inhibit-first-line-modes-suffixes
;; what jka-compr-install added.
- (mapcar
+ (mapc
(function (lambda (x)
(and (jka-compr-info-strip-extension x)
(setq inhibit-first-line-modes-suffixes
(delete (jka-compr-info-regexp x)
inhibit-first-line-modes-suffixes)))))
- jka-compr-compression-info-list)
+ jka-compr-compression-info-list--internal)
(let* ((fnha (cons nil file-name-handler-alist))
(last fnha))
(while (cdr last)
(setq entry (car (cdr last)))
- (if (or (member entry jka-compr-mode-alist-additions)
+ (if (or (member entry jka-compr-mode-alist-additions--internal)
(and (consp (cdr entry))
(eq (nth 2 entry) 'jka-compr)))
(setcdr last (cdr (cdr last)))
file-coding-system-alist)))
;; 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))))
+ (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))
(provide 'jka-compr)