diff lisp/arc-mode.el @ 88954:363e137c2601

(archive-file-name-coding-system): New variable. Make it permanent-local. (byte-after, bref, insert-unibyte): New function. Change most of char-after, aref, insert to them respectively. (archive-mode): Set archive-file-name-coding-system. (archive-summarize): Don't change the buffer's multibyteness. (archive-extract): Inherit archive-file-name-coding-system from archive-superior-buffer. Bind coding-system-for-write to archive-file-name-coding-system. (archive-*-write-file-member): Encode ENAME by archive-file-name-coding-system. Bind coding-system-for-write to no-conversion. (archive-rename-entry): Encode the filename by archive-file-name-coding-system. (archive-mode-revert): Don't change the buffer's multibyteness. (archive-arc-summarize, archive-lzh-summarize, archive-zoo-summarize): Don't change the buffer's multibyteness. Decode filenames by archive-file-name-coding-system. (archive-arc-rename-entry, archive-zip-chmod-entry): Don't change the buffer's multibyteness.

--- a/lisp/arc-mode.el	Wed Jul 31 07:11:47 2002 +0000
+++ b/lisp/arc-mode.el	Wed Jul 31 07:14:13 2002 +0000
@@ -334,6 +334,10 @@
 (make-variable-buffer-local 'archive-subfile-mode)
 (put 'archive-subfile-mode 'permanent-local t)
 
+(defvar archive-file-name-coding-system nil)
+(make-variable-buffer-local 'archive-file-name-coding-system)
+(put 'archive-file-name-coding-system 'permanent-local t)
+
 (defvar archive-files nil
   "Vector of file descriptors.
 Each descriptor is a vector of the form
@@ -346,6 +350,21 @@
 ;; -------------------------------------------------------------------------
 ;; Section: Support functions.
 
+(eval-when-compile
+  (defsubst byte-after (pos)
+    "Like char-after but an eight-bit char is converted to unibyte."
+    (multibyte-char-to-unibyte (char-after pos)))
+  (defsubst bref (string idx)
+    "Like aref but an eight-bit char is converted to unibyte."
+    (multibyte-char-to-unibyte (aref string idx)))
+  (defsubst insert-unibyte (&rest args)
+    "Like insert but don't make unibyte string and eight-bit char multibyte."
+    (dolist (elt args)
+      (if (integerp elt)
+	  (insert (if (< elt 128) elt (decode-char 'eight-bit elt)))
+	(insert (string-to-multibyte elt)))))
+  )
+
 (defsubst archive-name (suffix)
   (intern (concat "archive-" (symbol-name archive-subtype) "-" suffix)))
 
@@ -360,7 +379,8 @@
         (i 0))
     (while (< i len)
       (setq i (1+ i)
-            result (+ (ash result 8) (aref str (- len i)))))
+            result (+ (ash result 8)
+		      (bref str (- len i)))))
     result))
 
 (defun archive-int-to-mode (mode)
@@ -560,6 +580,12 @@
       (make-local-variable 'archive-file-list-start)
       (make-local-variable 'archive-file-list-end)
       (make-local-variable 'archive-file-name-indent)
+      (setq archive-file-name-coding-system
+	    (or file-name-coding-system
+		default-file-name-coding-system
+		locale-coding-system))
+      (if default-enable-multibyte-characters
+	  (set-buffer-multibyte t 'to))
       (archive-summarize nil)
       (setq buffer-read-only t))))
 
@@ -702,7 +728,6 @@
 Optional argument SHUT-UP, if non-nil, means don't print messages
 when parsing the archive."
   (widen)
-  (set-buffer-multibyte nil)
   (let (buffer-read-only)
     (or shut-up
 	(message "Parsing archive file..."))
@@ -907,7 +932,8 @@
 			  view-p
 			  (string-match file-name-invalid-regexp ename)))
          (buffer (get-buffer bufname))
-         (just-created nil))
+         (just-created nil)
+	 (file-name-coding archive-file-name-coding-system))
       (if buffer
           nil
 	(setq archive (archive-maybe-copy archive))
@@ -926,13 +952,14 @@
           (make-local-variable 'local-write-file-hooks)
           (add-hook 'local-write-file-hooks 'archive-write-file-member)
           (setq archive-subfile-mode descr)
+	  (setq archive-file-name-coding-system file-name-coding)
 	  (if (and
 	       (null
 		(let (;; We may have to encode file name arguement for
 		      ;; external programs.
 		      (coding-system-for-write
 		       (and enable-multibyte-characters
-			    file-name-coding-system))
+			    archive-file-name-coding-system))
 		      ;; We read an archive member by no-conversion at
 		      ;; first, then decode appropriately by calling
 		      ;; archive-set-buffer-as-visiting-file later.
@@ -1116,15 +1143,16 @@
 	  (if (aref descr 3)
 	      ;; Set the file modes, but make sure we can read it.
 	      (set-file-modes tmpfile (logior ?\400 (aref descr 3))))
-	  (if enable-multibyte-characters
-	      (setq ename
-		    (encode-coding-string ename file-name-coding-system)))
-          (let ((exitcode (apply 'call-process
-                                 (car command)
-                                 nil
-                                 nil
-                                 nil
-                                 (append (cdr command) (list archive ename)))))
+	  (setq ename
+		(encode-coding-string ename archive-file-name-coding-system))
+          (let* ((coding-system-for-write 'no-conversion)
+		 (exitcode (apply 'call-process
+				  (car command)
+				  nil
+				  nil
+				  nil
+				  (append (cdr command)
+					  (list archive ename)))))
             (if (equal exitcode 0)
                 nil
               (error "Updating was unsuccessful (%S)" exitcode))))
@@ -1297,9 +1325,8 @@
     (if (fboundp func)
         (progn
 	  (funcall func (buffer-file-name)
-		   (if enable-multibyte-characters
-		       (encode-coding-string newname file-name-coding-system)
-		     newname)
+		   (encode-coding-string newname
+					 archive-file-name-coding-system)
 		   descr)
 	  (archive-resummarize))
       (error "Renaming is not supported for this archive type"))))
@@ -1310,7 +1337,6 @@
     (setq archive-files nil)
     (let ((revert-buffer-function nil)
 	  (coding-system-for-read 'no-conversion))
-      (set-buffer-multibyte nil)
       (revert-buffer t t))
     (archive-mode)
     (goto-char archive-file-list-start)
@@ -1332,11 +1358,12 @@
         files
 	visual)
     (while (and (< (+ p 29) (point-max))
-		(= (char-after p) ?\C-z)
-		(> (char-after (1+ p)) 0))
+		(= (byte-after p) ?\C-z)
+		(> (byte-after (1+ p)) 0))
       (let* ((namefld (buffer-substring (+ p 2) (+ p 2 13)))
 	     (fnlen   (or (string-match "\0" namefld) 13))
-	     (efnname (substring namefld 0 fnlen))
+	     (efnname (decode-coding-string (substring namefld 0 fnlen)
+					    archive-file-name-coding-system))
              (csize   (archive-l-e (+ p 15) 4))
              (moddate (archive-l-e (+ p 19) 2))
              (modtime (archive-l-e (+ p 21) 2))
@@ -1383,10 +1410,9 @@
     (save-restriction
       (save-excursion
 	(widen)
-	(set-buffer-multibyte nil)
 	(goto-char (+ archive-proper-file-start (aref descr 4) 2))
 	(delete-char 13)
-	(insert name)))))
+	(insert-unibyte name)))))
 ;; -------------------------------------------------------------------------
 ;; Section: Lzh Archives
 
@@ -1398,22 +1424,21 @@
 	visual)
     (while (progn (goto-char p) 
 		  (looking-at "\\(.\\|\n\\)\\(.\\|\n\\)-l[hz][0-9ds]-"))
-      (let* ((hsize   (char-after p))
+      (let* ((hsize   (byte-after p))
              (csize   (archive-l-e (+ p 7) 4))
              (ucsize  (archive-l-e (+ p 11) 4))
 	     (modtime (archive-l-e (+ p 15) 2))
 	     (moddate (archive-l-e (+ p 17) 2))
-	     (hdrlvl  (char-after (+ p 20)))
-	     (fnlen   (char-after (+ p 21)))
+	     (hdrlvl  (byte-after (+ p 20)))
+	     (fnlen   (byte-after (+ p 21)))
 	     (efnname (let ((str (buffer-substring (+ p 22) (+ p 22 fnlen))))
-			(if file-name-coding-system
-			    (decode-coding-string str file-name-coding-system)
-			  (string-as-multibyte str))))
+			(decode-coding-string
+			 str archive-file-name-coding-system)))
 	     (fiddle  (string= efnname (upcase efnname)))
              (ifnname (if fiddle (downcase efnname) efnname))
 	     (width (string-width ifnname))
 	     (p2      (+ p 22 fnlen))
-	     (creator (if (>= (- hsize fnlen) 24) (char-after (+ p2 2)) 0))
+	     (creator (if (>= (- hsize fnlen) 24) (byte-after (+ p2 2)) 0))
 	     mode modestr uid gid text path prname
 	     )
 	(if (= hdrlvl 0)
@@ -1423,17 +1448,17 @@
 	  (if (= creator ?U)
 	      (let* ((p3 (+ p2 3))
 		     (hsize (archive-l-e p3 2))
-		     (etype (char-after (+ p3 2))))
+		     (etype (byte-after (+ p3 2))))
 		(while (not (= hsize 0))
 		  (cond
 		   ((= etype 2) (let ((i (+ p3 3)))
 				  (while (< i (+ p3 hsize))
 				    (setq path (concat path
-						       (if (= (char-after i)
+						       (if (= (byte-after i)
 							      255)
 							   "/"
 							 (char-to-string
-							  (char-after i)))))
+							  (byte-after i)))))
 				    (setq i (1+ i)))))
 		   ((= etype 80) (setq mode (archive-l-e (+ p3 3) 2)))
 		   ((= etype 81) (progn (setq uid (archive-l-e (+ p3 3) 2))
@@ -1441,7 +1466,7 @@
 		   )
 		  (setq p3 (+ p3 hsize))
 		  (setq hsize (archive-l-e p3 2))
-		  (setq etype (char-after (+ p3 2)))))))
+		  (setq etype (byte-after (+ p3 2)))))))
 	(setq prname (if path (concat path ifnname) ifnname))
 	(setq modestr (if mode (archive-int-to-mode mode) "??????????"))
 	(setq text    (if archive-alternate-display
@@ -1466,7 +1491,6 @@
                           files)
               p (+ p hsize 2 csize))))
     (goto-char (point-min))
-    (set-buffer-multibyte default-enable-multibyte-characters)
     (let ((dash (concat (if archive-alternate-display
 			    "- --------  -----  -----  "
 			  "- ----------  --------  -----------  --------  ")
@@ -1497,7 +1521,7 @@
   (let ((sum 0))
     (while (> count 0)
       (setq count (1- count)
-	    sum (+ sum (char-after p))
+	    sum (+ sum (byte-after p))
 	    p (1+ p)))
     (logand sum 255)))
 
@@ -1505,10 +1529,9 @@
   (save-restriction
     (save-excursion
       (widen)
-      (set-buffer-multibyte nil)
       (let* ((p        (+ archive-proper-file-start (aref descr 4)))
-	     (oldhsize (char-after p))
-	     (oldfnlen (char-after (+ p 21)))
+	     (oldhsize (byte-after p))
+	     (oldfnlen (byte-after (+ p 21)))
 	     (newfnlen (length newname))
 	     (newhsize (+ oldhsize newfnlen (- oldfnlen)))
 	     buffer-read-only)
@@ -1516,23 +1539,22 @@
 	    (error "The file name is too long"))
 	(goto-char (+ p 21))
 	(delete-char (1+ oldfnlen))
-	(insert newfnlen newname)
+	(insert-unibyte newfnlen newname)
 	(goto-char p)
 	(delete-char 2)
-	(insert newhsize (archive-lzh-resum p newhsize))))))
+	(insert-unibyte newhsize (archive-lzh-resum p newhsize))))))
 
 (defun archive-lzh-ogm (newval files errtxt ofs)
   (save-restriction
     (save-excursion
       (widen)
-      (set-buffer-multibyte nil)
       (while files
 	(let* ((fil (car files))
 	       (p (+ archive-proper-file-start (aref fil 4)))
-	       (hsize   (char-after p))
-	       (fnlen   (char-after (+ p 21)))
+	       (hsize   (byte-after p))
+	       (fnlen   (byte-after (+ p 21)))
 	       (p2      (+ p 22 fnlen))
-	       (creator (if (>= (- hsize fnlen) 24) (char-after (+ p2 2)) 0))
+	       (creator (if (>= (- hsize fnlen) 24) (byte-after (+ p2 2)) 0))
 	       buffer-read-only)
 	  (if (= creator ?U)
 	      (progn
@@ -1540,10 +1562,10 @@
 		    (setq newval (funcall newval (archive-l-e (+ p2 ofs) 2))))
 		(goto-char (+ p2 ofs))
 		(delete-char 2)
-		(insert (logand newval 255) (lsh newval -8))
+		(insert-unibyte (logand newval 255) (lsh newval -8))
 		(goto-char (1+ p))
 		(delete-char 1)
-		(insert (archive-lzh-resum (1+ p) hsize)))
+		(insert-unibyte (archive-lzh-resum (1+ p) hsize)))
 	    (message "Member %s does not have %s field"
 		     (aref fil 1) errtxt)))
 	(setq files (cdr files))))))
@@ -1571,7 +1593,7 @@
         files
 	visual)
     (while (string= "PK\001\002" (buffer-substring p (+ p 4)))
-      (let* ((creator (char-after (+ p 5)))
+      (let* ((creator (byte-after (+ p 5)))
 	     (method  (archive-l-e (+ p 10) 2))
              (modtime (archive-l-e (+ p 12) 2))
              (moddate (archive-l-e (+ p 14) 2))
@@ -1581,9 +1603,8 @@
              (fclen   (archive-l-e (+ p 32) 2))
              (lheader (archive-l-e (+ p 42) 4))
              (efnname (let ((str (buffer-substring (+ p 46) (+ p 46 fnlen))))
-			(if file-name-coding-system
-			    (decode-coding-string str file-name-coding-system)
-			  (string-as-multibyte str))))
+			(decode-coding-string
+			 str archive-file-name-coding-system)))
 	     (isdir   (and (= ucsize 0)
 			   (string= (file-name-nondirectory efnname) "")))
 	     (mode    (cond ((memq creator '(2 3)) ; Unix + VMS
@@ -1592,7 +1613,7 @@
 			     (logior ?\444
 				     (if isdir (logior 16384 ?\111) 0)
 				     (if (zerop
-					  (logand 1 (char-after (+ p 38))))
+					  (logand 1 (byte-after (+ p 38))))
 					 ?\222 0)))
 			    (t nil)))
 	     (modestr (if mode (archive-int-to-mode mode) "??????????"))
@@ -1649,22 +1670,21 @@
   (save-restriction
     (save-excursion
       (widen)
-      (set-buffer-multibyte nil)
       (while files
 	(let* ((fil (car files))
 	       (p (+ archive-proper-file-start (car (aref fil 4))))
-	       (creator (char-after (+ p 5)))
+	       (creator (byte-after (+ p 5)))
 	       (oldmode (aref fil 3))
 	       (newval  (archive-calc-mode oldmode newmode t))
 	       buffer-read-only)
 	  (cond ((memq creator '(2 3)) ; Unix + VMS
 		 (goto-char (+ p 40))
 		 (delete-char 2)
-		 (insert (logand newval 255) (lsh newval -8)))
+		 (insert-unibyte (logand newval 255) (lsh newval -8)))
 		((memq creator '(0 5 6 7 10 11 15)) ; Dos etc.
 		 (goto-char (+ p 38))
-		 (insert (logior (logand (char-after (point)) 254)
-				 (logand (logxor 1 (lsh newval -7)) 1)))
+		 (insert-unibyte (logior (logand (byte-after (point)) 254)
+					 (logand (logxor 1 (lsh newval -7)) 1)))
 		 (delete-char 1))
 		(t (message "Don't know how to change mode for this member"))))
 	(setq files (cdr files))))))
@@ -1684,9 +1704,9 @@
              (modtime (archive-l-e (+ p 16) 2))
              (ucsize  (archive-l-e (+ p 20) 4))
 	     (namefld (buffer-substring (+ p 38) (+ p 38 13)))
-	     (dirtype (char-after (+ p 4)))
-	     (lfnlen  (if (= dirtype 2) (char-after (+ p 56)) 0))
-	     (ldirlen (if (= dirtype 2) (char-after (+ p 57)) 0))
+	     (dirtype (byte-after (+ p 4)))
+	     (lfnlen  (if (= dirtype 2) (byte-after (+ p 56)) 0))
+	     (ldirlen (if (= dirtype 2) (byte-after (+ p 57)) 0))
 	     (fnlen   (or (string-match "\0" namefld) 13))
 	     (efnname (let ((str
 			     (concat
@@ -1700,9 +1720,8 @@
 				  (buffer-substring (+ p 58)
 						    (+ p 58 lfnlen -1))
 				(substring namefld 0 fnlen)))))
-			(if file-name-coding-system
-			    (decode-coding-string str file-name-coding-system)
-			  (string-as-multibyte str))))
+			(decode-coding-string
+			 str archive-file-name-coding-system)))
 	     (fiddle  (and (= lfnlen 0) (string= efnname (upcase efnname))))
              (ifnname (if fiddle (downcase efnname) efnname))
 	     (width (string-width ifnname))