;;; tar-mode.el --- simple editing of tar files from GNU emacs
;; Copyright (C) 1990, 1991, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
-;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
;; Author: Jamie Zawinski <jwz@lucid.com>
;; Maintainer: FSF
"Return a `tar-header' structure.
This is a list of name, mode, uid, gid, size,
write-date, checksum, link-type, and link-name."
- (assert (<= (+ pos 512) (point-max)))
+ (if (> (+ pos 512) (point-max)) (error "Malformed Tar header"))
(assert (zerop (mod (- pos (point-min)) 512)))
(assert (not enable-multibyte-characters))
(let ((string (buffer-substring pos (setq pos (+ pos 512)))))
(gname-end (1- tar-dmaj-offset))
(link-p (aref string tar-linkp-offset))
(magic-str (substring string tar-magic-offset
- (1- tar-uname-offset)))
- (uname-valid-p (car (member magic-str '("ustar " "ustar\0\0"))))
+ ;; The magic string is actually 6bytes
+ ;; of magic string plus 2bytes of version
+ ;; which we here ignore.
+ (- tar-uname-offset 2)))
+ ;; The magic string is "ustar\0" for POSIX format, and
+ ;; "ustar " for GNU Tar's format.
+ (uname-valid-p (car (member magic-str '("ustar " "ustar\0"))))
name linkname
(nulsexp "[^\000]*\000"))
(when (string-match nulsexp string tar-name-offset)
nil
(- link-p ?0)))
(setq linkname (substring string tar-link-offset link-end))
- (when (and (equal uname-valid-p "ustar\0\0")
+ (when (and (equal uname-valid-p "ustar\0")
(string-match nulsexp string tar-prefix-offset)
(> (match-end 0) (1+ tar-prefix-offset)))
(setq name (concat (substring string tar-prefix-offset
(setq link-p 5)) ; directory
(if (and (equal name "././@LongLink")
- (equal magic-str "ustar ")) ;OLDGNU_MAGIC.
+ (equal magic-str "ustar ")) ;OLDGNU_MAGIC.
;; This is a GNU Tar long-file-name header.
(let* ((size (tar-parse-octal-integer
string tar-size-offset tar-time-offset))
(point-min) (point-max))))
descriptor)
(with-current-buffer tar-data-buffer
- (while (and (<= (+ pos 512) (point-max))
+ (while (and (< pos (point-max))
(setq descriptor (tar-header-block-tokenize pos coding)))
(let ((size (tar-header-size descriptor)))
(if (< size 0)
See also: variables `tar-update-datestamp' and `tar-anal-blocksize'.
\\{tar-mode-map}"
- ;; this is not interactive because you shouldn't be turning this
- ;; 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-parse-info)
(set (make-local-variable 'require-final-newline) nil) ; binary data, dude...
(set (make-local-variable 'local-enable-local-variables) nil)
;; buffer for the summary.
(assert (not (tar-data-swapped-p)))
(set (make-local-variable 'revert-buffer-function) 'tar-mode-revert)
- (add-hook 'write-contents-functions 'tar-mode-write-contents nil t)
+ ;; We started using write-contents-functions, but this hook is not
+ ;; used during auto-save, so we now use
+ ;; write-region-annotate-functions which hooks at a lower-level.
+ (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.
(generate-new-buffer (format " *tar-data %s*"
(file-name-nondirectory
(or buffer-file-name (buffer-name))))))
- (tar-swap-data)
- (tar-summarize-buffer)
- (tar-next-line 0))
+ (condition-case err
+ (progn
+ (tar-swap-data)
+ (tar-summarize-buffer)
+ (tar-next-line 0))
+ (error
+ ;; If summarizing caused an error, then maybe the buffer doesn't contain
+ ;; tar data. Rather than show a mysterious empty buffer, let's
+ ;; revert to fundamental-mode.
+ (fundamental-mode)
+ (signal (car err) (cdr err)))))
(defun tar-subfile-mode (p)
(read-only-p (or buffer-read-only view-p))
(new-buffer-file-name (expand-file-name
;; `:' is not allowed on Windows
- (concat tarname "!" name)))
+ (concat tarname "!"
+ (if (string-match "/" name)
+ name
+ ;; Make sure `name' contains a /
+ ;; so set-auto-mode doesn't try
+ ;; to look at `tarname' for hints.
+ (concat "./" name)))))
(buffer (get-file-buffer new-buffer-file-name))
(just-created nil)
undo-list)
(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)
+ (normal-mode) ; pick a mode.
+ (set (make-local-variable 'tar-superior-buffer) tar-buffer)
+ (set (make-local-variable 'tar-superior-descriptor) descriptor)
+ (setq buffer-read-only read-only-p)
(tar-subfile-mode 1)))
(if view-p
(view-buffer
(string-match "/" encoded-new-name
(- (length encoded-new-name) 99))
(< (match-beginning 0) 155))
- (unless (equal (tar-header-magic descriptor) "ustar\0\0")
- (tar-alter-one-field tar-magic-offset "ustar\0\0"))
+ (unless (equal (tar-header-magic descriptor) "ustar\0")
+ (tar-alter-one-field tar-magic-offset (concat "ustar\0" "00")))
(setq prefix (substring encoded-new-name 0 (match-beginning 0)))
(setq encoded-new-name (substring encoded-new-name (match-end 0))))
(insert (make-string (- goal-end (point-max)) ?\0))))))))
-;; Used in write-contents-functions to write tar-files out correctly.
-(defun tar-mode-write-contents ()
- (save-excursion
- (unwind-protect
- (progn
- (when (tar-data-swapped-p) (tar-swap-data))
- (write-region nil nil buffer-file-name nil t))
- (unless (tar-data-swapped-p) (tar-swap-data))))
+;; 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-modified-p nil)
- ;; Return t because we've written the file.
- t)
+ (set-buffer tar-data-buffer)
+ nil))
(provide 'tar-mode)