diff lisp/arc-mode.el @ 89483:2f877ed80fa6

*** empty log message ***

--- a/lisp/arc-mode.el	Mon Sep 08 11:56:09 2003 +0000
+++ b/lisp/arc-mode.el	Mon Sep 08 12:53:41 2003 +0000
@@ -352,6 +352,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
@@ -364,6 +368,18 @@
 ;; -------------------------------------------------------------------------
 ;; 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 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)))
 
@@ -374,6 +390,7 @@
   (if (stringp str)
       (setq len (length str))
     (setq str (buffer-substring str (+ str len))))
+  (setq str (string-as-unibyte str))
   (let ((result 0)
         (i 0))
     (while (< i len)
@@ -578,6 +595,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 'to))
       (archive-summarize nil)
       (setq buffer-read-only t))))
 
@@ -720,7 +743,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..."))
@@ -924,7 +946,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))
@@ -943,13 +966,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.
@@ -1133,15 +1157,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))))
@@ -1314,9 +1339,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"))))
@@ -1327,7 +1351,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)
@@ -1349,11 +1372,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))
@@ -1400,10 +1424,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
 
@@ -1415,13 +1438,13 @@
 	visual)
     (while (progn (goto-char p)		;beginning of a base header.
 		  (looking-at "\\(.\\|\n\\)\\(.\\|\n\\)-l[hz][0-9ds]-"))
-      (let* ((hsize   (char-after p))	;size of the base header (level 0 and 1)
+      (let* ((hsize   (byte-after p))	;size of the base header (level 0 and 1)
 	     (csize   (archive-l-e (+ p 7) 4)) ;size of a compressed file to follow (level 0 and 2),
 					;size of extended headers + the compressed file to follow (level 1).
              (ucsize  (archive-l-e (+ p 11) 4))	;size of an uncompressed file.
 	     (time1   (archive-l-e (+ p 15) 2))	;date/time (MSDOS format in level 0, 1 headers
 	     (time2   (archive-l-e (+ p 17) 2))	;and UNIX format in level 2 header.)
-	     (hdrlvl  (char-after (+ p 20))) ;header level
+	     (hdrlvl  (byte-after (+ p 20))) ;header level
 	     thsize		;total header size (base + extensions)
 	     fnlen efnname fiddle ifnname width p2 creator
 	     neh	;beginning of next extension header (level 1 and 2)
@@ -1429,35 +1452,34 @@
 	     gname uname modtime moddate)
 	(if (= hdrlvl 3) (error "can't handle lzh level 3 header type"))
 	(when (or (= hdrlvl 0) (= hdrlvl 1))
-	  (setq fnlen   (char-after (+ p 21))) ;filename length
+	  (setq fnlen   (byte-after (+ p 21))) ;filename length
 	  (setq efnname (let ((str (buffer-substring (+ p 22) (+ p 22 fnlen))))	;filename from offset 22
-			(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)))
 	  (setq p2      (+ p 22 fnlen))) ;
 	(if (= hdrlvl 1)
 	    (progn		;specific to level 1 header
-	      (setq creator (if (>= (- hsize fnlen) 24) (char-after (+ p2 2)) 0))
+	      (setq creator (if (>= (- hsize fnlen) 24) (byte-after (+ p2 2)) 0))
 	      (setq neh (+ p2 3)))
 	  (if (= hdrlvl 2)
 	      (progn		;specific to level 2 header
-		(setq creator (char-after (+ p 23)) )
+		(setq creator (byte-after (+ p 23)) )
 		(setq neh (+ p 24)))))
 	(if neh		;if level 1 or 2 we expect extension headers to follow
 	    (let* ((ehsize (archive-l-e neh 2))	;size of the extension header
-		   (etype (char-after (+ neh 2)))) ;extension type
+		   (etype (byte-after (+ neh 2)))) ;extension type
 	      (while (not (= ehsize 0))
 		  (cond
 		 ((= etype 1)	;file name
 		  (let ((i (+ neh 3)))
 		    (while (< i (+ neh ehsize))
-		      (setq efnname (concat efnname (char-to-string (char-after i))))
+		      (setq efnname (concat efnname (char-to-string (byte-after i))))
 		      (setq i (1+ i)))))
 		 ((= etype 2)	;directory name
 		  (let ((i (+ neh 3)))
 		    (while (< i (+ neh ehsize))
 				    (setq dir (concat dir
-						       (if (= (char-after i)
+						       (if (= (byte-after i)
 							      255)
 							   "/"
 							 (char-to-string
@@ -1481,7 +1503,7 @@
 		   )
 		(setq neh (+ neh ehsize))
 		(setq ehsize (archive-l-e neh 2))
-		(setq etype (char-after (+ neh 2))))
+		(setq etype (byte-after (+ neh 2))))
 	      ;;get total header size for level 1 and 2 headers
 	      (setq thsize (- neh p))))
 	(if (= hdrlvl 0)  ;total header size
@@ -1523,7 +1545,6 @@
 	       (setq p (+ p thsize 2 csize))))
 	))
     (goto-char (point-min))
-    (set-buffer-multibyte default-enable-multibyte-characters)
     (let ((dash (concat (if archive-alternate-display
 			    "- --------  -----  -----  "
 			  "- ----------  --------  -----------  --------  ")
@@ -1554,7 +1575,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)))
 
@@ -1562,10 +1583,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)
@@ -1573,23 +1593,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
@@ -1597,10 +1616,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))))))
@@ -1628,7 +1647,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))
@@ -1638,9 +1657,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
@@ -1649,7 +1667,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) "??????????"))
@@ -1706,22 +1724,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))))))
@@ -1741,9 +1758,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
@@ -1757,9 +1774,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))