Mercurial > emacs
changeset 95346:29a62a8c830b
Use buffer-swap-text to separate summary and raw data.
(tar-header-offset): Remove.
(tar-parse-info, tar-header-offset, tar-file-name-coding-system):
Not permanent any more.
(tar-data-buffer): New var.
(tar-data-swapped-p, tar-change-major-mode-hook)
(tar-mode-kill-buffer-hook): New funs.
(tar-untar-buffer, tar-summarize-buffer, tar-mode, tar-mode-revert)
(tar-extract, tar-copy, tar-expunge-internal, tar-expunge)
(tar-clear-modification-flags, tar-alter-one-field)
(tar-subfile-save-buffer, tar-pad-to-blocksize, tar-mode-write-file):
Change accordingly.
| author | Stefan Monnier <monnier@iro.umontreal.ca> |
|---|---|
| date | Tue, 27 May 2008 17:58:40 +0000 |
| parents | 0350e5efb8f7 |
| children | 8a8bad853798 |
| files | lisp/ChangeLog lisp/tar-mode.el |
| diffstat | 2 files changed, 325 insertions(+), 307 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ChangeLog Tue May 27 15:56:59 2008 +0000 +++ b/lisp/ChangeLog Tue May 27 17:58:40 2008 +0000 @@ -1,7 +1,22 @@ +2008-05-27 Stefan Monnier <monnier@iro.umontreal.ca> + + * tar-mode.el: Use buffer-swap-text to separate summary and raw data. + (tar-header-offset): Remove. + (tar-parse-info, tar-header-offset, tar-file-name-coding-system): + Not permanent any more. + (tar-data-buffer): New var. + (tar-data-swapped-p, tar-change-major-mode-hook) + (tar-mode-kill-buffer-hook): New funs. + (tar-untar-buffer, tar-summarize-buffer, tar-mode, tar-mode-revert) + (tar-extract, tar-copy, tar-expunge-internal, tar-expunge) + (tar-clear-modification-flags, tar-alter-one-field) + (tar-subfile-save-buffer, tar-pad-to-blocksize, tar-mode-write-file): + Change accordingly. + 2008-05-27 Dan Nicolaescu <dann@ics.uci.edu> * vc-dispatcher.el (vc-directory-resynch-file): Rename to ... - (vc-dir-resynch-file): ... this. Update callers. + (vc-dir-resynch-file): ... this. Update callers. Use vc-string-prefix-p. Ignore directory args. (vc-string-prefix-p): CSE. (vc-resynch-buffer): Restore conditional.
--- a/lisp/tar-mode.el Tue May 27 15:56:59 2008 +0000 +++ b/lisp/tar-mode.el Tue May 27 17:58:40 2008 +0000 @@ -91,8 +91,16 @@ ;; some scratch directory would be very wasteful, and wouldn't be able to ;; preserve the file owners. +;;; Bugs: + +;; - Expunge and rename on ././@LongLink files +;; - Revert confirmation displays the raw data temporarily. +;; - Incorrect goal-column if username is too long. + ;;; Code: +(eval-when-compile (require 'cl)) + (defgroup tar nil "Simple editing of tar files." :prefix "tar-" @@ -127,17 +135,41 @@ :group 'tar) (defvar tar-parse-info nil) -(defvar tar-header-offset nil) (defvar tar-superior-buffer nil) (defvar tar-superior-descriptor nil) (defvar tar-subfile-mode nil) (defvar tar-file-name-coding-system nil) -(put 'tar-parse-info 'permanent-local t) -(put 'tar-header-offset 'permanent-local t) (put 'tar-superior-buffer 'permanent-local t) (put 'tar-superior-descriptor 'permanent-local t) -(put 'tar-file-name-coding-system 'permanent-local t) + +;; The Tar data is made up of bytes and better manipulated as bytes +;; and can be very large, so insert/delete can be costly. The summary we +;; want to display may contain non-ascci chars, of course, so we'd like it +;; to be multibyte. We used to keep both in the same buffer and switch +;; from/to uni/multibyte. But this had several downsides: +;; - set-buffer-multibyte has an O(N^2) worst case that tends to be triggered +;; here, so it gets atrociously slow on large Tar files. +;; - need to widen/narrow the buffer to show/hide the raw data, and need to +;; maintain a tar-header-offset that keeps track of the boundary between +;; the two. +;; - can't use markers because they're not preserved by set-buffer-multibyte. +;; So instead, we now keep the two pieces of data in separate buffers, and +;; use the new buffer-swap-text primitive when we need to change which data +;; is associated with "the" buffer. +(defvar tar-data-buffer nil "Buffer that holds the actual raw tar bytes.") +(make-variable-buffer-local 'tar-data-buffer) + +(defun tar-data-swapped-p () + "Return non-nil if the tar-data is in `tar-data-buffer'." + ;; We need to be careful to keep track of which buffer holds the tar-data, + ;; since we swap them back and forth. Since the user may make the summary + ;; buffer unibyte, we can't rely on the multibyteness of the buffers. + ;; We could try and recognize the tar-format signature, but instead + ;; I decided to go for something simpler. + (and (buffer-live-p tar-data-buffer) + (> (buffer-size tar-data-buffer) (buffer-size)))) + (defmacro tar-setf (form val) "A mind-numbingly simple implementation of setf." @@ -385,43 +417,41 @@ (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 (if (eq (tar-header-link-type tokens) 5) - name - (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)))))) - (if multibyte - (set-buffer-multibyte 'to))))) + ;; FIXME: make it work even if we're not in tar-mode. + (let ((descriptors tar-parse-info)) ;Read the var in its buffer. + (with-current-buffer + (if (tar-data-swapped-p) tar-data-buffer (current-buffer)) + (set-buffer-multibyte nil) ;Hopefully, a no-op. + (dolist (descriptor descriptors) + (let* ((tokens (tar-desc-tokens descriptor)) + (name (tar-header-name tokens)) + (dir (if (eq (tar-header-link-type tokens) 5) + name + (file-name-directory name))) + (start (tar-desc-data-start descriptor)) + (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)))))))) (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 ((modified (buffer-modified-p))) - (set-buffer-multibyte nil) - (let* ((result '()) - (pos (point-min)) - (progress-reporter - (make-progress-reporter "Parsing tar file..." - (point-min) (max 1 (- (buffer-size) 1024)))) - tokens) + (assert (tar-data-swapped-p)) + (let* ((modified (buffer-modified-p)) + (result '()) + (pos (point-min)) + (progress-reporter + (make-progress-reporter "Parsing tar file..." + (point-min) (max 1 (- (buffer-size) 1024)))) + tokens) + (with-current-buffer tar-data-buffer (while (and (<= (+ pos 512) (point-max)) (not (eq 'empty-tar-block (setq tokens @@ -457,21 +487,16 @@ (and (null (tar-header-link-type tokens)) (> size 0) ;; Round up to a multiple of 512. - (setq pos (+ pos (ash (ash (+ 511 size) -9) 9)))))) - (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) - (progress-reporter-done progress-reporter) - (message "Warning: premature EOF parsing tar file"))) - ;; Obey the user's preference for the use of uni/multibytes. - (if default-enable-multibyte-characters - (set-buffer-multibyte 'to)) + (setq pos (+ pos (ash (ash (+ 511 size) -9) 9))))))) + (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) + (progress-reporter-done progress-reporter) + (message "Warning: premature EOF parsing tar file")) (goto-char (point-min)) (let ((inhibit-read-only t) - ;; Collect summary lines and insert them all at once since tar files - ;; can be pretty big. (total-summaries (mapconcat (lambda (tar-desc) @@ -479,8 +504,6 @@ tar-parse-info "\n"))) (insert total-summaries "\n")) - (narrow-to-region (point-min) (point)) - (set (make-local-variable 'tar-header-offset) (position-bytes (point))) (goto-char (point-min)) (restore-buffer-modified-p modified))) @@ -568,6 +591,15 @@ (put 'tar-mode 'mode-class 'special) (put 'tar-subfile-mode 'mode-class 'special) +(defun tar-change-major-mode-hook () + ;; Bring the actual Tar data back into the main buffer. + (when (tar-data-swapped-p) (buffer-swap-text tar-data-buffer)) + ;; Throw away the summary. + (when (buffer-live-p tar-data-buffer) (kill-buffer tar-data-buffer))) + +(defun tar-mode-kill-buffer-hook () + (if (buffer-live-p tar-data-buffer) (kill-buffer tar-data-buffer))) + ;;;###autoload (define-derived-mode tar-mode nil "Tar" "Major mode for viewing a tar file as a dired-like listing of its contents. @@ -588,10 +620,8 @@ ;; 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. - (make-local-variable 'tar-header-offset) (make-local-variable 'tar-parse-info) (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) (set (make-local-variable 'tar-file-name-coding-system) @@ -601,13 +631,24 @@ ;; 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-functions) '(tar-mode-write-file)) (buffer-disable-undo) (widen) - (if (and (boundp 'tar-header-offset) tar-header-offset) - (narrow-to-region (point-min) tar-header-offset) - (tar-summarize-buffer) - (tar-next-line 0))) + ;; Now move the Tar data into an auxiliary buffer, so we can use the main + ;; buffer for the summary. + (assert (not (tar-data-swapped-p))) + (set (make-local-variable 'revert-buffer-function) 'tar-mode-revert) + (set (make-local-variable 'write-contents-functions) '(tar-mode-write-file)) + (add-hook 'kill-buffer-hook 'tar-mode-kill-buffer-hook nil t) + (add-hook 'change-major-mode-hook 'tar-change-major-mode-hook nil t) + ;; Tar data is made of bytes, not chars. + (set-buffer-multibyte nil) + (set (make-local-variable 'tar-data-buffer) + (generate-new-buffer (format " *tar-data %s*" + (file-name-nondirectory + (or buffer-file-name (buffer-name)))))) + (buffer-swap-text tar-data-buffer) + (tar-summarize-buffer) + (tar-next-line 0)) (defun tar-subfile-mode (p) @@ -639,19 +680,18 @@ ;; Revert the buffer and recompute the dired-like listing. (defun tar-mode-revert (&optional no-auto-save no-confirm) - (let ((revert-buffer-function nil) - (old-offset tar-header-offset) - success) - (setq tar-header-offset nil) - (unwind-protect - (and (revert-buffer t no-confirm) - (progn (widen) - (setq success t) - (tar-mode))) - ;; If the revert was canceled, - ;; put back the old value of tar-header-offset. - (or success - (setq tar-header-offset old-offset))))) + (unwind-protect + (let ((revert-buffer-function nil)) + (if (tar-data-swapped-p) (buffer-swap-text tar-data-buffer)) + ;; FIXME: If we ask for confirmation, the user will be temporarily + ;; looking at the raw data. + (revert-buffer no-auto-save no-confirm 'preserve-modes) + ;; The new raw data may be smaller than the old summary, so let's + ;; make sure tar-data-swapped-p doesn't get confused. + (if (buffer-live-p tar-data-buffer) (kill-buffer tar-data-buffer)) + ;; Recompute the summary. + (tar-mode)) + (unless (tar-data-swapped-p) (buffer-swap-text tar-data-buffer)))) (defun tar-next-line (arg) @@ -668,8 +708,7 @@ (defun tar-current-descriptor (&optional noerror) "Return the tar-descriptor of the current line, or signals an error." ;; I wish lines had plists, like in ZMACS... - (or (nth (count-lines (point-min) - (save-excursion (beginning-of-line) (point))) + (or (nth (count-lines (point-min) (line-beginning-position)) tar-parse-info) (if noerror nil @@ -719,8 +758,7 @@ (tokens (tar-desc-tokens descriptor)) (name (tar-header-name tokens)) (size (tar-header-size tokens)) - (start (+ (tar-desc-data-start descriptor) - (- tar-header-offset (point-min)))) + (start (tar-desc-data-start descriptor)) (end (+ start size))) (let* ((tar-buffer (current-buffer)) (tarname (buffer-name)) @@ -743,60 +781,57 @@ buffer-undo-list t)) (setq bufname (buffer-name buffer)) (setq just-created t) - (unwind-protect - (let (coding) - (narrow-to-region start end) - (goto-char start) - (setq coding (or coding-system-for-read - (and set-auto-coding-function - (funcall set-auto-coding-function - name (- end start))) - ;; The following binding causes - ;; find-buffer-file-type-coding-system - ;; (defined on dos-w32.el) to act as if - ;; the file being extracted existed, so - ;; that the file's contents' encoding and - ;; EOL format are auto-detected. - (let ((file-name-handler-alist - '(("" . tar-file-name-handler)))) - (car (find-operation-coding-system - 'insert-file-contents - (cons name (current-buffer)) t))))) - (if (or (not coding) - (eq (coding-system-type coding) 'undecided)) - (setq coding (detect-coding-region start end t))) - (if (and default-enable-multibyte-characters - (coding-system-get coding :for-unibyte)) - (with-current-buffer buffer - (set-buffer-multibyte nil))) - (widen) - (decode-coding-region start end coding buffer) - (with-current-buffer buffer - (goto-char (point-min)) - (setq buffer-file-name new-buffer-file-name) - (setq buffer-file-truename - (abbreviate-file-name buffer-file-name)) - ;; Force buffer-file-coding-system to what - ;; decode-coding-region actually used. - (set-buffer-file-coding-system last-coding-system-used t) - ;; Set the default-directory to the dir of the - ;; superior buffer. - (setq default-directory - (with-current-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) - (setq buffer-undo-list undo-list) - (tar-subfile-mode 1)) - (set-buffer tar-buffer)) - (narrow-to-region (point-min) tar-header-offset) - (goto-char pos))) + (with-current-buffer tar-data-buffer + (let (coding) + (narrow-to-region start end) + (goto-char start) + (setq coding (or coding-system-for-read + (and set-auto-coding-function + (funcall set-auto-coding-function + name (- end start))) + ;; The following binding causes + ;; find-buffer-file-type-coding-system + ;; (defined on dos-w32.el) to act as if + ;; the file being extracted existed, so + ;; that the file's contents' encoding and + ;; EOL format are auto-detected. + (let ((file-name-handler-alist + '(("" . tar-file-name-handler)))) + (car (find-operation-coding-system + 'insert-file-contents + (cons name (current-buffer)) t))))) + (if (or (not coding) + (eq (coding-system-type coding) 'undecided)) + (setq coding (detect-coding-region start end t))) + (if (and default-enable-multibyte-characters + (coding-system-get coding :for-unibyte)) + (with-current-buffer buffer + (set-buffer-multibyte nil))) + (widen) + (decode-coding-region start end coding buffer))) + (with-current-buffer buffer + (goto-char (point-min)) + (setq buffer-file-name new-buffer-file-name) + (setq buffer-file-truename + (abbreviate-file-name buffer-file-name)) + ;; Force buffer-file-coding-system to what + ;; decode-coding-region actually used. + (set-buffer-file-coding-system last-coding-system-used t) + ;; Set the default-directory to the dir of the + ;; superior buffer. + (setq default-directory + (with-current-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) + (setq buffer-undo-list undo-list) + (tar-subfile-mode 1))) (if view-p (view-buffer buffer (and just-created 'kill-buffer-if-not-modified)) @@ -852,8 +887,7 @@ (tokens (tar-desc-tokens descriptor)) (name (tar-header-name tokens)) (size (tar-header-size tokens)) - (start (+ (tar-desc-data-start descriptor) - (- tar-header-offset (point-min)))) + (start (tar-desc-data-start descriptor)) (end (+ start size)) (inhibit-file-name-handlers inhibit-file-name-handlers) (inhibit-file-name-operation inhibit-file-name-operation)) @@ -911,21 +945,16 @@ (if link-p (setq size 0)) ; size lies for hard-links. ;; ;; delete the current line... - (beginning-of-line) - (let ((line-start (point))) - (end-of-line) (forward-char) - ;; decrement the header-pointer to be in sync... - (setq tar-header-offset (- tar-header-offset (- (point) line-start))) - (delete-region line-start (point))) + (delete-region (line-beginning-position) (line-beginning-position 2)) ;; ;; delete the data pointer... (setq tar-parse-info (delq descriptor tar-parse-info)) ;; ;; delete the data from inside the file... - (widen) - (let* ((data-start (+ start (- tar-header-offset (point-min)) -512)) + (let* ((data-start (+ start -512)) (data-end (+ data-start 512 (ash (ash (+ size 511) -9) 9)))) - (delete-region data-start data-end) + (with-current-buffer tar-data-buffer + (delete-region data-start data-end)) ;; ;; and finally, decrement the start-pointers of all following ;; entries in the archive. This is a pig when deleting a bunch @@ -936,8 +965,7 @@ (dolist (desc following-descs) (tar-setf (tar-desc-data-start desc) (- (tar-desc-data-start desc) data-length)))) - )) - (narrow-to-region (point-min) tar-header-offset)) + ))) (defun tar-expunge (&optional noconfirm) @@ -956,8 +984,7 @@ (setq n (1+ n))) (forward-line 1))) ;; after doing the deletions, add any padding that may be necessary. - (tar-pad-to-blocksize) - (narrow-to-region (point-min) tar-header-offset)) + (tar-pad-to-blocksize)) (if (zerop n) (message "Nothing to expunge.") (message "%s files expunged. Be sure to save this buffer." n))))) @@ -968,7 +995,7 @@ (interactive) (save-excursion (goto-char (point-min)) - (while (< (point) tar-header-offset) + (while (not (eobp)) (if (not (eq (following-char) ?\s)) (progn (delete-char 1) (insert " "))) (forward-line 1)))) @@ -1062,50 +1089,40 @@ (defun tar-alter-one-field (data-position new-data-string) (let* ((descriptor (tar-current-descriptor)) (tokens (tar-desc-tokens descriptor))) - (unwind-protect - (save-excursion - ;; - ;; update the header-line. - (beginning-of-line) - (let ((p (point))) - (forward-line 1) - (delete-region p (point)) - (insert (tar-header-block-summarize tokens) "\n") - (setq tar-header-offset (point-max))) + ;; + ;; update the header-line. + (let ((col (current-column))) + (delete-region (line-beginning-position) (line-beginning-position 2)) + (insert (tar-header-block-summarize tokens) "\n") + (forward-line -1) (move-to-column col)) - (widen) - (let* ((start (+ (tar-desc-data-start descriptor) - (- tar-header-offset (point-min)) - -512))) - ;; - ;; delete the old field and insert a new one. - (goto-char (+ start data-position)) - (delete-region (point) (+ (point) (length new-data-string))) ; <-- + (with-current-buffer tar-data-buffer + (let* ((start (+ (tar-desc-data-start descriptor) + -512))) + ;; + ;; delete the old field and insert a new one. + (goto-char (+ start data-position)) + (delete-region (point) (+ (point) (length new-data-string))) ; <-- - ;; As new-data-string is unibyte, just inserting it will - ;; make eight-bit chars to the corresponding multibyte - ;; chars. This avoid that conversion, i.e., eight-bit - ;; chars are converted to multibyte form of eight-bit - ;; chars. - (insert (string-to-multibyte new-data-string)) - ;; - ;; compute a new checksum and insert it. - (let ((chk (tar-header-block-checksum - (buffer-substring start (+ start 512))))) - (goto-char (+ start tar-chk-offset)) - (delete-region (point) (+ (point) 8)) - (insert (format "%6o" chk)) - (insert 0) - (insert ? ) - (tar-setf (tar-header-checksum tokens) chk) - ;; - ;; ok, make sure we didn't botch it. - (tar-header-block-check-checksum - (buffer-substring start (+ start 512)) - chk (tar-header-name tokens)) - ))) - (narrow-to-region (point-min) tar-header-offset) - (tar-next-line 0)))) + (assert (not (or enable-multibyte-characters + (multibyte-string-p new-data-string)))) + (insert new-data-string) + ;; + ;; compute a new checksum and insert it. + (let ((chk (tar-header-block-checksum + (buffer-substring start (+ start 512))))) + (goto-char (+ start tar-chk-offset)) + (delete-region (point) (+ (point) 8)) + (insert (format "%6o" chk)) + (insert 0) + (insert ? ) + (tar-setf (tar-header-checksum tokens) chk) + ;; + ;; ok, make sure we didn't botch it. + (tar-header-block-check-checksum + (buffer-substring start (+ start 512)) + chk (tar-header-name tokens)) + ))))) (defun tar-octal-time (timeval) @@ -1124,108 +1141,102 @@ to make your changes permanent." (interactive) (if (not (and (boundp 'tar-superior-buffer) tar-superior-buffer)) - (error "This buffer has no superior tar file buffer")) + (error "This buffer has no superior tar file buffer")) (if (not (and (boundp 'tar-superior-descriptor) tar-superior-descriptor)) - (error "This buffer doesn't have an index into its superior tar file!")) - (save-excursion + (error "This buffer doesn't have an index into its superior tar file!")) (let ((subfile (current-buffer)) - (coding buffer-file-coding-system) - (descriptor tar-superior-descriptor) - subfile-size) - (set-buffer tar-superior-buffer) - (let* ((tokens (tar-desc-tokens descriptor)) - (start (tar-desc-data-start descriptor)) - (name (tar-header-name tokens)) - (size (tar-header-size tokens)) - (size-pad (ash (ash (+ size 511) -9) 9)) - (head (memq descriptor tar-parse-info)) - (following-descs (cdr head))) - (if (not head) - (error "Can't find this tar file entry in its parent tar file!")) - (unwind-protect - (save-excursion - ;; delete the old data... - (let* ((data-start (+ start (- tar-header-offset (point-min)))) - (data-end (+ data-start (ash (ash (+ size 511) -9) 9)))) - (narrow-to-region data-start data-end) - (delete-region (point-min) (point-max)) - ;; insert the new data... - (goto-char data-start) - (with-current-buffer subfile - (save-restriction - (widen) - (encode-coding-region 1 (point-max) coding tar-superior-buffer))) - (setq subfile-size (- (point-max) (point-min))) - ;; - ;; pad the new data out to a multiple of 512... - (let ((subfile-size-pad (ash (ash (+ subfile-size 511) -9) 9))) - (goto-char (point-max)) - (insert (make-string (- subfile-size-pad subfile-size) 0)) - ;; - ;; update the data pointer of this and all following files... - (tar-setf (tar-header-size tokens) subfile-size) - (let ((difference (- subfile-size-pad size-pad))) - (dolist (desc following-descs) - (tar-setf (tar-desc-data-start desc) - (+ (tar-desc-data-start desc) difference)))) - ;; - ;; Update the size field in the header block. - (widen) - (let ((header-start (- data-start 512))) - (goto-char (+ header-start tar-size-offset)) - (delete-region (point) (+ (point) 12)) - (insert (format "%11o" subfile-size)) - (insert ? ) - ;; - ;; Maybe update the datestamp. - (if (not tar-update-datestamp) - nil - (goto-char (+ header-start tar-time-offset)) - (delete-region (point) (+ (point) 12)) - (insert (tar-octal-time (current-time))) - (insert ? )) - ;; - ;; compute a new checksum and insert it. - (let ((chk (tar-header-block-checksum - (buffer-substring header-start data-start)))) - (goto-char (+ header-start tar-chk-offset)) - (delete-region (point) (+ (point) 8)) - (insert (format "%6o" chk)) - (insert 0) - (insert ? ) - (tar-setf (tar-header-checksum tokens) chk))) - ;; - ;; alter the descriptor-line... - ;; - (let ((position (- (length tar-parse-info) (length head)))) - (goto-char (point-min)) - (forward-line position) - (beginning-of-line) - (let ((p (point)) - after - (m (set-marker (make-marker) tar-header-offset))) - (forward-line 1) - (setq after (point)) - ;; Insert the new text after the old, before deleting, - ;; to preserve the window start. - (let ((line (tar-header-block-summarize tokens t))) - (insert-before-markers line "\n")) - (delete-region p after) - (setq tar-header-offset (marker-position m))) - ))) - ;; after doing the insertion, add any final padding that may be necessary. - (tar-pad-to-blocksize)) - (narrow-to-region (point-min) tar-header-offset))) - (set-buffer-modified-p t) ; mark the tar file as modified - (tar-next-line 0) - (set-buffer subfile) - (set-buffer-modified-p nil) ; mark the tar subfile as unmodified + (coding buffer-file-coding-system) + (descriptor tar-superior-descriptor) + subfile-size) + (with-current-buffer tar-superior-buffer + (let* ((tokens (tar-desc-tokens descriptor)) + (start (tar-desc-data-start descriptor)) + (name (tar-header-name tokens)) + (size (tar-header-size tokens)) + (size-pad (ash (ash (+ size 511) -9) 9)) + (head (memq descriptor tar-parse-info)) + (following-descs (cdr head))) + (if (not head) + (error "Can't find this tar file entry in its parent tar file!")) + (with-current-buffer tar-data-buffer + ;; delete the old data... + (let* ((data-start start) + (data-end (+ data-start (ash (ash (+ size 511) -9) 9)))) + (narrow-to-region data-start data-end) + (delete-region (point-min) (point-max)) + ;; insert the new data... + (goto-char data-start) + (let ((dest (current-buffer))) + (with-current-buffer subfile + (save-restriction + (widen) + (encode-coding-region (point-min) (point-max) coding dest)))) + (setq subfile-size (- (point-max) (point-min))) + ;; + ;; pad the new data out to a multiple of 512... + (let ((subfile-size-pad (ash (ash (+ subfile-size 511) -9) 9))) + (goto-char (point-max)) + (insert (make-string (- subfile-size-pad subfile-size) 0)) + ;; + ;; update the data pointer of this and all following files... + (tar-setf (tar-header-size tokens) subfile-size) + (let ((difference (- subfile-size-pad size-pad))) + (dolist (desc following-descs) + (tar-setf (tar-desc-data-start desc) + (+ (tar-desc-data-start desc) difference)))) + ;; + ;; Update the size field in the header block. + (widen) + (let ((header-start (- data-start 512))) + (goto-char (+ header-start tar-size-offset)) + (delete-region (point) (+ (point) 12)) + (insert (format "%11o" subfile-size)) + (insert ? ) + ;; + ;; Maybe update the datestamp. + (if (not tar-update-datestamp) + nil + (goto-char (+ header-start tar-time-offset)) + (delete-region (point) (+ (point) 12)) + (insert (tar-octal-time (current-time))) + (insert ? )) + ;; + ;; compute a new checksum and insert it. + (let ((chk (tar-header-block-checksum + (buffer-substring header-start data-start)))) + (goto-char (+ header-start tar-chk-offset)) + (delete-region (point) (+ (point) 8)) + (insert (format "%6o" chk)) + (insert 0) + (insert ? ) + (tar-setf (tar-header-checksum tokens) chk)))))) + ;; + ;; alter the descriptor-line... + ;; + (let ((position (- (length tar-parse-info) (length head)))) + (goto-char (point-min)) + (forward-line position) + (beginning-of-line) + (let ((p (point)) + after) + (forward-line 1) + (setq after (point)) + ;; Insert the new text after the old, before deleting, + ;; to preserve the window start. + (let ((line (tar-header-block-summarize tokens t))) + (insert-before-markers line "\n")) + (delete-region p after))) + ;; After doing the insertion, add any necessary final padding. + (tar-pad-to-blocksize)) + (set-buffer-modified-p t) ; mark the tar file as modified + (tar-next-line 0)) + (set-buffer-modified-p nil) ; mark the tar subfile as unmodified (message "Saved into tar-buffer `%s'. Be sure to save that buffer!" - (buffer-name tar-superior-buffer)) + (buffer-name tar-superior-buffer)) ;; Prevent basic-save-buffer from changing our coding-system. (setq last-coding-system-used buffer-file-coding-system) ;; Prevent ordinary saving from happening. - t))) + t)) ;; When this function is called, it is sure that the buffer is unibyte. @@ -1234,7 +1245,6 @@ Leaves the region wide." (if (null tar-anal-blocksize) nil - (widen) (let* ((last-desc (nth (1- (length tar-parse-info)) tar-parse-info)) (start (tar-desc-data-start last-desc)) (tokens (tar-desc-tokens last-desc)) @@ -1242,37 +1252,30 @@ (size (if link-p 0 (tar-header-size tokens))) (data-end (+ start size)) (bbytes (ash tar-anal-blocksize 9)) - (pad-to (+ bbytes (* bbytes (/ (- data-end (point-min)) bbytes)))) - (inhibit-read-only t) ; ## - ) + (pad-to (+ bbytes (* bbytes (/ (- data-end (point-min)) bbytes))))) ;; If the padding after the last data is too long, delete some; ;; else insert some until we are padded out to the right number of blocks. ;; - (let ((goal-end (+ (or tar-header-offset 0) pad-to))) - (if (> (point-max) goal-end) - (delete-region goal-end (point-max)) - (goto-char (point-max)) - (insert (make-string (- goal-end (point-max)) ?\0))))))) + (with-current-buffer tar-data-buffer + (let ((goal-end (+ (point-min) pad-to))) + (if (> (point-max) goal-end) + (delete-region goal-end (point-max)) + (goto-char (point-max)) + (insert (make-string (- goal-end (point-max)) ?\0)))))))) ;; Used in write-file-hook to write tar-files out correctly. (defun tar-mode-write-file () (unwind-protect - (save-excursion - (widen) - ;; Doing this here confuses things - the region gets left too wide! - ;; I suppose this is run in a context where changing the buffer is bad. - ;; (tar-pad-to-blocksize) - ;; 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 tar-header-offset - (point-min)) - (point-max) - buffer-file-name nil t)) - (tar-clear-modification-flags) - (set-buffer-modified-p nil)) - (narrow-to-region (point-min) tar-header-offset)) + (progn + (if (tar-data-swapped-p) (buffer-swap-text tar-data-buffer)) + ;; Yuck: This is an internal function. We should improve the + ;; write-content-functions hook to make it easier to DTRT. + (prog1 (basic-save-buffer-1) + (unless (tar-data-swapped-p) (buffer-swap-text tar-data-buffer)) + (tar-clear-modification-flags) + (set-buffer-modified-p nil))) + (unless (tar-data-swapped-p) (buffer-swap-text tar-data-buffer))) ;; Return t because we've written the file. t)