]> code.delx.au - gnu-emacs/blobdiff - lisp/tar-mode.el
*** empty log message ***
[gnu-emacs] / lisp / tar-mode.el
index be17e70c7855dc5986c6e1e7c858405994f64772..4362e97af0b1ab663372408c6947d95c8ddd7561 100644 (file)
@@ -1,7 +1,7 @@
 ;;; 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
@@ -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
-;; 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:
 
@@ -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))
-          (error "`%c' is not an octal digit"))))
+          (error "`%c' is not an octal digit" (aref string i)))))
   (tar-parse-octal-integer string))
 
 
@@ -404,11 +404,11 @@ 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 '())
         (pos (point-min))
-        (bs (max 1 (- (buffer-size) 1024))) ; always 2+ empty blocks at end.
-        (bs100 (max 1 (/ bs 100)))
+        (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
@@ -416,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))
-      (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)))
@@ -446,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)
-       (message "Parsing tar file...done")
+       (progress-reporter-done progress-reporter)
       (message "Warning: premature EOF parsing tar file")))
   (save-excursion
     (goto-char (point-min))
@@ -581,7 +578,8 @@ See also: variables `tar-update-datestamp' and `tar-anal-blocksize'.
   ;; Prevent loss of data when saving the file.
   (set (make-local-variable 'file-precious-flag) t)
   (auto-save-mode 0)
-  (set (make-local-variable '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)
       (narrow-to-region (point-min) (byte-to-position tar-header-offset))
@@ -718,65 +716,67 @@ appear on disk when you save the tar-file's 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
-                                (point-min)
-                                (min (+ (point-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
-                           (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)
+                           (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))
          (narrow-to-region (point-min) tar-header-offset)
@@ -1120,7 +1120,7 @@ to make your changes permanent."
        (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)
@@ -1144,7 +1144,7 @@ to make your changes permanent."
          (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))