aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2002-09-27 20:55:33 +0000
committerStefan Monnier2002-09-27 20:55:33 +0000
commit643415c46bde0c18336a5743366bb02a6889ca54 (patch)
tree9c045804d5163f279046f61aaad69ff3eae42048
parentdf3d183269a1387fba24f2ef229a1869e7c2f7c7 (diff)
downloademacs-643415c46bde0c18336a5743366bb02a6889ca54.tar.gz
emacs-643415c46bde0c18336a5743366bb02a6889ca54.zip
(tar-untar-buffer): Handle dir-entries.
(tar-summarize-buffer, tar-mode, tar-extract, tar-copy, tar-expunge) (tar-alter-one-field, tar-subfile-save-buffer, tar-mode-write-file): Don't hardcode 1 == point-min.
-rw-r--r--lisp/tar-mode.el47
1 files changed, 26 insertions, 21 deletions
diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el
index 9f34858cab2..2c755fd176e 100644
--- a/lisp/tar-mode.el
+++ b/lisp/tar-mode.el
@@ -375,7 +375,7 @@ MODE should be an integer which is a file mode value."
375 "")))) 375 ""))))
376 376
377(defun tar-untar-buffer () 377(defun tar-untar-buffer ()
378 "Extract all archive members in the tar-file." 378 "Extract all archive members in the tar-file into the current directory."
379 (interactive) 379 (interactive)
380 (let ((multibyte enable-multibyte-characters)) 380 (let ((multibyte enable-multibyte-characters))
381 (unwind-protect 381 (unwind-protect
@@ -386,13 +386,15 @@ MODE should be an integer which is a file mode value."
386 (let* ((tokens (tar-desc-tokens descriptor)) 386 (let* ((tokens (tar-desc-tokens descriptor))
387 (name (tar-header-name tokens)) 387 (name (tar-header-name tokens))
388 (dir (file-name-directory name)) 388 (dir (file-name-directory name))
389 (start (+ (tar-desc-data-start descriptor) tar-header-offset -1)) 389 (start (+ (tar-desc-data-start descriptor)
390 (- tar-header-offset (point-min))))
390 (end (+ start (tar-header-size tokens)))) 391 (end (+ start (tar-header-size tokens))))
391 (unless (file-directory-p name) 392 (unless (file-directory-p name)
392 (message "Extracting %s" name) 393 (message "Extracting %s" name)
393 (if (and dir (not (file-exists-p dir))) 394 (if (and dir (not (file-exists-p dir)))
394 (make-directory dir t)) 395 (make-directory dir t))
395 (write-region start end name) 396 (unless (file-directory-p name)
397 (write-region start end name))
396 (set-file-modes name (tar-header-mode tokens)))))) 398 (set-file-modes name (tar-header-mode tokens))))))
397 (set-buffer-multibyte multibyte)))) 399 (set-buffer-multibyte multibyte))))
398 400
@@ -404,7 +406,7 @@ is visible (and the real data of the buffer is hidden)."
404 (set-buffer-multibyte nil) 406 (set-buffer-multibyte nil)
405 (message "Parsing tar file...") 407 (message "Parsing tar file...")
406 (let* ((result '()) 408 (let* ((result '())
407 (pos 1) 409 (pos (point-min))
408 (bs (max 1 (- (buffer-size) 1024))) ; always 2+ empty blocks at end. 410 (bs (max 1 (- (buffer-size) 1024))) ; always 2+ empty blocks at end.
409 (bs100 (max 1 (/ bs 100))) 411 (bs100 (max 1 (/ bs 100)))
410 tokens) 412 tokens)
@@ -463,7 +465,7 @@ is visible (and the real data of the buffer is hidden)."
463 (insert total-summaries)) 465 (insert total-summaries))
464 (make-local-variable 'tar-header-offset) 466 (make-local-variable 'tar-header-offset)
465 (setq tar-header-offset (point)) 467 (setq tar-header-offset (point))
466 (narrow-to-region 1 tar-header-offset) 468 (narrow-to-region (point-min) tar-header-offset)
467 (if enable-multibyte-characters 469 (if enable-multibyte-characters
468 (setq tar-header-offset (position-bytes tar-header-offset))) 470 (setq tar-header-offset (position-bytes tar-header-offset)))
469 (set-buffer-modified-p nil)))) 471 (set-buffer-modified-p nil))))
@@ -582,7 +584,7 @@ See also: variables `tar-update-datestamp' and `tar-anal-blocksize'.
582 (set (make-local-variable 'write-contents-hooks) '(tar-mode-write-file)) 584 (set (make-local-variable 'write-contents-hooks) '(tar-mode-write-file))
583 (widen) 585 (widen)
584 (if (and (boundp 'tar-header-offset) tar-header-offset) 586 (if (and (boundp 'tar-header-offset) tar-header-offset)
585 (narrow-to-region 1 (byte-to-position tar-header-offset)) 587 (narrow-to-region (point-min) (byte-to-position tar-header-offset))
586 (tar-summarize-buffer) 588 (tar-summarize-buffer)
587 (tar-next-line 0))) 589 (tar-next-line 0)))
588 590
@@ -595,10 +597,10 @@ appear on disk when you save the tar-file's buffer."
595 (interactive "P") 597 (interactive "P")
596 (or (and (boundp 'tar-superior-buffer) tar-superior-buffer) 598 (or (and (boundp 'tar-superior-buffer) tar-superior-buffer)
597 (error "This buffer is not an element of a tar file")) 599 (error "This buffer is not an element of a tar file"))
598;;; Don't do this, because it is redundant and wastes mode line space. 600 ;; Don't do this, because it is redundant and wastes mode line space.
599;;; (or (assq 'tar-subfile-mode minor-mode-alist) 601 ;; (or (assq 'tar-subfile-mode minor-mode-alist)
600;;; (setq minor-mode-alist (append minor-mode-alist 602 ;; (setq minor-mode-alist (append minor-mode-alist
601;;; (list '(tar-subfile-mode " TarFile"))))) 603 ;; (list '(tar-subfile-mode " TarFile")))))
602 (make-local-variable 'tar-subfile-mode) 604 (make-local-variable 'tar-subfile-mode)
603 (setq tar-subfile-mode 605 (setq tar-subfile-mode
604 (if (null p) 606 (if (null p)
@@ -690,7 +692,8 @@ appear on disk when you save the tar-file's buffer."
690 (tokens (tar-desc-tokens descriptor)) 692 (tokens (tar-desc-tokens descriptor))
691 (name (tar-header-name tokens)) 693 (name (tar-header-name tokens))
692 (size (tar-header-size tokens)) 694 (size (tar-header-size tokens))
693 (start (+ (tar-desc-data-start descriptor) tar-header-offset -1)) 695 (start (+ (tar-desc-data-start descriptor)
696 (- tar-header-offset (point-min))))
694 (end (+ start size))) 697 (end (+ start size)))
695 (let* ((tar-buffer (current-buffer)) 698 (let* ((tar-buffer (current-buffer))
696 (tar-buffer-multibyte enable-multibyte-characters) 699 (tar-buffer-multibyte enable-multibyte-characters)
@@ -736,7 +739,8 @@ appear on disk when you save the tar-file's buffer."
736 name (- (point-max) (point))))))) 739 name (- (point-max) (point)))))))
737 (multibyte enable-multibyte-characters) 740 (multibyte enable-multibyte-characters)
738 (detected (detect-coding-region 741 (detected (detect-coding-region
739 1 (min 16384 (point-max)) t))) 742 (point-min)
743 (min (+ (point-min) 16384) (point-max)) t)))
740 (if coding 744 (if coding
741 (or (numberp (coding-system-eol-type coding)) 745 (or (numberp (coding-system-eol-type coding))
742 (setq coding (coding-system-change-eol-conversion 746 (setq coding (coding-system-change-eol-conversion
@@ -757,7 +761,7 @@ appear on disk when you save the tar-file's buffer."
757 (setq coding 761 (setq coding
758 (coding-system-change-text-conversion 762 (coding-system-change-text-conversion
759 coding 'raw-text))) 763 coding 'raw-text)))
760 (decode-coding-region 1 (point-max) coding) 764 (decode-coding-region (point-min) (point-max) coding)
761 (set-buffer-file-coding-system coding)) 765 (set-buffer-file-coding-system coding))
762 ;; Set the default-directory to the dir of the 766 ;; Set the default-directory to the dir of the
763 ;; superior buffer. 767 ;; superior buffer.
@@ -775,7 +779,7 @@ appear on disk when you save the tar-file's buffer."
775 (set-buffer-modified-p nil) 779 (set-buffer-modified-p nil)
776 (tar-subfile-mode 1)) 780 (tar-subfile-mode 1))
777 (set-buffer tar-buffer)) 781 (set-buffer tar-buffer))
778 (narrow-to-region 1 tar-header-offset) 782 (narrow-to-region (point-min) tar-header-offset)
779 (set-buffer-multibyte tar-buffer-multibyte))) 783 (set-buffer-multibyte tar-buffer-multibyte)))
780 (if view-p 784 (if view-p
781 (view-buffer buffer (and just-created 'kill-buffer)) 785 (view-buffer buffer (and just-created 'kill-buffer))
@@ -831,7 +835,8 @@ the current tar-entry."
831 (tokens (tar-desc-tokens descriptor)) 835 (tokens (tar-desc-tokens descriptor))
832 (name (tar-header-name tokens)) 836 (name (tar-header-name tokens))
833 (size (tar-header-size tokens)) 837 (size (tar-header-size tokens))
834 (start (+ (tar-desc-data-start descriptor) tar-header-offset -1)) 838 (start (+ (tar-desc-data-start descriptor)
839 (- tar-header-offset (point-min))))
835 (end (+ start size)) 840 (end (+ start size))
836 (multibyte enable-multibyte-characters) 841 (multibyte enable-multibyte-characters)
837 (inhibit-file-name-handlers inhibit-file-name-handlers) 842 (inhibit-file-name-handlers inhibit-file-name-handlers)
@@ -922,7 +927,7 @@ With a prefix argument, un-mark that many files backward."
922 (tar-setf (tar-desc-data-start desc) 927 (tar-setf (tar-desc-data-start desc)
923 (- (tar-desc-data-start desc) data-length)))) 928 (- (tar-desc-data-start desc) data-length))))
924 )) 929 ))
925 (narrow-to-region 1 tar-header-offset)) 930 (narrow-to-region (point-min) tar-header-offset))
926 931
927 932
928(defun tar-expunge (&optional noconfirm) 933(defun tar-expunge (&optional noconfirm)
@@ -944,7 +949,7 @@ for this to be permanent."
944 (forward-line 1))) 949 (forward-line 1)))
945 ;; after doing the deletions, add any padding that may be necessary. 950 ;; after doing the deletions, add any padding that may be necessary.
946 (tar-pad-to-blocksize) 951 (tar-pad-to-blocksize)
947 (narrow-to-region 1 tar-header-offset)) 952 (narrow-to-region (point-min) tar-header-offset))
948 (set-buffer-multibyte multibyte) 953 (set-buffer-multibyte multibyte)
949 (if (zerop n) 954 (if (zerop n)
950 (message "Nothing to expunge.") 955 (message "Nothing to expunge.")
@@ -1084,7 +1089,7 @@ for this to be permanent."
1084 (buffer-substring start (+ start 512)) 1089 (buffer-substring start (+ start 512))
1085 chk (tar-header-name tokens)) 1090 chk (tar-header-name tokens))
1086 ))) 1091 )))
1087 (narrow-to-region 1 tar-header-offset) 1092 (narrow-to-region (point-min) tar-header-offset)
1088 (set-buffer-multibyte multibyte) 1093 (set-buffer-multibyte multibyte)
1089 (tar-next-line 0)))) 1094 (tar-next-line 0))))
1090 1095
@@ -1134,7 +1139,7 @@ to make your changes permanent."
1134 (widen) 1139 (widen)
1135 (set-buffer-multibyte nil) 1140 (set-buffer-multibyte nil)
1136 ;; delete the old data... 1141 ;; delete the old data...
1137 (let* ((data-start (+ start tar-header-offset -1)) 1142 (let* ((data-start (+ start (- tar-header-offset (point-min))))
1138 (data-end (+ data-start (ash (ash (+ size 511) -9) 9)))) 1143 (data-end (+ data-start (ash (ash (+ size 511) -9) 9))))
1139 (delete-region data-start data-end) 1144 (delete-region data-start data-end)
1140 ;; insert the new data... 1145 ;; insert the new data...
@@ -1203,7 +1208,7 @@ to make your changes permanent."
1203 ))) 1208 )))
1204 ;; after doing the insertion, add any final padding that may be necessary. 1209 ;; after doing the insertion, add any final padding that may be necessary.
1205 (tar-pad-to-blocksize)) 1210 (tar-pad-to-blocksize))
1206 (narrow-to-region 1 tar-header-offset) 1211 (narrow-to-region (point-min) tar-header-offset)
1207 (set-buffer-multibyte tar-buffer-multibyte))) 1212 (set-buffer-multibyte tar-buffer-multibyte)))
1208 (set-buffer-modified-p t) ; mark the tar file as modified 1213 (set-buffer-modified-p t) ; mark the tar file as modified
1209 (tar-next-line 0) 1214 (tar-next-line 0)
@@ -1266,7 +1271,7 @@ Leaves the region wide."
1266 buffer-file-name nil t)) 1271 buffer-file-name nil t))
1267 (tar-clear-modification-flags) 1272 (tar-clear-modification-flags)
1268 (set-buffer-modified-p nil)) 1273 (set-buffer-modified-p nil))
1269 (narrow-to-region 1 (byte-to-position tar-header-offset))) 1274 (narrow-to-region (point-min) (byte-to-position tar-header-offset)))
1270 ;; Return t because we've written the file. 1275 ;; Return t because we've written the file.
1271 t) 1276 t)
1272 1277