comparison lisp/tar-mode.el @ 90261:7beb78bc1f8e

Revision: [e-mail]--gnu-2005/emacs--unicode--0--patch-97 Merge from emacs--cvs-trunk--0 Patches applied: * emacs--cvs-trunk--0 (patch 616-696) - Add lisp/mh-e/.arch-inventory - Update from CVS - Merge from gnus--rel--5.10 - Update from CVS: lisp/smerge-mode.el: Add 'tools' to file keywords. - lisp/gnus/ChangeLog: Remove duplicate entry * gnus--rel--5.10 (patch 147-181) - Update from CVS - Merge from emacs--cvs-trunk--0 - Update from CVS: lisp/mml.el (mml-preview): Doc fix. - Update from CVS: texi/message.texi: Fix default values. - Update from CVS: texi/gnus.texi (RSS): Addition.

90260:0ca0d9181b5e

  "Simple editing of tar files."
  :prefix "tar-"
  :group 'data)

(defcustom tar-anal-blocksize 20
  "*The blocksize of tar files written by Emacs, or nil, meaning don't care.
The blocksize of a tar file is not really the size of the blocks; rather, it is
the number of blocks written with one system call.  When tarring to a tape,
this is the size of the *tape* blocks, but when writing to a file, it doesn't
matter much.  The only noticeable difference is that if a tar file does not
have a blocksize of 20, tar will tell you that; all this really controls is
how many null padding bytes go on the end of the tar file."
  :type '(choice integer (const nil))
  :group 'tar)

(defcustom tar-update-datestamp nil
  "*Non-nil means Tar mode should play fast and loose with sub-file datestamps.
If this is true, then editing and saving a tar file entry back into its
tar file will update its datestamp.  If false, the datestamp is unchanged.
You may or may not want this - it is good in that you can tell when a file
in a tar archive has been changed, but it is bad for the same reason that
editing a file in the tar archive at all is bad - the changed version of
the file never exists on disk."
  :type 'boolean
  :group 'tar)

(defcustom tar-mode-show-date nil
  "*Non-nil means Tar mode should show the date/time of each subfile.
This information is useful, but it takes screen space away from file names."
  :type 'boolean
  :group 'tar)

(defvar tar-parse-info nil)

		  lo (logand lo 65535)))
	(setq start (1+ start)))
      (list hi lo))))

(defun tar-parse-octal-integer-safe (string)
  (let ((L (length string)))
    (if (= L 0) (error "empty string"))
    (dotimes (i L)
       (if (or (< (aref string i) ?0)
	       (> (aref string i) ?7))
	   (error "`%c' is not an octal digit" (aref string i)))))
  (tar-parse-octal-integer string))


(defun tar-header-block-checksum (string)
  "Compute and return a tar-acceptable checksum for this block."

	(gid (tar-header-gid tar-hblock))
	(uname (tar-header-uname tar-hblock))
	(gname (tar-header-gname tar-hblock))
	(size (tar-header-size tar-hblock))
	(time (tar-header-date tar-hblock))
	(ck (tar-header-checksum tar-hblock))
	(type (tar-header-link-type tar-hblock))
	(link-name (tar-header-link-name tar-hblock)))
    (format "%c%c%s%8s/%-8s%7s%s %s%s"
	    (if mod-p ?* ? )
	    (cond ((or (eq type nil) (eq type 0)) ?-)

Type `e' to pull a file out of the tar file and into its own buffer;
or click mouse-2 on the file's line in the Tar mode buffer.
Type `c' to copy an entry from the tar file into another file on disk.

If you edit a sub-file of this archive (as with the `e' command) and
save it with Control-x Control-s, the contents of that buffer will be
saved back into the tar-file buffer; in this way you can edit a file
inside of a tar archive without extracting it and re-archiving it.

See also: variables `tar-update-datestamp' and `tar-anal-blocksize'.
\\{tar-mode-map}"

	      (switch-to-buffer-other-window buffer)
	    (switch-to-buffer buffer)))))))


(defun tar-extract-other-window ()
  "*In Tar mode, find this entry of the tar file in another window."
  (interactive)
  (tar-extract t))

(defun tar-display-other-window ()
  "*In Tar mode, display this entry of the tar file in another window."
  (interactive)
  (tar-extract 'display))

(defun tar-view ()
  "*In Tar mode, view the tar file entry on this line."
  (interactive)
  (tar-extract 'view))


(defun tar-read-file-name (&optional prompt)

			     (file-name-nondirectory default-file))))
    target))


(defun tar-copy (&optional to-file)
  "*In Tar mode, extract this entry of the tar file into a file on disk.
If TO-FILE is not supplied, it is prompted for, defaulting to the name of
the current tar-entry."
  (interactive (list (tar-read-file-name)))
  (let* ((descriptor (tar-get-descriptor))
	 (tokens (tar-desc-tokens descriptor))

      (let ((coding-system-for-write 'no-conversion))
	(write-region start end to-file nil nil nil t)))
    (message "Copied tar entry %s to %s" name to-file)))

(defun tar-flag-deleted (p &optional unflag)
  "*In Tar mode, mark this sub-file to be deleted from the tar file.
With a prefix argument, mark that many files."
  (interactive "p")
  (beginning-of-line)
  (dotimes (i (if (< p 0) (- p) p))
    (if (tar-current-descriptor unflag) ; barf if we're not on an entry-line.
	(progn
	  (delete-char 1)
	  (insert (if unflag " " "D"))))
    (forward-line (if (< p 0) -1 1)))
  (if (eobp) nil (forward-char 36)))

(defun tar-unflag (p)
  "*In Tar mode, un-mark this sub-file if it is marked to be deleted.
With a prefix argument, un-mark that many files forward."
  (interactive "p")
  (tar-flag-deleted p t))

(defun tar-unflag-backwards (p)
  "*In Tar mode, un-mark this sub-file if it is marked to be deleted.
With a prefix argument, un-mark that many files backward."
  (interactive "p")
  (tar-flag-deleted (- p) t))


(defun tar-expunge-internal ()
  "Expunge the tar-entry specified by the current line."
  (let* ((descriptor (tar-current-descriptor))
	 (tokens (tar-desc-tokens descriptor))
	 (line (tar-desc-data-start descriptor))
	 (name (tar-header-name tokens))
	 (size (tar-header-size tokens))
	 (link-p (tar-header-link-type tokens))
	 (start (tar-desc-data-start descriptor))
	 (following-descs (cdr (memq descriptor tar-parse-info))))

    ;;
    ;; delete the current line...
    (beginning-of-line)
    (let ((line-start (point)))
      (end-of-line) (forward-char)
      (let ((line-len (- (point) line-start)))
	(delete-region line-start (point))
	;;
	;; decrement the header-pointer to be in sync...
	(setq tar-header-offset (- tar-header-offset line-len))))
    ;;
    ;; 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 -513))
	   (data-end (+ data-start 512 (ash (ash (+ size 511) -9) 9))))
      (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

      ))
  (narrow-to-region (point-min) tar-header-offset))


(defun tar-expunge (&optional noconfirm)
  "*In Tar mode, delete all the archived files flagged for deletion.
This does not modify the disk image; you must save the tar file itself
for this to be permanent."
  (interactive)
  (if (or noconfirm
	  (y-or-n-p "Expunge files marked for deletion? "))

	  (progn (delete-char 1) (insert " ")))
      (forward-line 1))))


(defun tar-chown-entry (new-uid)
  "*Change the user-id associated with this entry in the tar file.
If this tar file was written by GNU tar, then you will be able to edit
the user id as a string; otherwise, you must edit it as a number.
You can force editing as a number by calling this with a prefix arg.
This does not modify the disk image; you must save the tar file itself
for this to be permanent."

	 (tar-alter-one-field tar-uid-offset
	   (concat (substring (format "%6o" new-uid) 0 6) "\000 ")))))


(defun tar-chgrp-entry (new-gid)
  "*Change the group-id associated with this entry in the tar file.
If this tar file was written by GNU tar, then you will be able to edit
the group id as a string; otherwise, you must edit it as a number.
You can force editing as a number by calling this with a prefix arg.
This does not modify the disk image; you must save the tar file itself
for this to be permanent."

		   new-gid)
	 (tar-alter-one-field tar-gid-offset
	   (concat (substring (format "%6o" new-gid) 0 6) "\000 ")))))

(defun tar-rename-entry (new-name)
  "*Change the name associated with this entry in the tar file.
This does not modify the disk image; you must save the tar file itself
for this to be permanent."
  (interactive
    (list (read-string "New name: "
	    (tar-header-name (tar-desc-tokens (tar-current-descriptor))))))

	   (tokens (tar-desc-tokens last-desc))
	   (link-p (tar-header-link-type tokens))
	   (size (if link-p 0 (tar-header-size tokens)))
	   (data-end (+ start size))
	   (bbytes (ash tar-anal-blocksize 9))
	   (pad-to (+ bbytes (* bbytes (/ (1- data-end) bbytes))))
	   (inhibit-read-only t) ; ##
	   )
      ;; 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.
      ;;
      (goto-char (+ (or tar-header-offset 0) data-end))
      (if (> (1+ (buffer-size)) (+ (or tar-header-offset 0) pad-to))
	  (delete-region (+ (or tar-header-offset 0) pad-to) (1+ (buffer-size)))
	  (insert (make-string (- (+ (or tar-header-offset 0) pad-to)
				  (1+ (buffer-size)))
			       0)))
      )))


;; Used in write-file-hook to write tar-files out correctly.
(defun tar-mode-write-file ()
  (unwind-protect

  ;; Return t because we've written the file.
  t)

(provide 'tar-mode)

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

90261:7beb78bc1f8e

  "Simple editing of tar files."
  :prefix "tar-"
  :group 'data)

(defcustom tar-anal-blocksize 20
  "The blocksize of tar files written by Emacs, or nil, meaning don't care.
The blocksize of a tar file is not really the size of the blocks; rather, it is
the number of blocks written with one system call.  When tarring to a tape,
this is the size of the *tape* blocks, but when writing to a file, it doesn't
matter much.  The only noticeable difference is that if a tar file does not
have a blocksize of 20, tar will tell you that; all this really controls is
how many null padding bytes go on the end of the tar file."
  :type '(choice integer (const nil))
  :group 'tar)

(defcustom tar-update-datestamp nil
  "Non-nil means Tar mode should play fast and loose with sub-file datestamps.
If this is true, then editing and saving a tar file entry back into its
tar file will update its datestamp.  If false, the datestamp is unchanged.
You may or may not want this - it is good in that you can tell when a file
in a tar archive has been changed, but it is bad for the same reason that
editing a file in the tar archive at all is bad - the changed version of
the file never exists on disk."
  :type 'boolean
  :group 'tar)

(defcustom tar-mode-show-date nil
  "Non-nil means Tar mode should show the date/time of each subfile.
This information is useful, but it takes screen space away from file names."
  :type 'boolean
  :group 'tar)

(defvar tar-parse-info nil)

		  lo (logand lo 65535)))
	(setq start (1+ start)))
      (list hi lo))))

(defun tar-parse-octal-integer-safe (string)
  (if (zerop (length string)) (error "empty string"))
  (mapc (lambda (c)
	  (if (or (< c ?0) (> c ?7))
	      (error "`%c' is not an octal digit" c)))
	string)
  (tar-parse-octal-integer string))


(defun tar-header-block-checksum (string)
  "Compute and return a tar-acceptable checksum for this block."

	(gid (tar-header-gid tar-hblock))
	(uname (tar-header-uname tar-hblock))
	(gname (tar-header-gname tar-hblock))
	(size (tar-header-size tar-hblock))
	(time (tar-header-date tar-hblock))
	;; (ck (tar-header-checksum tar-hblock))
	(type (tar-header-link-type tar-hblock))
	(link-name (tar-header-link-name tar-hblock)))
    (format "%c%c%s%8s/%-8s%7s%s %s%s"
	    (if mod-p ?* ? )
	    (cond ((or (eq type nil) (eq type 0)) ?-)

Type `e' to pull a file out of the tar file and into its own buffer;
or click mouse-2 on the file's line in the Tar mode buffer.
Type `c' to copy an entry from the tar file into another file on disk.

If you edit a sub-file of this archive (as with the `e' command) and
save it with \\[save-buffer], the contents of that buffer will be
saved back into the tar-file buffer; in this way you can edit a file
inside of a tar archive without extracting it and re-archiving it.

See also: variables `tar-update-datestamp' and `tar-anal-blocksize'.
\\{tar-mode-map}"

	      (switch-to-buffer-other-window buffer)
	    (switch-to-buffer buffer)))))))


(defun tar-extract-other-window ()
  "In Tar mode, find this entry of the tar file in another window."
  (interactive)
  (tar-extract t))

(defun tar-display-other-window ()
  "In Tar mode, display this entry of the tar file in another window."
  (interactive)
  (tar-extract 'display))

(defun tar-view ()
  "In Tar mode, view the tar file entry on this line."
  (interactive)
  (tar-extract 'view))


(defun tar-read-file-name (&optional prompt)

			     (file-name-nondirectory default-file))))
    target))


(defun tar-copy (&optional to-file)
  "In Tar mode, extract this entry of the tar file into a file on disk.
If TO-FILE is not supplied, it is prompted for, defaulting to the name of
the current tar-entry."
  (interactive (list (tar-read-file-name)))
  (let* ((descriptor (tar-get-descriptor))
	 (tokens (tar-desc-tokens descriptor))

      (let ((coding-system-for-write 'no-conversion))
	(write-region start end to-file nil nil nil t)))
    (message "Copied tar entry %s to %s" name to-file)))

(defun tar-flag-deleted (p &optional unflag)
  "In Tar mode, mark this sub-file to be deleted from the tar file.
With a prefix argument, mark that many files."
  (interactive "p")
  (beginning-of-line)
  (dotimes (i (abs p))
    (if (tar-current-descriptor unflag) ; barf if we're not on an entry-line.
	(progn
	  (delete-char 1)
	  (insert (if unflag " " "D"))))
    (forward-line (if (< p 0) -1 1)))
  (if (eobp) nil (forward-char 36)))

(defun tar-unflag (p)
  "In Tar mode, un-mark this sub-file if it is marked to be deleted.
With a prefix argument, un-mark that many files forward."
  (interactive "p")
  (tar-flag-deleted p t))

(defun tar-unflag-backwards (p)
  "In Tar mode, un-mark this sub-file if it is marked to be deleted.
With a prefix argument, un-mark that many files backward."
  (interactive "p")
  (tar-flag-deleted (- p) t))


(defun tar-expunge-internal ()
  "Expunge the tar-entry specified by the current line."
  (let* ((descriptor (tar-current-descriptor))
	 (tokens (tar-desc-tokens descriptor))
	 ;; (line (tar-desc-data-start descriptor))
	 (name (tar-header-name tokens))
	 (size (tar-header-size tokens))
	 (link-p (tar-header-link-type tokens))
	 (start (tar-desc-data-start descriptor))
	 (following-descs (cdr (memq descriptor tar-parse-info))))

    ;;
    ;; 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 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))
	   (data-end (+ data-start 512 (ash (ash (+ size 511) -9) 9))))
      (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

      ))
  (narrow-to-region (point-min) tar-header-offset))


(defun tar-expunge (&optional noconfirm)
  "In Tar mode, delete all the archived files flagged for deletion.
This does not modify the disk image; you must save the tar file itself
for this to be permanent."
  (interactive)
  (if (or noconfirm
	  (y-or-n-p "Expunge files marked for deletion? "))

	  (progn (delete-char 1) (insert " ")))
      (forward-line 1))))


(defun tar-chown-entry (new-uid)
  "Change the user-id associated with this entry in the tar file.
If this tar file was written by GNU tar, then you will be able to edit
the user id as a string; otherwise, you must edit it as a number.
You can force editing as a number by calling this with a prefix arg.
This does not modify the disk image; you must save the tar file itself
for this to be permanent."

	 (tar-alter-one-field tar-uid-offset
	   (concat (substring (format "%6o" new-uid) 0 6) "\000 ")))))


(defun tar-chgrp-entry (new-gid)
  "Change the group-id associated with this entry in the tar file.
If this tar file was written by GNU tar, then you will be able to edit
the group id as a string; otherwise, you must edit it as a number.
You can force editing as a number by calling this with a prefix arg.
This does not modify the disk image; you must save the tar file itself
for this to be permanent."

		   new-gid)
	 (tar-alter-one-field tar-gid-offset
	   (concat (substring (format "%6o" new-gid) 0 6) "\000 ")))))

(defun tar-rename-entry (new-name)
  "Change the name associated with this entry in the tar file.
This does not modify the disk image; you must save the tar file itself
for this to be permanent."
  (interactive
    (list (read-string "New name: "
	    (tar-header-name (tar-desc-tokens (tar-current-descriptor))))))

	   (tokens (tar-desc-tokens last-desc))
	   (link-p (tar-header-link-type tokens))
	   (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) ; ##
	   )
      ;; 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)))))))


;; Used in write-file-hook to write tar-files out correctly.
(defun tar-mode-write-file ()
  (unwind-protect

  ;; Return t because we've written the file.
  t)

(provide 'tar-mode)

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