X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/5bc6ddff00c50acf546530ef0e08a27140614d27..758c81e87ded2bad9f5a5a6683fb498965eb508c:/lisp/jka-compr.el diff --git a/lisp/jka-compr.el b/lisp/jka-compr.el index c528e05623..7e50ae57b1 100644 --- a/lisp/jka-compr.el +++ b/lisp/jka-compr.el @@ -1,7 +1,6 @@ ;;; jka-compr.el --- reading/writing/loading compressed files -;; Copyright (C) 1993, 1994, 1995, 1997, 1999, 2000, 2001, 2002, 2003, -;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. +;; Copyright (C) 1993-1995, 1997, 1999-2012 Free Software Foundation, Inc. ;; Author: jka@ece.cmu.edu (Jay K. Adams) ;; Maintainer: FSF @@ -9,10 +8,10 @@ ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; 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 3, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -20,9 +19,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -95,7 +92,7 @@ (require 'jka-cmpr-hook) (defcustom jka-compr-shell "sh" - "*Shell to be used for calling compression programs. + "Shell to be used for calling compression programs. NOTE: Not used in MS-DOS and Windows systems." :type 'string :group 'jka-compr) @@ -168,8 +165,11 @@ to keep: LEN chars starting BEG chars from the beginning." (unwind-protect (or (memq (call-process jka-compr-shell infile t nil "-c" + ;; Windows shells need the program file name + ;; after the pipe symbol be quoted if they use + ;; forward slashes as directory separators. (format - "%s %s 2> %s | %s bs=%d skip=%d %s 2> %s" + "%s %s 2> %s | \"%s\" bs=%d skip=%d %s 2> %s" prog (mapconcat 'identity args " ") err-file @@ -183,7 +183,8 @@ to keep: LEN chars starting BEG chars from the beginning." null-device)) jka-compr-acceptable-retval-list) (jka-compr-error prog args infile message err-file)) - (jka-compr-delete-temp-file err-file))) + (delete-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)) @@ -202,6 +203,7 @@ to keep: LEN chars starting BEG chars from the beginning." ;; call-process barfs if default-directory is inaccessible. (let ((default-directory (if (and default-directory + (not (file-remote-p default-directory)) (file-accessible-directory-p default-directory)) default-directory (file-name-directory infile)))) @@ -224,7 +226,7 @@ to keep: LEN chars starting BEG chars from the beginning." ""))) jka-compr-acceptable-retval-list) (jka-compr-error prog args infile message err-file)) - (jka-compr-delete-temp-file err-file))) + (delete-file err-file))) (or (eq 0 (apply 'call-process prog infile (if (stringp output) temp output) @@ -246,29 +248,22 @@ There should be no more than seven characters after the final `/'." :type 'string :group 'jka-compr) -(defun jka-compr-make-temp-name (&optional local-copy) +(defun jka-compr-make-temp-name (&optional _local-copy) "This routine will return the name of a new file." (make-temp-file jka-compr-temp-name-template)) -(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)) (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)))) + (or (null start) + (= (- end start) (buffer-size)))) (setq magic nil)) (if (and info @@ -279,9 +274,10 @@ There should be no more than seven characters after the final `/'." (equal (if (stringp start) (substring start 0 (min (length start) (length magic))) - (buffer-substring start - (min end - (+ start (length magic))))) + (let* ((from (or start (point-min))) + (to (min (or end (point-max)) + (+ from (length magic))))) + (buffer-substring from to))) magic)))) (let ((can-append (jka-compr-info-can-append info)) (compress-program (jka-compr-info-compress-program info)) @@ -314,6 +310,7 @@ There should be no more than seven characters after the final `/'." (and compress-message + jka-compr-verbose (message "%s %s..." compress-message base-name)) (jka-compr-run-real-handler 'write-region @@ -342,10 +339,11 @@ There should be no more than seven characters after the final `/'." (and append can-append) 'dont)) (erase-buffer)) ) - (jka-compr-delete-temp-file temp-file) + (delete-file temp-file) (and compress-message + jka-compr-verbose (message "%s %s...done" compress-message base-name)) (cond @@ -409,6 +407,7 @@ There should be no more than seven characters after the final `/'." (and uncompress-message + jka-compr-verbose (message "%s %s..." uncompress-message base-name)) (condition-case error-code @@ -484,6 +483,7 @@ There should be no more than seven characters after the final `/'." (and uncompress-message + jka-compr-verbose (message "%s %s...done" uncompress-message base-name)) (and @@ -539,6 +539,7 @@ There should be no more than seven characters after the final `/'." (and uncompress-message + jka-compr-verbose (message "%s %s..." uncompress-message base-name)) ;; Here we must read the output of uncompress program @@ -559,6 +560,7 @@ There should be no more than seven characters after the final `/'." (and uncompress-message + jka-compr-verbose (message "%s %s...done" uncompress-message base-name)) (write-region @@ -577,7 +579,7 @@ There should be no more than seven characters after the final `/'." ;; Support for loading compressed files. -(defun jka-compr-load (file &optional noerror nomessage nosuffix) +(defun jka-compr-load (file &optional noerror nomessage _nosuffix) "Documented as original." (let* ((local-copy (jka-compr-file-local-copy file)) @@ -595,13 +597,20 @@ There should be no more than seven characters after the final `/'." (or nomessage (message "Loading %s...done." file)) ;; Fix up the load history to point at the right library. - (let ((l (assoc load-file load-history))) + (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)))) ;; 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)) + (delete-file local-copy)) t)) @@ -649,16 +658,15 @@ It is not recommended to set this variable permanently to anything but nil.") (defun jka-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 added +and `inhibit-local-variables-suffixes' that were added by `jka-compr-installed'." - ;; Delete from inhibit-first-line-modes-suffixes - ;; what jka-compr-install added. + ;; Delete from inhibit-local-variables-suffixes what jka-compr-install added. (mapc (function (lambda (x) (and (jka-compr-info-strip-extension x) - (setq inhibit-first-line-modes-suffixes + (setq inhibit-local-variables-suffixes (delete (jka-compr-info-regexp x) - inhibit-first-line-modes-suffixes))))) + inhibit-local-variables-suffixes))))) jka-compr-compression-info-list--internal) (let* ((fnha (cons nil file-name-handler-alist)) @@ -701,5 +709,4 @@ by `jka-compr-installed'." (provide 'jka-compr) -;; arch-tag: 3f15b630-e9a7-46c4-a22a-94afdde86ebc ;;; jka-compr.el ends here