;;; Copyright (C) 1993, 1994 Free Software Foundation, Inc.
;; Author: jka@ece.cmu.edu (Jay K. Adams)
-;; Version: 0.11
;; Keywords: data
;;; Commentary:
;;; APPLICATION NOTES:
-;;;
-;;; rmail, vm, gnus, etc.
-;;; To use compressed mail folders, .newsrc files, etc., you need
-;;; only compress the file. Since jka-compr searches for .gz
-;;; versions of the files it's finding, you need not change
-;;; variables within rmail, gnus, etc.
-;;;
;;;
;;; crypt++
;;; jka-compr can coexist with crpyt++ if you take all the decompression
;; compr-message compr-prog compr-args
;; uncomp-message uncomp-prog uncomp-args
;; can-append auto-mode-flag]
- '(["\\.Z~?\\'"
+ '(["\\.Z\\(~\\|\\.~[0-9]+~\\)?\\'"
"compressing" "compress" ("-c")
"uncompressing" "uncompress" ("-c")
nil t]
- ["\\.gz~?\\'"
+ ["\\.gz\\(~\\|\\.~[0-9]+~\\)?\\'"
"zipping" "gzip" ("-c" "-q")
"unzipping" "gzip" ("-c" "-q" "-d")
t t])
auto-mode flag non-nil means strip the regexp from file names
before attempting to set the mode.
-Because of the way call-process is defined, discarding the stderr output of
+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.")
(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-op-table
- (make-vector 127 0)
- "Hash table of operations supported by jka-compr.")
\f
;;; Functions for accessing the return value of jka-get-compression-info
(defun jka-compr-info-regexp (info) (aref info 0))
(defun jka-compr-partial-uncompress (prog message args infile beg len)
"Call program PROG with ARGS args taking input from INFILE.
Fourth and fifth args, BEG and LEN, specify which part of the output
-to discard. All output is discarded unless it comes within LEN chars after
-the BEGth char."
-
+to keep: LEN chars starting BEG chars from the beginning."
(let* ((skip (/ beg jka-compr-dd-blocksize))
(prefix (- beg (* skip jka-compr-dd-blocksize)))
(count (and len (1+ (/ (+ len prefix) jka-compr-dd-blocksize))))
(jka-compr-delete-temp-file err-file))
+ ;; Delete the stuff after what we want, if there is any.
(and
len
+ (< (+ start prefix len) (point))
(delete-region (+ start prefix len) (point)))
+ ;; Delete the stuff before what we want.
(delete-region start (+ start prefix))))
(defun jka-compr-write-region (start end file &optional append visit)
- "Documented as original."
- (interactive "r\nFWrite region to file: ")
-
(let* ((filename (expand-file-name file))
(visit-file (if (stringp visit) (expand-file-name visit) filename))
(info (jka-compr-get-compression-info visit-file)))
compress-message
(message "%s %s..." compress-message base-name))
- (write-region start end temp-file t 'dont)
+ (jka-compr-run-real-handler 'write-region
+ (list start end temp-file t 'dont))
(jka-compr-call-process compress-program
(concat compress-message
compress-args)
(set-buffer temp-buffer)
- (write-region (point-min) (point-max)
- filename (and append can-append) 'dont)
+ (jka-compr-run-real-handler 'write-region
+ (list (point-min) (point-max)
+ filename
+ (and append can-append) 'dont))
(erase-buffer)
(set-buffer cbuf)
nil)
- (write-region start end filename append visit))))
+ (jka-compr-run-real-handler 'write-region
+ (list start end filename append visit)))))
(defun jka-compr-insert-file-contents (file &optional visit beg end replace)
- "Documented as original."
-
(barf-if-buffer-read-only)
(and (or beg end)
(uncompress-args (jka-compr-info-uncompress-args info))
(base-name (file-name-nondirectory filename))
(notfound nil)
- (local-copy (file-local-copy filename))
+ (local-copy
+ (jka-compr-run-real-handler 'file-local-copy (list filename)))
local-file
size start)
(condition-case error-code
(progn
+ (if replace
+ (goto-char (point-min)))
(setq start (point))
(if (or beg end)
(jka-compr-partial-uncompress uncompress-program
nil
uncompress-args))
(setq size (- (point) start))
+ (if replace
+ (let* ((del-beg (point))
+ (del-end (+ del-beg size)))
+ (delete-region del-beg
+ (min del-end (point-max)))))
(goto-char start))
-
-
(error
(if (and (eq (car error-code) 'file-error)
(eq (nth 3 error-code) local-file))
(and
visit
(progn
+ (unlock-buffer)
(setq buffer-file-name filename)
(set-visited-file-modtime)))
(signal 'file-error
(cons "Opening input file" (nth 2 notfound))))
+ ;; Run the functions that insert-file-contents would.
+ (let ((p after-insert-file-functions)
+ (insval size))
+ (while p
+ (setq insval (funcall (car p) size))
+ (if insval
+ (progn
+ (or (integerp insval)
+ (signal 'wrong-type-argument
+ (list 'integerp insval)))
+ (setq size insval)))
+ (setq p (cdr p))))
+
(list filename size))
- (insert-file-contents file visit beg end replace))))
+ (jka-compr-run-real-handler 'insert-file-contents
+ (list file visit beg end replace)))))
(defun jka-compr-file-local-copy (file)
- "Documented as original."
-
(let* ((filename (expand-file-name file))
(info (jka-compr-get-compression-info filename)))
(uncompress-program (jka-compr-info-uncompress-program info))
(uncompress-args (jka-compr-info-uncompress-args info))
(base-name (file-name-nondirectory filename))
- (local-copy (file-local-copy filename))
+ (local-copy
+ (jka-compr-run-real-handler 'file-local-copy (list filename)))
(temp-file (jka-compr-make-temp-name t))
(temp-buffer (get-buffer-create " *jka-compr-temp*"))
(notfound nil)
temp-file)
- (file-local-copy filename))))
+ (jka-compr-run-real-handler 'file-local-copy (list filename)))))
;;; Support for loading compressed files.
(unwind-protect
- (progn
-
- (setq file-name-handler-alist
- (cons jka-compr-file-name-handler-entry
- file-name-handler-alist))
-
+ (let (inhibit-file-name-operation
+ inhibit-file-name-handlers)
(or nomessage
(message "Loading %s..." file))
(or nomessage
(message "Loading %s...done." file)))
- (setq file-name-handler-alist
- (delq jka-compr-file-name-handler-entry
- file-name-handler-alist))
-
(jka-compr-delete-temp-file local-copy))
t))
-
+\f
+(put 'write-region 'jka-compr 'jka-compr-write-region)
+(put 'insert-file-contents 'jka-compr 'jka-compr-insert-file-contents)
+(put 'file-local-copy 'jka-compr 'jka-compr-file-local-copy)
+(put 'load 'jka-compr 'jka-compr-load)
(defun jka-compr-handler (operation &rest args)
-
- (let ((jka-op (intern-soft (symbol-name operation) jka-compr-op-table))
- (match-data (match-data)))
-
- (unwind-protect
- (progn
- (setq file-name-handler-alist
- (delq jka-compr-file-name-handler-entry
- file-name-handler-alist))
- (if jka-op
- (apply jka-op args)
- (jka-compr-run-real-handler operation args)))
-
- (setq file-name-handler-alist
- (cons jka-compr-file-name-handler-entry
- file-name-handler-alist))
- (store-match-data match-data))))
+ (save-match-data
+ (let ((jka-op (get operation 'jka-compr)))
+ (if jka-op
+ (apply jka-op args)
+ (jka-compr-run-real-handler operation args)))))
;; If we are given an operation that we don't handle,
;; call the Emacs primitive for that operation,
(inhibit-file-name-operation operation))
(apply operation args)))
-
-(defun jka-compr-intern-operation (op)
- (let ((opsym (intern (symbol-name op) jka-compr-op-table))
- (jka-fn (intern (concat "jka-compr-" (symbol-name op)))))
- (fset opsym jka-fn)))
-
-
-(defvar jka-compr-operation-list
- '(
- write-region
- insert-file-contents
- file-local-copy
- load
- )
- "List of file operations implemented by jka-compr.")
-
-
-(mapcar
- (function
- (lambda (fn)
- (jka-compr-intern-operation fn)))
- jka-compr-operation-list)
-
-
(defun toggle-auto-compression (arg)
"Toggle automatic file compression and decompression.
With prefix argument ARG, turn auto compression on if positive, else off.
(setq file-name-handler-alist (cons jka-compr-file-name-handler-entry
file-name-handler-alist))
+ ;; Make entries in auto-mode-alist so that modes are chosen right
+ ;; according to the file names sans `.gz'.
(mapcar
(function (lambda (x)
(and
HCoop / bpt / emacs.git / blobdiff