X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/9c40111a84759fb7e57625a6b8f39e83a4ec40b9..ac3232837188f7e1c4ffe34b76edede0ccb54f5e:/lisp/jka-cmpr-hook.el diff --git a/lisp/jka-cmpr-hook.el b/lisp/jka-cmpr-hook.el index fb0a62d602..3377fed04c 100644 --- a/lisp/jka-cmpr-hook.el +++ b/lisp/jka-cmpr-hook.el @@ -1,7 +1,7 @@ ;;; jka-cmpr-hook.el --- preloaded code to enable jka-compr.el ;; Copyright (C) 1993, 1994, 1995, 1997, 1999, 2000, 2002, 2003, -;; 2004, 2005 Free Software Foundation, Inc. +;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. ;; Author: jka@ece.cmu.edu (Jay K. Adams) ;; Maintainer: FSF @@ -9,10 +9,10 @@ ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; 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. +;; 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 @@ -20,13 +20,11 @@ ;; 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., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: -;; This file contains the code to enable and disable Auto-Compression mode. +;; 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. @@ -40,21 +38,172 @@ "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. +;; 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.") + + +(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)) + (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 auto-mode-flag strip-extension-flag file-magic-bytes] + ;; can-append strip-extension-flag file-magic-bytes] '(["\\.Z\\(~\\|\\.~[0-9]+~\\)?\\'" "compressing" "compress" ("-c") - "uncompressing" "uncompress" ("-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\\'" + ["\\.bz2\\(~\\|\\.~[0-9]+~\\)?\\'" "bzip2ing" "bzip2" nil "bunzip2ing" "bzip2" ("-d") nil t "BZh"] @@ -62,7 +211,7 @@ "bzip2ing" "bzip2" nil "bunzip2ing" "bzip2" ("-d") nil nil "BZh"] - ["\\.tgz\\'" + ["\\.\\(?:tgz\\|svgz\\|sifz\\)\\(~\\|\\.~[0-9]+~\\)?\\'" "compressing" "gzip" ("-c" "-q") "uncompressing" "gzip" ("-c" "-q" "-d") t nil "\037\213"] @@ -111,9 +260,10 @@ APPEND-FLAG STRIP-EXTENSION-FLAG FILE-MAGIC-CHARS], where: 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." +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") @@ -132,129 +282,42 @@ invoked." (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 "\\.tgz\\'" 'tar-mode) (cons "\\.tbz\\'" 'tar-mode)) - "A list of pairs to add to `auto-mode-alist' when jka-compr is installed." + "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 '(".gz") - "List of suffixes to try when loading files." + "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) -;; 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 +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 @@ -277,16 +340,16 @@ Returns the new status of auto compression (non-nil means on)." (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. +;; 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. -(auto-compression-mode 1) +;; Turn on the mode. +(when auto-compression-mode (auto-compression-mode 1)) (provide 'jka-cmpr-hook)