X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/7f22a76506a3f3db2eb4bce1cfc49105bd8d0824..6b26f14f789112bb929f65a8d44caeda11418432:/lisp/jka-cmpr-hook.el diff --git a/lisp/jka-cmpr-hook.el b/lisp/jka-cmpr-hook.el index fb17fb37f0..7b36f7c121 100644 --- a/lisp/jka-cmpr-hook.el +++ b/lisp/jka-cmpr-hook.el @@ -1,18 +1,19 @@ ;;; 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 Free Software Foundation, Inc. +;; Copyright (C) 1993-1995, 1997, 1999-2000, 2002-2013 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. -;; 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 +21,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: @@ -40,6 +39,12 @@ "jka-compr customization." :group 'compression) +(defcustom jka-compr-verbose t + "If non-nil, output messages whenever compressing or uncompressing files." + :version "24.1" + :type 'boolean + :group 'jka-compr) + ;; List of all the elements we actually added to file-coding-system-alist. (defvar jka-compr-added-to-file-coding-system-alist nil) @@ -73,10 +78,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,19 +109,18 @@ Otherwise, it is nil.") "Return information about the compression scheme of FILENAME. The determination as to which compression scheme, if any, to use is based on the filename itself and `jka-compr-compression-info-list'." + (setq filename (file-name-sans-versions filename)) (catch 'compression-info (let ((case-fold-search nil)) - (mapcar - (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 () "Install jka-compr. This adds entries to `file-name-handler-alist' and `auto-mode-alist' -and `inhibit-first-line-modes-suffixes'." +and `inhibit-local-variables-suffixes'." (setq jka-compr-file-name-handler-entry (cons (jka-compr-build-file-regexp) 'jka-compr-handler)) @@ -133,12 +146,12 @@ and `inhibit-first-line-modes-suffixes'." ;; are chosen right according to the file names ;; sans `.gz'. (push (list (jka-compr-info-regexp x) 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. + ;; Also add these regexps to inhibit-local-variables-suffixes, + ;; so that a -*- line in the first file of a compressed tar file, + ;; or a Local Variables section in a member file at the end of + ;; the tar file don't override tar-mode. (push (jka-compr-info-regexp x) - inhibit-first-line-modes-suffixes))) + inhibit-local-variables-suffixes))) (setq auto-mode-alist (append auto-mode-alist jka-compr-mode-alist-additions)) @@ -184,36 +197,50 @@ 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") - "uncompressing" "uncompress" ("-c") + ;; gzip is more common than uncompress. It can only read, not write. + "uncompressing" "gzip" ("-c" "-q" "-d") nil t "\037\235"] ;; 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\\)\\'" + ["\\.\\(?: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"] + ["\\.lz\\'" + "Lzip compressing" "lzip" ("-c" "-q") + "Lzip uncompressing" "lzip" ("-c" "-q" "-d") + t t "LZIP"] + ["\\.lzma\\'" + "LZMA compressing" "lzma" ("-c" "-q" "-z") + "LZMA uncompressing" "lzma" ("-c" "-q" "-d") + t t ""] + ["\\.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 @@ -271,10 +298,11 @@ variables. Setting this through Custom does that automatically." (boolean :tag "Strip Extension") (string :tag "Magic Bytes"))) :set 'jka-compr-set + :version "24.1" ; removed version extension piece :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. @@ -287,7 +315,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 @@ -302,9 +330,14 @@ variables. Setting this through Custom does that automatically." :group 'jka-compr) (define-minor-mode auto-compression-mode - "Toggle automatic file compression and uncompression. -With prefix argument ARG, turn auto compression on if positive, else off. -Return the new status of auto compression (non-nil means on)." + "Toggle Auto Compression mode. +With a prefix argument ARG, enable Auto Compression mode if ARG +is positive, and disable it otherwise. If called from Lisp, +enable the mode if ARG is omitted or nil. + +Auto Compression mode is a global minor mode. When enabled, +compressed files are automatically uncompressed for reading, and +compressed when writing." :global t :init-value t :group 'jka-compr :version "22.1" (let* ((installed (jka-compr-installed-p)) (flag auto-compression-mode)) @@ -315,7 +348,8 @@ Return the new status of auto compression (non-nil means on)." (t (jka-compr-uninstall))))) (defmacro with-auto-compression-mode (&rest body) - "Evalute BODY with automatic file compression and uncompression enabled." + "Evaluate 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 @@ -325,8 +359,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. @@ -341,5 +373,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