X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/f67e15be8d94718b2e2ea7da68eb0b2dc94ce016..d6930356cabd3036e445cc6a2f668b1fd3e0cde4:/lisp/jka-cmpr-hook.el diff --git a/lisp/jka-cmpr-hook.el b/lisp/jka-cmpr-hook.el index 4c1e9eda99..39302f028e 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, 2008 Free Software Foundation, Inc. +;; Copyright (C) 1993-1995, 1997, 1999-2000, 2002-2016 Free Software +;; Foundation, Inc. -;; Author: jka@ece.cmu.edu (Jay K. Adams) -;; Maintainer: FSF +;; Author: Jay K. Adams +;; Maintainer: emacs-devel@gnu.org ;; 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)) - (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 () "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)) @@ -179,25 +192,13 @@ options through Custom does this automatically." ;; I have this defined so that .Z files are assumed to be in unix ;; compress format; and .gz files, in gzip format, and .bz2 files in bzip fmt. - -;; FIXME? It seems ugly that one has to add "\\(~\\|\\.~[0-9]+~\\)?" to -;; all the regexps here, in order to match backup files etc. -;; It's trivial to modify jka-compr-get-compression-info to match -;; regexps against file-name-sans-versions, but this regexp is also -;; used to build a file-name-handler-alist entry. -;; find-file-name-handler does not use file-name-sans-versions. -;; Perhaps it should, -;; http://lists.gnu.org/archive/html/emacs-devel/2008-02/msg00812.html, -;; but it's used all over the place and there are probably other ramifications. -;; One could modify jka-compr-build-file-regexp to add the backup regexp, -;; but jka-compr-compression-info-list is a defcustom to which -;; anything could be added, so it's easiest to leave things as they are. (defcustom jka-compr-compression-info-list ;;[regexp ;; 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") @@ -205,29 +206,45 @@ 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"] + ["\\.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"] + ["\\.txz\\'" + "XZ compressing" "xz" ("-c" "-q") + "XZ uncompressing" "xz" ("-c" "-q" "-d") + t nil "\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 @@ -285,10 +302,13 @@ 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)) + (purecopy '(("\\.tgz\\'" . tar-mode) + ("\\.tbz2?\\'" . tar-mode) + ("\\.txz\\'" . 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. @@ -298,10 +318,11 @@ already enabled \(as it is by default), you have to call `jka-compr-update' after setting it to properly update other variables. Setting this through Custom does that automatically." :type '(repeat (cons string symbol)) + :version "24.4" ; add txz :set 'jka-compr-set :group 'jka-compr) -(defcustom jka-compr-load-suffixes '(".gz") +(defcustom jka-compr-load-suffixes (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 @@ -316,9 +337,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)) @@ -329,7 +355,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 @@ -339,8 +366,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. @@ -355,5 +380,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