Commit ad38511a authored by Kenichi Handa's avatar Kenichi Handa

(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.
parent 88dad6e7
......@@ -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))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment