[Emacs-diffs] master 4633b0e: * lisp/tar-mode.el (tar-extract): Call tar--try-jka-compr (bug#34251)

[Juri Linkov]

branch: master
commit 4633b0ef3ff7fc8ac013e4236edf782fb3cadfb4
Author: Juri Linkov <address@hidden>
Commit: Juri Linkov <address@hidden>

    * lisp/tar-mode.el (tar-extract): Call tar--try-jka-compr (bug#34251)
    
    * lisp/tar-mode.el (tar--try-jka-compr): New function copied from
    archive-try-jka-compr.
    
    * lisp/arc-mode.el (archive-try-jka-compr): Set buffer-multibyte to t
    instead of let-binding coding-system-for-read to 'no-conversion.
    
    * test/data/decompress/tg.tar.gz:
    * test/data/decompress/zg.zip: New fixtures.
    
    * test/lisp/arc-mode-tests.el (arc-mode-test-zip-extract-gz):
    * test/lisp/tar-mode-tests.el (tar-mode-test-tar-extract-gz): New tests.
    
    * test/lisp/vc/diff-mode-tests.el (diff-mode-test-font-lock)
    (diff-mode-test-font-lock-syntax-one-line): Skip unless shell and
    diff executables are found.
---
 lisp/arc-mode.el                |   4 ++--
 lisp/tar-mode.el                |  21 +++++++++++++++++++++
 test/data/decompress/tg.tar.gz  | Bin 0 -> 150 bytes
 test/data/decompress/zg.zip     | Bin 0 -> 182 bytes
 test/lisp/arc-mode-tests.el     |  14 ++++++++++++++
 test/lisp/tar-mode-tests.el     |  13 +++++++++++++
 test/lisp/vc/diff-mode-tests.el |   4 ++++
 7 files changed, 54 insertions(+), 2 deletions(-)

diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el
index 263f251..2b5b616 100644
--- a/lisp/arc-mode.el
+++ b/lisp/arc-mode.el
@@ -967,9 +967,9 @@ using `make-temp-file', and the generated name is returned."
                   ;; Don't re-compress this data just before decompressing it.
                   (jka-compr-inhibit t))
               (write-region (point-min) (point-max) tmpfile nil 'quiet))
+            (set-buffer-multibyte t)
             (erase-buffer)
-            (let ((coding-system-for-read 'no-conversion))
-              (insert-file-contents tmpfile)))
+            (insert-file-contents tmpfile))
         (delete-file tmpfile)))))
 
 (defun archive-file-name-handler (op &rest args)
diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el
index 5b83d17..c5382d3 100644
--- a/lisp/tar-mode.el
+++ b/lisp/tar-mode.el
@@ -852,6 +852,26 @@ actually appear on disk when you save the tar-file's 
buffer."
   (goto-char (posn-point (event-end event)))
   (tar-extract))
 
+(defun tar--try-jka-compr ()
+  (when (and auto-compression-mode
+             (jka-compr-get-compression-info buffer-file-name))
+    (let* ((basename (file-name-nondirectory buffer-file-name))
+           (tmpname (if (string-match ":\\([^:]+\\)\\'" basename)
+                        (match-string 1 basename) basename))
+           (tmpfile (make-temp-file (file-name-sans-extension tmpname)
+                                    nil
+                                    (file-name-extension tmpname 'period))))
+      (unwind-protect
+          (progn
+            (let ((coding-system-for-write 'no-conversion)
+                  ;; Don't re-compress this data just before decompressing it.
+                  (jka-compr-inhibit t))
+              (write-region (point-min) (point-max) tmpfile nil 'quiet))
+            (set-buffer-multibyte t)
+            (erase-buffer)
+            (insert-file-contents tmpfile))
+        (delete-file tmpfile)))))
+
 (defun tar-file-name-handler (op &rest args)
   "Helper function for `tar-extract'."
   (or (eq op 'file-exists-p)
@@ -931,6 +951,7 @@ actually appear on disk when you save the tar-file's 
buffer."
         (setq buffer-file-name new-buffer-file-name)
         (setq buffer-file-truename
               (abbreviate-file-name buffer-file-name))
+        (tar--try-jka-compr)       ;Pretty ugly hack :-(
         ;; Force buffer-file-coding-system to what
         ;; decode-coding-region actually used.
         (set-buffer-file-coding-system last-coding-system-used t)
diff --git a/test/data/decompress/tg.tar.gz b/test/data/decompress/tg.tar.gz
new file mode 100644
index 0000000..3dc8185
Binary files /dev/null and b/test/data/decompress/tg.tar.gz differ
diff --git a/test/data/decompress/zg.zip b/test/data/decompress/zg.zip
new file mode 100644
index 0000000..c4c998e
Binary files /dev/null and b/test/data/decompress/zg.zip differ
diff --git a/test/lisp/arc-mode-tests.el b/test/lisp/arc-mode-tests.el
index e685767..79d3ac6 100644
--- a/test/lisp/arc-mode-tests.el
+++ b/test/lisp/arc-mode-tests.el
@@ -21,6 +21,8 @@
 (require 'ert)
 (require 'arc-mode)
 
+(defvar arc-mode-tests-data-directory
+  (expand-file-name "test/data/decompress" source-directory))
 
 (ert-deftest arc-mode-test-archive-int-to-mode ()
   (let ((alist (list (cons 448 "-rwx------")
@@ -32,6 +34,18 @@
     (dolist (x alist)
       (should (equal (cdr x) (archive-int-to-mode (car x)))))))
 
+(ert-deftest arc-mode-test-zip-extract-gz ()
+  (skip-unless (and archive-zip-extract (executable-find (car 
archive-zip-extract))))
+  (skip-unless (executable-find "gzip"))
+  (let* ((zip-file (expand-file-name "zg.zip" arc-mode-tests-data-directory))
+         zip-buffer gz-buffer)
+    (unwind-protect
+        (with-current-buffer (setq zip-buffer (find-file-noselect zip-file))
+          (setq gz-buffer (archive-extract))
+          (should (equal (char-after) ?\N{SNOWFLAKE})))
+      (when (buffer-live-p zip-buffer) (kill-buffer zip-buffer))
+      (when (buffer-live-p gz-buffer) (kill-buffer gz-buffer)))))
+
 (provide 'arc-mode-tests)
 
 ;; arc-mode-tests.el ends here
diff --git a/test/lisp/tar-mode-tests.el b/test/lisp/tar-mode-tests.el
index 3ad0ced..1fce200 100644
--- a/test/lisp/tar-mode-tests.el
+++ b/test/lisp/tar-mode-tests.el
@@ -21,6 +21,8 @@
 (require 'ert)
 (require 'tar-mode)
 
+(defvar tar-mode-tests-data-directory
+  (expand-file-name "test/data/decompress" source-directory))
 
 (ert-deftest tar-mode-test-tar-grind-file-mode ()
   (let ((alist (list (cons 448 "rwx------")
@@ -31,6 +33,17 @@
     (dolist (x alist)
       (should (equal (cdr x) (tar-grind-file-mode (car x)))))))
 
+(ert-deftest tar-mode-test-tar-extract-gz ()
+  (skip-unless (executable-find "gzip"))
+  (let* ((tar-file (expand-file-name "tg.tar.gz" 
tar-mode-tests-data-directory))
+         tar-buffer gz-buffer)
+    (unwind-protect
+        (with-current-buffer (setq tar-buffer (find-file-noselect tar-file))
+          (setq gz-buffer (tar-extract))
+          (should (equal (char-after) ?\N{SNOWFLAKE})))
+      (when (buffer-live-p tar-buffer) (kill-buffer tar-buffer))
+      (when (buffer-live-p gz-buffer) (kill-buffer gz-buffer)))))
+
 (provide 'tar-mode-tests)
 
 ;; tar-mode-tests.el ends here
diff --git a/test/lisp/vc/diff-mode-tests.el b/test/lisp/vc/diff-mode-tests.el
index 8e69054..8695d95 100644
--- a/test/lisp/vc/diff-mode-tests.el
+++ b/test/lisp/vc/diff-mode-tests.el
@@ -204,6 +204,8 @@ youthfulness
 
 (ert-deftest diff-mode-test-font-lock ()
   "Check font-locking of diff hunks."
+  (skip-unless (executable-find shell-file-name))
+  (skip-unless (executable-find diff-command))
   (let ((default-directory diff-mode-tests--datadir)
         (old "hello_world.c")
         (new "hello_emacs.c")
@@ -263,6 +265,8 @@ youthfulness
 
 (ert-deftest diff-mode-test-font-lock-syntax-one-line ()
   "Check diff syntax highlighting for one line with no newline at end."
+  (skip-unless (executable-find shell-file-name))
+  (skip-unless (executable-find diff-command))
   (let ((default-directory diff-mode-tests--datadir)
         (old "hello_world_1.c")
         (new "hello_emacs_1.c")