]> git.eshelyaron.com Git - emacs.git/commitdiff
(archive-file-name-coding-system): New variable.
authorKenichi Handa <handa@m17n.org>
Wed, 31 Jul 2002 07:14:13 +0000 (07:14 +0000)
committerKenichi Handa <handa@m17n.org>
Wed, 31 Jul 2002 07:14:13 +0000 (07:14 +0000)
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.

lisp/arc-mode.el

index c844abedebed84fd1bde7cf192ae112d59f3871e..69b00ec575bfcfa7cc05509983f13bd8ad59ea8d 100644 (file)
@@ -334,6 +334,10 @@ Archive and member name will be added."
 (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 @@ Each descriptor is a vector of the form
 ;; -------------------------------------------------------------------------
 ;; 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 @@ in which case a second argument, length, should be supplied."
         (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 @@ archive.
       (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 @@ 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..."))
@@ -907,7 +932,8 @@ using `make-temp-file', and the generated name is returned."
                          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 @@ using `make-temp-file', and the generated name is returned."
           (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 @@ using `make-temp-file', 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))))
-         (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 @@ as a relative change like \"g+rw\" as for chmod(2)"
     (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 @@ 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)
@@ -1332,11 +1358,12 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
         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 @@ 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)))))
+       (insert-unibyte name)))))
 ;; -------------------------------------------------------------------------
 ;; Section: Lzh Archives
 
@@ -1398,22 +1424,21 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
        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 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
          (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 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
                   )
                  (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 @@ 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
                            "- --------  -----  -----  "
                          "- ----------  --------  -----------  --------  ")
@@ -1497,7 +1521,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
   (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 @@ 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)))
+            (oldhsize (byte-after p))
+            (oldfnlen (byte-after (+ p 21)))
             (newfnlen (length newname))
             (newhsize (+ oldhsize newfnlen (- oldfnlen)))
             buffer-read-only)
@@ -1516,23 +1539,22 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
            (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 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
                    (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 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
         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 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
              (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 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
                             (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 @@ 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))))
-              (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 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
              (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 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
                                  (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))