(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.

diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el
index 8f3ebd1f439d84f403a1542e4bda242125c12aae..ca5d6185337c0bf064d439b27ed178aaf53b52c9 100644 (file)
--- a/lisp/arc-mode.el
+++ b/lisp/arc-mode.el
@@ -690,6 +690,7 @@ is visible (and the real data of the buffer is hidden).
 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 @@ using `make-temp-name', and the generated name is returned."
 ;; -------------------------------------------------------------------------
 ;; 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 @@ using `make-temp-name', and the generated name is returned."
           (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 @@ using `make-temp-name', and the generated name is returned."
     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 @@ using `make-temp-name', and the generated name is returned."
          (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 @@ as a relative change like \"g+rw\" as for chmod(2)"
        (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 @@ as a relative change like \"g+rw\" as for chmod(2)"
     (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 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
     (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 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
             (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 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
                                (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 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
                           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 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
   (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 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
   (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 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
              (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 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
                           (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 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
   (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 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
             (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))