;; 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)
(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)
(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)
(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------")
(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
(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------")
(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
(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")
(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")