diff options
| author | Lars Ingebrigtsen | 2021-07-13 23:23:11 +0200 |
|---|---|---|
| committer | Lars Ingebrigtsen | 2021-07-13 23:23:11 +0200 |
| commit | 3ce37f5afa7d7852b0c69b355f531682efebc832 (patch) | |
| tree | 9e456f7f11348eb327a08ff129c6d7e55dea3053 | |
| parent | e368f5603734394525417c886b0b3871aef72755 (diff) | |
| download | emacs-3ce37f5afa7d7852b0c69b355f531682efebc832.tar.gz emacs-3ce37f5afa7d7852b0c69b355f531682efebc832.zip | |
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.
| -rw-r--r-- | lisp/jka-cmpr-hook.el | 15 | ||||
| -rw-r--r-- | 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 11d93a6df9a..eadf5f0d500 100644 --- a/lisp/jka-cmpr-hook.el +++ b/lisp/jka-cmpr-hook.el | |||
| @@ -104,6 +104,9 @@ Otherwise, it is nil.") | |||
| 104 | (defun jka-compr-info-can-append (info) (aref info 7)) | 104 | (defun jka-compr-info-can-append (info) (aref info 7)) |
| 105 | (defun jka-compr-info-strip-extension (info) (aref info 8)) | 105 | (defun jka-compr-info-strip-extension (info) (aref info 8)) |
| 106 | (defun jka-compr-info-file-magic-bytes (info) (aref info 9)) | 106 | (defun jka-compr-info-file-magic-bytes (info) (aref info 9)) |
| 107 | (defun jka-compr-info-uncompress-function (info) | ||
| 108 | (and (> (length info) 10) | ||
| 109 | (aref info 10))) | ||
| 107 | 110 | ||
| 108 | 111 | ||
| 109 | (defun jka-compr-get-compression-info (filename) | 112 | (defun jka-compr-get-compression-info (filename) |
| @@ -197,13 +200,15 @@ options through Custom does this automatically." | |||
| 197 | ;;[regexp | 200 | ;;[regexp |
| 198 | ;; compr-message compr-prog compr-args | 201 | ;; compr-message compr-prog compr-args |
| 199 | ;; uncomp-message uncomp-prog uncomp-args | 202 | ;; uncomp-message uncomp-prog uncomp-args |
| 200 | ;; can-append strip-extension-flag file-magic-bytes] | 203 | ;; can-append strip-extension-flag file-magic-bytes |
| 204 | ;; uncompress-function] | ||
| 201 | (mapcar 'purecopy | 205 | (mapcar 'purecopy |
| 202 | '(["\\.Z\\'" | 206 | '(["\\.Z\\'" |
| 203 | "compressing" "compress" ("-c") | 207 | "compressing" "compress" ("-c") |
| 204 | ;; gzip is more common than uncompress. It can only read, not write. | 208 | ;; gzip is more common than uncompress. It can only read, not write. |
| 205 | "uncompressing" "gzip" ("-c" "-q" "-d") | 209 | "uncompressing" "gzip" ("-c" "-q" "-d") |
| 206 | nil t "\037\235"] | 210 | nil t "\037\235" |
| 211 | zlib-decompress-region] | ||
| 207 | ;; Formerly, these had an additional arg "-c", but that fails with | 212 | ;; Formerly, these had an additional arg "-c", but that fails with |
| 208 | ;; "Version 0.1pl2, 29-Aug-97." (RedHat 5.1 GNU/Linux) and | 213 | ;; "Version 0.1pl2, 29-Aug-97." (RedHat 5.1 GNU/Linux) and |
| 209 | ;; "Version 0.9.0b, 9-Sept-98". | 214 | ;; "Version 0.9.0b, 9-Sept-98". |
| @@ -218,11 +223,13 @@ options through Custom does this automatically." | |||
| 218 | ["\\.\\(?:tgz\\|svgz\\|sifz\\)\\'" | 223 | ["\\.\\(?:tgz\\|svgz\\|sifz\\)\\'" |
| 219 | "compressing" "gzip" ("-c" "-q") | 224 | "compressing" "gzip" ("-c" "-q") |
| 220 | "uncompressing" "gzip" ("-c" "-q" "-d") | 225 | "uncompressing" "gzip" ("-c" "-q" "-d") |
| 221 | t nil "\037\213"] | 226 | t nil "\037\213" |
| 227 | zlib-decompress-region] | ||
| 222 | ["\\.g?z\\'" | 228 | ["\\.g?z\\'" |
| 223 | "compressing" "gzip" ("-c" "-q") | 229 | "compressing" "gzip" ("-c" "-q") |
| 224 | "uncompressing" "gzip" ("-c" "-q" "-d") | 230 | "uncompressing" "gzip" ("-c" "-q" "-d") |
| 225 | t t "\037\213"] | 231 | t t "\037\213" |
| 232 | zlib-decompress-region] | ||
| 226 | ["\\.lz\\'" | 233 | ["\\.lz\\'" |
| 227 | "Lzip compressing" "lzip" ("-c" "-q") | 234 | "Lzip compressing" "lzip" ("-c" "-q") |
| 228 | "Lzip uncompressing" "lzip" ("-c" "-q" "-d") | 235 | "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 `/'." | |||
| 386 | 386 | ||
| 387 | (let ((uncompress-message (jka-compr-info-uncompress-message info)) | 387 | (let ((uncompress-message (jka-compr-info-uncompress-message info)) |
| 388 | (uncompress-program (jka-compr-info-uncompress-program info)) | 388 | (uncompress-program (jka-compr-info-uncompress-program info)) |
| 389 | (uncompress-function (jka-compr-info-uncompress-function info)) | ||
| 389 | (uncompress-args (jka-compr-info-uncompress-args info)) | 390 | (uncompress-args (jka-compr-info-uncompress-args info)) |
| 390 | (base-name (file-name-nondirectory filename)) | 391 | (base-name (file-name-nondirectory filename)) |
| 391 | (notfound nil) | 392 | (notfound nil) |
| @@ -409,58 +410,77 @@ There should be no more than seven characters after the final `/'." | |||
| 409 | jka-compr-verbose | 410 | jka-compr-verbose |
| 410 | (message "%s %s..." uncompress-message base-name)) | 411 | (message "%s %s..." uncompress-message base-name)) |
| 411 | 412 | ||
| 412 | (condition-case error-code | 413 | (if (and (not (executable-find uncompress-program)) |
| 413 | 414 | uncompress-function | |
| 414 | (let ((coding-system-for-read 'no-conversion)) | 415 | (fboundp uncompress-function)) |
| 415 | (if replace | 416 | ;; If we don't have the uncompression program, then use the |
| 416 | (goto-char (point-min))) | 417 | ;; internal uncompression function (if we have one). |
| 417 | (setq start (point)) | 418 | (progn |
| 418 | (if (or beg end) | 419 | (insert |
| 419 | (jka-compr-partial-uncompress uncompress-program | 420 | (with-temp-buffer |
| 420 | (concat uncompress-message | 421 | (set-buffer-multibyte nil) |
| 421 | " " base-name) | 422 | (insert-file-contents-literally file) |
| 422 | uncompress-args | 423 | (funcall uncompress-function (point-min) (point-max)) |
| 423 | local-file | 424 | (when end |
| 424 | (or beg 0) | 425 | (delete-region end (point-max))) |
| 425 | (if (and beg end) | 426 | (when beg |
| 426 | (- end beg) | 427 | (delete-region (point-min) beg)) |
| 427 | end)) | 428 | (setq size (buffer-size)) |
| 428 | ;; If visiting, bind off buffer-file-name so that | 429 | (buffer-string))) |
| 429 | ;; file-locking will not ask whether we should | 430 | (goto-char (point-min))) |
| 430 | ;; really edit the buffer. | 431 | ;; Use the external uncompression program. |
| 431 | (let ((buffer-file-name | 432 | (condition-case error-code |
| 432 | (if visit nil buffer-file-name))) | 433 | |
| 433 | (jka-compr-call-process uncompress-program | 434 | (let ((coding-system-for-read 'no-conversion)) |
| 434 | (concat uncompress-message | 435 | (if replace |
| 435 | " " base-name) | 436 | (goto-char (point-min))) |
| 436 | local-file | 437 | (setq start (point)) |
| 437 | t | 438 | (if (or beg end) |
| 438 | nil | 439 | (jka-compr-partial-uncompress |
| 439 | uncompress-args))) | 440 | uncompress-program |
| 440 | (setq size (- (point) start)) | 441 | (concat uncompress-message " " base-name) |
| 441 | (if replace | 442 | uncompress-args |
| 442 | (delete-region (point) (point-max))) | 443 | local-file |
| 443 | (goto-char start)) | 444 | (or beg 0) |
| 444 | (error | 445 | (if (and beg end) |
| 445 | ;; If the file we wanted to uncompress does not exist, | 446 | (- end beg) |
| 446 | ;; handle that according to VISIT as `insert-file-contents' | 447 | end)) |
| 447 | ;; would, maybe signaling the same error it normally would. | 448 | ;; If visiting, bind off buffer-file-name so that |
| 448 | (if (and (eq (car error-code) 'file-missing) | 449 | ;; file-locking will not ask whether we should |
| 449 | (eq (nth 3 error-code) local-file)) | 450 | ;; really edit the buffer. |
| 450 | (if visit | 451 | (let ((buffer-file-name |
| 451 | (setq notfound error-code) | 452 | (if visit nil buffer-file-name))) |
| 452 | (signal 'file-missing | 453 | (jka-compr-call-process uncompress-program |
| 453 | (cons "Opening input file" | 454 | (concat uncompress-message |
| 454 | (nthcdr 2 error-code)))) | 455 | " " base-name) |
| 455 | ;; If the uncompression program can't be found, | 456 | local-file |
| 456 | ;; signal that as a non-file error | 457 | t |
| 457 | ;; so that find-file-noselect-1 won't handle it. | 458 | nil |
| 458 | (if (and (memq 'file-error (get (car error-code) | 459 | uncompress-args))) |
| 459 | 'error-conditions)) | 460 | (setq size (- (point) start)) |
| 460 | (equal (cadr error-code) "Searching for program")) | 461 | (if replace |
| 461 | (error "Uncompression program `%s' not found" | 462 | (delete-region (point) (point-max))) |
| 462 | (nth 3 error-code))) | 463 | (goto-char start)) |
| 463 | (signal (car error-code) (cdr error-code)))))) | 464 | (error |
| 465 | ;; If the file we wanted to uncompress does not exist, | ||
| 466 | ;; handle that according to VISIT as `insert-file-contents' | ||
| 467 | ;; would, maybe signaling the same error it normally would. | ||
| 468 | (if (and (eq (car error-code) 'file-missing) | ||
| 469 | (eq (nth 3 error-code) local-file)) | ||
| 470 | (if visit | ||
| 471 | (setq notfound error-code) | ||
| 472 | (signal 'file-missing | ||
| 473 | (cons "Opening input file" | ||
| 474 | (nthcdr 2 error-code)))) | ||
| 475 | ;; If the uncompression program can't be found, | ||
| 476 | ;; signal that as a non-file error | ||
| 477 | ;; so that find-file-noselect-1 won't handle it. | ||
| 478 | (if (and (memq 'file-error (get (car error-code) | ||
| 479 | 'error-conditions)) | ||
| 480 | (equal (cadr error-code) "Searching for program")) | ||
| 481 | (error "Uncompression program `%s' not found" | ||
| 482 | (nth 3 error-code))) | ||
| 483 | (signal (car error-code) (cdr error-code))))))) | ||
| 464 | 484 | ||
| 465 | (and | 485 | (and |
| 466 | local-copy | 486 | local-copy |