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