From: Lars Ingebrigtsen Date: Tue, 13 Jul 2021 21:23:11 +0000 (+0200) Subject: Fall back on zlib-decompress-region if gzip doesn't exist X-Git-Tag: emacs-28.0.90~1881 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=3ce37f5afa7d7852b0c69b355f531682efebc832;p=emacs.git 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. --- diff --git a/lisp/jka-cmpr-hook.el b/lisp/jka-cmpr-hook.el index 11d93a6df9a..eadf5f0d500 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 2f98c8d9ff4..692b6b4adfb 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