comparison lisp/tar-mode.el @ 95370:fafc513e04bc

(tar-summarize-buffer): Fix reporter initialization. (tar-mode): Use write-region-annotate-functions rather than write-contents-functions. (tar-extract): Remove unused var `pos'. (tar-subfile-save-buffer): Remove unused var `following-descs'. (tar-mode-write-file): Remove. (tar-write-region-annotate): New function.

95369:d147ddeb05f9

  (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))))
         descriptor)
    (with-current-buffer tar-data-buffer
      (while (and (<= (+ pos 512) (point-max))
                  (setq descriptor (tar-header-block-tokenize pos)))
        (setq pos (marker-position (tar-header-data-start descriptor)))

          (push descriptor result)

          (and (null (tar-header-link-type descriptor))
               (> size 0)
               ;; Round up to a multiple of 512.
               (setq pos (+ pos (tar-roundup-512 size)))))))
    
    (set (make-local-variable '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.

       (or file-name-coding-system
	   default-file-name-coding-system
	   locale-coding-system))
  ;; Prevent loss of data when saving the file.
  (set (make-local-variable 'file-precious-flag) t)
  (auto-save-mode 0)
  (buffer-disable-undo)
  (widen)
  ;; 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)

	   (new-buffer-file-name (expand-file-name
				  ;; `:' is not allowed on Windows
				  (concat tarname "!" name)))
	   (buffer (get-file-buffer new-buffer-file-name))
	   (just-created nil)
	   (pos (point))
	   undo-list)
      (unless buffer
	(setq buffer (generate-new-buffer bufname))
	(with-current-buffer buffer
	  (setq undo-list buffer-undo-list

  (if (string= "" new-name) (error "zero length name"))
  (let ((encoded-new-name (encode-coding-string new-name
						tar-file-name-coding-system)))
    (if (> (length encoded-new-name) 98) (error "name too long"))
    (setf (tar-header-name (tar-current-descriptor)) new-name)
    (tar-alter-one-field 0
     (substring (concat encoded-new-name (make-string 99 0)) 0 99))))


(defun tar-chmod-entry (new-mode)

        subfile-size)
    (with-current-buffer tar-superior-buffer
      (let* ((start (tar-header-data-start descriptor))
             (name (tar-header-name descriptor))
             (size (tar-header-size descriptor))
             (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)

              (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
      (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)

(provide 'tar-mode)

;; arch-tag: 8a585a4a-340e-42c2-89e7-d3b1013a4b78
;;; tar-mode.el ends here

95370:fafc513e04bc

  (assert (tar-data-swapped-p))
  (let* ((modified (buffer-modified-p))
         (result '())
         (pos (point-min))
         (progress-reporter
          (with-current-buffer tar-data-buffer
            (make-progress-reporter "Parsing tar file..."
                                    (point-min) (point-max))))
         descriptor)
    (with-current-buffer tar-data-buffer
      (while (and (<= (+ pos 512) (point-max))
                  (setq descriptor (tar-header-block-tokenize pos)))
        (setq pos (marker-position (tar-header-data-start descriptor)))

          (push descriptor result)

          (and (null (tar-header-link-type descriptor))
               (> size 0)
               (setq pos (+ pos (tar-roundup-512 size)))))))
    
    (set (make-local-variable '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.

       (or file-name-coding-system
	   default-file-name-coding-system
	   locale-coding-system))
  ;; Prevent loss of data when saving the file.
  (set (make-local-variable 'file-precious-flag) t)
  (buffer-disable-undo)
  (widen)
  ;; 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)
  (add-hook 'write-region-annotate-functions 'tar-write-region-annotate nil t)
  (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)

	   (new-buffer-file-name (expand-file-name
				  ;; `:' is not allowed on Windows
				  (concat tarname "!" name)))
	   (buffer (get-file-buffer new-buffer-file-name))
	   (just-created nil)
	   undo-list)
      (unless buffer
	(setq buffer (generate-new-buffer bufname))
	(with-current-buffer buffer
	  (setq undo-list buffer-undo-list

  (if (string= "" new-name) (error "zero length name"))
  (let ((encoded-new-name (encode-coding-string new-name
						tar-file-name-coding-system)))
    (if (> (length encoded-new-name) 98) (error "name too long"))
    (setf (tar-header-name (tar-current-descriptor)) new-name)
    ;; FIXME: Make it work for ././@LongLink.
    (tar-alter-one-field 0
     (substring (concat encoded-new-name (make-string 99 0)) 0 99))))


(defun tar-chmod-entry (new-mode)

        subfile-size)
    (with-current-buffer tar-superior-buffer
      (let* ((start (tar-header-data-start descriptor))
             (name (tar-header-name descriptor))
             (size (tar-header-size descriptor))
             (head (memq descriptor tar-parse-info)))
        (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)

              (delete-region goal-end (point-max))
            (goto-char (point-max))
            (insert (make-string (- goal-end (point-max)) ?\0))))))))


;; Used in write-region-annotate-functions to write tar-files out correctly.
(defun tar-write-region-annotate (start end)
  ;; When called from write-file (and auto-save), `start' is nil.
  ;; When called from M-x write-region, we assume the user wants to save
  ;; (part of) the summary, not the tar data.
  (unless (or start (not (tar-data-swapped-p)))
    (tar-clear-modification-flags)
    (set-buffer tar-data-buffer)
    nil))

(provide 'tar-mode)

;; arch-tag: 8a585a4a-340e-42c2-89e7-d3b1013a4b78
;;; tar-mode.el ends here