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 11d93a6df9a3bf9a2129c24d6b18ee7222301d77..eadf5f0d500a24d43a2767d38a1d59493f602428 100644 (file)
--- 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 2f98c8d9ff47574cbbf39d7ff531f0ffdd462106..692b6b4adfb0da708451b702be63621e57fd7aca 100644 (file)
--- 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