diff lisp/arc-mode.el @ 22830:d79de5a60ee8

(archive-summarize): Set buffer unibyte before calling archive-XXX-summarize. (archive-file-name-handler): New function to make the caller behave as if the extracted file existed. (archive-set-buffer-as-visiting-file): New function to simulate file visiting. Uses archive-file-name-handler to make dos-w32 systems preserve the coding-system of the extracted files. (archive-extract): Bind coding-system-for-write to file-name-coding-system, coding-system-for-read to 'no-conversion. Call archive-set-buffer-as-visiting-file after a member file is inserted in the current buffer. (archive-extract-by-stdout): Don't bind coding-system-for-read and inherit-process-coding-system. (archive-*-write-file-member): Give an encoded file name to external archive program. (archive-rename-entry): Likewise. (archive-mode-revert): Set buffer unibyte before calling revert-buffer. (archive-arc-rename-entry, archive-zip-chmod-entry): Set buffer unibyte before handling binary archive data. (archive-lzh-rename-entry, archive-lzh-ogm, archive-zip-chmod-entry): Likewise. (archive-lzh-summarize): Set local variable efnname to the decoded file name. If default-enable-multibyte-characters is non-nil, set buffer multibyte before inserting summary lines.

--- a/lisp/arc-mode.el	Sun Jul 26 06:40:13 1998 +0000
+++ b/lisp/arc-mode.el	Sun Jul 26 13:57:08 1998 +0000
@@ -690,6 +690,7 @@
 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..."))
@@ -827,6 +828,41 @@
 ;; -------------------------------------------------------------------------
 ;; Section: Member extraction
 
+(defun archive-file-name-handler (op &rest args)
+  (or (eq op 'file-exists-p)
+      (let ((file-name-handler-alist nil))
+	(apply op args))))
+
+(defun archive-set-buffer-as-visiting-file (filename)
+  "Set the current buffer as if it were visiting FILENAME."
+  (save-excursion
+    (goto-char (point-min))
+    (let ((coding
+	   (or coding-system-for-read
+	       (and set-auto-coding-function
+		    (funcall set-auto-coding-function
+			     (- (point-max) (point-min))))
+	       ;; dos-w32.el defines find-operation-coding-system for
+	       ;; DOS/Windows systems which preserves the coding-system
+	       ;; of existing files.  We want it to act here as if the
+	       ;; extracted file existed.
+	       (let ((file-name-handler-alist
+		      '(("" . archive-file-name-handler))))
+		 (car (find-operation-coding-system 'insert-file-contents
+						    filename t))))))
+      (if (and (not coding-system-for-read)
+	       (not enable-multibyte-characters))
+	  (setq coding
+		(coding-system-change-text-conversion coding 'raw-text)))
+      (if (and coding
+	       (not (eq coding 'no-conversion)))
+	  (decode-coding-region (point-min) (point-max) coding)
+	(setq last-coding-system-used coding))
+      (set-buffer-modified-p nil)
+      (kill-local-variable 'buffer-file-coding-system)
+      (after-insert-file-set-buffer-file-coding-system (- (point-max)
+							  (point-min))))))
+
 (defun archive-mouse-extract (event)
   "Extract a file whose name you click on."
   (interactive "e")
@@ -876,27 +912,26 @@
           (setq archive-subfile-mode descr)
 	  (if (and
 	       (null
-		(condition-case err
-		    (if (fboundp extractor)
-			(funcall extractor archive ename)
-		      (archive-*-extract archive ename
-					 (symbol-value extractor)))
-		  (error
-		   (ding (message "%s" (error-message-string err)))
-		   nil)))
+		(let (;; We may have to encode file name arguement for
+		      ;; external programs.
+		      (coding-system-for-write 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.
+		      (coding-system-for-read 'no-conversion))
+		  (condition-case err
+		      (if (fboundp extractor)
+			  (funcall extractor archive ename)
+			(archive-*-extract archive ename
+					   (symbol-value extractor)))
+		    (error
+		     (ding (message "%s" (error-message-string err)))
+		     nil))))
 	       just-created)
 	      (progn
 		(set-buffer-modified-p nil)
 		(kill-buffer buffer))
-	    ;; If Emacs were to visit the file we've extracted, it would make
-	    ;; the buffer be unibyte if the detected coding-system is
-	    ;; no-conversion or raw-text-*.  We want the same behavior here
-	    ;; as if we were visiting the file, even though some extractors
-	    ;; read the file's contents from a pipe.
-	    (if (or (eq last-coding-system-used 'no-conversion)
-		    ;; type 5 is raw-text
-		    (eq (coding-system-type last-coding-system-used) 5))
-		(set-buffer-multibyte nil))
+	    (archive-set-buffer-as-visiting-file ename)
 	    (goto-char (point-min))
 	    (rename-buffer bufname)
 	    (setq buffer-read-only read-only-p)
@@ -955,17 +990,12 @@
     success))
 
 (defun archive-extract-by-stdout (archive name command)
-  ;; We need the coding system of the output of the extract program,
-  ;; including the EOL encoding, be decoded dynamically, since what
-  ;; the extract program outputs is the contents of some file.
-  (let ((coding-system-for-read (or coding-system-for-read 'undecided))
-	(inherit-process-coding-system t))
-    (apply 'call-process
-	   (car command)
-	   nil
-	   t
-	   nil
-	   (append (cdr command) (list archive name)))))
+  (apply 'call-process
+	 (car command)
+	 nil
+	 t
+	 nil
+	 (append (cdr command) (list archive name))))
 
 (defun archive-extract-other-window ()
   "In archive mode, find this member in another window."
@@ -1068,6 +1098,7 @@
 	  (if (aref descr 3)
 	      ;; Set the file modes, but make sure we can read it.
 	      (set-file-modes tmpfile (logior ?\400 (aref descr 3))))
+	  (setq ename (encode-coding-string ename file-name-coding-system))
           (let ((exitcode (apply 'call-process
                                  (car command)
                                  nil
@@ -1245,7 +1276,9 @@
 	(descr (archive-get-descr)))
     (if (fboundp func)
         (progn
-	  (funcall func (buffer-file-name) newname descr)
+	  (funcall func (buffer-file-name)
+		   (encode-coding-string newname file-name-coding-system)
+		   descr)
 	  (archive-resummarize))
       (error "Renaming is not supported for this archive type"))))
 
@@ -1255,6 +1288,7 @@
     (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)
@@ -1327,6 +1361,7 @@
     (save-restriction
       (save-excursion
 	(widen)
+	(set-buffer-multibyte nil)
 	(goto-char (+ archive-proper-file-start (aref descr 4) 2))
 	(delete-char 13)
 	(insert name)))))
@@ -1348,9 +1383,13 @@
 	     (moddate (archive-l-e (+ p 17) 2))
 	     (hdrlvl  (char-after (+ p 20)))
 	     (fnlen   (char-after (+ p 21)))
-	     (efnname (buffer-substring (+ p 22) (+ p 22 fnlen)))
+	     (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))))
 	     (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))
 	     mode modestr uid gid text path prname
@@ -1395,7 +1434,7 @@
 				(archive-dosdate moddate)
 				(archive-dostime modtime)
 				ifnname)))
-        (setq maxlen (max maxlen fnlen)
+        (setq maxlen (max maxlen width)
 	      totalsize (+ totalsize ucsize)
 	      visual (cons (vector text
 				   (- (length text) (length ifnname))
@@ -1405,6 +1444,7 @@
                           files)
               p (+ p hsize 2 csize))))
     (goto-char (point-min))
+    (set-buffer-multibyte default-enable-multibyte-characters)
     (let ((dash (concat (if archive-alternate-display
 			    "- --------  -----  -----  "
 			  "- ----------  --------  -----------  --------  ")
@@ -1443,6 +1483,7 @@
   (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)))
@@ -1462,6 +1503,7 @@
   (save-restriction
     (save-excursion
       (widen)
+      (set-buffer-multibyte nil)
       (while files
 	(let* ((fil (car files))
 	       (p (+ archive-proper-file-start (aref fil 4)))
@@ -1516,7 +1558,10 @@
              (exlen   (archive-l-e (+ p 30) 2))
              (fclen   (archive-l-e (+ p 32) 2))
              (lheader (archive-l-e (+ p 42) 4))
-             (efnname (buffer-substring (+ p 46) (+ p 46 fnlen)))
+             (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))))
 	     (isdir   (and (= ucsize 0)
 			   (string= (file-name-nondirectory efnname) "")))
 	     (mode    (cond ((memq creator '(2 3)) ; Unix + VMS
@@ -1533,13 +1578,14 @@
 			   (not (not (memq creator '(0 2 4 5 9))))
 			   (string= (upcase efnname) efnname)))
              (ifnname (if fiddle (downcase efnname) efnname))
+	     (width (string-width ifnname))
              (text    (format "  %10s  %8d  %-11s  %-8s  %s"
 			      modestr
                               ucsize
                               (archive-dosdate moddate)
                               (archive-dostime modtime)
                               ifnname)))
-        (setq maxlen (max maxlen fnlen)
+        (setq maxlen (max maxlen width)
 	      totalsize (+ totalsize ucsize)
 	      visual (cons (vector text
 				   (- (length text) (length ifnname))
@@ -1581,6 +1627,7 @@
   (save-restriction
     (save-excursion
       (widen)
+      (set-buffer-multibyte nil)
       (while files
 	(let* ((fil (car files))
 	       (p (+ archive-proper-file-start (car (aref fil 4))))
@@ -1619,23 +1666,30 @@
 	     (lfnlen  (if (= dirtype 2) (char-after (+ p 56)) 0))
 	     (ldirlen (if (= dirtype 2) (char-after (+ p 57)) 0))
 	     (fnlen   (or (string-match "\0" namefld) 13))
-	     (efnname (concat
-		       (if (> ldirlen 0)
-			   (concat (buffer-substring
-				    (+ p 58 lfnlen) (+ p 58 lfnlen ldirlen -1))
-				   "/")
-			 "")
-		       (if (> lfnlen 0)
-			   (buffer-substring (+ p 58) (+ p 58 lfnlen -1))
-			 (substring namefld 0 fnlen))))
+	     (efnname (let ((str
+			     (concat
+			      (if (> ldirlen 0)
+				  (concat (buffer-substring
+					   (+ p 58 lfnlen)
+					   (+ p 58 lfnlen ldirlen -1))
+					  "/")
+				"")
+			      (if (> lfnlen 0)
+				  (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))))
 	     (fiddle  (and (= lfnlen 0) (string= efnname (upcase efnname))))
              (ifnname (if fiddle (downcase efnname) efnname))
+	     (width (string-width ifnname))
              (text    (format "  %8d  %-11s  %-8s  %s"
                               ucsize
                               (archive-dosdate moddate)
                               (archive-dostime modtime)
                               ifnname)))
-        (setq maxlen (max maxlen (length ifnname))
+        (setq maxlen (max maxlen (length width))
 	      totalsize (+ totalsize ucsize)
 	      visual (cons (vector text
 				   (- (length text) (length ifnname))