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.
This commit is contained in:
Lars Ingebrigtsen
parent
e368f56037
commit
3ce37f5afa
2 changed files with 82 additions and 55 deletions
|
|
@ -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")
|
||||
|
|
|
|||
|
|
@ -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
|
||||
(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))))))
|
||||
(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
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue