X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/048d06bdf5b6401a1b28854f6d4df9f0f6af73ff..0b01facaa26b182854259fb7a08a255fe8cc364a:/lisp/tar-mode.el diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el index 46d595ffea..a02fd1b2ba 100644 --- a/lisp/tar-mode.el +++ b/lisp/tar-mode.el @@ -1,6 +1,7 @@ ;;; tar-mode.el --- simple editing of tar files from GNU emacs -;; Copyright (C) 1990, 1991, 1993, 1994, 1995 Free Software Foundation, Inc. +;; Copyright (C) 1990, 1991, 1993, 1994, 1995, 1996, 1997, 1998, 1999, +;; 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. ;; Author: Jamie Zawinski ;; Maintainer: FSF @@ -21,8 +22,8 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: @@ -40,7 +41,7 @@ ;; This code now understands the extra fields that GNU tar adds to tar files. ;; This interacts correctly with "uncompress.el" in the Emacs library, -;; which you get with +;; which you get with ;; ;; (autoload 'uncompress-while-visiting "uncompress") ;; (setq auto-mode-alist (cons '("\\.Z$" . uncompress-while-visiting) @@ -48,11 +49,11 @@ ;; ;; Do not attempt to use tar-mode.el with crypt.el, you will lose. -;; *************** TO DO *************** +;; *************** TO DO *************** ;; ;; o chmod should understand "a+x,og-w". ;; -;; o It's not possible to add a NEW file to a tar archive; not that +;; o It's not possible to add a NEW file to a tar archive; not that ;; important, but still... ;; ;; o The code is less efficient that it could be - in a lot of places, I @@ -63,7 +64,7 @@ ;; of an archive, where would leave you in a subfile-edit buffer. ;; (Like the Meta-R command of the Zmacs mail reader.) ;; -;; o Sometimes (but not always) reverting the tar-file buffer does not +;; o Sometimes (but not always) reverting the tar-file buffer does not ;; re-grind the listing, and you are staring at the binary tar data. ;; Typing 'g' again immediately after that will always revert and re-grind ;; it, though. I have no idea why this happens. @@ -75,7 +76,7 @@ ;; might be a problem if the tar write-file-hook does not come *first* on ;; the list. ;; -;; o Block files, sparse files, continuation files, and the various header +;; o Block files, sparse files, continuation files, and the various header ;; types aren't editable. Actually I don't know that they work at all. ;; Rationale: @@ -100,9 +101,9 @@ :group 'data) (defcustom tar-anal-blocksize 20 - "*The blocksize of tar files written by Emacs, or nil, meaning don't care. + "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, +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 @@ -111,18 +112,18 @@ how many null padding bytes go on the end of the tar file." :group 'tar) (defcustom tar-update-datestamp nil - "*Non-nil means Tar mode should play fast and loose with sub-file datestamps. + "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 +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. + "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) @@ -200,7 +201,7 @@ This information is useful, but it takes screen space away from file names." (defun tar-header-block-tokenize (string) "Return a `tar-header' structure. -This is a list of name, mode, uid, gid, size, +This is a list of name, mode, uid, gid, size, write-date, checksum, link-type, and link-name." (cond ((< (length string) 512) nil) (;(some 'plusp string) ; <-- oops, massive cycle hog! @@ -230,12 +231,16 @@ write-date, checksum, link-type, and link-name." (setq linkname (substring string tar-link-offset link-end)) (if default-enable-multibyte-characters (setq name - (decode-coding-string name (or file-name-coding-system - 'undecided)) + (decode-coding-string name + (or file-name-coding-system + default-file-name-coding-system + 'undecided)) linkname - (decode-coding-string linkname (or file-name-coding-system - 'undecided)))) - (if (and (null link-p) (string-match "/$" name)) (setq link-p 5)) ; directory + (decode-coding-string linkname + (or file-name-coding-system + default-file-name-coding-system + 'undecided)))) + (if (and (null link-p) (string-match "/\\'" name)) (setq link-p 5)) ; directory (make-tar-header name (tar-parse-octal-integer string tar-mode-offset tar-uid-offset) @@ -283,12 +288,11 @@ write-date, checksum, link-type, and link-name." (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")))) + (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)) @@ -314,38 +318,26 @@ write-date, checksum, link-type, and link-name." (if (not (= desired-checksum (tar-header-block-checksum hblock))) (progn (beep) (message "Invalid checksum for file %s!" file-name)))) -(defun tar-header-block-recompute-checksum (hblock) - "Modifies the given string to have a valid checksum field." - (let* ((chk (tar-header-block-checksum hblock)) - (chk-string (format "%6o" chk)) - (l (length chk-string))) - (aset hblock 154 0) - (aset hblock 155 32) - (dotimes (i l) (aset hblock (- 153 i) (aref chk-string (- l i 1))))) - hblock) - (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) (substring str 19 24)))) -(defun tar-grind-file-mode (mode string start) - "Store `-rw--r--r--' indicating MODE into STRING beginning at START. +(defun tar-grind-file-mode (mode) + "Construct a `-rw--r--r--' string indicating MODE. MODE should be an integer which is a file mode value." - (aset string start (if (zerop (logand 256 mode)) ?- ?r)) - (aset string (+ start 1) (if (zerop (logand 128 mode)) ?- ?w)) - (aset string (+ start 2) (if (zerop (logand 64 mode)) ?- ?x)) - (aset string (+ start 3) (if (zerop (logand 32 mode)) ?- ?r)) - (aset string (+ start 4) (if (zerop (logand 16 mode)) ?- ?w)) - (aset string (+ start 5) (if (zerop (logand 8 mode)) ?- ?x)) - (aset string (+ start 6) (if (zerop (logand 4 mode)) ?- ?r)) - (aset string (+ start 7) (if (zerop (logand 2 mode)) ?- ?w)) - (aset string (+ start 8) (if (zerop (logand 1 mode)) ?- ?x)) - (if (zerop (logand 1024 mode)) nil (aset string (+ start 2) ?s)) - (if (zerop (logand 2048 mode)) nil (aset string (+ start 5) ?s)) - string) + (string + (if (zerop (logand 256 mode)) ?- ?r) + (if (zerop (logand 128 mode)) ?- ?w) + (if (zerop (logand 1024 mode)) (if (zerop (logand 64 mode)) ?- ?x) ?s) + (if (zerop (logand 32 mode)) ?- ?r) + (if (zerop (logand 16 mode)) ?- ?w) + (if (zerop (logand 2048 mode)) (if (zerop (logand 8 mode)) ?- ?x) ?s) + (if (zerop (logand 4 mode)) ?- ?r) + (if (zerop (logand 2 mode)) ?- ?w) + (if (zerop (logand 1 mode)) ?- ?x))) (defun tar-header-block-summarize (tar-hblock &optional mod-p) - "Returns a line similar to the output of `tar -vtf'." + "Return a line similar to the output of `tar -vtf'." (let ((name (tar-header-name tar-hblock)) (mode (tar-header-mode tar-hblock)) (uid (tar-header-uid tar-hblock)) @@ -354,236 +346,220 @@ MODE should be an integer which is a file mode value." (gname (tar-header-gname tar-hblock)) (size (tar-header-size tar-hblock)) (time (tar-header-date tar-hblock)) - (ck (tar-header-checksum tar-hblock)) - (link-p (tar-header-link-type tar-hblock)) - (link-name (tar-header-link-name tar-hblock)) - ) - (let* ((left 11) - (namew 8) - (groupw 8) - (sizew 8) - (datew (if tar-mode-show-date 18 0)) - (slash (1- (+ left namew))) - (lastdigit (+ slash groupw sizew)) - (datestart (+ lastdigit 2)) - (namestart (+ datestart datew)) - (multibyte (or (multibyte-string-p name) - (multibyte-string-p link-name))) - ;; If multibyte, we can't use optimized method of aset, - ;; instead we must use concat. - (string (make-string (if multibyte - namestart - (+ namestart - (length name) - (if link-p (+ 5 (length link-name)) 0))) - 32)) - (type (tar-header-link-type tar-hblock))) - (aset string 0 (if mod-p ?* ? )) - (aset string 1 + ;; (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)) ?-) - ((eq type 1) ?l) ; link - ((eq type 2) ?s) ; symlink - ((eq type 3) ?c) ; char special - ((eq type 4) ?b) ; block special - ((eq type 5) ?d) ; directory - ((eq type 6) ?p) ; FIFO/pipe - ((eq type 20) ?*) ; directory listing - ((eq type 29) ?M) ; multivolume continuation - ((eq type 35) ?S) ; sparse - ((eq type 38) ?V) ; volume header - )) - (tar-grind-file-mode mode string 2) - (setq uid (if (= 0 (length uname)) (int-to-string uid) uname)) - (setq gid (if (= 0 (length gname)) (int-to-string gid) gname)) - (setq size (int-to-string size)) - (setq time (tar-clip-time-string time)) - (dotimes (i (min (1- namew) (length uid))) (aset string (- slash i) (aref uid (- (length uid) i 1)))) - (aset string (1+ slash) ?/) - (dotimes (i (min (1- groupw) (length gid))) (aset string (+ (+ slash 2) i) (aref gid i))) - (dotimes (i (min sizew (length size))) (aset string (- lastdigit i) (aref size (- (length size) i 1)))) - (if tar-mode-show-date - (dotimes (i (length time)) (aset string (+ datestart i) (aref time i)))) - (if multibyte - (setq string (concat string name)) - (dotimes (i (length name)) (aset string (+ namestart i) (aref name i)))) - (if (or (eq link-p 1) (eq link-p 2)) - (if multibyte - (setq string (concat string - (if (= link-p 1) " ==> " " --> ") - link-name)) - (dotimes (i 3) (aset string (+ namestart 1 (length name) i) (aref (if (= link-p 1) "==>" "-->") i))) - (dotimes (i (length link-name)) (aset string (+ namestart 5 (length name) i) (aref link-name i))))) - (put-text-property namestart (length string) - 'mouse-face 'highlight string) - string))) - + ((eq type 1) ?h) ; link + ((eq type 2) ?l) ; symlink + ((eq type 3) ?c) ; char special + ((eq type 4) ?b) ; block special + ((eq type 5) ?d) ; directory + ((eq type 6) ?p) ; FIFO/pipe + ((eq type 20) ?*) ; directory listing + ((eq type 28) ?L) ; next has longname + ((eq type 29) ?M) ; multivolume continuation + ((eq type 35) ?S) ; sparse + ((eq type 38) ?V) ; volume header + (t ?\ ) + ) + (tar-grind-file-mode mode) + (if (= 0 (length uname)) uid uname) + (if (= 0 (length gname)) gid gname) + size + (if tar-mode-show-date (tar-clip-time-string time) "") + (propertize name + 'mouse-face 'highlight + 'help-echo "mouse-2: extract this file into a buffer") + (if (or (eq type 1) (eq type 2)) + (concat (if (= type 1) " ==> " " --> ") link-name) + "")))) + +(defun tar-untar-buffer () + "Extract all archive members in the tar-file into the current directory." + (interactive) + (let ((multibyte enable-multibyte-characters)) + (unwind-protect + (save-restriction + (widen) + (set-buffer-multibyte nil) + (dolist (descriptor tar-parse-info) + (let* ((tokens (tar-desc-tokens descriptor)) + (name (tar-header-name tokens)) + (dir (file-name-directory name)) + (start (+ (tar-desc-data-start descriptor) + (- tar-header-offset (point-min)))) + (end (+ start (tar-header-size tokens)))) + (unless (file-directory-p name) + (message "Extracting %s" name) + (if (and dir (not (file-exists-p dir))) + (make-directory dir t)) + (unless (file-directory-p name) + (write-region start end name)) + (set-file-modes name (tar-header-mode tokens)))))) + (set-buffer-multibyte multibyte)))) (defun tar-summarize-buffer () "Parse the contents of the tar file in the current buffer. Place a dired-like listing on the front; then narrow to it, so that only that listing is visible (and the real data of the buffer is hidden)." - (set-buffer-multibyte nil) - (message "Parsing tar file...") - (let* ((result '()) - (pos 1) - (bs (max 1 (- (buffer-size) 1024))) ; always 2+ empty blocks at end. - (bs100 (max 1 (/ bs 100))) - tokens) - (while (and (<= (+ pos 512) (point-max)) - (not (eq 'empty-tar-block - (setq tokens - (tar-header-block-tokenize - (buffer-substring pos (+ pos 512))))))) - (setq pos (+ pos 512)) - (message "Parsing tar file...%d%%" - ;(/ (* pos 100) bs) ; this gets round-off lossage - (/ pos bs100) ; this doesn't - ) - (if (eq (tar-header-link-type tokens) 20) - ;; Foo. There's an extra empty block after these. - (setq pos (+ pos 512))) - (let ((size (tar-header-size tokens))) - (if (< size 0) - (error "%s has size %s - corrupted" - (tar-header-name tokens) size)) - ; - ; This is just too slow. Don't really need it anyway.... - ;(tar-header-block-check-checksum - ; hblock (tar-header-block-checksum hblock) - ; (tar-header-name tokens)) - - (setq result (cons (make-tar-desc pos tokens) result)) - - (and (null (tar-header-link-type tokens)) - (> size 0) - (setq pos - (+ pos 512 (ash (ash (1- size) -9) 9)) ; this works - ;(+ pos (+ size (- 512 (rem (1- size) 512)))) ; this doesn't - )))) - (make-local-variable 'tar-parse-info) - (setq tar-parse-info (nreverse result)) - ;; A tar file should end with a block or two of nulls, - ;; but let's not get a fatal error if it doesn't. - (if (eq tokens 'empty-tar-block) - (message "Parsing tar file...done") - (message "Warning: premature EOF parsing tar file"))) - (save-excursion + (let ((modified (buffer-modified-p))) + (set-buffer-multibyte nil) + (let* ((result '()) + (pos (point-min)) + (progress-reporter + (make-progress-reporter "Parsing tar file..." + (point-min) (max 1 (- (buffer-size) 1024)))) + tokens) + (while (and (<= (+ pos 512) (point-max)) + (not (eq 'empty-tar-block + (setq tokens + (tar-header-block-tokenize + (buffer-substring pos (+ pos 512))))))) + (setq pos (+ pos 512)) + (progress-reporter-update progress-reporter pos) + (if (eq (tar-header-link-type tokens) 20) + ;; Foo. There's an extra empty block after these. + (setq pos (+ pos 512))) + (let ((size (tar-header-size tokens))) + (if (< size 0) + (error "%s has size %s - corrupted" + (tar-header-name tokens) size)) + ; + ; This is just too slow. Don't really need it anyway.... + ;(tar-header-block-check-checksum + ; hblock (tar-header-block-checksum hblock) + ; (tar-header-name tokens)) + + (push (make-tar-desc pos tokens) result) + + (and (null (tar-header-link-type tokens)) + (> size 0) + (setq pos + (+ pos 512 (ash (ash (1- size) -9) 9)) ; this works + ;(+ pos (+ size (- 512 (rem (1- size) 512)))) ; this doesn't + )))) + (make-local-variable 'tar-parse-info) + (setq tar-parse-info (nreverse result)) + ;; A tar file should end with a block or two of nulls, + ;; but let's not get a fatal error if it doesn't. + (if (eq tokens 'empty-tar-block) + (progress-reporter-done progress-reporter) + (message "Warning: premature EOF parsing tar file"))) + (set-buffer-multibyte default-enable-multibyte-characters) (goto-char (point-min)) - (let ((buffer-read-only nil) - (summaries nil)) + (let ((inhibit-read-only t)) ;; Collect summary lines and insert them all at once since tar files ;; can be pretty big. - (dolist (tar-desc (reverse tar-parse-info)) - (setq summaries - (cons (tar-header-block-summarize (tar-desc-tokens tar-desc)) - (cons "\n" - summaries)))) - (let ((total-summaries (apply 'concat summaries))) - (if (multibyte-string-p total-summaries) - (set-buffer-multibyte t)) - (insert total-summaries)) - (make-local-variable 'tar-header-offset) - (setq tar-header-offset (point)) - (narrow-to-region 1 tar-header-offset) - (if enable-multibyte-characters - (setq tar-header-offset (position-bytes tar-header-offset))) - (set-buffer-modified-p nil)))) - -(defvar tar-mode-map nil "*Local keymap for Tar mode listings.") - -(if tar-mode-map - nil - (setq tar-mode-map (make-keymap)) - (suppress-keymap tar-mode-map) - (define-key tar-mode-map " " 'tar-next-line) - (define-key tar-mode-map "C" 'tar-copy) - (define-key tar-mode-map "d" 'tar-flag-deleted) - (define-key tar-mode-map "\^D" 'tar-flag-deleted) - (define-key tar-mode-map "e" 'tar-extract) - (define-key tar-mode-map "f" 'tar-extract) - (define-key tar-mode-map "\C-m" 'tar-extract) - (define-key tar-mode-map [mouse-2] 'tar-mouse-extract) - (define-key tar-mode-map "g" 'revert-buffer) - (define-key tar-mode-map "h" 'describe-mode) - (define-key tar-mode-map "n" 'tar-next-line) - (define-key tar-mode-map "\^N" 'tar-next-line) - (define-key tar-mode-map [down] 'tar-next-line) - (define-key tar-mode-map "o" 'tar-extract-other-window) - (define-key tar-mode-map "p" 'tar-previous-line) - (define-key tar-mode-map "q" 'quit-window) - (define-key tar-mode-map "\^P" 'tar-previous-line) - (define-key tar-mode-map [up] 'tar-previous-line) - (define-key tar-mode-map "R" 'tar-rename-entry) - (define-key tar-mode-map "u" 'tar-unflag) - (define-key tar-mode-map "v" 'tar-view) - (define-key tar-mode-map "x" 'tar-expunge) - (define-key tar-mode-map "\177" 'tar-unflag-backwards) - (define-key tar-mode-map "E" 'tar-extract-other-window) - (define-key tar-mode-map "M" 'tar-chmod-entry) - (define-key tar-mode-map "G" 'tar-chgrp-entry) - (define-key tar-mode-map "O" 'tar-chown-entry) - ) + (let ((total-summaries + (mapconcat + (lambda (tar-desc) + (tar-header-block-summarize (tar-desc-tokens tar-desc))) + tar-parse-info + "\n"))) + (insert total-summaries "\n")) + (narrow-to-region (point-min) (point)) + (set (make-local-variable 'tar-header-offset) (position-bytes (point))) + (goto-char (point-min)) + (restore-buffer-modified-p modified)))) -;; Make menu bar items. - -;; Get rid of the Edit menu bar item to save space. -(define-key tar-mode-map [menu-bar edit] 'undefined) - -(define-key tar-mode-map [menu-bar immediate] - (cons "Immediate" (make-sparse-keymap "Immediate"))) - -(define-key tar-mode-map [menu-bar immediate view] - '("View This File" . tar-view)) -(define-key tar-mode-map [menu-bar immediate display] - '("Display in Other Window" . tar-display-other-window)) -(define-key tar-mode-map [menu-bar immediate find-file-other-window] - '("Find in Other Window" . tar-extract-other-window)) -(define-key tar-mode-map [menu-bar immediate find-file] - '("Find This File" . tar-extract)) - -(define-key tar-mode-map [menu-bar mark] - (cons "Mark" (make-sparse-keymap "Mark"))) - -(define-key tar-mode-map [menu-bar mark unmark-all] - '("Unmark All" . tar-clear-modification-flags)) -(define-key tar-mode-map [menu-bar mark deletion] - '("Flag" . tar-flag-deleted)) -(define-key tar-mode-map [menu-bar mark unmark] - '("Unflag" . tar-unflag)) - -(define-key tar-mode-map [menu-bar operate] - (cons "Operate" (make-sparse-keymap "Operate"))) - -(define-key tar-mode-map [menu-bar operate chown] - '("Change Owner..." . tar-chown-entry)) -(define-key tar-mode-map [menu-bar operate chgrp] - '("Change Group..." . tar-chgrp-entry)) -(define-key tar-mode-map [menu-bar operate chmod] - '("Change Mode..." . tar-chmod-entry)) -(define-key tar-mode-map [menu-bar operate rename] - '("Rename to..." . tar-rename-entry)) -(define-key tar-mode-map [menu-bar operate copy] - '("Copy to..." . tar-copy)) -(define-key tar-mode-map [menu-bar operate expunge] - '("Expunge Marked Files" . tar-expunge)) +(defvar tar-mode-map + (let ((map (make-keymap))) + (suppress-keymap map) + (define-key map " " 'tar-next-line) + (define-key map "C" 'tar-copy) + (define-key map "d" 'tar-flag-deleted) + (define-key map "\^D" 'tar-flag-deleted) + (define-key map "e" 'tar-extract) + (define-key map "f" 'tar-extract) + (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) + (define-key map "u" 'tar-unflag) + (define-key map "v" 'tar-view) + (define-key map "x" 'tar-expunge) + (define-key map "\177" 'tar-unflag-backwards) + (define-key map "E" 'tar-extract-other-window) + (define-key map "M" 'tar-chmod-entry) + (define-key map "G" 'tar-chgrp-entry) + (define-key map "O" 'tar-chown-entry) + + ;; Make menu bar items. + + ;; Get rid of the Edit menu bar item to save space. + (define-key map [menu-bar edit] 'undefined) + + (define-key map [menu-bar immediate] + (cons "Immediate" (make-sparse-keymap "Immediate"))) + + (define-key map [menu-bar immediate view] + '("View This File" . tar-view)) + (define-key map [menu-bar immediate display] + '("Display in Other Window" . tar-display-other-window)) + (define-key map [menu-bar immediate find-file-other-window] + '("Find in Other Window" . tar-extract-other-window)) + (define-key map [menu-bar immediate find-file] + '("Find This File" . tar-extract)) + + (define-key map [menu-bar mark] + (cons "Mark" (make-sparse-keymap "Mark"))) + + (define-key map [menu-bar mark unmark-all] + '("Unmark All" . tar-clear-modification-flags)) + (define-key map [menu-bar mark deletion] + '("Flag" . tar-flag-deleted)) + (define-key map [menu-bar mark unmark] + '("Unflag" . tar-unflag)) + + (define-key map [menu-bar operate] + (cons "Operate" (make-sparse-keymap "Operate"))) + + (define-key map [menu-bar operate chown] + '("Change Owner..." . tar-chown-entry)) + (define-key map [menu-bar operate chgrp] + '("Change Group..." . tar-chgrp-entry)) + (define-key map [menu-bar operate chmod] + '("Change Mode..." . tar-chmod-entry)) + (define-key map [menu-bar operate rename] + '("Rename to..." . tar-rename-entry)) + (define-key map [menu-bar operate copy] + '("Copy to..." . tar-copy)) + (define-key map [menu-bar operate expunge] + '("Expunge Marked Files" . tar-expunge)) + + map) + "Local keymap for Tar mode listings.") + ;; tar mode is suitable only for specially formatted data. (put 'tar-mode 'mode-class 'special) (put 'tar-subfile-mode 'mode-class 'special) ;;;###autoload -(defun tar-mode () +(define-derived-mode tar-mode nil "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. +You can move around using the usual cursor motion commands. Letters no longer insert themselves. 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 +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'. @@ -592,33 +568,22 @@ See also: variables `tar-update-datestamp' and `tar-anal-blocksize'. ;; 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. - (kill-all-local-variables) (make-local-variable 'tar-header-offset) (make-local-variable 'tar-parse-info) - (make-local-variable 'require-final-newline) - (setq require-final-newline nil) ; binary data, dude... - (make-local-variable 'revert-buffer-function) - (setq revert-buffer-function 'tar-mode-revert) - (make-local-variable 'local-enable-local-variables) - (setq local-enable-local-variables nil) - (make-local-variable 'next-line-add-newlines) - (setq next-line-add-newlines nil) + (set (make-local-variable 'require-final-newline) nil) ; binary data, dude... + (set (make-local-variable 'revert-buffer-function) 'tar-mode-revert) + (set (make-local-variable 'local-enable-local-variables) nil) + (set (make-local-variable 'next-line-add-newlines) nil) ;; Prevent loss of data when saving the file. - (make-local-variable 'file-precious-flag) - (setq file-precious-flag t) - (setq major-mode 'tar-mode) - (setq mode-name "Tar") - (use-local-map tar-mode-map) + (set (make-local-variable 'file-precious-flag) t) (auto-save-mode 0) - (make-local-variable 'write-contents-hooks) - (setq write-contents-hooks '(tar-mode-write-file)) + (set (make-local-variable 'write-contents-functions) '(tar-mode-write-file)) + (buffer-disable-undo) (widen) (if (and (boundp 'tar-header-offset) tar-header-offset) - (narrow-to-region 1 (byte-to-position tar-header-offset)) - (tar-summarize-buffer) - (tar-next-line 0)) - (run-hooks 'tar-mode-hook) - ) + (narrow-to-region (point-min) (byte-to-position tar-header-offset)) + (tar-summarize-buffer) + (tar-next-line 0))) (defun tar-subfile-mode (p) @@ -629,24 +594,23 @@ appear on disk when you save the tar-file's buffer." (interactive "P") (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"))))) + ;; 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 - (make-local-variable 'local-write-file-hooks) - (setq local-write-file-hooks '(tar-subfile-save-buffer)) + (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)) (t - (kill-local-variable 'local-write-file-hooks)))) + (remove-hook 'write-file-functions 'tar-subfile-save-buffer t)))) ;; Revert the buffer and recompute the dired-like listing. @@ -666,14 +630,16 @@ appear on disk when you save the tar-file's buffer." (setq tar-header-offset old-offset))))) -(defun tar-next-line (p) +(defun tar-next-line (arg) + "Move cursor vertically down ARG lines and to the start of the filename." (interactive "p") - (forward-line p) + (forward-line arg) (if (eobp) nil (forward-char (if tar-mode-show-date 54 36)))) -(defun tar-previous-line (p) +(defun tar-previous-line (arg) + "Move cursor vertically up ARG lines and to the start of the filename." (interactive "p") - (tar-next-line (- p))) + (tar-next-line (- arg))) (defun tar-current-descriptor (&optional noerror) "Return the tar-descriptor of the current line, or signals an error." @@ -694,6 +660,7 @@ appear on disk when you save the tar-file's buffer." (error "This is a %s, not a real file" (cond ((eq link-p 5) "directory") ((eq link-p 20) "tar directory header") + ((eq link-p 28) "next has longname") ((eq link-p 29) "multivolume-continuation") ((eq link-p 35) "sparse entry") ((eq link-p 38) "volume header") @@ -722,23 +689,25 @@ appear on disk when you save the tar-file's buffer." (tokens (tar-desc-tokens descriptor)) (name (tar-header-name tokens)) (size (tar-header-size tokens)) - (start (+ (tar-desc-data-start descriptor) tar-header-offset -1)) + (start (+ (tar-desc-data-start descriptor) + (- tar-header-offset (point-min)))) (end (+ start size))) (let* ((tar-buffer (current-buffer)) (tar-buffer-multibyte enable-multibyte-characters) - (tarname (if (buffer-file-name) - (file-name-nondirectory (buffer-file-name)) - (buffer-name))) + (tarname (buffer-name)) (bufname (concat (file-name-nondirectory name) " (" - tarname - ")")) + tarname + ")")) (read-only-p (or buffer-read-only view-p)) - (buffer (get-buffer bufname)) + (new-buffer-file-name (expand-file-name + ;; `:' is not allowed on Windows + (concat tarname "!" name))) + (buffer (get-file-buffer new-buffer-file-name)) (just-created nil)) - (if buffer - nil - (setq buffer (get-buffer-create bufname)) + (unless buffer + (setq buffer (generate-new-buffer bufname)) + (setq bufname (buffer-name buffer)) (setq just-created t) (unwind-protect (progn @@ -746,68 +715,67 @@ appear on disk when you save the tar-file's buffer." (set-buffer-multibyte nil) (save-excursion (set-buffer buffer) - (if enable-multibyte-characters - (progn - ;; We must avoid unibyte->multibyte conversion. - (set-buffer-multibyte nil) - (insert-buffer-substring tar-buffer start end) - (set-buffer-multibyte t)) - (insert-buffer-substring tar-buffer start end)) - (goto-char 0) - (setq buffer-file-name - ;; `:' is not allowed on Windows - (expand-file-name (concat tarname "!" name))) - (setq buffer-file-truename - (abbreviate-file-name buffer-file-name)) - ;; We need to mimic the parts of insert-file-contents - ;; which determine the coding-system and decode the text. - (let ((coding - (and set-auto-coding-function - (save-excursion - (funcall set-auto-coding-function - name (point-max))))) - (multibyte enable-multibyte-characters) - (detected (detect-coding-region - 1 (min 16384 (point-max)) t))) - (if coding - (or (numberp (coding-system-eol-type coding)) - (setq coding (coding-system-change-eol-conversion - coding - (coding-system-eol-type detected)))) - (setq coding - (or (find-new-buffer-file-coding-system detected) - (let ((file-coding - (find-operation-coding-system - 'insert-file-contents buffer-file-name))) - (if (consp file-coding) - (setq file-coding (car file-coding)) - file-coding))))) - (if (or (eq coding 'no-conversion) - (eq (coding-system-type coding) 5)) - (setq multibyte (set-buffer-multibyte nil))) - (or multibyte + (let ((buffer-undo-list t)) + (if enable-multibyte-characters + (progn + ;; We must avoid unibyte->multibyte conversion. + (set-buffer-multibyte nil) + (insert-buffer-substring tar-buffer start end) + (set-buffer-multibyte t)) + (insert-buffer-substring tar-buffer start end)) + (goto-char (point-min)) + (setq buffer-file-name new-buffer-file-name) + (setq buffer-file-truename + (abbreviate-file-name buffer-file-name)) + ;; We need to mimic the parts of insert-file-contents + ;; which determine the coding-system and decode the text. + (let ((coding + (or coding-system-for-read + (and set-auto-coding-function + (save-excursion + (funcall set-auto-coding-function + name (- (point-max) (point))))) + (car (find-operation-coding-system + 'insert-file-contents + (cons name (current-buffer)) t)))) + (multibyte enable-multibyte-characters) + (detected (detect-coding-region + (point-min) + (min (+ (point-min) 16384) (point-max)) t))) + (if coding + (or (numberp (coding-system-eol-type coding)) + (vectorp (coding-system-eol-type detected)) + (setq coding (coding-system-change-eol-conversion + coding + (coding-system-eol-type detected)))) (setq coding - (coding-system-change-text-conversion - coding 'raw-text))) - (decode-coding-region 1 (point-max) coding) - (set-buffer-file-coding-system coding)) - ;; Set the default-directory to the dir of the - ;; superior buffer. - (setq default-directory - (save-excursion - (set-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) + (find-new-buffer-file-coding-system detected))) + (if (or (eq coding 'no-conversion) + (eq (coding-system-type coding) 5)) + (setq multibyte (set-buffer-multibyte nil))) + (or multibyte + (setq coding + (coding-system-change-text-conversion + coding 'raw-text))) + (decode-coding-region (point-min) (point-max) coding) + (set-buffer-file-coding-system coding)) + ;; Set the default-directory to the dir of the + ;; superior buffer. + (setq default-directory + (save-excursion + (set-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)) (tar-subfile-mode 1)) (set-buffer tar-buffer)) - (narrow-to-region 1 tar-header-offset) + (narrow-to-region (point-min) tar-header-offset) (set-buffer-multibyte tar-buffer-multibyte))) (if view-p (view-buffer buffer (and just-created 'kill-buffer)) @@ -819,17 +787,17 @@ appear on disk when you save the tar-file's buffer." (defun tar-extract-other-window () - "*In Tar mode, find this entry of the tar file in another 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." + "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." + "In Tar mode, view the tar file entry on this line." (interactive) (tar-extract 'view)) @@ -855,7 +823,7 @@ appear on disk when you save the tar-file's buffer." (defun tar-copy (&optional to-file) - "*In Tar mode, extract this entry of the tar file into a file on disk. + "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))) @@ -863,7 +831,8 @@ the current tar-entry." (tokens (tar-desc-tokens descriptor)) (name (tar-header-name tokens)) (size (tar-header-size tokens)) - (start (+ (tar-desc-data-start descriptor) tar-header-offset -1)) + (start (+ (tar-desc-data-start descriptor) + (- tar-header-offset (point-min)))) (end (+ start size)) (multibyte enable-multibyte-characters) (inhibit-file-name-handlers inhibit-file-name-handlers) @@ -882,16 +851,16 @@ the current tar-entry." (unwind-protect (let ((coding-system-for-write 'no-conversion)) (set-buffer-multibyte nil) - (write-region start end to-file)) + (write-region start end to-file nil nil nil t)) (set-buffer-multibyte multibyte))) (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. + "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)) + (dotimes (i (abs p)) (if (tar-current-descriptor unflag) ; barf if we're not on an entry-line. (progn (delete-char 1) @@ -900,13 +869,13 @@ With a prefix argument, mark that many files." (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. + "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. + "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)) @@ -917,7 +886,7 @@ With a prefix argument, un-mark that many files backward." "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)) + ;; (line (tar-desc-data-start descriptor)) (name (tar-header-name tokens)) (size (tar-header-size tokens)) (link-p (tar-header-link-type tokens)) @@ -929,18 +898,16 @@ With a prefix argument, un-mark that many files backward." (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)))) + ;; 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 -513)) + (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) ;; @@ -954,11 +921,11 @@ With a prefix argument, un-mark that many files backward." (tar-setf (tar-desc-data-start desc) (- (tar-desc-data-start desc) data-length)))) )) - (narrow-to-region 1 tar-header-offset)) + (narrow-to-region (point-min) tar-header-offset)) (defun tar-expunge (&optional noconfirm) - "*In Tar mode, delete all the archived files flagged for deletion. + "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) @@ -966,9 +933,10 @@ for this to be permanent." (y-or-n-p "Expunge files marked for deletion? ")) (let ((n 0) (multibyte enable-multibyte-characters)) - (set-buffer-multibyte nil) (save-excursion - (goto-char 0) + (widen) + (set-buffer-multibyte nil) + (goto-char (point-min)) (while (not (eobp)) (if (looking-at "D") (progn (tar-expunge-internal) @@ -976,8 +944,9 @@ for this to be permanent." (forward-line 1))) ;; after doing the deletions, add any padding that may be necessary. (tar-pad-to-blocksize) - (narrow-to-region 1 tar-header-offset)) - (set-buffer-multibyte multibyte) + (widen) + (set-buffer-multibyte multibyte) + (narrow-to-region (point-min) tar-header-offset)) (if (zerop n) (message "Nothing to expunge.") (message "%s files expunged. Be sure to save this buffer." n))))) @@ -987,7 +956,7 @@ for this to be permanent." "Remove the stars at the beginning of each line." (interactive) (save-excursion - (goto-char 1) + (goto-char (point-min)) (while (< (position-bytes (point)) tar-header-offset) (if (not (eq (following-char) ?\ )) (progn (delete-char 1) (insert " "))) @@ -995,7 +964,7 @@ for this to be permanent." (defun tar-chown-entry (new-uid) - "*Change the user-id associated with this entry in the tar file. + "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. @@ -1023,7 +992,7 @@ for this to be permanent." (defun tar-chgrp-entry (new-gid) - "*Change the group-id associated with this entry in the tar file. + "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. @@ -1051,7 +1020,7 @@ for this to be permanent." (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. + "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 @@ -1061,12 +1030,16 @@ for this to be permanent." (if (> (length new-name) 98) (error "name too long")) (tar-setf (tar-header-name (tar-desc-tokens (tar-current-descriptor))) new-name) + (if (multibyte-string-p new-name) + (setq new-name (encode-coding-string new-name + (or file-name-coding-system + default-file-name-coding-system)))) (tar-alter-one-field 0 (substring (concat new-name (make-string 99 0)) 0 99))) (defun tar-chmod-entry (new-mode) - "*Change the protection bits associated with this entry in the tar file. + "Change the protection bits 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 (tar-parse-octal-integer-safe @@ -1091,10 +1064,12 @@ for this to be permanent." (delete-region p (point)) (insert (tar-header-block-summarize tokens) "\n") (setq tar-header-offset (position-bytes (point-max)))) - + (widen) (set-buffer-multibyte nil) - (let* ((start (+ (tar-desc-data-start descriptor) tar-header-offset -513))) + (let* ((start (+ (tar-desc-data-start descriptor) + (- tar-header-offset (point-min)) + -512))) ;; ;; delete the old field and insert a new one. (goto-char (+ start data-position)) @@ -1116,7 +1091,7 @@ for this to be permanent." (buffer-substring start (+ start 512)) chk (tar-header-name tokens)) ))) - (narrow-to-region 1 tar-header-offset) + (narrow-to-region (point-min) tar-header-offset) (set-buffer-multibyte multibyte) (tar-next-line 0)))) @@ -1124,11 +1099,12 @@ for this to be permanent." (defun tar-octal-time (timeval) ;; Format a timestamp as 11 octal digits. Ghod, I hope this works... (let ((hibits (car timeval)) (lobits (car (cdr timeval)))) - (insert (format "%05o%01o%05o" - (lsh hibits -2) - (logior (lsh (logand 3 hibits) 1) (> (logand lobits 32768) 0)) - (logand 32767 lobits) - )))) + (format "%05o%01o%05o" + (lsh hibits -2) + (logior (lsh (logand 3 hibits) 1) + (if (> (logand lobits 32768) 0) 1 0)) + (logand 32767 lobits) + ))) (defun tar-subfile-save-buffer () "In tar subfile mode, save this buffer into its parent tar-file buffer. @@ -1146,7 +1122,7 @@ to make your changes permanent." (descriptor tar-superior-descriptor) subfile-size) ;; We must make the current buffer unibyte temporarily to avoid - ;; multibyte->unibyte conversion in `insert-buffer'. + ;; multibyte->unibyte conversion in `insert-buffer-substring'. (set-buffer-multibyte nil) (setq subfile-size (buffer-size)) (set-buffer tar-superior-buffer) @@ -1165,12 +1141,12 @@ to make your changes permanent." (widen) (set-buffer-multibyte nil) ;; delete the old data... - (let* ((data-start (+ start tar-header-offset -1)) + (let* ((data-start (+ start (- tar-header-offset (point-min)))) (data-end (+ data-start (ash (ash (+ size 511) -9) 9)))) (delete-region data-start data-end) ;; insert the new data... (goto-char data-start) - (insert-buffer subfile) + (insert-buffer-substring subfile) (setq subfile-size (encode-coding-region data-start (+ data-start subfile-size) coding)) @@ -1215,7 +1191,7 @@ to make your changes permanent." ;; alter the descriptor-line... ;; (let ((position (- (length tar-parse-info) (length head)))) - (goto-char 1) + (goto-char (point-min)) (next-line position) (beginning-of-line) (let ((p (point)) @@ -1226,15 +1202,13 @@ to make your changes permanent." ;; Insert the new text after the old, before deleting, ;; to preserve the window start. (let ((line (tar-header-block-summarize tokens t))) - (if (multibyte-string-p line) - (insert-before-markers (string-as-unibyte line) "\n") - (insert-before-markers line "\n"))) + (insert-before-markers (string-as-unibyte line) "\n")) (delete-region p after) (setq tar-header-offset (marker-position m))) ))) ;; after doing the insertion, add any final padding that may be necessary. (tar-pad-to-blocksize)) - (narrow-to-region 1 tar-header-offset) + (narrow-to-region (point-min) tar-header-offset) (set-buffer-multibyte tar-buffer-multibyte))) (set-buffer-modified-p t) ; mark the tar file as modified (tar-next-line 0) @@ -1264,19 +1238,17 @@ Leaves the region wide." (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)))) + (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. ;; - (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))) - ))) + (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. @@ -1290,16 +1262,18 @@ Leaves the region wide." ;; tar-header-offset turns out to be null for files fetched with W3, ;; at least. (let ((coding-system-for-write 'no-conversion)) - (write-region (or (byte-to-position tar-header-offset) - (point-min)) + (write-region (if tar-header-offset + (byte-to-position tar-header-offset) + (point-min)) (point-max) buffer-file-name nil t)) (tar-clear-modification-flags) (set-buffer-modified-p nil)) - (narrow-to-region 1 (byte-to-position tar-header-offset))) + (narrow-to-region (point-min) (byte-to-position tar-header-offset))) ;; Return t because we've written the file. t) (provide 'tar-mode) +;; arch-tag: 8a585a4a-340e-42c2-89e7-d3b1013a4b78 ;;; tar-mode.el ends here