;;; 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, 2009 Free Software Foundation, Inc.
+;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
+;; Free Software Foundation, Inc.
;; Author: Jamie Zawinski <jwz@lucid.com>
;; Maintainer: FSF
;; state correctly: the raw data is expected to be always larger than
;; the summary.
(progn
- (assert (eq tar-data-swapped
- (> (buffer-size tar-data-buffer) (buffer-size))))
+ (assert (or (= (buffer-size tar-data-buffer) (buffer-size))
+ (eq tar-data-swapped
+ (> (buffer-size tar-data-buffer) (buffer-size)))))
tar-data-swapped)))
(defun tar-swap-data ()
(setq name (concat (substring string tar-prefix-offset
(1- (match-end 0)))
"/" name)))
- (if default-enable-multibyte-characters
+ (if (default-value 'enable-multibyte-characters)
(setq name
(decode-coding-string name coding)
linkname
(setq link-p 5)) ; directory
(if (and (equal name "././@LongLink")
- (equal magic-str "ustar ")) ;OLDGNU_MAGIC.
+ ;; Supposedly @LongLink is only used for GNUTAR
+ ;; format (i.e. "ustar ") but some POSIX Tar files
+ ;; (with "ustar\0") have been seen using it as well.
+ (member magic-str '("ustar " "ustar\0")))
;; This is a GNU Tar long-file-name header.
(let* ((size (tar-parse-octal-integer
string tar-size-offset tar-time-offset))
;; -1 so as to strip the terminating 0 byte.
- (name (buffer-substring pos (+ pos size -1)))
+ (name (decode-coding-string
+ (buffer-substring pos (+ pos size -1)) coding))
(descriptor (tar-header-block-tokenize
(+ pos (tar-roundup-512 size))
coding)))
link-p
linkname
uname-valid-p
- (and uname-valid-p (substring string tar-uname-offset uname-end))
- (and uname-valid-p (substring string tar-gname-offset gname-end))
+ (when uname-valid-p
+ (decode-coding-string
+ (substring string tar-uname-offset uname-end) coding))
+ (when uname-valid-p
+ (decode-coding-string
+ (substring string tar-gname-offset gname-end) coding))
(tar-parse-octal-integer string tar-dmaj-offset tar-dmin-offset)
(tar-parse-octal-integer string tar-dmin-offset tar-prefix-offset)
))))))
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)
(if (or (not coding)
(eq (coding-system-type coding) 'undecided))
(setq coding (detect-coding-region start end t)))
- (if (and default-enable-multibyte-characters
+ (if (and (default-value 'enable-multibyte-characters)
(coding-system-get coding :for-unibyte))
(with-current-buffer buffer
(set-buffer-multibyte nil)))
(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
(end (+ start size))
(inhibit-file-name-handlers inhibit-file-name-handlers)
(inhibit-file-name-operation inhibit-file-name-operation))
- (save-restriction
- (widen)
+ (with-current-buffer
+ (if (tar-data-swapped-p) tar-data-buffer (current-buffer))
;; Inhibit compressing a subfile again if *both* name and
;; to-file are handled by jka-compr
- (if (and (eq (find-file-name-handler name 'write-region) 'jka-compr-handler)
- (eq (find-file-name-handler to-file 'write-region) 'jka-compr-handler))
+ (if (and (eq (find-file-name-handler name 'write-region)
+ 'jka-compr-handler)
+ (eq (find-file-name-handler to-file 'write-region)
+ 'jka-compr-handler))
(setq inhibit-file-name-handlers
(cons 'jka-compr-handler
(and (eq inhibit-file-name-operation 'write-region)
(read-string "New UID string: " (tar-header-uname descriptor))))))
(cond ((stringp new-uid)
(setf (tar-header-uname (tar-current-descriptor)) new-uid)
- (tar-alter-one-field tar-uname-offset (concat new-uid "\000")))
+ (tar-alter-one-field tar-uname-offset
+ (concat (encode-coding-string
+ new-uid tar-file-name-coding-system)
+ "\000")))
(t
(setf (tar-header-uid (tar-current-descriptor)) new-uid)
(tar-alter-one-field tar-uid-offset
(cond ((stringp new-gid)
(setf (tar-header-gname (tar-current-descriptor)) new-gid)
(tar-alter-one-field tar-gname-offset
- (concat new-gid "\000")))
+ (concat (encode-coding-string
+ new-gid tar-file-name-coding-system)
+ "\000")))
(t
(setf (tar-header-gid (tar-current-descriptor)) new-gid)
(tar-alter-one-field tar-gid-offset