jka-cmpr-hook.el 14.7 KB
Newer Older
1
;;; jka-cmpr-hook.el --- preloaded code to enable jka-compr.el
Richard M. Stallman's avatar
Richard M. Stallman committed
2

Paul Eggert's avatar
Paul Eggert committed
3
;; Copyright (C) 1993-1995, 1997, 1999-2000, 2002-2019 Free Software
Paul Eggert's avatar
Paul Eggert committed
4
;; Foundation, Inc.
Richard M. Stallman's avatar
Richard M. Stallman committed
5

6
;; Author: Jay K. Adams <jka@ece.cmu.edu>
7
;; Maintainer: emacs-devel@gnu.org
Richard M. Stallman's avatar
Richard M. Stallman committed
8
;; Keywords: data
9
;; Package: emacs
Richard M. Stallman's avatar
Richard M. Stallman committed
10 11 12

;; This file is part of GNU Emacs.

13
;; GNU Emacs is free software: you can redistribute it and/or modify
Richard M. Stallman's avatar
Richard M. Stallman committed
14
;; it under the terms of the GNU General Public License as published by
15 16
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
Richard M. Stallman's avatar
Richard M. Stallman committed
17 18 19 20 21 22 23

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
24
;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
Richard M. Stallman's avatar
Richard M. Stallman committed
25 26 27

;;; Commentary:

28
;; This file contains the code to enable and disable Auto-Compression mode.
Richard M. Stallman's avatar
Richard M. Stallman committed
29 30 31 32 33 34
;; It is preloaded.  The guts of this mode are in jka-compr.el, which
;; is loaded only when you really try to uncompress something.

;;; Code:

(defgroup compression nil
35
  "Data compression utilities."
Richard M. Stallman's avatar
Richard M. Stallman committed
36 37 38
  :group 'data)

(defgroup jka-compr nil
39
  "jka-compr customization."
Richard M. Stallman's avatar
Richard M. Stallman committed
40
  :group 'compression)
Glenn Morris's avatar
Glenn Morris committed
41 42 43 44 45 46

(defcustom jka-compr-verbose t
  "If non-nil, output messages whenever compressing or uncompressing files."
  :version "24.1"
  :type 'boolean
  :group 'jka-compr)
Richard M. Stallman's avatar
Richard M. Stallman committed
47 48 49 50 51 52

;; List of all the elements we actually added to file-coding-system-alist.
(defvar jka-compr-added-to-file-coding-system-alist nil)

(defvar jka-compr-file-name-handler-entry
  nil
53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78
  "`file-name-handler-alist' entry used by jka-compr I/O functions.")

;; Compiler defvars.  These three variables will be defined later with
;; `defcustom' when everything used in the :set functions is defined.
(defvar jka-compr-compression-info-list)
(defvar jka-compr-mode-alist-additions)
(defvar jka-compr-load-suffixes)

(defvar jka-compr-compression-info-list--internal nil
  "Stored value of `jka-compr-compression-info-list'.
If Auto Compression mode is enabled, this is the value of
`jka-compr-compression-info-list' when `jka-compr-install' was last called.
Otherwise, it is nil.")

(defvar jka-compr-mode-alist-additions--internal nil
  "Stored value of `jka-compr-mode-alist-additions'.
If Auto Compression mode is enabled, this is the value of
`jka-compr-mode-alist-additions' when `jka-compr-install' was last called.
Otherwise, it is nil.")

(defvar jka-compr-load-suffixes--internal nil
  "Stored value of `jka-compr-load-suffixes'.
If Auto Compression mode is enabled, this is the value of
`jka-compr-load-suffixes' when `jka-compr-install' was last called.
Otherwise, it is nil.")

Richard M. Stallman's avatar
Richard M. Stallman committed
79 80

(defun jka-compr-build-file-regexp ()
81
  (purecopy
82 83 84 85 86 87 88 89 90 91 92 93
   (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 "?\\'"))))
Richard M. Stallman's avatar
Richard M. Stallman committed
94

95
;; Functions for accessing the return value of jka-compr-get-compression-info
Richard M. Stallman's avatar
Richard M. Stallman committed
96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111
(defun jka-compr-info-regexp               (info)  (aref info 0))
(defun jka-compr-info-compress-message     (info)  (aref info 1))
(defun jka-compr-info-compress-program     (info)  (aref info 2))
(defun jka-compr-info-compress-args        (info)  (aref info 3))
(defun jka-compr-info-uncompress-message   (info)  (aref info 4))
(defun jka-compr-info-uncompress-program   (info)  (aref info 5))
(defun jka-compr-info-uncompress-args      (info)  (aref info 6))
(defun jka-compr-info-can-append           (info)  (aref info 7))
(defun jka-compr-info-strip-extension      (info)  (aref info 8))
(defun jka-compr-info-file-magic-bytes     (info)  (aref info 9))


(defun jka-compr-get-compression-info (filename)
  "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'."
112
  (setq filename (file-name-sans-versions filename))
Richard M. Stallman's avatar
Richard M. Stallman committed
113 114
  (catch 'compression-info
    (let ((case-fold-search nil))
115 116 117
      (dolist (x jka-compr-compression-info-list)
        (and (string-match (jka-compr-info-regexp x) filename)
             (throw 'compression-info x)))
Richard M. Stallman's avatar
Richard M. Stallman committed
118 119 120 121 122
      nil)))

(defun jka-compr-install ()
  "Install jka-compr.
This adds entries to `file-name-handler-alist' and `auto-mode-alist'
Glenn Morris's avatar
Glenn Morris committed
123
and `inhibit-local-variables-suffixes'."
Richard M. Stallman's avatar
Richard M. Stallman committed
124 125 126 127

  (setq jka-compr-file-name-handler-entry
	(cons (jka-compr-build-file-regexp) 'jka-compr-handler))

128 129
  (push jka-compr-file-name-handler-entry file-name-handler-alist)

130 131 132 133 134 135 136
  (setq jka-compr-compression-info-list--internal
	jka-compr-compression-info-list
	jka-compr-mode-alist-additions--internal
	jka-compr-mode-alist-additions
	jka-compr-load-suffixes--internal
	jka-compr-load-suffixes)

137 138 139 140 141 142 143 144 145 146 147 148
  (dolist (x jka-compr-compression-info-list)
    ;; Don't do multibyte encoding on the compressed files.
    (let ((elt (cons (jka-compr-info-regexp x)
                     '(no-conversion . no-conversion))))
      (push elt file-coding-system-alist)
      (push elt jka-compr-added-to-file-coding-system-alist))

    (and (jka-compr-info-strip-extension x)
         ;; Make entries in auto-mode-alist so that modes
         ;; are chosen right according to the file names
         ;; sans `.gz'.
         (push (list (jka-compr-info-regexp x) nil 'jka-compr) auto-mode-alist)
Glenn Morris's avatar
Glenn Morris committed
149 150 151 152
         ;; 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.
153
         (push (jka-compr-info-regexp x)
Glenn Morris's avatar
Glenn Morris committed
154
               inhibit-local-variables-suffixes)))
Richard M. Stallman's avatar
Richard M. Stallman committed
155 156 157 158
  (setq auto-mode-alist
	(append auto-mode-alist jka-compr-mode-alist-additions))

  ;; Make sure that (load "foo") will find /bla/foo.el.gz.
159 160
  (setq load-file-rep-suffixes
	(append load-file-rep-suffixes jka-compr-load-suffixes nil)))
Richard M. Stallman's avatar
Richard M. Stallman committed
161 162 163 164 165 166 167 168 169 170 171 172 173 174 175

(defun jka-compr-installed-p ()
  "Return non-nil if jka-compr is installed.
The return value is the entry in `file-name-handler-alist' for jka-compr."

  (let ((fnha file-name-handler-alist)
	(installed nil))

    (while (and fnha (not installed))
     (and (eq (cdr (car fnha)) 'jka-compr-handler)
	   (setq installed (car fnha)))
      (setq fnha (cdr fnha)))

    installed))

176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192
(defun jka-compr-update ()
  "Update Auto Compression mode for changes in option values.
If you change the options `jka-compr-compression-info-list',
`jka-compr-mode-alist-additions' or `jka-compr-load-suffixes'
outside Custom, while Auto Compression mode is already enabled
\(as it is by default), then you have to call this function
afterward to properly update other variables.  Setting these
options through Custom does this automatically."
  (when (jka-compr-installed-p)
    (jka-compr-uninstall)
    (jka-compr-install)))

(defun jka-compr-set (variable value)
  "Internal Custom :set function."
  (set-default variable value)
  (jka-compr-update))

193 194 195 196 197 198
;; 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.
(defcustom jka-compr-compression-info-list
  ;;[regexp
  ;; compr-message  compr-prog  compr-args
  ;; uncomp-message uncomp-prog uncomp-args
199
  ;; can-append strip-extension-flag file-magic-bytes]
200
  (mapcar 'purecopy
201
  '(["\\.Z\\'"
202
     "compressing"    "compress"     ("-c")
Glenn Morris's avatar
Glenn Morris committed
203
     ;; gzip is more common than uncompress. It can only read, not write.
204
     "uncompressing"  "gzip"   ("-c" "-q" "-d")
205 206 207 208
     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".
209
    ["\\.bz2\\'"
210 211 212
     "bzip2ing"        "bzip2"         nil
     "bunzip2ing"      "bzip2"         ("-d")
     nil t "BZh"]
213
    ["\\.tbz2?\\'"
214 215 216
     "bzip2ing"        "bzip2"         nil
     "bunzip2ing"      "bzip2"         ("-d")
     nil nil "BZh"]
217
    ["\\.\\(?:tgz\\|svgz\\|sifz\\)\\'"
218 219 220
     "compressing"        "gzip"         ("-c" "-q")
     "uncompressing"      "gzip"         ("-c" "-q" "-d")
     t nil "\037\213"]
221
    ["\\.g?z\\'"
222 223 224
     "compressing"        "gzip"         ("-c" "-q")
     "uncompressing"      "gzip"         ("-c" "-q" "-d")
     t t "\037\213"]
225 226 227 228 229 230 231 232
    ["\\.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 ""]
233
    ["\\.xz\\'"
234 235 236
     "XZ compressing"     "xz"           ("-c" "-q")
     "XZ uncompressing"   "xz"           ("-c" "-q" "-d")
     t t "\3757zXZ\0"]
237 238 239 240
    ["\\.txz\\'"
     "XZ compressing"     "xz"           ("-c" "-q")
     "XZ uncompressing"   "xz"           ("-c" "-q" "-d")
     t nil "\3757zXZ\0"]
241 242 243 244 245 246
    ;; 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")
Nick Terrell's avatar
Nick Terrell committed
247 248 249 250 251 252 253 254 255
     nil t "\037\213"]
    ["\\.zst\\'"
     "zstd compressing"   "zstd"         ("-c" "-q")
     "zstd uncompressing" "zstd"         ("-c" "-q" "-d")
     t t "\050\265\057\375"]
    ["\\.tzst\\'"
     "zstd compressing"   "zstd"         ("-c" "-q")
     "zstd uncompressing" "zstd"         ("-c" "-q" "-d")
     t nil "\050\265\057\375"]))
256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312

  "List of vectors that describe available compression techniques.
Each element, which describes a compression technique, is a vector of
the form [REGEXP COMPRESS-MSG COMPRESS-PROGRAM COMPRESS-ARGS
UNCOMPRESS-MSG UNCOMPRESS-PROGRAM UNCOMPRESS-ARGS
APPEND-FLAG STRIP-EXTENSION-FLAG FILE-MAGIC-CHARS], where:

   regexp                is a regexp that matches filenames that are
                         compressed with this format

   compress-msg          is the message to issue to the user when doing this
                         type of compression (nil means no message)

   compress-program      is a program that performs this compression
                         (nil means visit file in read-only mode)

   compress-args         is a list of args to pass to the compress program

   uncompress-msg        is the message to issue to the user when doing this
                         type of uncompression (nil means no message)

   uncompress-program    is a program that performs this compression

   uncompress-args       is a list of args to pass to the uncompress program

   append-flag           is non-nil if this compression technique can be
                         appended

   strip-extension-flag  non-nil means strip the regexp from file names
                         before attempting to set the mode.

   file-magic-chars      is a string of characters that you would find
			 at the beginning of a file compressed in this way.

If you set this outside Custom while Auto Compression mode is
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 (vector regexp
			 (choice :tag "Compress Message"
				 (string :format "%v")
				 (const :tag "No Message" nil))
			 (choice :tag "Compress Program"
				 (string)
				 (const :tag "None" nil))
			 (repeat :tag "Compress Arguments" string)
			 (choice :tag "Uncompress Message"
				 (string :format "%v")
				 (const :tag "No Message" nil))
			 (choice :tag "Uncompress Program"
				 (string)
				 (const :tag "None" nil))
			 (repeat :tag "Uncompress Arguments" string)
			 (boolean :tag "Append")
			 (boolean :tag "Strip Extension")
			 (string :tag "Magic Bytes")))
  :set 'jka-compr-set
313
  :version "24.1"			; removed version extension piece
314 315 316
  :group 'jka-compr)

(defcustom jka-compr-mode-alist-additions
317 318
  (purecopy '(("\\.tgz\\'" . tar-mode)
              ("\\.tbz2?\\'" . tar-mode)
Nick Terrell's avatar
Nick Terrell committed
319 320
              ("\\.txz\\'" . tar-mode)
              ("\\.tzst\\'" . tar-mode)))
321 322 323 324 325 326 327 328 329
  "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.

If you set this outside Custom while Auto Compression mode is
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))
330
  :version "24.4"			; add txz
331 332 333
  :set 'jka-compr-set
  :group 'jka-compr)

334
(defcustom jka-compr-load-suffixes (purecopy '(".gz"))
335 336 337 338 339 340 341 342 343 344 345 346 347
  "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
from `load-file-rep-suffixes' that enabling added.

If you set this outside Custom while Auto Compression mode is
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 string)
  :set 'jka-compr-set
  :group 'jka-compr)

Richard M. Stallman's avatar
Richard M. Stallman committed
348
(define-minor-mode auto-compression-mode
349 350 351 352 353
  "Toggle Auto Compression mode.

Auto Compression mode is a global minor mode.  When enabled,
compressed files are automatically uncompressed for reading, and
compressed when writing."
354
  :global t :init-value t :group 'jka-compr :version "22.1"
Richard M. Stallman's avatar
Richard M. Stallman committed
355 356 357 358 359 360 361 362 363
  (let* ((installed (jka-compr-installed-p))
	 (flag auto-compression-mode))
    (cond
     ((and flag installed) t)		; already installed
     ((and (not flag) (not installed)) nil) ; already not installed
     (flag (jka-compr-install))
     (t (jka-compr-uninstall)))))

(defmacro with-auto-compression-mode (&rest body)
Juanma Barranquero's avatar
Juanma Barranquero committed
364
  "Evaluate BODY with automatic file compression and uncompression enabled."
Stefan Monnier's avatar
Stefan Monnier committed
365
  (declare (indent 0))
Richard M. Stallman's avatar
Richard M. Stallman committed
366 367 368 369 370 371 372 373 374 375
  (let ((already-installed (make-symbol "already-installed")))
    `(let ((,already-installed (jka-compr-installed-p)))
       (unwind-protect
	   (progn
	     (unless ,already-installed
	       (jka-compr-install))
	     ,@body)
	 (unless ,already-installed
	   (jka-compr-uninstall))))))

376 377
;; This is what we need to know about jka-compr-handler
;; in order to decide when to call it.
Richard M. Stallman's avatar
Richard M. Stallman committed
378 379

(put 'jka-compr-handler 'safe-magic t)
380
(put 'jka-compr-handler 'operations '(byte-compiler-base-file-name
Richard M. Stallman's avatar
Richard M. Stallman committed
381 382 383
				      write-region insert-file-contents
				      file-local-copy load))

384
;; Turn on the mode.
385
(when auto-compression-mode (auto-compression-mode 1))
Richard M. Stallman's avatar
Richard M. Stallman committed
386

387
(provide 'jka-cmpr-hook)
Richard M. Stallman's avatar
Richard M. Stallman committed
388

389
;;; jka-cmpr-hook.el ends here