X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/ab5796a9f97180707734a81320e3eb81937281fe..f720b30e1123ca3549436b0a5b8ea65b4473329b:/lisp/tar-mode.el diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el index be17e70c78..4362e97af0 100644 --- a/lisp/tar-mode.el +++ b/lisp/tar-mode.el @@ -1,7 +1,7 @@ ;;; tar-mode.el --- simple editing of tar files from GNU emacs -;; Copyright (C) 1990,91,93,94,95,96,97,98,99,2000,2001 -;; Free Software Foundation, Inc. +;; Copyright (C) 1990, 1991, 1993, 1994, 1995, 1996, 1997, 1998, 1999, +;; 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc. ;; Author: Jamie Zawinski ;; Maintainer: FSF @@ -22,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: @@ -289,7 +289,7 @@ write-date, checksum, link-type, and link-name." (dotimes (i L) (if (or (< (aref string i) ?0) (> (aref string i) ?7)) - (error "`%c' is not an octal digit")))) + (error "`%c' is not an octal digit" (aref string i))))) (tar-parse-octal-integer string)) @@ -404,11 +404,11 @@ 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 (point-min)) - (bs (max 1 (- (buffer-size) 1024))) ; always 2+ empty blocks at end. - (bs100 (max 1 (/ bs 100))) + (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 @@ -416,10 +416,7 @@ is visible (and the real data of the buffer is hidden)." (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 - ) + (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))) @@ -446,7 +443,7 @@ is visible (and the real data of the buffer is hidden)." ;; 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") + (progress-reporter-done progress-reporter) (message "Warning: premature EOF parsing tar file"))) (save-excursion (goto-char (point-min)) @@ -581,7 +578,8 @@ See also: variables `tar-update-datestamp' and `tar-anal-blocksize'. ;; Prevent loss of data when saving the file. (set (make-local-variable 'file-precious-flag) t) (auto-save-mode 0) - (set (make-local-variable '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 (point-min) (byte-to-position tar-header-offset)) @@ -718,65 +716,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 (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))))))) - (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)) - (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))))))) + (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 (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) + (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 + (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 (point-min) tar-header-offset) @@ -1120,7 +1120,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) @@ -1144,7 +1144,7 @@ to make your changes permanent." (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))