aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorLars Ingebrigtsen2021-07-13 23:23:11 +0200
committerLars Ingebrigtsen2021-07-13 23:23:11 +0200
commit3ce37f5afa7d7852b0c69b355f531682efebc832 (patch)
tree9e456f7f11348eb327a08ff129c6d7e55dea3053
parente368f5603734394525417c886b0b3871aef72755 (diff)
downloademacs-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.el15
-rw-r--r--lisp/jka-compr.el124
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