-;;; tar-mode.el --- simple editing of tar files from GNU emacs
+;;; 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.
+;; Copyright (C) 1990-1991, 1993-2011 Free Software Foundation, Inc.
;; Author: Jamie Zawinski <jwz@lucid.com>
;; Maintainer: FSF
(defvar tar-parse-info nil)
(defvar tar-superior-buffer nil)
(defvar tar-superior-descriptor nil)
-(defvar tar-subfile-mode nil)
(defvar tar-file-name-coding-system nil)
(put 'tar-superior-buffer 'permanent-local t)
;; 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 ()
(defun tar-roundup-512 (s)
"Round S up to the next multiple of 512."
(ash (ash (+ s 511) -9) 9))
-
+
(defun tar-header-block-tokenize (pos coding)
"Return a `tar-header' structure.
This is a list of name, mode, uid, gid, size,
(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)))
(setf (tar-header-header-start descriptor)
(copy-marker (- pos 512) t))
descriptor)
-
+
(make-tar-header
(copy-marker pos nil)
name
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)
))))))
(if (and dir (not (file-exists-p dir)))
(make-directory dir t))
(unless (file-directory-p name)
- (write-region start end name))
+ (let ((coding-system-for-write 'no-conversion))
+ (write-region start end name)))
(set-file-modes name (tar-header-mode descriptor))))))))
(defun tar-summarize-buffer ()
;;(tar-header-block-check-checksum
;; hblock (tar-header-block-checksum hblock)
;; (tar-header-name descriptor))
-
+
(push descriptor result)
(setq pos (tar-header-data-end descriptor))
(progress-reporter-update progress-reporter pos)))
(define-key map "\C-m" 'tar-extract)
(define-key map [mouse-2] 'tar-mouse-extract)
(define-key map "g" 'revert-buffer)
- (define-key map "h" 'describe-mode)
(define-key map "n" 'tar-next-line)
(define-key map "\^N" 'tar-next-line)
(define-key map [down] 'tar-next-line)
(define-key map "o" 'tar-extract-other-window)
(define-key map "p" 'tar-previous-line)
- (define-key map "q" 'quit-window)
(define-key map "\^P" 'tar-previous-line)
(define-key map [up] 'tar-previous-line)
(define-key map "R" 'tar-rename-entry)
(if (buffer-live-p tar-data-buffer) (kill-buffer tar-data-buffer)))
;;;###autoload
-(define-derived-mode tar-mode nil "Tar"
+(define-derived-mode tar-mode special-mode "Tar"
"Major mode for viewing a tar file as a dired-like listing of its contents.
You can move around using the usual cursor motion commands.
Letters no longer insert themselves.
(signal (car err) (cdr err)))))
-(defun tar-subfile-mode (p)
+(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."
- (interactive "P")
+ ;; Don't do this, because it is redundant and wastes mode line space.
+ ;; :lighter " TarFile"
+ nil nil nil
(or (and (boundp 'tar-superior-buffer) tar-superior-buffer)
(error "This buffer is not an element of a tar file"))
- ;; Don't do this, because it is redundant and wastes mode line space.
- ;; (or (assq 'tar-subfile-mode minor-mode-alist)
- ;; (setq minor-mode-alist (append minor-mode-alist
- ;; (list '(tar-subfile-mode " TarFile")))))
- (make-local-variable 'tar-subfile-mode)
- (setq tar-subfile-mode
- (if (null p)
- (not tar-subfile-mode)
- (> (prefix-numeric-value p) 0)))
(cond (tar-subfile-mode
(add-hook 'write-file-functions 'tar-subfile-save-buffer nil t)
;; turn off auto-save.
(auto-save-mode -1)
- (setq buffer-auto-save-file-name nil)
- (run-hooks 'tar-subfile-mode-hook))
+ (setq buffer-auto-save-file-name nil))
(t
(remove-hook 'write-file-functions 'tar-subfile-save-buffer t))))
(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)))
(set (make-local-variable 'tar-superior-descriptor) descriptor)
(setq buffer-read-only read-only-p)
(tar-subfile-mode 1)))
- (if view-p
- (view-buffer
- buffer (and just-created 'kill-buffer-if-not-modified))
- (if (eq other-window-p 'display)
- (display-buffer buffer)
- (if other-window-p
- (switch-to-buffer-other-window buffer)
- (switch-to-buffer buffer)))))))
+ (cond
+ (view-p
+ (view-buffer buffer (and just-created 'kill-buffer-if-not-modified)))
+ ((eq other-window-p 'display) (display-buffer buffer))
+ (other-window-p (switch-to-buffer-other-window buffer))
+ (t (switch-to-buffer buffer))))))
(defun tar-extract-other-window ()
(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
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)
;; Used in write-region-annotate-functions to write tar-files out correctly.
-(defun tar-write-region-annotate (start end)
+(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.
(provide 'tar-mode)
-;; arch-tag: 8a585a4a-340e-42c2-89e7-d3b1013a4b78
;;; tar-mode.el ends here