aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJuri Linkov2019-02-03 23:00:29 +0200
committerJuri Linkov2019-02-03 23:00:29 +0200
commit4633b0ef3ff7fc8ac013e4236edf782fb3cadfb4 (patch)
tree86b978e4f2cd9f5fc9c6620a24b015856b004b0d
parentb32ac17c32486d8fce0fb9ecd5e09fe324448d3d (diff)
downloademacs-4633b0ef3ff7fc8ac013e4236edf782fb3cadfb4.tar.gz
emacs-4633b0ef3ff7fc8ac013e4236edf782fb3cadfb4.zip
* 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.
-rw-r--r--lisp/arc-mode.el4
-rw-r--r--lisp/tar-mode.el21
-rw-r--r--test/data/decompress/tg.tar.gzbin0 -> 150 bytes
-rw-r--r--test/data/decompress/zg.zipbin0 -> 182 bytes
-rw-r--r--test/lisp/arc-mode-tests.el14
-rw-r--r--test/lisp/tar-mode-tests.el13
-rw-r--r--test/lisp/vc/diff-mode-tests.el4
7 files changed, 54 insertions, 2 deletions
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."
967 ;; Don't re-compress this data just before decompressing it. 967 ;; Don't re-compress this data just before decompressing it.
968 (jka-compr-inhibit t)) 968 (jka-compr-inhibit t))
969 (write-region (point-min) (point-max) tmpfile nil 'quiet)) 969 (write-region (point-min) (point-max) tmpfile nil 'quiet))
970 (set-buffer-multibyte t)
970 (erase-buffer) 971 (erase-buffer)
971 (let ((coding-system-for-read 'no-conversion)) 972 (insert-file-contents tmpfile))
972 (insert-file-contents tmpfile)))
973 (delete-file tmpfile))))) 973 (delete-file tmpfile)))))
974 974
975(defun archive-file-name-handler (op &rest args) 975(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."
852 (goto-char (posn-point (event-end event))) 852 (goto-char (posn-point (event-end event)))
853 (tar-extract)) 853 (tar-extract))
854 854
855(defun tar--try-jka-compr ()
856 (when (and auto-compression-mode
857 (jka-compr-get-compression-info buffer-file-name))
858 (let* ((basename (file-name-nondirectory buffer-file-name))
859 (tmpname (if (string-match ":\\([^:]+\\)\\'" basename)
860 (match-string 1 basename) basename))
861 (tmpfile (make-temp-file (file-name-sans-extension tmpname)
862 nil
863 (file-name-extension tmpname 'period))))
864 (unwind-protect
865 (progn
866 (let ((coding-system-for-write 'no-conversion)
867 ;; Don't re-compress this data just before decompressing it.
868 (jka-compr-inhibit t))
869 (write-region (point-min) (point-max) tmpfile nil 'quiet))
870 (set-buffer-multibyte t)
871 (erase-buffer)
872 (insert-file-contents tmpfile))
873 (delete-file tmpfile)))))
874
855(defun tar-file-name-handler (op &rest args) 875(defun tar-file-name-handler (op &rest args)
856 "Helper function for `tar-extract'." 876 "Helper function for `tar-extract'."
857 (or (eq op 'file-exists-p) 877 (or (eq op 'file-exists-p)
@@ -931,6 +951,7 @@ actually appear on disk when you save the tar-file's buffer."
931 (setq buffer-file-name new-buffer-file-name) 951 (setq buffer-file-name new-buffer-file-name)
932 (setq buffer-file-truename 952 (setq buffer-file-truename
933 (abbreviate-file-name buffer-file-name)) 953 (abbreviate-file-name buffer-file-name))
954 (tar--try-jka-compr) ;Pretty ugly hack :-(
934 ;; Force buffer-file-coding-system to what 955 ;; Force buffer-file-coding-system to what
935 ;; decode-coding-region actually used. 956 ;; decode-coding-region actually used.
936 (set-buffer-file-coding-system last-coding-system-used t) 957 (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 00000000000..3dc8185f56e
--- /dev/null
+++ b/test/data/decompress/tg.tar.gz
Binary files differ
diff --git a/test/data/decompress/zg.zip b/test/data/decompress/zg.zip
new file mode 100644
index 00000000000..c4c998ee63d
--- /dev/null
+++ b/test/data/decompress/zg.zip
Binary files differ
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 @@
21(require 'ert) 21(require 'ert)
22(require 'arc-mode) 22(require 'arc-mode)
23 23
24(defvar arc-mode-tests-data-directory
25 (expand-file-name "test/data/decompress" source-directory))
24 26
25(ert-deftest arc-mode-test-archive-int-to-mode () 27(ert-deftest arc-mode-test-archive-int-to-mode ()
26 (let ((alist (list (cons 448 "-rwx------") 28 (let ((alist (list (cons 448 "-rwx------")
@@ -32,6 +34,18 @@
32 (dolist (x alist) 34 (dolist (x alist)
33 (should (equal (cdr x) (archive-int-to-mode (car x))))))) 35 (should (equal (cdr x) (archive-int-to-mode (car x)))))))
34 36
37(ert-deftest arc-mode-test-zip-extract-gz ()
38 (skip-unless (and archive-zip-extract (executable-find (car archive-zip-extract))))
39 (skip-unless (executable-find "gzip"))
40 (let* ((zip-file (expand-file-name "zg.zip" arc-mode-tests-data-directory))
41 zip-buffer gz-buffer)
42 (unwind-protect
43 (with-current-buffer (setq zip-buffer (find-file-noselect zip-file))
44 (setq gz-buffer (archive-extract))
45 (should (equal (char-after) ?\N{SNOWFLAKE})))
46 (when (buffer-live-p zip-buffer) (kill-buffer zip-buffer))
47 (when (buffer-live-p gz-buffer) (kill-buffer gz-buffer)))))
48
35(provide 'arc-mode-tests) 49(provide 'arc-mode-tests)
36 50
37;; arc-mode-tests.el ends here 51;; 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 @@
21(require 'ert) 21(require 'ert)
22(require 'tar-mode) 22(require 'tar-mode)
23 23
24(defvar tar-mode-tests-data-directory
25 (expand-file-name "test/data/decompress" source-directory))
24 26
25(ert-deftest tar-mode-test-tar-grind-file-mode () 27(ert-deftest tar-mode-test-tar-grind-file-mode ()
26 (let ((alist (list (cons 448 "rwx------") 28 (let ((alist (list (cons 448 "rwx------")
@@ -31,6 +33,17 @@
31 (dolist (x alist) 33 (dolist (x alist)
32 (should (equal (cdr x) (tar-grind-file-mode (car x))))))) 34 (should (equal (cdr x) (tar-grind-file-mode (car x)))))))
33 35
36(ert-deftest tar-mode-test-tar-extract-gz ()
37 (skip-unless (executable-find "gzip"))
38 (let* ((tar-file (expand-file-name "tg.tar.gz" tar-mode-tests-data-directory))
39 tar-buffer gz-buffer)
40 (unwind-protect
41 (with-current-buffer (setq tar-buffer (find-file-noselect tar-file))
42 (setq gz-buffer (tar-extract))
43 (should (equal (char-after) ?\N{SNOWFLAKE})))
44 (when (buffer-live-p tar-buffer) (kill-buffer tar-buffer))
45 (when (buffer-live-p gz-buffer) (kill-buffer gz-buffer)))))
46
34(provide 'tar-mode-tests) 47(provide 'tar-mode-tests)
35 48
36;; tar-mode-tests.el ends here 49;; 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
204 204
205(ert-deftest diff-mode-test-font-lock () 205(ert-deftest diff-mode-test-font-lock ()
206 "Check font-locking of diff hunks." 206 "Check font-locking of diff hunks."
207 (skip-unless (executable-find shell-file-name))
208 (skip-unless (executable-find diff-command))
207 (let ((default-directory diff-mode-tests--datadir) 209 (let ((default-directory diff-mode-tests--datadir)
208 (old "hello_world.c") 210 (old "hello_world.c")
209 (new "hello_emacs.c") 211 (new "hello_emacs.c")
@@ -263,6 +265,8 @@ youthfulness
263 265
264(ert-deftest diff-mode-test-font-lock-syntax-one-line () 266(ert-deftest diff-mode-test-font-lock-syntax-one-line ()
265 "Check diff syntax highlighting for one line with no newline at end." 267 "Check diff syntax highlighting for one line with no newline at end."
268 (skip-unless (executable-find shell-file-name))
269 (skip-unless (executable-find diff-command))
266 (let ((default-directory diff-mode-tests--datadir) 270 (let ((default-directory diff-mode-tests--datadir)
267 (old "hello_world_1.c") 271 (old "hello_world_1.c")
268 (new "hello_emacs_1.c") 272 (new "hello_emacs_1.c")