changeset 88955:1d1275f5d5b7

(tar-file-name-coding-system): New variable. Make it permanent-local.p (tar-header-block-tokenize): Decode filename and linkname by tar-file-name-coding-system. (tar-header-block-checksum): Call multibyte-char-to-unibyte to get the byte value of eight-bit chars. (tar-summarize-buffer): Call set-buffer-multibyte with METHOD `to'. Delete unnecessary call of position-bytes. (tar-mode): Set tar-file-name-coding-system. Delete unnecessary call of position-bytes. (tar-extract): Simplified by calling decode-coding-region with DESTINATION argument. Don't toggle multibyteness of tar buffer. (tar-copy): Don't toggle multibyteness of tar buffer. (tar-expunge): Likewise. (tar-clear-modification-flags): Delete unnecessary call of position-bytes. (tar-rename-entry): Call tar-alter-one-field with encoded new name. (tar-alter-one-field): Don't toggle multibyteness of tar buffer. Convert new-data-string by string-to-multibyte before inserting it. (tar-subfile-save-buffer): Don't toggle multibyteness of tar buffer. Simplified by calling encoding-coding-region with DESTINATION argument. (tar-mode-write-file): Delete unnecessary call of byte-to-position.

--- a/lisp/tar-mode.el	Wed Jul 31 07:14:13 2002 +0000
+++ b/lisp/tar-mode.el	Wed Jul 31 07:14:35 2002 +0000
@@ -129,16 +129,17 @@
   :group 'tar)
 
 (defvar tar-parse-info nil)
-;; Be sure that this variable holds byte position, not char position.
 (defvar tar-header-offset 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-parse-info 'permanent-local t)
 (put 'tar-header-offset 'permanent-local t)
 (put 'tar-superior-buffer 'permanent-local t)
 (put 'tar-superior-descriptor 'permanent-local t)
+(put 'tar-file-name-coding-system 'permanent-local t)
 
 (defmacro tar-setf (form val)
   "A mind-numbingly simple implementation of setf."
@@ -231,11 +232,10 @@
 	   (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 tar-file-name-coding-system)
 		     linkname
-		     (decode-coding-string linkname (or file-name-coding-system
-							'undecided))))
+		     (decode-coding-string linkname
+					   tar-file-name-coding-system)))
 	   (if (and (null link-p) (string-match "/$" name)) (setq link-p 5)) ; directory
 	   (make-tar-header
 	     name
@@ -302,11 +302,11 @@
     ;; Add up all of the characters except the ones in the checksum field.
     ;; Add that field as if it were filled with spaces.
     (while (< i chk-field-start)
-      (setq sum (+ sum (aref string i))
+      (setq sum (+ sum (multibyte-char-to-unibyte (aref string i)))
 	    i (1+ i)))
     (setq i chk-field-end)
     (while (< i 512)
-      (setq sum (+ sum (aref string i))
+      (setq sum (+ sum (multibyte-char-to-unibyte (aref string i)))
 	    i (1+ i)))
     (+ sum (* 32 8))))
 
@@ -434,15 +434,13 @@
 	      (cons (tar-header-block-summarize (tar-desc-tokens tar-desc))
 		    (cons "\n"
 			  summaries))))
+      (if default-enable-multibyte-characters
+	  (set-buffer-multibyte t 'to))
       (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.")
@@ -553,13 +551,17 @@
   (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)
+  (set (make-local-variable 'tar-file-name-coding-system)
+       (or file-name-coding-system
+	   default-file-name-coding-system
+	   locale-coding-system))
   ;; 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))
   (widen)
   (if (and (boundp 'tar-header-offset) tar-header-offset)
-      (narrow-to-region 1 (byte-to-position tar-header-offset))
+      (narrow-to-region 1 tar-header-offset)
     (tar-summarize-buffer)
     (tar-next-line 0)))
 
@@ -681,61 +683,40 @@
 				  ;; `:' is not allowed on Windows
 				  (concat tarname "!" name)))
 	   (buffer (get-file-buffer new-buffer-file-name))
-	   (just-created nil))
+	   (just-created nil)
+	   (pos (point)))
       (unless buffer
 	(setq buffer (generate-new-buffer bufname))
 	(setq bufname (buffer-name buffer))
 	(setq just-created t)
 	(unwind-protect
-	    (progn
-	      (widen)
-	      (set-buffer-multibyte nil)
+	    (let (coding)
+	      (narrow-to-region start end)
+	      (goto-char start)
+	      (setq coding (or coding-system-for-read
+			       (and set-auto-coding-function
+				    (funcall set-auto-coding-function
+					     name (point-max)))))
+	      (if (or (not coding)
+		      (eq (coding-system-type coding) 'undecided))
+		  (setq coding (detect-coding-region start end t)))
+	      (if (eq (coding-system-type coding) 'undecided)
+		  (setq coding
+			(coding-system-change-text-conversion coding
+							      'us-ascii)))
 	      (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))
+		(if (and enable-multibyte-characters
+			 (eq (coding-system-type 'raw-text) coding))
+		    (set-buffer-multibyte nil))
 		(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
-				 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
-		      (setq coding
-			    (coding-system-change-text-conversion
-			     coding 'raw-text)))
-		  (decode-coding-region 1 (point-max) coding)
-		  (set-buffer-file-coding-system coding))
+		      (abbreviate-file-name buffer-file-name)))
+	      (decode-coding-region start end coding buffer)
+	      (save-excursion
+		(set-buffer buffer)
+		(goto-char (point-min))
 		;; Set the default-directory to the dir of the
 		;; superior buffer. 
 		(setq default-directory
@@ -753,7 +734,7 @@
 		(tar-subfile-mode 1))
 	      (set-buffer tar-buffer))
 	  (narrow-to-region 1 tar-header-offset)
-	  (set-buffer-multibyte tar-buffer-multibyte)))
+	  (goto-char pos)))
       (if view-p
 	  (view-buffer buffer (and just-created 'kill-buffer))
 	(if (eq other-window-p 'display)
@@ -810,7 +791,6 @@
 	 (size (tar-header-size tokens))
 	 (start (+ (tar-desc-data-start descriptor) tar-header-offset -1))
 	 (end (+ start size))
-	 (multibyte enable-multibyte-characters)
 	 (inhibit-file-name-handlers inhibit-file-name-handlers)
 	 (inhibit-file-name-operation inhibit-file-name-operation))
     (save-restriction
@@ -824,11 +804,8 @@
 		      (and (eq inhibit-file-name-operation 'write-region)
 			   inhibit-file-name-handlers))
 		inhibit-file-name-operation 'write-region))
-      (unwind-protect
-	  (let ((coding-system-for-write 'no-conversion))
-	    (set-buffer-multibyte nil)
-	    (write-region start end to-file nil nil nil t))
-	(set-buffer-multibyte multibyte)))
+      (let ((coding-system-for-write 'no-conversion))
+	(write-region start end to-file nil nil nil t)))
     (message "Copied tar entry %s to %s" name to-file)))
 
 (defun tar-flag-deleted (p &optional unflag)
@@ -857,7 +834,6 @@
   (tar-flag-deleted (- p) t))
 
 
-;; When this function is called, it is sure that the buffer is unibyte.
 (defun tar-expunge-internal ()
   "Expunge the tar-entry specified by the current line."
   (let* ((descriptor (tar-current-descriptor))
@@ -909,9 +885,7 @@
   (interactive)
   (if (or noconfirm
 	  (y-or-n-p "Expunge files marked for deletion? "))
-      (let ((n 0)
-	    (multibyte enable-multibyte-characters))
-	(set-buffer-multibyte nil)
+      (let ((n 0))
 	(save-excursion
 	  (goto-char (point-min))
 	  (while (not (eobp))
@@ -922,7 +896,6 @@
 	  ;; 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)
 	(if (zerop n)
 	    (message "Nothing to expunge.")
 	    (message "%s files expunged.  Be sure to save this buffer." n)))))
@@ -933,7 +906,7 @@
   (interactive)
   (save-excursion
     (goto-char (point-min))
-    (while (< (position-bytes (point)) tar-header-offset)
+    (while (< (point) tar-header-offset)
       (if (not (eq (following-char) ?\ ))
 	  (progn (delete-char 1) (insert " ")))
       (forward-line 1))))
@@ -1003,11 +976,13 @@
     (list (read-string "New name: "
 	    (tar-header-name (tar-desc-tokens (tar-current-descriptor))))))
   (if (string= "" new-name) (error "zero length name"))
-  (if (> (length new-name) 98) (error "name too long"))
-  (tar-setf (tar-header-name (tar-desc-tokens (tar-current-descriptor)))
-	    new-name)
-  (tar-alter-one-field 0
-    (substring (concat new-name (make-string 99 0)) 0 99)))
+  (let ((encoded-new-name (encode-coding-string new-name
+						tar-file-name-coding-system)))
+    (if (> (length encoded-new-name) 98) (error "name too long"))
+    (tar-setf (tar-header-name (tar-desc-tokens (tar-current-descriptor)))
+	      new-name)
+    (tar-alter-one-field 0
+     (substring (concat encoded-new-name (make-string 99 0)) 0 99))))
 
 
 (defun tar-chmod-entry (new-mode)
@@ -1024,8 +999,7 @@
 
 (defun tar-alter-one-field (data-position new-data-string)
   (let* ((descriptor (tar-current-descriptor))
-	 (tokens (tar-desc-tokens descriptor))
-	 (multibyte enable-multibyte-characters))
+	 (tokens (tar-desc-tokens descriptor)))
     (unwind-protect
 	(save-excursion
 	  ;;
@@ -1035,16 +1009,21 @@
 	    (forward-line 1)
 	    (delete-region p (point))
 	    (insert (tar-header-block-summarize tokens) "\n")
-	    (setq tar-header-offset (position-bytes (point-max))))
+	    (setq tar-header-offset (point-max)))
 	  
 	  (widen)
-	  (set-buffer-multibyte nil)
 	  (let* ((start (+ (tar-desc-data-start descriptor) tar-header-offset -513)))
 	    ;;
 	    ;; delete the old field and insert a new one.
 	    (goto-char (+ start data-position))
 	    (delete-region (point) (+ (point) (length new-data-string))) ; <--
-	    (insert new-data-string) ; <--
+
+	    ;; As new-data-string is unibyte, just inserting it will
+	    ;; make eight-bit chars to the corresponding multibyte
+	    ;; chars.  This avoid that conversion, i.e., eight-bit
+	    ;; chars are converted to multibyte form of eight-bit
+	    ;; chars.
+	    (insert (string-to-multibyte new-data-string))
 	    ;;
 	    ;; compute a new checksum and insert it.
 	    (let ((chk (tar-header-block-checksum
@@ -1062,7 +1041,6 @@
 	        chk (tar-header-name tokens))
 	      )))
       (narrow-to-region 1 tar-header-offset)
-      (set-buffer-multibyte multibyte)
       (tar-next-line 0))))
 
 
@@ -1086,14 +1064,9 @@
     (error "This buffer doesn't have an index into its superior tar file!"))
   (save-excursion
   (let ((subfile (current-buffer))
-	(subfile-multibyte enable-multibyte-characters)
 	(coding buffer-file-coding-system)
 	(descriptor tar-superior-descriptor)
 	subfile-size)
-    ;; We must make the current buffer unibyte temporarily to avoid
-    ;; multibyte->unibyte conversion in `insert-buffer'.
-    (set-buffer-multibyte nil)
-    (setq subfile-size (buffer-size))
     (set-buffer tar-superior-buffer)
     (let* ((tokens (tar-desc-tokens descriptor))
 	   (start (tar-desc-data-start descriptor))
@@ -1101,28 +1074,28 @@
 	   (size (tar-header-size tokens))
 	   (size-pad (ash (ash (+ size 511) -9) 9))
 	   (head (memq descriptor tar-parse-info))
-	   (following-descs (cdr head))
-	   (tar-buffer-multibyte enable-multibyte-characters))
+	   (following-descs (cdr head)))
       (if (not head)
 	(error "Can't find this tar file entry in its parent tar file!"))
       (unwind-protect
        (save-excursion
-	(widen)
-	(set-buffer-multibyte nil)
 	;; delete the old data...
 	(let* ((data-start (+ start tar-header-offset -1))
 	       (data-end (+ data-start (ash (ash (+ size 511) -9) 9))))
-	  (delete-region data-start data-end)
+	  (narrow-to-region data-start data-end)
+	  (delete-region (point-min) (point-max))
 	  ;; insert the new data...
 	  (goto-char data-start)
-	  (insert-buffer subfile)
-	  (setq subfile-size
-		(encode-coding-region
-		 data-start (+ data-start subfile-size) coding))
+	  (save-excursion
+	    (set-buffer subfile)
+	    (save-restriction
+	      (widen)
+	      (encode-coding-region 1 (point-max) coding tar-superior-buffer)))
+	  (setq subfile-size (- (point-max) (point-min)))
 	  ;;
 	  ;; pad the new data out to a multiple of 512...
 	  (let ((subfile-size-pad (ash (ash (+ subfile-size 511) -9) 9)))
-	    (goto-char (+ data-start subfile-size))
+	    (goto-char (point-max))
 	    (insert (make-string (- subfile-size-pad subfile-size) 0))
 	    ;;
 	    ;; update the data pointer of this and all following files...
@@ -1133,6 +1106,7 @@
 			  (+ (tar-desc-data-start desc) difference))))
 	    ;;
 	    ;; Update the size field in the header block.
+	    (widen)
 	    (let ((header-start (- data-start 512)))
 	      (goto-char (+ header-start tar-size-offset))
 	      (delete-region (point) (+ (point) 12))
@@ -1171,21 +1145,16 @@
 		;; 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 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)
-       (set-buffer-multibyte tar-buffer-multibyte)))
+       (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)
-    ;; Restore the buffer multibyteness.
-    (set-buffer-multibyte subfile-multibyte)
     (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))
@@ -1235,14 +1204,13 @@
 	;; tar-header-offset turns out to be null for files fetched with W3,
 	;; at least.
 	(let ((coding-system-for-write 'no-conversion))
-	  (write-region (if tar-header-offset
-			    (byte-to-position tar-header-offset)
-			  (point-min))
+	  (write-region (or 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 1 tar-header-offset))
   ;; Return t because we've written the file.
   t)