LCOV - code coverage report
Current view: top level - lisp - jka-cmpr-hook.el (source / functions) Hit Total Coverage
Test: tramp-tests-after.info Lines: 49 72 68.1 %
Date: 2017-08-30 10:12:24 Functions: 8 18 44.4 %

          Line data    Source code
       1             : ;;; jka-cmpr-hook.el --- preloaded code to enable jka-compr.el
       2             : 
       3             : ;; Copyright (C) 1993-1995, 1997, 1999-2000, 2002-2017 Free Software
       4             : ;; Foundation, Inc.
       5             : 
       6             : ;; Author: Jay K. Adams <jka@ece.cmu.edu>
       7             : ;; Maintainer: emacs-devel@gnu.org
       8             : ;; Keywords: data
       9             : ;; Package: emacs
      10             : 
      11             : ;; This file is part of GNU Emacs.
      12             : 
      13             : ;; GNU Emacs is free software: you can redistribute it and/or modify
      14             : ;; it under the terms of the GNU General Public License as published by
      15             : ;; the Free Software Foundation, either version 3 of the License, or
      16             : ;; (at your option) any later version.
      17             : 
      18             : ;; GNU Emacs is distributed in the hope that it will be useful,
      19             : ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
      20             : ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
      21             : ;; GNU General Public License for more details.
      22             : 
      23             : ;; You should have received a copy of the GNU General Public License
      24             : ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
      25             : 
      26             : ;;; Commentary:
      27             : 
      28             : ;; This file contains the code to enable and disable Auto-Compression mode.
      29             : ;; It is preloaded.  The guts of this mode are in jka-compr.el, which
      30             : ;; is loaded only when you really try to uncompress something.
      31             : 
      32             : ;;; Code:
      33             : 
      34             : (defgroup compression nil
      35             :   "Data compression utilities."
      36             :   :group 'data)
      37             : 
      38             : (defgroup jka-compr nil
      39             :   "jka-compr customization."
      40             :   :group 'compression)
      41             : 
      42             : (defcustom jka-compr-verbose t
      43             :   "If non-nil, output messages whenever compressing or uncompressing files."
      44             :   :version "24.1"
      45             :   :type 'boolean
      46             :   :group 'jka-compr)
      47             : 
      48             : ;; List of all the elements we actually added to file-coding-system-alist.
      49             : (defvar jka-compr-added-to-file-coding-system-alist nil)
      50             : 
      51             : (defvar jka-compr-file-name-handler-entry
      52             :   nil
      53             :   "`file-name-handler-alist' entry used by jka-compr I/O functions.")
      54             : 
      55             : ;; Compiler defvars.  These three variables will be defined later with
      56             : ;; `defcustom' when everything used in the :set functions is defined.
      57             : (defvar jka-compr-compression-info-list)
      58             : (defvar jka-compr-mode-alist-additions)
      59             : (defvar jka-compr-load-suffixes)
      60             : 
      61             : (defvar jka-compr-compression-info-list--internal nil
      62             :   "Stored value of `jka-compr-compression-info-list'.
      63             : If Auto Compression mode is enabled, this is the value of
      64             : `jka-compr-compression-info-list' when `jka-compr-install' was last called.
      65             : Otherwise, it is nil.")
      66             : 
      67             : (defvar jka-compr-mode-alist-additions--internal nil
      68             :   "Stored value of `jka-compr-mode-alist-additions'.
      69             : If Auto Compression mode is enabled, this is the value of
      70             : `jka-compr-mode-alist-additions' when `jka-compr-install' was last called.
      71             : Otherwise, it is nil.")
      72             : 
      73             : (defvar jka-compr-load-suffixes--internal nil
      74             :   "Stored value of `jka-compr-load-suffixes'.
      75             : If Auto Compression mode is enabled, this is the value of
      76             : `jka-compr-load-suffixes' when `jka-compr-install' was last called.
      77             : Otherwise, it is nil.")
      78             : 
      79             : 
      80             : (defun jka-compr-build-file-regexp ()
      81           3 :   (purecopy
      82           3 :    (let ((re-anchored '())
      83             :          (re-free '()))
      84           3 :      (dolist (e jka-compr-compression-info-list)
      85          36 :        (let ((re (jka-compr-info-regexp e)))
      86          36 :          (if (string-match "\\\\'\\'" re)
      87          72 :              (push (substring re 0 (match-beginning 0)) re-anchored)
      88          36 :            (push re re-free))))
      89           3 :      (concat
      90           3 :       (if re-free (concat (mapconcat 'identity re-free "\\|") "\\|"))
      91             :       "\\(?:"
      92           3 :       (mapconcat 'identity re-anchored "\\|")
      93           3 :       "\\)" file-name-version-regexp "?\\'"))))
      94             : 
      95             : ;; Functions for accessing the return value of jka-compr-get-compression-info
      96         144 : (defun jka-compr-info-regexp               (info)  (aref info 0))
      97           0 : (defun jka-compr-info-compress-message     (info)  (aref info 1))
      98           0 : (defun jka-compr-info-compress-program     (info)  (aref info 2))
      99           0 : (defun jka-compr-info-compress-args        (info)  (aref info 3))
     100           0 : (defun jka-compr-info-uncompress-message   (info)  (aref info 4))
     101           0 : (defun jka-compr-info-uncompress-program   (info)  (aref info 5))
     102           0 : (defun jka-compr-info-uncompress-args      (info)  (aref info 6))
     103           0 : (defun jka-compr-info-can-append           (info)  (aref info 7))
     104          72 : (defun jka-compr-info-strip-extension      (info)  (aref info 8))
     105           0 : (defun jka-compr-info-file-magic-bytes     (info)  (aref info 9))
     106             : 
     107             : 
     108             : (defun jka-compr-get-compression-info (filename)
     109             :   "Return information about the compression scheme of FILENAME.
     110             : The determination as to which compression scheme, if any, to use is
     111             : based on the filename itself and `jka-compr-compression-info-list'."
     112           0 :   (setq filename (file-name-sans-versions filename))
     113           0 :   (catch 'compression-info
     114           0 :     (let ((case-fold-search nil))
     115           0 :       (dolist (x jka-compr-compression-info-list)
     116           0 :         (and (string-match (jka-compr-info-regexp x) filename)
     117           0 :              (throw 'compression-info x)))
     118           0 :       nil)))
     119             : 
     120             : (defun jka-compr-install ()
     121             :   "Install jka-compr.
     122             : This adds entries to `file-name-handler-alist' and `auto-mode-alist'
     123             : and `inhibit-local-variables-suffixes'."
     124             : 
     125           3 :   (setq jka-compr-file-name-handler-entry
     126           3 :         (cons (jka-compr-build-file-regexp) 'jka-compr-handler))
     127             : 
     128           6 :   (push jka-compr-file-name-handler-entry file-name-handler-alist)
     129             : 
     130           3 :   (setq jka-compr-compression-info-list--internal
     131           3 :         jka-compr-compression-info-list
     132             :         jka-compr-mode-alist-additions--internal
     133           3 :         jka-compr-mode-alist-additions
     134             :         jka-compr-load-suffixes--internal
     135           3 :         jka-compr-load-suffixes)
     136             : 
     137           3 :   (dolist (x jka-compr-compression-info-list)
     138             :     ;; Don't do multibyte encoding on the compressed files.
     139          36 :     (let ((elt (cons (jka-compr-info-regexp x)
     140          36 :                      '(no-conversion . no-conversion))))
     141          72 :       (push elt file-coding-system-alist)
     142          72 :       (push elt jka-compr-added-to-file-coding-system-alist))
     143             : 
     144          36 :     (and (jka-compr-info-strip-extension x)
     145             :          ;; Make entries in auto-mode-alist so that modes
     146             :          ;; are chosen right according to the file names
     147             :          ;; sans `.gz'.
     148          48 :          (push (list (jka-compr-info-regexp x) nil 'jka-compr) auto-mode-alist)
     149             :          ;; Also add these regexps to inhibit-local-variables-suffixes,
     150             :          ;; so that a -*- line in the first file of a compressed tar file,
     151             :          ;; or a Local Variables section in a member file at the end of
     152             :          ;; the tar file don't override tar-mode.
     153          24 :          (push (jka-compr-info-regexp x)
     154          48 :                inhibit-local-variables-suffixes)))
     155           3 :   (setq auto-mode-alist
     156           3 :         (append auto-mode-alist jka-compr-mode-alist-additions))
     157             : 
     158             :   ;; Make sure that (load "foo") will find /bla/foo.el.gz.
     159           3 :   (setq load-file-rep-suffixes
     160           3 :         (append load-file-rep-suffixes jka-compr-load-suffixes nil)))
     161             : 
     162             : (defun jka-compr-installed-p ()
     163             :   "Return non-nil if jka-compr is installed.
     164             : The return value is the entry in `file-name-handler-alist' for jka-compr."
     165             : 
     166           4 :   (let ((fnha file-name-handler-alist)
     167             :         (installed nil))
     168             : 
     169          10 :     (while (and fnha (not installed))
     170           6 :      (and (eq (cdr (car fnha)) 'jka-compr-handler)
     171           6 :            (setq installed (car fnha)))
     172           6 :       (setq fnha (cdr fnha)))
     173             : 
     174           4 :     installed))
     175             : 
     176             : (defun jka-compr-update ()
     177             :   "Update Auto Compression mode for changes in option values.
     178             : If you change the options `jka-compr-compression-info-list',
     179             : `jka-compr-mode-alist-additions' or `jka-compr-load-suffixes'
     180             : outside Custom, while Auto Compression mode is already enabled
     181             : \(as it is by default), then you have to call this function
     182             : afterward to properly update other variables.  Setting these
     183             : options through Custom does this automatically."
     184           3 :   (when (jka-compr-installed-p)
     185           3 :     (jka-compr-uninstall)
     186           3 :     (jka-compr-install)))
     187             : 
     188             : (defun jka-compr-set (variable value)
     189             :   "Internal Custom :set function."
     190           3 :   (set-default variable value)
     191           3 :   (jka-compr-update))
     192             : 
     193             : ;; I have this defined so that .Z files are assumed to be in unix
     194             : ;; compress format; and .gz files, in gzip format, and .bz2 files in bzip fmt.
     195             : (defcustom jka-compr-compression-info-list
     196             :   ;;[regexp
     197             :   ;; compr-message  compr-prog  compr-args
     198             :   ;; uncomp-message uncomp-prog uncomp-args
     199             :   ;; can-append strip-extension-flag file-magic-bytes]
     200             :   (mapcar 'purecopy
     201             :   '(["\\.Z\\'"
     202             :      "compressing"    "compress"     ("-c")
     203             :      ;; gzip is more common than uncompress. It can only read, not write.
     204             :      "uncompressing"  "gzip"   ("-c" "-q" "-d")
     205             :      nil t "\037\235"]
     206             :      ;; Formerly, these had an additional arg "-c", but that fails with
     207             :      ;; "Version 0.1pl2, 29-Aug-97." (RedHat 5.1 GNU/Linux) and
     208             :      ;; "Version 0.9.0b, 9-Sept-98".
     209             :     ["\\.bz2\\'"
     210             :      "bzip2ing"        "bzip2"         nil
     211             :      "bunzip2ing"      "bzip2"         ("-d")
     212             :      nil t "BZh"]
     213             :     ["\\.tbz2?\\'"
     214             :      "bzip2ing"        "bzip2"         nil
     215             :      "bunzip2ing"      "bzip2"         ("-d")
     216             :      nil nil "BZh"]
     217             :     ["\\.\\(?:tgz\\|svgz\\|sifz\\)\\'"
     218             :      "compressing"        "gzip"         ("-c" "-q")
     219             :      "uncompressing"      "gzip"         ("-c" "-q" "-d")
     220             :      t nil "\037\213"]
     221             :     ["\\.g?z\\'"
     222             :      "compressing"        "gzip"         ("-c" "-q")
     223             :      "uncompressing"      "gzip"         ("-c" "-q" "-d")
     224             :      t t "\037\213"]
     225             :     ["\\.lz\\'"
     226             :      "Lzip compressing"   "lzip"         ("-c" "-q")
     227             :      "Lzip uncompressing" "lzip"         ("-c" "-q" "-d")
     228             :      t t "LZIP"]
     229             :     ["\\.lzma\\'"
     230             :      "LZMA compressing"   "lzma"         ("-c" "-q" "-z")
     231             :      "LZMA uncompressing" "lzma"         ("-c" "-q" "-d")
     232             :      t t ""]
     233             :     ["\\.xz\\'"
     234             :      "XZ compressing"     "xz"           ("-c" "-q")
     235             :      "XZ uncompressing"   "xz"           ("-c" "-q" "-d")
     236             :      t t "\3757zXZ\0"]
     237             :     ["\\.txz\\'"
     238             :      "XZ compressing"     "xz"           ("-c" "-q")
     239             :      "XZ uncompressing"   "xz"           ("-c" "-q" "-d")
     240             :      t nil "\3757zXZ\0"]
     241             :     ;; dzip is gzip with random access.  Its compression program can't
     242             :     ;; read/write stdin/out, so .dz files can only be viewed without
     243             :     ;; saving, having their contents decompressed with gzip.
     244             :     ["\\.dz\\'"
     245             :      nil              nil            nil
     246             :      "uncompressing"      "gzip"         ("-c" "-q" "-d")
     247             :      nil t "\037\213"]
     248             :     ["\\.zst\\'"
     249             :      "zstd compressing"   "zstd"         ("-c" "-q")
     250             :      "zstd uncompressing" "zstd"         ("-c" "-q" "-d")
     251             :      t t "\050\265\057\375"]
     252             :     ["\\.tzst\\'"
     253             :      "zstd compressing"   "zstd"         ("-c" "-q")
     254             :      "zstd uncompressing" "zstd"         ("-c" "-q" "-d")
     255             :      t nil "\050\265\057\375"]))
     256             : 
     257             :   "List of vectors that describe available compression techniques.
     258             : Each element, which describes a compression technique, is a vector of
     259             : the form [REGEXP COMPRESS-MSG COMPRESS-PROGRAM COMPRESS-ARGS
     260             : UNCOMPRESS-MSG UNCOMPRESS-PROGRAM UNCOMPRESS-ARGS
     261             : APPEND-FLAG STRIP-EXTENSION-FLAG FILE-MAGIC-CHARS], where:
     262             : 
     263             :    regexp                is a regexp that matches filenames that are
     264             :                          compressed with this format
     265             : 
     266             :    compress-msg          is the message to issue to the user when doing this
     267             :                          type of compression (nil means no message)
     268             : 
     269             :    compress-program      is a program that performs this compression
     270             :                          (nil means visit file in read-only mode)
     271             : 
     272             :    compress-args         is a list of args to pass to the compress program
     273             : 
     274             :    uncompress-msg        is the message to issue to the user when doing this
     275             :                          type of uncompression (nil means no message)
     276             : 
     277             :    uncompress-program    is a program that performs this compression
     278             : 
     279             :    uncompress-args       is a list of args to pass to the uncompress program
     280             : 
     281             :    append-flag           is non-nil if this compression technique can be
     282             :                          appended
     283             : 
     284             :    strip-extension-flag  non-nil means strip the regexp from file names
     285             :                          before attempting to set the mode.
     286             : 
     287             :    file-magic-chars      is a string of characters that you would find
     288             :                          at the beginning of a file compressed in this way.
     289             : 
     290             : If you set this outside Custom while Auto Compression mode is
     291             : already enabled \(as it is by default), you have to call
     292             : `jka-compr-update' after setting it to properly update other
     293             : variables.  Setting this through Custom does that automatically."
     294             :   :type '(repeat (vector regexp
     295             :                          (choice :tag "Compress Message"
     296             :                                  (string :format "%v")
     297             :                                  (const :tag "No Message" nil))
     298             :                          (choice :tag "Compress Program"
     299             :                                  (string)
     300             :                                  (const :tag "None" nil))
     301             :                          (repeat :tag "Compress Arguments" string)
     302             :                          (choice :tag "Uncompress Message"
     303             :                                  (string :format "%v")
     304             :                                  (const :tag "No Message" nil))
     305             :                          (choice :tag "Uncompress Program"
     306             :                                  (string)
     307             :                                  (const :tag "None" nil))
     308             :                          (repeat :tag "Uncompress Arguments" string)
     309             :                          (boolean :tag "Append")
     310             :                          (boolean :tag "Strip Extension")
     311             :                          (string :tag "Magic Bytes")))
     312             :   :set 'jka-compr-set
     313             :   :version "24.1"                     ; removed version extension piece
     314             :   :group 'jka-compr)
     315             : 
     316             : (defcustom jka-compr-mode-alist-additions
     317             :   (purecopy '(("\\.tgz\\'" . tar-mode)
     318             :               ("\\.tbz2?\\'" . tar-mode)
     319             :               ("\\.txz\\'" . tar-mode)
     320             :               ("\\.tzst\\'" . tar-mode)))
     321             :   "List of pairs added to `auto-mode-alist' when installing jka-compr.
     322             : Uninstalling jka-compr removes all pairs from `auto-mode-alist' that
     323             : installing added.
     324             : 
     325             : If you set this outside Custom while Auto Compression mode is
     326             : already enabled \(as it is by default), you have to call
     327             : `jka-compr-update' after setting it to properly update other
     328             : variables.  Setting this through Custom does that automatically."
     329             :   :type '(repeat (cons string symbol))
     330             :   :version "24.4"                     ; add txz
     331             :   :set 'jka-compr-set
     332             :   :group 'jka-compr)
     333             : 
     334             : (defcustom jka-compr-load-suffixes (purecopy '(".gz"))
     335             :   "List of compression related suffixes to try when loading files.
     336             : Enabling Auto Compression mode appends this list to `load-file-rep-suffixes',
     337             : which see.  Disabling Auto Compression mode removes all suffixes
     338             : from `load-file-rep-suffixes' that enabling added.
     339             : 
     340             : If you set this outside Custom while Auto Compression mode is
     341             : already enabled \(as it is by default), you have to call
     342             : `jka-compr-update' after setting it to properly update other
     343             : variables.  Setting this through Custom does that automatically."
     344             :   :type '(repeat string)
     345             :   :set 'jka-compr-set
     346             :   :group 'jka-compr)
     347             : 
     348             : (define-minor-mode auto-compression-mode
     349             :   "Toggle Auto Compression mode.
     350             : With a prefix argument ARG, enable Auto Compression mode if ARG
     351             : is positive, and disable it otherwise.  If called from Lisp,
     352             : enable the mode if ARG is omitted or nil.
     353             : 
     354             : Auto Compression mode is a global minor mode.  When enabled,
     355             : compressed files are automatically uncompressed for reading, and
     356             : compressed when writing."
     357             :   :global t :init-value t :group 'jka-compr :version "22.1"
     358           1 :   (let* ((installed (jka-compr-installed-p))
     359           1 :          (flag auto-compression-mode))
     360           1 :     (cond
     361           1 :      ((and flag installed) t)           ; already installed
     362           0 :      ((and (not flag) (not installed)) nil) ; already not installed
     363           0 :      (flag (jka-compr-install))
     364           1 :      (t (jka-compr-uninstall)))))
     365             : 
     366             : (defmacro with-auto-compression-mode (&rest body)
     367             :   "Evaluate BODY with automatic file compression and uncompression enabled."
     368             :   (declare (indent 0))
     369           0 :   (let ((already-installed (make-symbol "already-installed")))
     370           0 :     `(let ((,already-installed (jka-compr-installed-p)))
     371             :        (unwind-protect
     372             :            (progn
     373           0 :              (unless ,already-installed
     374             :                (jka-compr-install))
     375           0 :              ,@body)
     376           0 :          (unless ,already-installed
     377           0 :            (jka-compr-uninstall))))))
     378             : 
     379             : ;; This is what we need to know about jka-compr-handler
     380             : ;; in order to decide when to call it.
     381             : 
     382             : (put 'jka-compr-handler 'safe-magic t)
     383             : (put 'jka-compr-handler 'operations '(byte-compiler-base-file-name
     384             :                                       write-region insert-file-contents
     385             :                                       file-local-copy load))
     386             : 
     387             : ;; Turn on the mode.
     388             : (when auto-compression-mode (auto-compression-mode 1))
     389             : 
     390             : (provide 'jka-cmpr-hook)
     391             : 
     392             : ;;; jka-cmpr-hook.el ends here

Generated by: LCOV version 1.12