[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 3ce37f5 1/3: Fall back on zlib-decompress-region if gzip doesn't
|
From: |
Lars Ingebrigtsen |
|
Subject: |
master 3ce37f5 1/3: Fall back on zlib-decompress-region if gzip doesn't exist |
|
Date: |
Tue, 13 Jul 2021 17:48:13 -0400 (EDT) |
branch: master
commit 3ce37f5afa7d7852b0c69b355f531682efebc832
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>
Fall back on zlib-decompress-region if gzip doesn't exist
* lisp/jka-cmpr-hook.el (jka-compr-info-uncompress-function): New
function (bug#18823).
(jka-compr-compression-info-list): Expand info with decompression
function.
* lisp/jka-compr.el (jka-compr-insert-file-contents): Fall back on
internal decompression function if external doesn't exist.
---
lisp/jka-cmpr-hook.el | 15 ++++--
lisp/jka-compr.el | 124 +++++++++++++++++++++++++++++---------------------
2 files changed, 83 insertions(+), 56 deletions(-)
diff --git a/lisp/jka-cmpr-hook.el b/lisp/jka-cmpr-hook.el
index 11d93a6..eadf5f0 100644
--- a/lisp/jka-cmpr-hook.el
+++ b/lisp/jka-cmpr-hook.el
@@ -104,6 +104,9 @@ Otherwise, it is nil.")
(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-info-uncompress-function (info)
+ (and (> (length info) 10)
+ (aref info 10)))
(defun jka-compr-get-compression-info (filename)
@@ -197,13 +200,15 @@ options through Custom does this automatically."
;;[regexp
;; compr-message compr-prog compr-args
;; uncomp-message uncomp-prog uncomp-args
- ;; can-append strip-extension-flag file-magic-bytes]
+ ;; can-append strip-extension-flag file-magic-bytes
+ ;; uncompress-function]
(mapcar 'purecopy
'(["\\.Z\\'"
"compressing" "compress" ("-c")
;; gzip is more common than uncompress. It can only read, not write.
"uncompressing" "gzip" ("-c" "-q" "-d")
- nil t "\037\235"]
+ nil t "\037\235"
+ zlib-decompress-region]
;; 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".
@@ -218,11 +223,13 @@ options through Custom does this automatically."
["\\.\\(?:tgz\\|svgz\\|sifz\\)\\'"
"compressing" "gzip" ("-c" "-q")
"uncompressing" "gzip" ("-c" "-q" "-d")
- t nil "\037\213"]
+ t nil "\037\213"
+ zlib-decompress-region]
["\\.g?z\\'"
"compressing" "gzip" ("-c" "-q")
"uncompressing" "gzip" ("-c" "-q" "-d")
- t t "\037\213"]
+ t t "\037\213"
+ zlib-decompress-region]
["\\.lz\\'"
"Lzip compressing" "lzip" ("-c" "-q")
"Lzip uncompressing" "lzip" ("-c" "-q" "-d")
diff --git a/lisp/jka-compr.el b/lisp/jka-compr.el
index 2f98c8d..692b6b4 100644
--- a/lisp/jka-compr.el
+++ b/lisp/jka-compr.el
@@ -386,6 +386,7 @@ There should be no more than seven characters after the
final `/'."
(let ((uncompress-message (jka-compr-info-uncompress-message info))
(uncompress-program (jka-compr-info-uncompress-program info))
+ (uncompress-function (jka-compr-info-uncompress-function info))
(uncompress-args (jka-compr-info-uncompress-args info))
(base-name (file-name-nondirectory filename))
(notfound nil)
@@ -409,58 +410,77 @@ There should be no more than seven characters after the
final `/'."
jka-compr-verbose
(message "%s %s..." uncompress-message base-name))
- (condition-case error-code
-
- (let ((coding-system-for-read 'no-conversion))
- (if replace
- (goto-char (point-min)))
- (setq start (point))
- (if (or beg end)
- (jka-compr-partial-uncompress uncompress-program
- (concat
uncompress-message
- " " base-name)
- uncompress-args
- local-file
- (or beg 0)
- (if (and beg end)
- (- end beg)
- end))
- ;; If visiting, bind off buffer-file-name so that
- ;; file-locking will not ask whether we should
- ;; really edit the buffer.
- (let ((buffer-file-name
- (if visit nil buffer-file-name)))
- (jka-compr-call-process uncompress-program
- (concat uncompress-message
- " " base-name)
- local-file
- t
- nil
- uncompress-args)))
- (setq size (- (point) start))
- (if replace
- (delete-region (point) (point-max)))
- (goto-char start))
- (error
- ;; If the file we wanted to uncompress does not exist,
- ;; handle that according to VISIT as `insert-file-contents'
- ;; would, maybe signaling the same error it normally would.
- (if (and (eq (car error-code) 'file-missing)
- (eq (nth 3 error-code) local-file))
- (if visit
- (setq notfound error-code)
- (signal 'file-missing
- (cons "Opening input file"
- (nthcdr 2 error-code))))
- ;; If the uncompression program can't be found,
- ;; signal that as a non-file error
- ;; so that find-file-noselect-1 won't handle it.
- (if (and (memq 'file-error (get (car error-code)
- 'error-conditions))
- (equal (cadr error-code) "Searching for program"))
- (error "Uncompression program `%s' not found"
- (nth 3 error-code)))
- (signal (car error-code) (cdr error-code))))))
+ (if (and (not (executable-find uncompress-program))
+ uncompress-function
+ (fboundp uncompress-function))
+ ;; If we don't have the uncompression program, then use the
+ ;; internal uncompression function (if we have one).
+ (progn
+ (insert
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert-file-contents-literally file)
+ (funcall uncompress-function (point-min) (point-max))
+ (when end
+ (delete-region end (point-max)))
+ (when beg
+ (delete-region (point-min) beg))
+ (setq size (buffer-size))
+ (buffer-string)))
+ (goto-char (point-min)))
+ ;; Use the external uncompression program.
+ (condition-case error-code
+
+ (let ((coding-system-for-read 'no-conversion))
+ (if replace
+ (goto-char (point-min)))
+ (setq start (point))
+ (if (or beg end)
+ (jka-compr-partial-uncompress
+ uncompress-program
+ (concat uncompress-message " " base-name)
+ uncompress-args
+ local-file
+ (or beg 0)
+ (if (and beg end)
+ (- end beg)
+ end))
+ ;; If visiting, bind off buffer-file-name so that
+ ;; file-locking will not ask whether we should
+ ;; really edit the buffer.
+ (let ((buffer-file-name
+ (if visit nil buffer-file-name)))
+ (jka-compr-call-process uncompress-program
+ (concat uncompress-message
+ " " base-name)
+ local-file
+ t
+ nil
+ uncompress-args)))
+ (setq size (- (point) start))
+ (if replace
+ (delete-region (point) (point-max)))
+ (goto-char start))
+ (error
+ ;; If the file we wanted to uncompress does not exist,
+ ;; handle that according to VISIT as `insert-file-contents'
+ ;; would, maybe signaling the same error it normally would.
+ (if (and (eq (car error-code) 'file-missing)
+ (eq (nth 3 error-code) local-file))
+ (if visit
+ (setq notfound error-code)
+ (signal 'file-missing
+ (cons "Opening input file"
+ (nthcdr 2 error-code))))
+ ;; If the uncompression program can't be found,
+ ;; signal that as a non-file error
+ ;; so that find-file-noselect-1 won't handle it.
+ (if (and (memq 'file-error (get (car error-code)
+ 'error-conditions))
+ (equal (cadr error-code) "Searching for
program"))
+ (error "Uncompression program `%s' not found"
+ (nth 3 error-code)))
+ (signal (car error-code) (cdr error-code)))))))
(and
local-copy