Mercurial > emacs

changeset 61945:a6e35466de6b

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
New file. Enable the mode by default.
author Richard M. Stallman <rms@gnu.org>
date Sat, 30 Apr 2005 20:15:33 +0000
parents beaf4d3d5cbf
children 982afd92d8bb
files lisp/jka-comp-hook.el
diffstat 1 files changed, 292 insertions(+), 0 deletions(-) [+]
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/jka-comp-hook.el	Sat Apr 30 20:15:33 2005 +0000
@@ -0,0 +1,292 @@
+;;; jka-comp-hook.el --- preloaded code to enable jka-compr.el
+
+;; Copyright (C) 1993, 1994, 1995, 1997, 1999, 2000, 2003, 2004, 2005  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 2, 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; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; 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)
+
+;;; 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
+  ;; can-append auto-mode-flag strip-extension-flag file-magic-bytes]
+  '(["\\.Z\\(~\\|\\.~[0-9]+~\\)?\\'"
+     "compressing"    "compress"     ("-c")
+     "uncompressing"  "uncompress"   ("-c")
+     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\\'"
+     "bzip2ing"        "bzip2"         nil
+     "bunzip2ing"      "bzip2"         ("-d")
+     nil t "BZh"]
+    ["\\.tbz\\'"
+     "bzip2ing"        "bzip2"         nil
+     "bunzip2ing"      "bzip2"         ("-d")
+     nil nil "BZh"]
+    ["\\.tgz\\'"
+     "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"]
+    ;; 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.
+
+Because of the way `call-process' is defined, discarding the stderr output of
+a program adds the overhead of starting a shell each time the program is
+invoked."
+  :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")))
+  :group 'jka-compr)
+
+(defcustom jka-compr-mode-alist-additions
+  (list (cons "\\.tgz\\'" 'tar-mode) (cons "\\.tbz\\'" 'tar-mode))
+  "A list of pairs to add to `auto-mode-alist' when jka-compr is installed."
+  :type '(repeat (cons string symbol))
+  :group 'jka-compr)
+
+(defcustom jka-compr-load-suffixes '(".gz")
+  "List of suffixes to try when loading files."
+  :type '(repeat string)
+  :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)
+
+(defvar jka-compr-file-name-handler-entry
+  nil
+  "The entry in `file-name-handler-alist' used by the jka-compr I/O functions.")
+
+(defun jka-compr-build-file-regexp ()
+  (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))
+      (mapcar
+       (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))
+
+  (setq file-name-handler-alist (cons jka-compr-file-name-handler-entry
+				      file-name-handler-alist))
+
+  (setq jka-compr-added-to-file-coding-system-alist nil)
+
+  (mapcar
+   (function (lambda (x)
+	       ;; Don't do multibyte encoding on the compressed files.
+	       (let ((elt (cons (jka-compr-info-regexp x)
+				 '(no-conversion . no-conversion))))
+		 (setq file-coding-system-alist
+		       (cons elt file-coding-system-alist))
+		 (setq jka-compr-added-to-file-coding-system-alist
+		       (cons 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'.
+		    (setq auto-mode-alist
+			  (cons (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.
+		    (setq inhibit-first-line-modes-suffixes
+			  (cons (jka-compr-info-regexp x)
+				inhibit-first-line-modes-suffixes)))))
+   jka-compr-compression-info-list)
+  (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-suffixes
+	(apply 'append
+	       (mapcar (lambda (suffix)
+			 (cons suffix
+			       (mapcar (lambda (ext) (concat suffix ext))
+				       jka-compr-load-suffixes)))
+		       load-suffixes))))
+
+
+(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))
+
+(define-minor-mode auto-compression-mode
+  "Toggle automatic file compression and uncompression.
+With prefix argument ARG, turn auto compression on if positive, else off.
+Returns the new status of auto compression (non-nil means on)."
+  :global t :group 'jka-compr
+  (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 '(jka-compr-byte-compiler-base-file-name
+				      write-region insert-file-contents
+				      file-local-copy load))
+
+;;; Turn on the mode.
+(auto-compression-mode 1)
+
+(provide 'jka-comp-hook)
+
+;;; jka-comp-hook.el ends here
\ No newline at end of file