;;; tar-mode.el --- simple editing of tar files from GNU Emacs
-;; Copyright (C) 1990-1991, 1993-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1991, 1993-2014 Free Software Foundation, Inc.
;; Author: Jamie Zawinski <jwz@lucid.com>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Created: 04 Apr 1990
;; Keywords: unix
:group 'tar)
(defvar tar-parse-info nil)
-(defvar tar-superior-buffer nil)
-(defvar tar-superior-descriptor nil)
+(defvar tar-superior-buffer nil
+ "Buffer containing the tar archive from which a member was extracted.")
+(defvar tar-superior-descriptor nil
+ "Tar descriptor for a member extracted from an archive.")
(defvar tar-file-name-coding-system nil)
(put 'tar-superior-buffer 'permanent-local t)
(progress-reporter-done progress-reporter)
(message "Warning: premature EOF parsing tar file"))
(goto-char (point-min))
- (let ((inhibit-read-only t)
+ (let ((buffer-file-truename nil) ; avoid changing dir mtime by lock_file
+ (inhibit-read-only t)
(total-summaries
(mapconcat 'tar-header-block-summarize tar-parse-info "\n")))
- (insert total-summaries "\n"))
- (goto-char (point-min))
- (restore-buffer-modified-p modified)))
+ (insert total-summaries "\n")
+ (goto-char (point-min))
+ (restore-buffer-modified-p modified))))
\f
(defvar tar-mode-map
(let ((map (make-keymap)))
nil
(error "This line does not describe a tar-file entry"))))
-(defun tar-get-descriptor ()
- (let* ((descriptor (tar-current-descriptor))
- (size (tar-header-size descriptor))
- (link-p (tar-header-link-type descriptor)))
+(defun tar--check-descriptor (descriptor)
+ (let ((link-p (tar-header-link-type descriptor)))
(if link-p
(error "This is %s, not a real file"
(cond ((eq link-p 5) "a directory")
((eq link-p 38) "a volume header")
((eq link-p 55) "a pax global extended header")
((eq link-p 72) "a pax extended header")
- (t "a link"))))
+ (t "a link"))))))
+
+(defun tar-get-descriptor ()
+ (let* ((descriptor (tar-current-descriptor))
+ (size (tar-header-size descriptor)))
+ (tar--check-descriptor descriptor)
(if (zerop size) (message "This is a zero-length file"))
descriptor))
+(defun tar-get-file-descriptor (file)
+ ;; Used by package.el.
+ (let ((desc ()))
+ (dolist (hdr tar-parse-info)
+ (when (equal file (tar-header-name hdr))
+ (setq desc hdr)))
+ (tar--check-descriptor desc)
+ desc))
+
(defun tar-mouse-extract (event)
"Extract a file whose tar directory line you click on."
(interactive "e")
(let ((file-name-handler-alist nil))
(apply op args))))
+(defun tar--extract (descriptor)
+ "Extract this entry of the tar file into its own buffer."
+ (let* ((name (tar-header-name descriptor))
+ (size (tar-header-size descriptor))
+ (start (tar-header-data-start descriptor))
+ (end (+ start size))
+ (tarname (buffer-name))
+ (bufname (concat (file-name-nondirectory name)
+ " ("
+ tarname
+ ")"))
+ (buffer (generate-new-buffer bufname)))
+ (with-current-buffer buffer
+ (setq buffer-undo-list t))
+ (with-current-buffer tar-data-buffer
+ (let (coding)
+ (narrow-to-region start end)
+ (goto-char start)
+ (setq coding (or coding-system-for-read
+ (and set-auto-coding-function
+ (funcall set-auto-coding-function
+ name (- end start)))
+ ;; The following binding causes
+ ;; find-buffer-file-type-coding-system
+ ;; (defined on dos-w32.el) to act as if
+ ;; the file being extracted existed, so
+ ;; that the file's contents' encoding and
+ ;; EOL format are auto-detected.
+ (let ((file-name-handler-alist
+ '(("" . tar-file-name-handler))))
+ (car (find-operation-coding-system
+ 'insert-file-contents
+ (cons name (current-buffer)) t)))))
+ (if (or (not coding)
+ (eq (coding-system-type coding) 'undecided))
+ (setq coding (detect-coding-region start end t)))
+ (if (and (default-value 'enable-multibyte-characters)
+ (coding-system-get coding :for-unibyte))
+ (with-current-buffer buffer
+ (set-buffer-multibyte nil)))
+ (widen)
+ (decode-coding-region start end coding buffer)))
+ buffer))
+
(defun tar-extract (&optional other-window-p)
"In Tar mode, extract this entry of the tar file into its own buffer."
(interactive)
(let* ((view-p (eq other-window-p 'view))
(descriptor (tar-get-descriptor))
(name (tar-header-name descriptor))
- (size (tar-header-size descriptor))
- (start (tar-header-data-start descriptor))
- (end (+ start size)))
- (let* ((tar-buffer (current-buffer))
- (tarname (buffer-name))
- (bufname (concat (file-name-nondirectory name)
- " ("
- tarname
- ")"))
- (read-only-p (or buffer-read-only view-p))
- (new-buffer-file-name (expand-file-name
- ;; `:' is not allowed on Windows
- (concat tarname "!"
- (if (string-match "/" name)
- name
- ;; Make sure `name' contains a /
- ;; so set-auto-mode doesn't try
- ;; to look at `tarname' for hints.
- (concat "./" name)))))
- (buffer (get-file-buffer new-buffer-file-name))
- (just-created nil)
- undo-list)
- (unless buffer
- (setq buffer (generate-new-buffer bufname))
- (with-current-buffer buffer
- (setq undo-list buffer-undo-list
- buffer-undo-list t))
- (setq bufname (buffer-name buffer))
- (setq just-created t)
- (with-current-buffer tar-data-buffer
- (let (coding)
- (narrow-to-region start end)
- (goto-char start)
- (setq coding (or coding-system-for-read
- (and set-auto-coding-function
- (funcall set-auto-coding-function
- name (- end start)))
- ;; The following binding causes
- ;; find-buffer-file-type-coding-system
- ;; (defined on dos-w32.el) to act as if
- ;; the file being extracted existed, so
- ;; that the file's contents' encoding and
- ;; EOL format are auto-detected.
- (let ((file-name-handler-alist
- '(("" . tar-file-name-handler))))
- (car (find-operation-coding-system
- 'insert-file-contents
- (cons name (current-buffer)) t)))))
- (if (or (not coding)
- (eq (coding-system-type coding) 'undecided))
- (setq coding (detect-coding-region start end t)))
- (if (and (default-value 'enable-multibyte-characters)
- (coding-system-get coding :for-unibyte))
- (with-current-buffer buffer
- (set-buffer-multibyte nil)))
- (widen)
- (decode-coding-region start end coding buffer)))
- (with-current-buffer buffer
- (goto-char (point-min))
- (setq buffer-file-name new-buffer-file-name)
- (setq buffer-file-truename
- (abbreviate-file-name buffer-file-name))
- ;; Force buffer-file-coding-system to what
- ;; decode-coding-region actually used.
- (set-buffer-file-coding-system last-coding-system-used t)
- ;; Set the default-directory to the dir of the
- ;; superior buffer.
- (setq default-directory
- (with-current-buffer tar-buffer
- default-directory))
- (rename-buffer bufname)
- (set-buffer-modified-p nil)
- (setq buffer-undo-list undo-list)
- (normal-mode) ; pick a mode.
- (set (make-local-variable 'tar-superior-buffer) tar-buffer)
- (set (make-local-variable 'tar-superior-descriptor) descriptor)
- (setq buffer-read-only read-only-p)
- (tar-subfile-mode 1)))
- (cond
- (view-p
- (view-buffer buffer (and just-created 'kill-buffer-if-not-modified)))
- ((eq other-window-p 'display) (display-buffer buffer))
- (other-window-p (switch-to-buffer-other-window buffer))
- (t (switch-to-buffer buffer))))))
+ (tar-buffer (current-buffer))
+ (tarname (buffer-name))
+ (read-only-p (or buffer-read-only view-p))
+ (new-buffer-file-name (expand-file-name
+ ;; `:' is not allowed on Windows
+ (concat tarname "!"
+ (if (string-match "/" name)
+ name
+ ;; Make sure `name' contains a /
+ ;; so set-auto-mode doesn't try
+ ;; to look at `tarname' for hints.
+ (concat "./" name)))))
+ (buffer (get-file-buffer new-buffer-file-name))
+ (just-created nil))
+ (unless buffer
+ (setq buffer (tar--extract descriptor))
+ (setq just-created t)
+ (with-current-buffer buffer
+ (goto-char (point-min))
+ (setq buffer-file-name new-buffer-file-name)
+ (setq buffer-file-truename
+ (abbreviate-file-name buffer-file-name))
+ ;; Force buffer-file-coding-system to what
+ ;; decode-coding-region actually used.
+ (set-buffer-file-coding-system last-coding-system-used t)
+ ;; Set the default-directory to the dir of the
+ ;; superior buffer.
+ (setq default-directory
+ (with-current-buffer tar-buffer
+ default-directory))
+ (set-buffer-modified-p nil)
+ (setq buffer-undo-list t)
+ (normal-mode) ; pick a mode.
+ (set (make-local-variable 'tar-superior-buffer) tar-buffer)
+ (set (make-local-variable 'tar-superior-descriptor) descriptor)
+ (setq buffer-read-only read-only-p)
+ (tar-subfile-mode 1)))
+ (cond
+ (view-p
+ (view-buffer buffer (and just-created 'kill-buffer-if-not-modified)))
+ ((eq other-window-p 'display) (display-buffer buffer))
+ (other-window-p (switch-to-buffer-other-window buffer))
+ (t (switch-to-buffer buffer)))))
(defun tar-extract-other-window ()