changeset 22181:dc8c3736ebea

(tar-mode): Position point on the name of the first file. (tar-extract): Detect coding-system of the archive member and decode it like insert-file-contents does. (tar-alter-one-field): Reposition point on the file name of the current tar entry. (tar-subfile-save-buffer): Encode the file when updating it in the archive, and use the size of encoded text to update the header block. Set last-coding-system-used to coding-system of the file. Restore point of tar-superior-buffer after updating the descriptor line.
author Richard M. Stallman <rms@gnu.org>
date Fri, 22 May 1998 05:00:25 +0000
parents 485917486caf
children 8075f717f3e4
files lisp/tar-mode.el
diffstat 1 files changed, 48 insertions(+), 2 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/tar-mode.el	Fri May 22 04:42:48 1998 +0000
+++ b/lisp/tar-mode.el	Fri May 22 05:00:25 1998 +0000
@@ -610,7 +610,8 @@
   (widen)
   (if (and (boundp 'tar-header-offset) tar-header-offset)
       (narrow-to-region 1 tar-header-offset)
-      (tar-summarize-buffer))
+      (tar-summarize-buffer)
+      (tar-next-line 0))
   (run-hooks 'tar-mode-hook)
   )
 
@@ -743,6 +744,43 @@
 		      (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
+			    (funcall
+			     set-auto-coding-function
+			     (if (< (point-max) 4096)
+				 (buffer-substring-no-properties 1 (point-max))
+			       (concat
+				(buffer-substring-no-properties 1  1025)
+				(buffer-substring-no-properties
+				 (- (point-max) 3072) (point-max)))))))
+		      (multibyte enable-multibyte-characters)
+		      (detected (detect-coding-region
+				 1 (min 16384 (point-max)))))
+		  (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
+		      (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
@@ -1057,7 +1095,8 @@
 	        (buffer-substring start (+ start 512))
 	        chk (tar-header-name tokens))
 	      )))
-      (narrow-to-region 1 tar-header-offset))))
+      (narrow-to-region 1 tar-header-offset)
+      (tar-next-line 0))))
 
 
 (defun tar-octal-time (timeval)
@@ -1081,6 +1120,7 @@
   (save-excursion
   (let ((subfile (current-buffer))
 	(subfile-size (buffer-size))
+	(coding buffer-file-coding-system)
 	(descriptor tar-superior-descriptor))
     (set-buffer tar-superior-buffer)
     (let* ((tokens (tar-desc-tokens descriptor))
@@ -1102,6 +1142,9 @@
 	  ;; insert the new data...
 	  (goto-char data-start)
 	  (insert-buffer subfile)
+	  (setq subfile-size
+		(encode-coding-region
+		 data-start (+ data-start subfile-size) coding))
 	  ;;
 	  ;; pad the new data out to a multiple of 512...
 	  (let ((subfile-size-pad (ash (ash (+ subfile-size 511) -9) 9)))
@@ -1161,10 +1204,13 @@
 	(tar-pad-to-blocksize))
        (narrow-to-region 1 tar-header-offset)))
     (set-buffer-modified-p t)   ; mark the tar file as modified
+    (tar-next-line 0)
     (set-buffer subfile)
     (set-buffer-modified-p nil) ; mark the tar subfile as unmodified
     (message "Saved into tar-buffer `%s'.  Be sure to save that buffer!"
 	     (buffer-name tar-superior-buffer))
+    ;; Prevent basic-save-buffer from changing our coding-system.
+    (setq last-coding-system-used buffer-file-coding-system)
     ;; Prevent ordinary saving from happening.
     t)))