Commit e073a356 authored by Richard M. Stallman's avatar Richard M. Stallman
Browse files

(jka-compr-info-file-magic-bytes): New function.

(jka-compr-compression-info-list): Add new elt to each vector.
(jka-compr-write-region): Don't compress the data if it is already compressed.

(jka-compr-really-do-compress): New variable.
(jka-compr-insert-file-contents): Set jka-compr-really-do-compress if visiting.
(jka-compr-write-region): Set jka-compr-really-do-compress
if visiting.  Test it when deciding to compress.
parent f21b06b7
......@@ -126,32 +126,32 @@ for `jka-compr-compression-info-list')."
;;[regexp
;; compr-message compr-prog compr-args
;; uncomp-message uncomp-prog uncomp-args
;; can-append auto-mode-flag]
;; can-append auto-mode-flag strip-extension-flag file-magic-bytes]
'(["\\.Z\\(~\\|\\.~[0-9]+~\\)?\\'"
"compressing" "compress" ("-c")
"uncompressing" "uncompress" ("-c")
nil t]
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]
nil t "BZh"]
["\\.tgz\\'"
"zipping" "gzip" ("-c" "-q")
"unzipping" "gzip" ("-c" "-q" "-d")
t nil]
t nil "\037\213"]
["\\.gz\\(~\\|\\.~[0-9]+~\\)?\\'"
"zipping" "gzip" ("-c" "-q")
"unzipping" "gzip" ("-c" "-q" "-d")
t t])
t 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 EXTENSION], where:
APPEND-FLAG STRIP-EXTENSION-FLAG FILE-MAGIC-CHARS], where:
regexp is a regexp that matches filenames that are
compressed with this format
......@@ -173,9 +173,12 @@ APPEND-FLAG EXTENSION], where:
append-flag is non-nil if this compression technique can be
appended
auto-mode flag non-nil means strip the regexp from file names
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."
......@@ -204,6 +207,10 @@ 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-really-do-compress nil
"Non-nil in a buffer whose visited file was uncompressed on visiting it.")
(put 'jka-compr-really-do-compress 'permanent-local t)
;;; Functions for accessing the return value of jka-compr-get-compression-info
(defun jka-compr-info-regexp (info) (aref info 0))
......@@ -215,6 +222,7 @@ invoked."
(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)
......@@ -366,96 +374,116 @@ There should be no more than seven characters after the final `/'."
(defun jka-compr-write-region (start end file &optional append visit)
(let* ((filename (expand-file-name file))
(visit-file (if (stringp visit) (expand-file-name visit) filename))
(info (jka-compr-get-compression-info visit-file)))
(if info
(let ((can-append (jka-compr-info-can-append info))
(compress-program (jka-compr-info-compress-program info))
(compress-message (jka-compr-info-compress-message info))
(uncompress-program (jka-compr-info-uncompress-program info))
(uncompress-message (jka-compr-info-uncompress-message info))
(compress-args (jka-compr-info-compress-args info))
(uncompress-args (jka-compr-info-uncompress-args info))
(base-name (file-name-nondirectory visit-file))
temp-file temp-buffer
;; we need to leave `last-coding-system-used' set to its
;; value after calling write-region the first time, so
;; that `basic-save-buffer' sees the right value.
(coding-system-used last-coding-system-used))
(setq temp-buffer (get-buffer-create " *jka-compr-wr-temp*"))
(with-current-buffer temp-buffer
(widen) (erase-buffer))
(if (and append
(not can-append)
(file-exists-p filename))
(let* ((local-copy (file-local-copy filename))
(local-file (or local-copy filename)))
(setq temp-file local-file))
(setq temp-file (jka-compr-make-temp-name)))
(and
compress-message
(message "%s %s..." compress-message base-name))
(jka-compr-run-real-handler 'write-region
(list start end temp-file t 'dont))
;; save value used by the real write-region
(setq coding-system-used last-coding-system-used)
;; Here we must read the output of compress program as is
;; without any code conversion.
(let ((coding-system-for-read 'no-conversion))
(jka-compr-call-process compress-program
(concat compress-message
" " base-name)
temp-file
temp-buffer
nil
compress-args))
(with-current-buffer temp-buffer
(let ((coding-system-for-write 'no-conversion))
(if (memq system-type '(ms-dos windows-nt))
(setq buffer-file-type t) )
(jka-compr-run-real-handler 'write-region
(list (point-min) (point-max)
filename
(and append can-append) 'dont))
(erase-buffer)) )
(jka-compr-delete-temp-file temp-file)
(info (jka-compr-get-compression-info visit-file))
(magic (and info (jka-compr-info-file-magic-bytes info))))
;; If we uncompressed this file when visiting it,
;; then recompress it when writing it
;; even if the contents look compressed already.
(if (and jka-compr-really-do-compress
(eq start 1)
(eq end (1+ (buffer-size))))
(setq magic nil))
(if (and info
;; If the contents to be written out
;; are properly compressed already,
;; don't try to compress them over again.
(not (and magic
(equal (if (stringp start)
(substring start 0 (min (length start)
(length magic)))
(buffer-substring start
(min end
(+ start (length magic)))))
magic))))
(let ((can-append (jka-compr-info-can-append info))
(compress-program (jka-compr-info-compress-program info))
(compress-message (jka-compr-info-compress-message info))
(uncompress-program (jka-compr-info-uncompress-program info))
(uncompress-message (jka-compr-info-uncompress-message info))
(compress-args (jka-compr-info-compress-args info))
(uncompress-args (jka-compr-info-uncompress-args info))
(base-name (file-name-nondirectory visit-file))
temp-file temp-buffer
;; we need to leave `last-coding-system-used' set to its
;; value after calling write-region the first time, so
;; that `basic-save-buffer' sees the right value.
(coding-system-used last-coding-system-used))
(setq temp-buffer (get-buffer-create " *jka-compr-wr-temp*"))
(with-current-buffer temp-buffer
(widen) (erase-buffer))
(if (and append
(not can-append)
(file-exists-p filename))
(let* ((local-copy (file-local-copy filename))
(local-file (or local-copy filename)))
(setq temp-file local-file))
(setq temp-file (jka-compr-make-temp-name)))
(and
compress-message
(message "%s %s..." compress-message base-name))
(jka-compr-run-real-handler 'write-region
(list start end temp-file t 'dont))
;; save value used by the real write-region
(setq coding-system-used last-coding-system-used)
;; Here we must read the output of compress program as is
;; without any code conversion.
(let ((coding-system-for-read 'no-conversion))
(jka-compr-call-process compress-program
(concat compress-message
" " base-name)
temp-file
temp-buffer
nil
compress-args))
(with-current-buffer temp-buffer
(let ((coding-system-for-write 'no-conversion))
(if (memq system-type '(ms-dos windows-nt))
(setq buffer-file-type t) )
(jka-compr-run-real-handler 'write-region
(list (point-min) (point-max)
filename
(and append can-append) 'dont))
(erase-buffer)) )
(jka-compr-delete-temp-file temp-file)
(and
compress-message
(message "%s %s...done" compress-message base-name))
(cond
((eq visit t)
(setq buffer-file-name filename)
(set-visited-file-modtime))
((stringp visit)
(setq buffer-file-name visit)
(let ((buffer-file-name filename))
(set-visited-file-modtime))))
(and (or (eq visit t)
(eq visit nil)
(stringp visit))
(message "Wrote %s" visit-file))
;; ensure `last-coding-system-used' has an appropriate value
(setq last-coding-system-used coding-system-used)
nil)
(and
compress-message
(message "%s %s...done" compress-message base-name))
(cond
((eq visit t)
(setq buffer-file-name filename)
(setq jka-compr-really-do-compress t)
(set-visited-file-modtime))
((stringp visit)
(setq buffer-file-name visit)
(let ((buffer-file-name filename))
(set-visited-file-modtime))))
(and (or (eq visit t)
(eq visit nil)
(stringp visit))
(message "Wrote %s" visit-file))
;; ensure `last-coding-system-used' has an appropriate value
(setq last-coding-system-used coding-system-used)
nil)
(jka-compr-run-real-handler 'write-region
(list 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)
......@@ -562,6 +590,7 @@ There should be no more than seven characters after the final `/'."
(progn
(unlock-buffer)
(setq buffer-file-name filename)
(setq jka-compr-really-do-compress t)
(set-visited-file-modtime)))
(and
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment