diff options
| author | Juri Linkov | 2019-02-03 23:00:29 +0200 |
|---|---|---|
| committer | Juri Linkov | 2019-02-03 23:00:29 +0200 |
| commit | 4633b0ef3ff7fc8ac013e4236edf782fb3cadfb4 (patch) | |
| tree | 86b978e4f2cd9f5fc9c6620a24b015856b004b0d | |
| parent | b32ac17c32486d8fce0fb9ecd5e09fe324448d3d (diff) | |
| download | emacs-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.el | 4 | ||||
| -rw-r--r-- | lisp/tar-mode.el | 21 | ||||
| -rw-r--r-- | test/data/decompress/tg.tar.gz | bin | 0 -> 150 bytes | |||
| -rw-r--r-- | test/data/decompress/zg.zip | bin | 0 -> 182 bytes | |||
| -rw-r--r-- | test/lisp/arc-mode-tests.el | 14 | ||||
| -rw-r--r-- | test/lisp/tar-mode-tests.el | 13 | ||||
| -rw-r--r-- | 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 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") |