Mercurial > emacs
changeset 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.
| author | Kenichi Handa <handa@m17n.org> |
|---|---|
| date | Wed, 31 Jul 2002 07:14:13 +0000 |
| parents | b18e038d980f |
| children | 1d1275f5d5b7 |
| files | lisp/arc-mode.el |
| diffstat | 1 files changed, 81 insertions(+), 62 deletions(-) [+] |
line wrap: on
line diff
--- 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))