mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2025-01-02 11:21:42 +00:00
Many functions and vars moved to jka-compr-hook.el.
(jka-compr-handler): Add autoload. `put' calls moved to jka-compr-hook.el. (compression, jka-compr): defgroups moved to jka-compr-hook.el. (jka-compr-inhibit): Autoload.
This commit is contained in:
Richard M. Stallman
parent
216b5993d8
commit
0e2846fbad
@ -100,15 +100,6 @@
|
||||
|
||||
;;; Code:
|
||||
|
||||
(defgroup compression nil
|
||||
"Data compression utilities"
|
||||
:group 'data)
|
||||
|
||||
(defgroup jka-compr nil
|
||||
"jka-compr customization"
|
||||
:group 'compression)
|
||||
|
||||
|
||||
(defcustom jka-compr-shell "sh"
|
||||
"*Shell to be used for calling compression programs.
|
||||
The value of this variable only matters if you want to discard the
|
||||
@ -120,118 +111,6 @@ for `jka-compr-compression-info-list')."
|
||||
(defvar jka-compr-use-shell
|
||||
(not (memq system-type '(ms-dos windows-nt))))
|
||||
|
||||
;;; 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\\'"
|
||||
"zipping" "gzip" ("-c" "-q")
|
||||
"unzipping" "gzip" ("-c" "-q" "-d")
|
||||
t nil "\037\213"]
|
||||
["\\.g?z\\(~\\|\\.~[0-9]+~\\)?\\'"
|
||||
"zipping" "gzip" ("-c" "-q")
|
||||
"unzipping" "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
|
||||
"unzipping" "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.")
|
||||
|
||||
(defvar jka-compr-really-do-compress nil
|
||||
"Non-nil in a buffer whose visited file was uncompressed on visiting it.
|
||||
This means compress the data on writing the file, even if the
|
||||
@ -764,12 +643,13 @@ There should be no more than seven characters after the final `/'."
|
||||
(put 'byte-compiler-base-file-name 'jka-compr
|
||||
'jka-compr-byte-compiler-base-file-name)
|
||||
|
||||
;;;###autoload
|
||||
(defvar jka-compr-inhibit nil
|
||||
"Non-nil means inhibit automatic uncompression temporarily.
|
||||
Lisp programs can bind this to t to do that.
|
||||
It is not recommended to set this variable permanently to anything but nil.")
|
||||
|
||||
(put 'jka-compr-handler 'safe-magic t)
|
||||
;;;###autoload
|
||||
(defun jka-compr-handler (operation &rest args)
|
||||
(save-match-data
|
||||
(let ((jka-op (get operation 'jka-compr)))
|
||||
@ -790,65 +670,6 @@ It is not recommended to set this variable permanently to anything but nil.")
|
||||
(apply operation args)))
|
||||
|
||||
|
||||
(defun jka-compr-build-file-regexp ()
|
||||
(mapconcat
|
||||
'jka-compr-info-regexp
|
||||
jka-compr-compression-info-list
|
||||
"\\|"))
|
||||
|
||||
|
||||
(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-uninstall ()
|
||||
"Uninstall jka-compr.
|
||||
This removes the entries in `file-name-handler-alist' and `auto-mode-alist'
|
||||
@ -908,59 +729,6 @@ by `jka-compr-installed'."
|
||||
(push suffix suffixes)))
|
||||
(setq load-suffixes (nreverse 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))
|
||||
|
||||
|
||||
;;; Add the file I/O hook if it does not already exist.
|
||||
;;; Make sure that jka-compr-file-name-handler-entry is eq to the
|
||||
;;; entry for jka-compr in file-name-handler-alist.
|
||||
(and (jka-compr-installed-p)
|
||||
(jka-compr-uninstall))
|
||||
|
||||
|
||||
;;;###autoload
|
||||
(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)))))
|
||||
|
||||
|
||||
;;;###autoload
|
||||
(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)
|
||||
|
||||
|
||||
(provide 'jka-compr)
|
||||
|
||||
;;; arch-tag: 3f15b630-e9a7-46c4-a22a-94afdde86ebc
|
||||
|
||||
Loading…
Reference in New Issue
Block a user