tar-mode.el

[Erik Assum]

Hi all!

Here is a patch to tar-mode.el which adds untar functionality, eg lets
you untar a buffer to the filesystem.

I've also added a function tar-apply-to-buffer which accepts a
function as parameter and applies this to all entries in the tar file.

Erik.
-- 
"...as a robotics designer once told me, you don't really appreciate how smart
a moron is until you try to design a robot..." --Jerry Pournelle
--- lisp/tar-mode.el    Thu Sep 27 10:11:36 2001
+++ /usr/local/share/emacs/21.1/lisp/tar-mode.el        Thu Jan 10 15:36:27 2002
@@ -373,15 +373,37 @@
                (concat (if (= type 1) " ==> " " --> ") link-name)
              ""))))
 
-(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-untar-buffer (&optional buffer)
+  "Extracts all the files in the tar-file to the filesystem, like
+tar xf would have done"
+  (interactive)
+  (if buffer
+      (set-buffer buffer))
+  (let ((tar-directory nil))
+    (widen)
+      (beginning-of-buffer)
+      (forward-char (1- (or tar-header-offset 1)))
+      (tar-apply-to-buffer
+     (lambda (tokens pos)
+       (let* ((current-file (tar-header-name tokens))
+            (current-directory (or (file-name-directory current-file)
+                                   nil))
+            (current-size (tar-header-size tokens)))
+        (message "Extracting %s" current-file)
+        (if (and current-directory (not (file-exists-p current-directory)))
+          (make-directory current-directory  t))
+        (write-region pos (+ pos current-size) current-file)
+        (set-file-modes current-file (tar-header-mode tokens)))))
+      (narrow-to-region (point-min) tar-header-offset)
+    tar-directory))
+
+(defun tar-apply-to-buffer (func)
+  "Applies the function passed as parameter to each file in the tar file
+the function is passed two parameters, the tokens structure for the current
+entry in the tar-file, and the current position in the buffer"
   (message "Parsing tar file...")
-  (let* ((result '())
-        (pos 1)
+  (set-buffer-multibyte nil)
+  (let* ((pos (point))
         (bs (max 1 (- (buffer-size) 1024))) ; always 2+ empty blocks at end.
         (bs100 (max 1 (/ bs 100)))
         tokens)
@@ -391,14 +413,15 @@
                               (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
-              )
+;       (message "Parsing tar file...%d%%"
+;             ;(/ (* pos 100) bs)   ; this gets round-off lossage
+;             (/ pos bs100)         ; this doesn't
+;             )
       (if (eq (tar-header-link-type tokens) 20)
          ;; Foo.  There's an extra empty block after these.
          (setq pos (+ pos 512)))
       (let ((size (tar-header-size tokens)))
+
        (if (< size 0)
            (error "%s has size %s - corrupted"
                   (tar-header-name tokens) size))
@@ -408,21 +431,31 @@
        ;  hblock (tar-header-block-checksum hblock)
        ;  (tar-header-name tokens))
 
-       (setq result (cons (make-tar-desc pos tokens) result))
+       (funcall func tokens pos)
 
        (and (null (tar-header-link-type tokens))
             (> size 0)
             (setq pos
                   (+ pos 512 (ash (ash (1- size) -9) 9))        ; this works
-                  ;(+ pos (+ size (- 512 (rem (1- size) 512)))) ; this doesn't
                   ))))
+     (if (eq tokens 'empty-tar-block)
+        (message "Parsing tar file...done")
+       (message "Warning: premature EOF parsing tar file"))))
+  
+(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)."
+  (let ((result '()))
+    (beginning-of-buffer)
+    (tar-apply-to-buffer (lambda (tokens pos)
+                          (setq result (cons
+                                        (make-tar-desc pos tokens)
+                                        result))))
+;    (message "final result has length %s" result)
     (make-local-variable 'tar-parse-info)
     (setq tar-parse-info (nreverse result))
-    ;; 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")
-      (message "Warning: premature EOF parsing tar file")))
   (save-excursion
     (goto-char (point-min))
     (let ((buffer-read-only nil)
@@ -443,7 +476,7 @@
       (narrow-to-region 1 tar-header-offset)
       (if enable-multibyte-characters
          (setq tar-header-offset (position-bytes tar-header-offset)))
-      (set-buffer-modified-p nil))))
+      (set-buffer-modified-p nil)))))
 
 (defvar tar-mode-map nil "*Local keymap for Tar mode listings.")