]> code.delx.au - gnu-emacs/blobdiff - lisp/tar-mode.el
(truncate-lines, write-file, print-buffer)
[gnu-emacs] / lisp / tar-mode.el
index 2e1b8c5d5deb8fbdcf3540baaa835911ea95f81e..4362e97af0b1ab663372408c6947d95c8ddd7561 100644 (file)
@@ -1,7 +1,7 @@
 ;;; tar-mode.el --- simple editing of tar files from GNU emacs
 
 ;;; tar-mode.el --- simple editing of tar files from GNU emacs
 
-;; Copyright (C) 1990,91,93,94,95,96,97,98,99,2000,2001
-;; Free Software Foundation, Inc.
+;; Copyright (C) 1990, 1991, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
+;;   2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
 
 ;; Author: Jamie Zawinski <jwz@lucid.com>
 ;; Maintainer: FSF
 
 ;; Author: Jamie Zawinski <jwz@lucid.com>
 ;; Maintainer: FSF
@@ -22,8 +22,8 @@
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; Commentary:
 
 
 ;;; Commentary:
 
@@ -41,7 +41,7 @@
 ;; This code now understands the extra fields that GNU tar adds to tar files.
 
 ;; This interacts correctly with "uncompress.el" in the Emacs library,
 ;; This code now understands the extra fields that GNU tar adds to tar files.
 
 ;; This interacts correctly with "uncompress.el" in the Emacs library,
-;; which you get with 
+;; which you get with
 ;;
 ;;  (autoload 'uncompress-while-visiting "uncompress")
 ;;  (setq auto-mode-alist (cons '("\\.Z$" . uncompress-while-visiting)
 ;;
 ;;  (autoload 'uncompress-while-visiting "uncompress")
 ;;  (setq auto-mode-alist (cons '("\\.Z$" . uncompress-while-visiting)
 ;;
 ;; Do not attempt to use tar-mode.el with crypt.el, you will lose.
 
 ;;
 ;; Do not attempt to use tar-mode.el with crypt.el, you will lose.
 
-;;    ***************   TO DO   *************** 
+;;    ***************   TO DO   ***************
 ;;
 ;; o  chmod should understand "a+x,og-w".
 ;;
 ;;
 ;; o  chmod should understand "a+x,og-w".
 ;;
-;; o  It's not possible to add a NEW file to a tar archive; not that 
+;; o  It's not possible to add a NEW file to a tar archive; not that
 ;;    important, but still...
 ;;
 ;; o  The code is less efficient that it could be - in a lot of places, I
 ;;    important, but still...
 ;;
 ;; o  The code is less efficient that it could be - in a lot of places, I
@@ -64,7 +64,7 @@
 ;;    of an archive, where <esc> would leave you in a subfile-edit buffer.
 ;;    (Like the Meta-R command of the Zmacs mail reader.)
 ;;
 ;;    of an archive, where <esc> would leave you in a subfile-edit buffer.
 ;;    (Like the Meta-R command of the Zmacs mail reader.)
 ;;
-;; o  Sometimes (but not always) reverting the tar-file buffer does not 
+;; o  Sometimes (but not always) reverting the tar-file buffer does not
 ;;    re-grind the listing, and you are staring at the binary tar data.
 ;;    Typing 'g' again immediately after that will always revert and re-grind
 ;;    it, though.  I have no idea why this happens.
 ;;    re-grind the listing, and you are staring at the binary tar data.
 ;;    Typing 'g' again immediately after that will always revert and re-grind
 ;;    it, though.  I have no idea why this happens.
@@ -76,7 +76,7 @@
 ;;    might be a problem if the tar write-file-hook does not come *first* on
 ;;    the list.
 ;;
 ;;    might be a problem if the tar write-file-hook does not come *first* on
 ;;    the list.
 ;;
-;; o  Block files, sparse files, continuation files, and the various header 
+;; o  Block files, sparse files, continuation files, and the various header
 ;;    types aren't editable.  Actually I don't know that they work at all.
 
 ;; Rationale:
 ;;    types aren't editable.  Actually I don't know that they work at all.
 
 ;; Rationale:
 (defcustom tar-anal-blocksize 20
   "*The blocksize of tar files written by Emacs, or nil, meaning don't care.
 The blocksize of a tar file is not really the size of the blocks; rather, it is
 (defcustom tar-anal-blocksize 20
   "*The blocksize of tar files written by Emacs, or nil, meaning don't care.
 The blocksize of a tar file is not really the size of the blocks; rather, it is
-the number of blocks written with one system call.  When tarring to a tape, 
+the number of blocks written with one system call.  When tarring to a tape,
 this is the size of the *tape* blocks, but when writing to a file, it doesn't
 matter much.  The only noticeable difference is that if a tar file does not
 have a blocksize of 20, tar will tell you that; all this really controls is
 this is the size of the *tape* blocks, but when writing to a file, it doesn't
 matter much.  The only noticeable difference is that if a tar file does not
 have a blocksize of 20, tar will tell you that; all this really controls is
@@ -117,7 +117,7 @@ If this is true, then editing and saving a tar file entry back into its
 tar file will update its datestamp.  If false, the datestamp is unchanged.
 You may or may not want this - it is good in that you can tell when a file
 in a tar archive has been changed, but it is bad for the same reason that
 tar file will update its datestamp.  If false, the datestamp is unchanged.
 You may or may not want this - it is good in that you can tell when a file
 in a tar archive has been changed, but it is bad for the same reason that
-editing a file in the tar archive at all is bad - the changed version of 
+editing a file in the tar archive at all is bad - the changed version of
 the file never exists on disk."
   :type 'boolean
   :group 'tar)
 the file never exists on disk."
   :type 'boolean
   :group 'tar)
@@ -201,7 +201,7 @@ This information is useful, but it takes screen space away from file names."
 
 (defun tar-header-block-tokenize (string)
   "Return a `tar-header' structure.
 
 (defun tar-header-block-tokenize (string)
   "Return a `tar-header' structure.
-This is a list of name, mode, uid, gid, size, 
+This is a list of name, mode, uid, gid, size,
 write-date, checksum, link-type, and link-name."
   (cond ((< (length string) 512) nil)
        (;(some 'plusp string)           ; <-- oops, massive cycle hog!
 write-date, checksum, link-type, and link-name."
   (cond ((< (length string) 512) nil)
        (;(some 'plusp string)           ; <-- oops, massive cycle hog!
@@ -289,7 +289,7 @@ write-date, checksum, link-type, and link-name."
     (dotimes (i L)
        (if (or (< (aref string i) ?0)
               (> (aref string i) ?7))
     (dotimes (i L)
        (if (or (< (aref string i) ?0)
               (> (aref string i) ?7))
-          (error "`%c' is not an octal digit"))))
+          (error "`%c' is not an octal digit" (aref string i)))))
   (tar-parse-octal-integer string))
 
 
   (tar-parse-octal-integer string))
 
 
@@ -349,13 +349,14 @@ MODE should be an integer which is a file mode value."
     (format "%c%c%s%8s/%-8s%7s%s %s%s"
            (if mod-p ?* ? )
            (cond ((or (eq type nil) (eq type 0)) ?-)
     (format "%c%c%s%8s/%-8s%7s%s %s%s"
            (if mod-p ?* ? )
            (cond ((or (eq type nil) (eq type 0)) ?-)
-                 ((eq type 1) ?l)      ; link
-                 ((eq type 2) ?s)      ; symlink
+                 ((eq type 1) ?h)      ; link
+                 ((eq type 2) ?l)      ; symlink
                  ((eq type 3) ?c)      ; char special
                  ((eq type 4) ?b)      ; block special
                  ((eq type 5) ?d)      ; directory
                  ((eq type 6) ?p)      ; FIFO/pipe
                  ((eq type 20) ?*)     ; directory listing
                  ((eq type 3) ?c)      ; char special
                  ((eq type 4) ?b)      ; block special
                  ((eq type 5) ?d)      ; directory
                  ((eq type 6) ?p)      ; FIFO/pipe
                  ((eq type 20) ?*)     ; directory listing
+                 ((eq type 28) ?L)     ; next has longname
                  ((eq type 29) ?M)     ; multivolume continuation
                  ((eq type 35) ?S)     ; sparse
                  ((eq type 38) ?V)     ; volume header
                  ((eq type 29) ?M)     ; multivolume continuation
                  ((eq type 35) ?S)     ; sparse
                  ((eq type 38) ?V)     ; volume header
@@ -373,17 +374,41 @@ MODE should be an integer which is a file mode value."
                (concat (if (= type 1) " ==> " " --> ") link-name)
              ""))))
 
                (concat (if (= type 1) " ==> " " --> ") link-name)
              ""))))
 
+(defun tar-untar-buffer ()
+  "Extract all archive members in the tar-file into the current directory."
+  (interactive)
+  (let ((multibyte enable-multibyte-characters))
+    (unwind-protect
+       (save-restriction
+         (widen)
+         (set-buffer-multibyte nil)
+         (dolist (descriptor tar-parse-info)
+           (let* ((tokens (tar-desc-tokens descriptor))
+                  (name (tar-header-name tokens))
+                  (dir (file-name-directory name))
+                  (start (+ (tar-desc-data-start descriptor)
+                            (- tar-header-offset (point-min))))
+                  (end (+ start (tar-header-size tokens))))
+             (unless (file-directory-p name)
+               (message "Extracting %s" name)
+               (if (and dir (not (file-exists-p dir)))
+                   (make-directory dir t))
+               (unless (file-directory-p name)
+                 (write-region start end name))
+               (set-file-modes name (tar-header-mode tokens))))))
+      (set-buffer-multibyte multibyte))))
+
 (defun tar-summarize-buffer ()
   "Parse the contents of the tar file in the current buffer.
 Place a dired-like listing on the front;
 then narrow to it, so that only that listing
 is visible (and the real data of the buffer is hidden)."
   (set-buffer-multibyte nil)
 (defun tar-summarize-buffer ()
   "Parse the contents of the tar file in the current buffer.
 Place a dired-like listing on the front;
 then narrow to it, so that only that listing
 is visible (and the real data of the buffer is hidden)."
   (set-buffer-multibyte nil)
-  (message "Parsing tar file...")
   (let* ((result '())
   (let* ((result '())
-        (pos 1)
-        (bs (max 1 (- (buffer-size) 1024))) ; always 2+ empty blocks at end.
-        (bs100 (max 1 (/ bs 100)))
+        (pos (point-min))
+        (progress-reporter
+         (make-progress-reporter "Parsing tar file..."
+                                 (point-min) (max 1 (- (buffer-size) 1024))))
         tokens)
     (while (and (<= (+ pos 512) (point-max))
                (not (eq 'empty-tar-block
         tokens)
     (while (and (<= (+ pos 512) (point-max))
                (not (eq 'empty-tar-block
@@ -391,10 +416,7 @@ is visible (and the real data of the buffer is hidden)."
                               (tar-header-block-tokenize
                                (buffer-substring pos (+ pos 512)))))))
       (setq pos (+ pos 512))
                               (tar-header-block-tokenize
                                (buffer-substring pos (+ pos 512)))))))
       (setq pos (+ pos 512))
-      (message "Parsing tar file...%d%%"
-              ;(/ (* pos 100) bs)   ; this gets round-off lossage
-              (/ pos bs100)         ; this doesn't
-              )
+      (progress-reporter-update progress-reporter pos)
       (if (eq (tar-header-link-type tokens) 20)
          ;; Foo.  There's an extra empty block after these.
          (setq pos (+ pos 512)))
       (if (eq (tar-header-link-type tokens) 20)
          ;; Foo.  There's an extra empty block after these.
          (setq pos (+ pos 512)))
@@ -421,7 +443,7 @@ is visible (and the real data of the buffer is hidden)."
     ;; A tar file should end with a block or two of nulls,
     ;; but let's not get a fatal error if it doesn't.
     (if (eq tokens 'empty-tar-block)
     ;; A tar file should end with a block or two of nulls,
     ;; but let's not get a fatal error if it doesn't.
     (if (eq tokens 'empty-tar-block)
-       (message "Parsing tar file...done")
+       (progress-reporter-done progress-reporter)
       (message "Warning: premature EOF parsing tar file")))
   (save-excursion
     (goto-char (point-min))
       (message "Warning: premature EOF parsing tar file")))
   (save-excursion
     (goto-char (point-min))
@@ -440,7 +462,7 @@ is visible (and the real data of the buffer is hidden)."
        (insert total-summaries))
       (make-local-variable 'tar-header-offset)
       (setq tar-header-offset (point))
        (insert total-summaries))
       (make-local-variable 'tar-header-offset)
       (setq tar-header-offset (point))
-      (narrow-to-region 1 tar-header-offset)
+      (narrow-to-region (point-min) tar-header-offset)
       (if enable-multibyte-characters
          (setq tar-header-offset (position-bytes tar-header-offset)))
       (set-buffer-modified-p nil))))
       (if enable-multibyte-characters
          (setq tar-header-offset (position-bytes tar-header-offset)))
       (set-buffer-modified-p nil))))
@@ -528,17 +550,17 @@ is visible (and the real data of the buffer is hidden)."
 (put 'tar-subfile-mode 'mode-class 'special)
 
 ;;;###autoload
 (put 'tar-subfile-mode 'mode-class 'special)
 
 ;;;###autoload
-(defun tar-mode ()
+(define-derived-mode tar-mode nil "Tar"
   "Major mode for viewing a tar file as a dired-like listing of its contents.
   "Major mode for viewing a tar file as a dired-like listing of its contents.
-You can move around using the usual cursor motion commands. 
+You can move around using the usual cursor motion commands.
 Letters no longer insert themselves.
 Type `e' to pull a file out of the tar file and into its own buffer;
 or click mouse-2 on the file's line in the Tar mode buffer.
 Type `c' to copy an entry from the tar file into another file on disk.
 
 Letters no longer insert themselves.
 Type `e' to pull a file out of the tar file and into its own buffer;
 or click mouse-2 on the file's line in the Tar mode buffer.
 Type `c' to copy an entry from the tar file into another file on disk.
 
-If you edit a sub-file of this archive (as with the `e' command) and 
-save it with Control-x Control-s, the contents of that buffer will be 
-saved back into the tar-file buffer; in this way you can edit a file 
+If you edit a sub-file of this archive (as with the `e' command) and
+save it with Control-x Control-s, the contents of that buffer will be
+saved back into the tar-file buffer; in this way you can edit a file
 inside of a tar archive without extracting it and re-archiving it.
 
 See also: variables `tar-update-datestamp' and `tar-anal-blocksize'.
 inside of a tar archive without extracting it and re-archiving it.
 
 See also: variables `tar-update-datestamp' and `tar-anal-blocksize'.
@@ -547,33 +569,22 @@ See also: variables `tar-update-datestamp' and `tar-anal-blocksize'.
   ;; mode on and off.  You can corrupt things that way.
   ;; rms: with permanent locals, it should now be possible to make this work
   ;; interactively in some reasonable fashion.
   ;; mode on and off.  You can corrupt things that way.
   ;; rms: with permanent locals, it should now be possible to make this work
   ;; interactively in some reasonable fashion.
-  (kill-all-local-variables)
   (make-local-variable 'tar-header-offset)
   (make-local-variable 'tar-parse-info)
   (make-local-variable 'tar-header-offset)
   (make-local-variable 'tar-parse-info)
-  (make-local-variable 'require-final-newline)
-  (setq require-final-newline nil) ; binary data, dude...
-  (make-local-variable 'revert-buffer-function)
-  (setq revert-buffer-function 'tar-mode-revert)
-  (make-local-variable 'local-enable-local-variables)
-  (setq local-enable-local-variables nil)
-  (make-local-variable 'next-line-add-newlines)
-  (setq next-line-add-newlines nil)
+  (set (make-local-variable 'require-final-newline) nil) ; binary data, dude...
+  (set (make-local-variable 'revert-buffer-function) 'tar-mode-revert)
+  (set (make-local-variable 'local-enable-local-variables) nil)
+  (set (make-local-variable 'next-line-add-newlines) nil)
   ;; Prevent loss of data when saving the file.
   ;; Prevent loss of data when saving the file.
-  (make-local-variable 'file-precious-flag)
-  (setq file-precious-flag t)
-  (setq major-mode 'tar-mode)
-  (setq mode-name "Tar")
-  (use-local-map tar-mode-map)
+  (set (make-local-variable 'file-precious-flag) t)
   (auto-save-mode 0)
   (auto-save-mode 0)
-  (make-local-variable 'write-contents-hooks)
-  (setq write-contents-hooks '(tar-mode-write-file))
+  (set (make-local-variable 'write-contents-functions) '(tar-mode-write-file))
+  (buffer-disable-undo)
   (widen)
   (if (and (boundp 'tar-header-offset) tar-header-offset)
   (widen)
   (if (and (boundp 'tar-header-offset) tar-header-offset)
-      (narrow-to-region 1 (byte-to-position tar-header-offset))
-      (tar-summarize-buffer)
-      (tar-next-line 0))
-  (run-hooks 'tar-mode-hook)
-  )
+      (narrow-to-region (point-min) (byte-to-position tar-header-offset))
+    (tar-summarize-buffer)
+    (tar-next-line 0)))
 
 
 (defun tar-subfile-mode (p)
 
 
 (defun tar-subfile-mode (p)
@@ -584,24 +595,23 @@ appear on disk when you save the tar-file's buffer."
   (interactive "P")
   (or (and (boundp 'tar-superior-buffer) tar-superior-buffer)
       (error "This buffer is not an element of a tar file"))
   (interactive "P")
   (or (and (boundp 'tar-superior-buffer) tar-superior-buffer)
       (error "This buffer is not an element of a tar file"))
-;;; Don't do this, because it is redundant and wastes mode line space.
-;;;  (or (assq 'tar-subfile-mode minor-mode-alist)
-;;;      (setq minor-mode-alist (append minor-mode-alist
-;;;                                 (list '(tar-subfile-mode " TarFile")))))
+  ;; Don't do this, because it is redundant and wastes mode line space.
+  ;;  (or (assq 'tar-subfile-mode minor-mode-alist)
+  ;;      (setq minor-mode-alist (append minor-mode-alist
+  ;;                                (list '(tar-subfile-mode " TarFile")))))
   (make-local-variable 'tar-subfile-mode)
   (setq tar-subfile-mode
        (if (null p)
            (not tar-subfile-mode)
            (> (prefix-numeric-value p) 0)))
   (cond (tar-subfile-mode
   (make-local-variable 'tar-subfile-mode)
   (setq tar-subfile-mode
        (if (null p)
            (not tar-subfile-mode)
            (> (prefix-numeric-value p) 0)))
   (cond (tar-subfile-mode
-        (make-local-variable 'local-write-file-hooks)
-        (setq local-write-file-hooks '(tar-subfile-save-buffer))
+        (add-hook 'write-file-functions 'tar-subfile-save-buffer nil t)
         ;; turn off auto-save.
         (auto-save-mode -1)
         (setq buffer-auto-save-file-name nil)
         (run-hooks 'tar-subfile-mode-hook))
        (t
         ;; turn off auto-save.
         (auto-save-mode -1)
         (setq buffer-auto-save-file-name nil)
         (run-hooks 'tar-subfile-mode-hook))
        (t
-        (kill-local-variable 'local-write-file-hooks))))
+        (remove-hook 'write-file-functions 'tar-subfile-save-buffer t))))
 
 
 ;; Revert the buffer and recompute the dired-like listing.
 
 
 ;; Revert the buffer and recompute the dired-like listing.
@@ -621,14 +631,16 @@ appear on disk when you save the tar-file's buffer."
          (setq tar-header-offset old-offset)))))
 
 
          (setq tar-header-offset old-offset)))))
 
 
-(defun tar-next-line (p)
+(defun tar-next-line (arg)
+  "Move cursor vertically down ARG lines and to the start of the filename."
   (interactive "p")
   (interactive "p")
-  (forward-line p)
+  (forward-line arg)
   (if (eobp) nil (forward-char (if tar-mode-show-date 54 36))))
 
   (if (eobp) nil (forward-char (if tar-mode-show-date 54 36))))
 
-(defun tar-previous-line (p)
+(defun tar-previous-line (arg)
+  "Move cursor vertically up ARG lines and to the start of the filename."
   (interactive "p")
   (interactive "p")
-  (tar-next-line (- p)))
+  (tar-next-line (- arg)))
 
 (defun tar-current-descriptor (&optional noerror)
   "Return the tar-descriptor of the current line, or signals an error."
 
 (defun tar-current-descriptor (&optional noerror)
   "Return the tar-descriptor of the current line, or signals an error."
@@ -649,6 +661,7 @@ appear on disk when you save the tar-file's buffer."
        (error "This is a %s, not a real file"
               (cond ((eq link-p 5) "directory")
                     ((eq link-p 20) "tar directory header")
        (error "This is a %s, not a real file"
               (cond ((eq link-p 5) "directory")
                     ((eq link-p 20) "tar directory header")
+                    ((eq link-p 28) "next has longname")
                     ((eq link-p 29) "multivolume-continuation")
                     ((eq link-p 35) "sparse entry")
                     ((eq link-p 38) "volume header")
                     ((eq link-p 29) "multivolume-continuation")
                     ((eq link-p 35) "sparse entry")
                     ((eq link-p 38) "volume header")
@@ -677,7 +690,8 @@ appear on disk when you save the tar-file's buffer."
         (tokens (tar-desc-tokens descriptor))
         (name (tar-header-name tokens))
         (size (tar-header-size tokens))
         (tokens (tar-desc-tokens descriptor))
         (name (tar-header-name tokens))
         (size (tar-header-size tokens))
-        (start (+ (tar-desc-data-start descriptor) tar-header-offset -1))
+        (start (+ (tar-desc-data-start descriptor)
+                  (- tar-header-offset (point-min))))
         (end (+ start size)))
     (let* ((tar-buffer (current-buffer))
           (tar-buffer-multibyte enable-multibyte-characters)
         (end (+ start size)))
     (let* ((tar-buffer (current-buffer))
           (tar-buffer-multibyte enable-multibyte-characters)
@@ -702,67 +716,70 @@ appear on disk when you save the tar-file's buffer."
              (set-buffer-multibyte nil)
              (save-excursion
                (set-buffer buffer)
              (set-buffer-multibyte nil)
              (save-excursion
                (set-buffer buffer)
-               (if enable-multibyte-characters
-                   (progn
-                     ;; We must avoid unibyte->multibyte conversion.
-                     (set-buffer-multibyte nil)
-                     (insert-buffer-substring tar-buffer start end)
-                     (set-buffer-multibyte t))
-                 (insert-buffer-substring tar-buffer start end))
-               (goto-char (point-min))
-               (setq buffer-file-name new-buffer-file-name)
-               (setq buffer-file-truename
-                     (abbreviate-file-name buffer-file-name))
-               ;; We need to mimic the parts of insert-file-contents
-               ;; which determine the coding-system and decode the text.
-               (let ((coding
-                      (or coding-system-for-read
-                          (and set-auto-coding-function
-                               (save-excursion
-                                 (funcall set-auto-coding-function
-                                          name (- (point-max) (point)))))))
-                     (multibyte enable-multibyte-characters)
-                     (detected (detect-coding-region
-                                1 (min 16384 (point-max)) t)))
-                 (if coding
-                     (or (numberp (coding-system-eol-type coding))
-                         (setq coding (coding-system-change-eol-conversion
-                                       coding
-                                       (coding-system-eol-type detected))))
-                   (setq coding
-                         (or (find-new-buffer-file-coding-system detected)
-                             (let ((file-coding
-                                    (find-operation-coding-system
-                                     'insert-file-contents buffer-file-name)))
-                               (if (consp file-coding)
-                                   (setq file-coding (car file-coding))
-                                 file-coding)))))
-                 (if (or (eq coding 'no-conversion)
-                         (eq (coding-system-type coding) 5))
-                     (setq multibyte (set-buffer-multibyte nil)))
-                 (or multibyte
+               (let ((buffer-undo-list t))
+                 (if enable-multibyte-characters
+                     (progn
+                       ;; We must avoid unibyte->multibyte conversion.
+                       (set-buffer-multibyte nil)
+                       (insert-buffer-substring tar-buffer start end)
+                       (set-buffer-multibyte t))
+                   (insert-buffer-substring tar-buffer start end))
+                 (goto-char (point-min))
+                 (setq buffer-file-name new-buffer-file-name)
+                 (setq buffer-file-truename
+                       (abbreviate-file-name buffer-file-name))
+                 ;; We need to mimic the parts of insert-file-contents
+                 ;; which determine the coding-system and decode the text.
+                 (let ((coding
+                        (or coding-system-for-read
+                            (and set-auto-coding-function
+                                 (save-excursion
+                                   (funcall set-auto-coding-function
+                                            name (- (point-max) (point)))))))
+                       (multibyte enable-multibyte-characters)
+                       (detected (detect-coding-region
+                                  (point-min)
+                                  (min (+ (point-min) 16384) (point-max)) t)))
+                   (if coding
+                       (or (numberp (coding-system-eol-type coding))
+                           (vectorp (coding-system-eol-type detected))
+                           (setq coding (coding-system-change-eol-conversion
+                                         coding
+                                         (coding-system-eol-type detected))))
                      (setq coding
                      (setq coding
-                           (coding-system-change-text-conversion
-                            coding 'raw-text)))
-                 (decode-coding-region 1 (point-max) coding)
-                 (set-buffer-file-coding-system coding))
-               ;; Set the default-directory to the dir of the
-               ;; superior buffer. 
-               (setq default-directory
-                     (save-excursion
-                       (set-buffer tar-buffer)
-                       default-directory))
-               (normal-mode)  ; pick a mode.
-               (rename-buffer bufname)
-               (make-local-variable 'tar-superior-buffer)
-               (make-local-variable 'tar-superior-descriptor)
-               (setq tar-superior-buffer tar-buffer)
-               (setq tar-superior-descriptor descriptor)
-               (setq buffer-read-only read-only-p)             
-               (set-buffer-modified-p nil)
+                           (or (find-new-buffer-file-coding-system detected)
+                               (let ((file-coding
+                                      (find-operation-coding-system
+                                       'insert-file-contents buffer-file-name)))
+                                 (if (consp file-coding)
+                                     (setq file-coding (car file-coding))
+                                   file-coding)))))
+                   (if (or (eq coding 'no-conversion)
+                           (eq (coding-system-type coding) 5))
+                       (setq multibyte (set-buffer-multibyte nil)))
+                   (or multibyte
+                       (setq coding
+                             (coding-system-change-text-conversion
+                              coding 'raw-text)))
+                   (decode-coding-region (point-min) (point-max) coding)
+                   (set-buffer-file-coding-system coding))
+                 ;; Set the default-directory to the dir of the
+                 ;; superior buffer.
+                 (setq default-directory
+                       (save-excursion
+                         (set-buffer tar-buffer)
+                         default-directory))
+                 (normal-mode)  ; pick a mode.
+                 (rename-buffer bufname)
+                 (make-local-variable 'tar-superior-buffer)
+                 (make-local-variable 'tar-superior-descriptor)
+                 (setq tar-superior-buffer tar-buffer)
+                 (setq tar-superior-descriptor descriptor)
+                 (setq buffer-read-only read-only-p)
+                 (set-buffer-modified-p nil))
                (tar-subfile-mode 1))
              (set-buffer tar-buffer))
                (tar-subfile-mode 1))
              (set-buffer tar-buffer))
-         (narrow-to-region 1 tar-header-offset)
+         (narrow-to-region (point-min) tar-header-offset)
          (set-buffer-multibyte tar-buffer-multibyte)))
       (if view-p
          (view-buffer buffer (and just-created 'kill-buffer))
          (set-buffer-multibyte tar-buffer-multibyte)))
       (if view-p
          (view-buffer buffer (and just-created 'kill-buffer))
@@ -818,7 +835,8 @@ the current tar-entry."
         (tokens (tar-desc-tokens descriptor))
         (name (tar-header-name tokens))
         (size (tar-header-size tokens))
         (tokens (tar-desc-tokens descriptor))
         (name (tar-header-name tokens))
         (size (tar-header-size tokens))
-        (start (+ (tar-desc-data-start descriptor) tar-header-offset -1))
+        (start (+ (tar-desc-data-start descriptor)
+                  (- tar-header-offset (point-min))))
         (end (+ start size))
         (multibyte enable-multibyte-characters)
         (inhibit-file-name-handlers inhibit-file-name-handlers)
         (end (+ start size))
         (multibyte enable-multibyte-characters)
         (inhibit-file-name-handlers inhibit-file-name-handlers)
@@ -909,7 +927,7 @@ With a prefix argument, un-mark that many files backward."
          (tar-setf (tar-desc-data-start desc)
                    (- (tar-desc-data-start desc) data-length))))
       ))
          (tar-setf (tar-desc-data-start desc)
                    (- (tar-desc-data-start desc) data-length))))
       ))
-  (narrow-to-region 1 tar-header-offset))
+  (narrow-to-region (point-min) tar-header-offset))
 
 
 (defun tar-expunge (&optional noconfirm)
 
 
 (defun tar-expunge (&optional noconfirm)
@@ -931,7 +949,7 @@ for this to be permanent."
                (forward-line 1)))
          ;; after doing the deletions, add any padding that may be necessary.
          (tar-pad-to-blocksize)
                (forward-line 1)))
          ;; after doing the deletions, add any padding that may be necessary.
          (tar-pad-to-blocksize)
-         (narrow-to-region 1 tar-header-offset))
+         (narrow-to-region (point-min) tar-header-offset))
        (set-buffer-multibyte multibyte)
        (if (zerop n)
            (message "Nothing to expunge.")
        (set-buffer-multibyte multibyte)
        (if (zerop n)
            (message "Nothing to expunge.")
@@ -1046,7 +1064,7 @@ for this to be permanent."
            (delete-region p (point))
            (insert (tar-header-block-summarize tokens) "\n")
            (setq tar-header-offset (position-bytes (point-max))))
            (delete-region p (point))
            (insert (tar-header-block-summarize tokens) "\n")
            (setq tar-header-offset (position-bytes (point-max))))
-         
+
          (widen)
          (set-buffer-multibyte nil)
          (let* ((start (+ (tar-desc-data-start descriptor) tar-header-offset -513)))
          (widen)
          (set-buffer-multibyte nil)
          (let* ((start (+ (tar-desc-data-start descriptor) tar-header-offset -513)))
@@ -1071,7 +1089,7 @@ for this to be permanent."
                (buffer-substring start (+ start 512))
                chk (tar-header-name tokens))
              )))
                (buffer-substring start (+ start 512))
                chk (tar-header-name tokens))
              )))
-      (narrow-to-region 1 tar-header-offset)
+      (narrow-to-region (point-min) tar-header-offset)
       (set-buffer-multibyte multibyte)
       (tar-next-line 0))))
 
       (set-buffer-multibyte multibyte)
       (tar-next-line 0))))
 
@@ -1079,11 +1097,12 @@ for this to be permanent."
 (defun tar-octal-time (timeval)
   ;; Format a timestamp as 11 octal digits.  Ghod, I hope this works...
   (let ((hibits (car timeval)) (lobits (car (cdr timeval))))
 (defun tar-octal-time (timeval)
   ;; Format a timestamp as 11 octal digits.  Ghod, I hope this works...
   (let ((hibits (car timeval)) (lobits (car (cdr timeval))))
-    (insert (format "%05o%01o%05o"
-                   (lsh hibits -2)
-                   (logior (lsh (logand 3 hibits) 1) (> (logand lobits 32768) 0))
-                   (logand 32767 lobits)
-                   ))))
+    (format "%05o%01o%05o"
+           (lsh hibits -2)
+           (logior (lsh (logand 3 hibits) 1)
+                   (if (> (logand lobits 32768) 0) 1 0))
+           (logand 32767 lobits)
+           )))
 
 (defun tar-subfile-save-buffer ()
   "In tar subfile mode, save this buffer into its parent tar-file buffer.
 
 (defun tar-subfile-save-buffer ()
   "In tar subfile mode, save this buffer into its parent tar-file buffer.
@@ -1101,7 +1120,7 @@ to make your changes permanent."
        (descriptor tar-superior-descriptor)
        subfile-size)
     ;; We must make the current buffer unibyte temporarily to avoid
        (descriptor tar-superior-descriptor)
        subfile-size)
     ;; We must make the current buffer unibyte temporarily to avoid
-    ;; multibyte->unibyte conversion in `insert-buffer'.
+    ;; multibyte->unibyte conversion in `insert-buffer-substring'.
     (set-buffer-multibyte nil)
     (setq subfile-size (buffer-size))
     (set-buffer tar-superior-buffer)
     (set-buffer-multibyte nil)
     (setq subfile-size (buffer-size))
     (set-buffer tar-superior-buffer)
@@ -1120,12 +1139,12 @@ to make your changes permanent."
        (widen)
        (set-buffer-multibyte nil)
        ;; delete the old data...
        (widen)
        (set-buffer-multibyte nil)
        ;; delete the old data...
-       (let* ((data-start (+ start tar-header-offset -1))
+       (let* ((data-start (+ start (- tar-header-offset (point-min))))
               (data-end (+ data-start (ash (ash (+ size 511) -9) 9))))
          (delete-region data-start data-end)
          ;; insert the new data...
          (goto-char data-start)
               (data-end (+ data-start (ash (ash (+ size 511) -9) 9))))
          (delete-region data-start data-end)
          ;; insert the new data...
          (goto-char data-start)
-         (insert-buffer subfile)
+         (insert-buffer-substring subfile)
          (setq subfile-size
                (encode-coding-region
                 data-start (+ data-start subfile-size) coding))
          (setq subfile-size
                (encode-coding-region
                 data-start (+ data-start subfile-size) coding))
@@ -1189,7 +1208,7 @@ to make your changes permanent."
              )))
        ;; after doing the insertion, add any final padding that may be necessary.
        (tar-pad-to-blocksize))
              )))
        ;; after doing the insertion, add any final padding that may be necessary.
        (tar-pad-to-blocksize))
-       (narrow-to-region 1 tar-header-offset)
+       (narrow-to-region (point-min) tar-header-offset)
        (set-buffer-multibyte tar-buffer-multibyte)))
     (set-buffer-modified-p t)   ; mark the tar file as modified
     (tar-next-line 0)
        (set-buffer-multibyte tar-buffer-multibyte)))
     (set-buffer-modified-p t)   ; mark the tar file as modified
     (tar-next-line 0)
@@ -1245,16 +1264,18 @@ Leaves the region wide."
        ;; tar-header-offset turns out to be null for files fetched with W3,
        ;; at least.
        (let ((coding-system-for-write 'no-conversion))
        ;; tar-header-offset turns out to be null for files fetched with W3,
        ;; at least.
        (let ((coding-system-for-write 'no-conversion))
-         (write-region (or (byte-to-position tar-header-offset)
-                           (point-min))
+         (write-region (if tar-header-offset
+                           (byte-to-position tar-header-offset)
+                         (point-min))
                        (point-max)
                        buffer-file-name nil t))
        (tar-clear-modification-flags)
        (set-buffer-modified-p nil))
                        (point-max)
                        buffer-file-name nil t))
        (tar-clear-modification-flags)
        (set-buffer-modified-p nil))
-    (narrow-to-region 1 (byte-to-position tar-header-offset)))
+    (narrow-to-region (point-min) (byte-to-position tar-header-offset)))
   ;; Return t because we've written the file.
   t)
 \f
 (provide 'tar-mode)
 
   ;; Return t because we've written the file.
   t)
 \f
 (provide 'tar-mode)
 
+;;; arch-tag: 8a585a4a-340e-42c2-89e7-d3b1013a4b78
 ;;; tar-mode.el ends here
 ;;; tar-mode.el ends here