;;; tar-mode.el --- simple editing of tar files from GNU Emacs
-;; Copyright (C) 1990-1991, 1993-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1991, 1993-2013 Free Software Foundation, Inc.
;; Author: Jamie Zawinski <jwz@lucid.com>
;; Maintainer: FSF
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(defgroup tar nil
"Simple editing of tar files."
;; state correctly: the raw data is expected to be always larger than
;; the summary.
(progn
- (assert (or (= (buffer-size tar-data-buffer) (buffer-size))
+ (cl-assert (or (= (buffer-size tar-data-buffer) (buffer-size))
(eq tar-data-swapped
(> (buffer-size tar-data-buffer) (buffer-size)))))
tar-data-swapped)))
\f
;;; down to business.
-(defstruct (tar-header
+(cl-defstruct (tar-header
(:constructor nil)
(:type vector)
:named
This is a list of name, mode, uid, gid, size,
write-date, checksum, link-type, and link-name."
(if (> (+ pos 512) (point-max)) (error "Malformed Tar header"))
- (assert (zerop (mod (- pos (point-min)) 512)))
- (assert (not enable-multibyte-characters))
+ (cl-assert (zerop (mod (- pos (point-min)) 512)))
+ (cl-assert (not enable-multibyte-characters))
(let ((string (buffer-substring pos (setq pos (+ pos 512)))))
(when ;(some 'plusp string) ; <-- oops, massive cycle hog!
(or (not (= 0 (aref string 0))) ; This will do.
(defun tar-header-data-end (descriptor)
(let* ((data-start (tar-header-data-start descriptor))
(link-type (tar-header-link-type descriptor))
- (size (tar-header-size descriptor))
- (fudge (cond
- ;; Foo. There's an extra empty block after these.
- ((memq link-type '(20 55)) 512)
- (t 0))))
- (+ data-start fudge
- (if (and (null link-type) (> size 0))
+ (size (tar-header-size descriptor)))
+ (+ data-start
+ ;; Ignore size for files of type 1-6
+ (if (and (not (memq link-type '(1 2 3 4 5 6))) (> size 0))
(tar-roundup-512 size)
0))))
(defun tar-header-block-checksum (string)
"Compute and return a tar-acceptable checksum for this block."
- (assert (not (multibyte-string-p string)))
+ (cl-assert (not (multibyte-string-p string)))
(let* ((chk-field-start tar-chk-offset)
(chk-field-end (+ chk-field-start 8))
(sum 0)
(defun tar-clip-time-string (time)
(let ((str (current-time-string time)))
- (concat " " (substring str 4 16) (substring str 19 24))))
+ (concat " " (substring str 4 16) (format-time-string " %Y" time))))
(defun tar-grind-file-mode (mode)
"Construct a `-rw--r--r--' string indicating MODE.
((eq type 29) ?M) ; multivolume continuation
((eq type 35) ?S) ; sparse
((eq type 38) ?V) ; volume header
- ((eq type 55) ?H) ; extended pax header
+ ((eq type 55) ?H) ; pax global extended header
+ ((eq type 72) ?X) ; pax extended header
(t ?\s)
)
(tar-grind-file-mode mode)
(defun tar-summarize-buffer ()
"Parse the contents of the tar file in the current buffer."
- (assert (tar-data-swapped-p))
+ (cl-assert (tar-data-swapped-p))
(let* ((modified (buffer-modified-p))
(result '())
(pos (point-min))
(progress-reporter-done progress-reporter)
(message "Warning: premature EOF parsing tar file"))
(goto-char (point-min))
- (let ((inhibit-read-only t)
+ (let ((buffer-file-truename nil) ; avoid changing dir mtime by lock_file
+ (inhibit-read-only t)
(total-summaries
(mapconcat 'tar-header-block-summarize tar-parse-info "\n")))
- (insert total-summaries "\n"))
- (goto-char (point-min))
- (restore-buffer-modified-p modified)))
+ (insert total-summaries "\n")
+ (goto-char (point-min))
+ (restore-buffer-modified-p modified))))
\f
(defvar tar-mode-map
(let ((map (make-keymap)))
(define-key map "R" 'tar-rename-entry)
(define-key map "u" 'tar-unflag)
(define-key map "v" 'tar-view)
+ (define-key map "w" 'woman-tar-extract-file)
(define-key map "x" 'tar-expunge)
(define-key map "\177" 'tar-unflag-backwards)
(define-key map "E" 'tar-extract-other-window)
(define-key map [menu-bar immediate]
(cons "Immediate" (make-sparse-keymap "Immediate")))
+ (define-key map [menu-bar immediate woman]
+ '("Read Man Page (WoMan)" . woman-tar-extract-file))
(define-key map [menu-bar immediate view]
'("View This File" . tar-view))
(define-key map [menu-bar immediate display]
See also: variables `tar-update-datestamp' and `tar-anal-blocksize'.
\\{tar-mode-map}"
+ (and buffer-file-name
+ (file-writable-p buffer-file-name)
+ (setq buffer-read-only nil)) ; undo what `special-mode' did
(make-local-variable 'tar-parse-info)
(set (make-local-variable 'require-final-newline) nil) ; binary data, dude...
(set (make-local-variable 'local-enable-local-variables) nil)
(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)))
+ (cl-assert (not (tar-data-swapped-p)))
(set (make-local-variable 'revert-buffer-function) 'tar-mode-revert)
;; We started using write-contents-functions, but this hook is not
;; used during auto-save, so we now use
(fundamental-mode)
(signal (car err) (cdr err)))))
+(autoload 'woman-tar-extract-file "woman"
+ "In tar mode, run the WoMan man-page browser on this file." t)
(define-minor-mode tar-subfile-mode
"Minor mode for editing an element of a tar-file.
-This mode arranges for \"saving\" this buffer to write the data
-into the tar-file buffer that it came from. The changes will actually
-appear on disk when you save the tar-file's buffer."
+With a prefix argument ARG, enable the mode if ARG is positive,
+and disable it otherwise. If called from Lisp, enable the mode
+if ARG is omitted or nil. This mode arranges for \"saving\" this
+buffer to write the data into the tar-file buffer that it came
+from. The changes will actually appear on disk when you save the
+tar-file's buffer."
;; Don't do this, because it is redundant and wastes mode line space.
;; :lighter " TarFile"
nil nil nil
((eq link-p 29) "a multivolume-continuation")
((eq link-p 35) "a sparse entry")
((eq link-p 38) "a volume header")
- ((eq link-p 55) "an extended pax header")
+ ((eq link-p 55) "a pax global extended header")
+ ((eq link-p 72) "a pax extended header")
(t "a link"))))
(if (zerop size) (message "This is a zero-length file"))
descriptor))
(insert (tar-header-block-summarize descriptor) "\n")))
(forward-line -1) (move-to-column col))
- (assert (tar-data-swapped-p))
+ (cl-assert (tar-data-swapped-p))
(with-current-buffer tar-data-buffer
(let* ((start (- (tar-header-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))) ; <--
- (assert (not (or enable-multibyte-characters
- (multibyte-string-p new-data-string))))
+ (cl-assert (not (or enable-multibyte-characters
+ (multibyte-string-p new-data-string))))
(insert new-data-string)
;;
;; compute a new checksum and insert it.