X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/7ad8fe5e2876518a8f33b80050f98dab4ff78398..b14e3e21ec6702d27257a1400681fc36ee10282f:/lisp/jka-cmpr-hook.el

diff --git a/lisp/jka-cmpr-hook.el b/lisp/jka-cmpr-hook.el
index 3377fed04c..fda9804bbb 100644
--- a/lisp/jka-cmpr-hook.el
+++ b/lisp/jka-cmpr-hook.el
@@ -1,11 +1,12 @@
 ;;; jka-cmpr-hook.el --- preloaded code to enable jka-compr.el
 
-;; Copyright (C) 1993, 1994, 1995, 1997, 1999, 2000, 2002, 2003,
-;;   2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1995, 1997, 1999-2000, 2002-2011
+;;   Free Software Foundation, Inc.
 
 ;; Author: jka@ece.cmu.edu (Jay K. Adams)
 ;; Maintainer: FSF
 ;; Keywords: data
+;; Package: emacs
 
 ;; This file is part of GNU Emacs.
 
@@ -71,10 +72,19 @@ Otherwise, it is nil.")
 
 
 (defun jka-compr-build-file-regexp ()
-  (mapconcat
-   'jka-compr-info-regexp
-   jka-compr-compression-info-list
-   "\\|"))
+  (purecopy
+   (let ((re-anchored '())
+         (re-free '()))
+     (dolist (e jka-compr-compression-info-list)
+       (let ((re (jka-compr-info-regexp e)))
+         (if (string-match "\\\\'\\'" re)
+             (push (substring re 0 (match-beginning 0)) re-anchored)
+           (push re re-free))))
+     (concat
+      (if re-free (concat (mapconcat 'identity re-free "\\|") "\\|"))
+      "\\(?:"
+      (mapconcat 'identity re-anchored "\\|")
+      "\\)" file-name-version-regexp "?\\'"))))
 
 ;; Functions for accessing the return value of jka-compr-get-compression-info
 (defun jka-compr-info-regexp               (info)  (aref info 0))
@@ -95,11 +105,9 @@ The determination as to which compression scheme, if any, to use is
 based on the filename itself and `jka-compr-compression-info-list'."
   (catch 'compression-info
     (let ((case-fold-search nil))
-      (mapc
-       (function (lambda (x)
-		   (and (string-match (jka-compr-info-regexp x) filename)
-			(throw 'compression-info x))))
-       jka-compr-compression-info-list)
+      (dolist (x jka-compr-compression-info-list)
+        (and (string-match (jka-compr-info-regexp x) filename)
+             (throw 'compression-info x)))
       nil)))
 
 (defun jka-compr-install ()
@@ -195,7 +203,8 @@ options through Custom does this automatically."
   ;; compr-message  compr-prog  compr-args
   ;; uncomp-message uncomp-prog uncomp-args
   ;; can-append strip-extension-flag file-magic-bytes]
-  '(["\\.Z\\(~\\|\\.~[0-9]+~\\)?\\'"
+  (mapcar 'purecopy
+  '(["\\.Z\\'"
      "compressing"    "compress"     ("-c")
      ;; gzip is more common than uncompress. It can only read, not write.
      "uncompressing"  "gzip"   ("-c" "-q" "-d")
@@ -203,29 +212,33 @@ options through Custom does this automatically."
      ;; Formerly, these had an additional arg "-c", but that fails with
      ;; "Version 0.1pl2, 29-Aug-97." (RedHat 5.1 GNU/Linux) and
      ;; "Version 0.9.0b, 9-Sept-98".
-    ["\\.bz2\\(~\\|\\.~[0-9]+~\\)?\\'"
+    ["\\.bz2\\'"
      "bzip2ing"        "bzip2"         nil
      "bunzip2ing"      "bzip2"         ("-d")
      nil t "BZh"]
-    ["\\.tbz\\'"
+    ["\\.tbz2?\\'"
      "bzip2ing"        "bzip2"         nil
      "bunzip2ing"      "bzip2"         ("-d")
      nil nil "BZh"]
-    ["\\.\\(?:tgz\\|svgz\\|sifz\\)\\(~\\|\\.~[0-9]+~\\)?\\'"
+    ["\\.\\(?:tgz\\|svgz\\|sifz\\)\\'"
      "compressing"        "gzip"         ("-c" "-q")
      "uncompressing"      "gzip"         ("-c" "-q" "-d")
      t nil "\037\213"]
-    ["\\.g?z\\(~\\|\\.~[0-9]+~\\)?\\'"
+    ["\\.g?z\\'"
      "compressing"        "gzip"         ("-c" "-q")
      "uncompressing"      "gzip"         ("-c" "-q" "-d")
      t t "\037\213"]
+    ["\\.xz\\'"
+     "XZ compressing"     "xz"           ("-c" "-q")
+     "XZ uncompressing"   "xz"           ("-c" "-q" "-d")
+     t t "\3757zXZ\0"]
     ;; dzip is gzip with random access.  Its compression program can't
     ;; read/write stdin/out, so .dz files can only be viewed without
     ;; saving, having their contents decompressed with gzip.
     ["\\.dz\\'"
      nil              nil            nil
      "uncompressing"      "gzip"         ("-c" "-q" "-d")
-     nil t "\037\213"])
+     nil t "\037\213"]))
 
   "List of vectors that describe available compression techniques.
 Each element, which describes a compression technique, is a vector of
@@ -286,7 +299,7 @@ variables.  Setting this through Custom does that automatically."
   :group 'jka-compr)
 
 (defcustom jka-compr-mode-alist-additions
-  (list (cons "\\.tgz\\'" 'tar-mode) (cons "\\.tbz\\'" 'tar-mode))
+  (list (cons (purecopy "\\.tgz\\'") 'tar-mode) (cons (purecopy "\\.tbz2?\\'") 'tar-mode))
   "List of pairs added to `auto-mode-alist' when installing jka-compr.
 Uninstalling jka-compr removes all pairs from `auto-mode-alist' that
 installing added.
@@ -299,7 +312,7 @@ variables.  Setting this through Custom does that automatically."
   :set 'jka-compr-set
   :group 'jka-compr)
 
-(defcustom jka-compr-load-suffixes '(".gz")
+(defcustom jka-compr-load-suffixes (list (purecopy ".gz"))
   "List of compression related suffixes to try when loading files.
 Enabling Auto Compression mode appends this list to `load-file-rep-suffixes',
 which see.  Disabling Auto Compression mode removes all suffixes
@@ -328,6 +341,7 @@ Return the new status of auto compression (non-nil means on)."
 
 (defmacro with-auto-compression-mode (&rest body)
   "Evalute BODY with automatic file compression and uncompression enabled."
+  (declare (indent 0))
   (let ((already-installed (make-symbol "already-installed")))
     `(let ((,already-installed (jka-compr-installed-p)))
        (unwind-protect
@@ -337,8 +351,6 @@ Return the new status of auto compression (non-nil means on)."
 	     ,@body)
 	 (unless ,already-installed
 	   (jka-compr-uninstall))))))
-(put 'with-auto-compression-mode 'lisp-indent-function 0)
-
 
 ;; This is what we need to know about jka-compr-handler
 ;; in order to decide when to call it.
@@ -353,5 +365,4 @@ Return the new status of auto compression (non-nil means on)."
 
 (provide 'jka-cmpr-hook)
 
-;; arch-tag: 4bd73429-f400-45fe-a065-270a113e31a8
 ;;; jka-cmpr-hook.el ends here