diff options
| author | Stefan Monnier | 2002-09-27 20:55:33 +0000 |
|---|---|---|
| committer | Stefan Monnier | 2002-09-27 20:55:33 +0000 |
| commit | 643415c46bde0c18336a5743366bb02a6889ca54 (patch) | |
| tree | 9c045804d5163f279046f61aaad69ff3eae42048 | |
| parent | df3d183269a1387fba24f2ef229a1869e7c2f7c7 (diff) | |
| download | emacs-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.el | 47 |
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 | ||