From 4633b0ef3ff7fc8ac013e4236edf782fb3cadfb4 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Sun, 3 Feb 2019 23:00:29 +0200 Subject: [PATCH] * 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(-) create mode 100644 test/data/decompress/tg.tar.gz create mode 100644 test/data/decompress/zg.zip diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index 263f251fc00..2b5b6166ad5 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 5b83d173b4a..c5382d3f3d1 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 0000000000000000000000000000000000000000..3dc8185f56e510139392dd25734ae8bb19b7c124 GIT binary patch literal 150 zcmb2|=3w~nJ1mBQ`RzGHzC#WoEf1$RC_H5F_{MTJx=g-WI7Dy-TgpNg&e1(tR>s x&!2=$J-+a6#Q){jzBJ9K_WRhdXWiH5c2w2hxq9L}hLTo{^A;6oJ Q4Wxz<2)%%G7>L6F0Ded!IsgCw literal 0 HcmV?d00001 diff --git a/test/lisp/arc-mode-tests.el b/test/lisp/arc-mode-tests.el index e6857671393..79d3ac6365c 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 3ad0ced01d6..1fce200721b 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 8e690548f05..8695d958bac 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") -- 2.39.5