[bpt/emacs.git] / lisp / jka-cmpr-hook.el

;;; 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, 2009, 2010 Free Software Foundation, Inc.

;; Author: jka@ece.cmu.edu (Jay K. Adams)
;; Maintainer: FSF
;; Keywords: data

;; This file is part of GNU Emacs.

;; 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 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
;; 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
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; This file contains the code to enable and disable Auto-Compression mode.
;; 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
  "Data compression utilities."
  :group 'data)

(defgroup jka-compr nil
  "jka-compr customization."
  :group 'compression)

;; 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
  "`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.")

\f
(defun jka-compr-build-file-regexp ()
  (purecopy
  (mapconcat
   'jka-compr-info-regexp
   jka-compr-compression-info-list
   "\\|")))

;; Functions for accessing the return value of jka-compr-get-compression-info
(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'."
  (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)
      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'."

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

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

  (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)

  (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)
         ;; 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.
         (push (jka-compr-info-regexp x)
               inhibit-first-line-modes-suffixes)))
  (setq auto-mode-alist
	(append auto-mode-alist jka-compr-mode-alist-additions))

  ;; Make sure that (load "foo") will find /bla/foo.el.gz.
  (setq load-file-rep-suffixes
	(append load-file-rep-suffixes jka-compr-load-suffixes nil)))

(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))

(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))

;; 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]
  (mapcar 'purecopy
  '(["\\.Z\\(~\\|\\.~[0-9]+~\\)?\\'"
     "compressing"    "compress"     ("-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]+~\\)?\\'"
     "bzip2ing"        "bzip2"         nil
     "bunzip2ing"      "bzip2"         ("-d")
     nil t "BZh"]
    ["\\.tbz2?\\'"
     "bzip2ing"        "bzip2"         nil
     "bunzip2ing"      "bzip2"         ("-d")
     nil nil "BZh"]
    ["\\.\\(?:tgz\\|svgz\\|sifz\\)\\(~\\|\\.~[0-9]+~\\)?\\'"
     "compressing"        "gzip"         ("-c" "-q")
     "uncompressing"      "gzip"         ("-c" "-q" "-d")
     t nil "\037\213"]
    ["\\.g?z\\(~\\|\\.~[0-9]+~\\)?\\'"
     "compressing"        "gzip"         ("-c" "-q")
     "uncompressing"      "gzip"         ("-c" "-q" "-d")
     t t "\037\213"]
    ["\\.xz\\(~\\|\\.~[0-9]+~\\)?\\'"
     "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"]))

  "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
  :group 'jka-compr)

(defcustom jka-compr-mode-alist-additions
  (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.

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))
  :set 'jka-compr-set
  :group 'jka-compr)

(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
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)

(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)."
  :global t :init-value t :group 'jka-compr :version "22.1"
  (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)
  "Evalute BODY with automatic file compression and uncompression enabled."
  (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))))))
(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.

(put 'jka-compr-handler 'safe-magic t)
(put 'jka-compr-handler 'operations '(byte-compiler-base-file-name
				      write-region insert-file-contents
				      file-local-copy load))

;; Turn on the mode.
(when auto-compression-mode (auto-compression-mode 1))

(provide 'jka-cmpr-hook)

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