Mercurial > emacs

comparison lisp/arc-mode.el @ 88954:363e137c2601

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(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 6d7f6edfdb45
children 2f877ed80fa6
comparison
equal deleted inserted replaced
88953:b18e038d980f 88954:363e137c2601
332 332
333 (defvar archive-subfile-mode nil "*Non-nil in archive member buffers.") 333 (defvar archive-subfile-mode nil "*Non-nil in archive member buffers.")
334 (make-variable-buffer-local 'archive-subfile-mode) 334 (make-variable-buffer-local 'archive-subfile-mode)
335 (put 'archive-subfile-mode 'permanent-local t) 335 (put 'archive-subfile-mode 'permanent-local t)
336 336
337 (defvar archive-file-name-coding-system nil)
338 (make-variable-buffer-local 'archive-file-name-coding-system)
339 (put 'archive-file-name-coding-system 'permanent-local t)
340
337 (defvar archive-files nil 341 (defvar archive-files nil
338 "Vector of file descriptors. 342 "Vector of file descriptors.
339 Each descriptor is a vector of the form 343 Each descriptor is a vector of the form
340 [EXT-FILE-NAME INT-FILE-NAME CASE-FIDDLED MODE ...]") 344 [EXT-FILE-NAME INT-FILE-NAME CASE-FIDDLED MODE ...]")
341 (make-variable-buffer-local 'archive-files) 345 (make-variable-buffer-local 'archive-files)
343 (defvar archive-lemacs 347 (defvar archive-lemacs
344 (string-match "\\(Lucid\\|Xemacs\\)" emacs-version) 348 (string-match "\\(Lucid\\|Xemacs\\)" emacs-version)
345 "*Non-nil when running under under Lucid Emacs or Xemacs.") 349 "*Non-nil when running under under Lucid Emacs or Xemacs.")
346 ;; ------------------------------------------------------------------------- 350 ;; -------------------------------------------------------------------------
347 ;; Section: Support functions. 351 ;; Section: Support functions.
352
353 (eval-when-compile
354 (defsubst byte-after (pos)
355 "Like char-after but an eight-bit char is converted to unibyte."
356 (multibyte-char-to-unibyte (char-after pos)))
357 (defsubst bref (string idx)
358 "Like aref but an eight-bit char is converted to unibyte."
359 (multibyte-char-to-unibyte (aref string idx)))
360 (defsubst insert-unibyte (&rest args)
361 "Like insert but don't make unibyte string and eight-bit char multibyte."
362 (dolist (elt args)
363 (if (integerp elt)
364 (insert (if (< elt 128) elt (decode-char 'eight-bit elt)))
365 (insert (string-to-multibyte elt)))))
366 )
348 367
349 (defsubst archive-name (suffix) 368 (defsubst archive-name (suffix)
350 (intern (concat "archive-" (symbol-name archive-subtype) "-" suffix))) 369 (intern (concat "archive-" (symbol-name archive-subtype) "-" suffix)))
351 370
352 (defun archive-l-e (str &optional len) 371 (defun archive-l-e (str &optional len)
358 (setq str (buffer-substring str (+ str len)))) 377 (setq str (buffer-substring str (+ str len))))
359 (let ((result 0) 378 (let ((result 0)
360 (i 0)) 379 (i 0))
361 (while (< i len) 380 (while (< i len)
362 (setq i (1+ i) 381 (setq i (1+ i)
363 result (+ (ash result 8) (aref str (- len i))))) 382 result (+ (ash result 8)
383 (bref str (- len i)))))
364 result)) 384 result))
365 385
366 (defun archive-int-to-mode (mode) 386 (defun archive-int-to-mode (mode)
367 "Turn an integer like 0700 (i.e., 448) into a mode string like -rwx------." 387 "Turn an integer like 0700 (i.e., 448) into a mode string like -rwx------."
368 ;; FIXME: merge with tar-grind-file-mode. 388 ;; FIXME: merge with tar-grind-file-mode.
558 578
559 (make-local-variable 'archive-proper-file-start) 579 (make-local-variable 'archive-proper-file-start)
560 (make-local-variable 'archive-file-list-start) 580 (make-local-variable 'archive-file-list-start)
561 (make-local-variable 'archive-file-list-end) 581 (make-local-variable 'archive-file-list-end)
562 (make-local-variable 'archive-file-name-indent) 582 (make-local-variable 'archive-file-name-indent)
583 (setq archive-file-name-coding-system
584 (or file-name-coding-system
585 default-file-name-coding-system
586 locale-coding-system))
587 (if default-enable-multibyte-characters
588 (set-buffer-multibyte t 'to))
563 (archive-summarize nil) 589 (archive-summarize nil)
564 (setq buffer-read-only t)))) 590 (setq buffer-read-only t))))
565 591
566 ;; Archive mode is suitable only for specially formatted data. 592 ;; Archive mode is suitable only for specially formatted data.
567 (put 'archive-mode 'mode-class 'special) 593 (put 'archive-mode 'mode-class 'special)
700 then narrow to it, so that only that listing 726 then narrow to it, so that only that listing
701 is visible (and the real data of the buffer is hidden). 727 is visible (and the real data of the buffer is hidden).
702 Optional argument SHUT-UP, if non-nil, means don't print messages 728 Optional argument SHUT-UP, if non-nil, means don't print messages
703 when parsing the archive." 729 when parsing the archive."
704 (widen) 730 (widen)
705 (set-buffer-multibyte nil)
706 (let (buffer-read-only) 731 (let (buffer-read-only)
707 (or shut-up 732 (or shut-up
708 (message "Parsing archive file...")) 733 (message "Parsing archive file..."))
709 (buffer-disable-undo (current-buffer)) 734 (buffer-disable-undo (current-buffer))
710 (setq archive-files (funcall (archive-name "summarize"))) 735 (setq archive-files (funcall (archive-name "summarize")))
905 ;; underlying filesystem, are treated as read-only. 930 ;; underlying filesystem, are treated as read-only.
906 (read-only-p (or archive-read-only 931 (read-only-p (or archive-read-only
907 view-p 932 view-p
908 (string-match file-name-invalid-regexp ename))) 933 (string-match file-name-invalid-regexp ename)))
909 (buffer (get-buffer bufname)) 934 (buffer (get-buffer bufname))
910 (just-created nil)) 935 (just-created nil)
936 (file-name-coding archive-file-name-coding-system))
911 (if buffer 937 (if buffer
912 nil 938 nil
913 (setq archive (archive-maybe-copy archive)) 939 (setq archive (archive-maybe-copy archive))
914 (setq buffer (get-buffer-create bufname)) 940 (setq buffer (get-buffer-create bufname))
915 (setq just-created t) 941 (setq just-created t)
924 (make-local-variable 'archive-superior-buffer) 950 (make-local-variable 'archive-superior-buffer)
925 (setq archive-superior-buffer archive-buffer) 951 (setq archive-superior-buffer archive-buffer)
926 (make-local-variable 'local-write-file-hooks) 952 (make-local-variable 'local-write-file-hooks)
927 (add-hook 'local-write-file-hooks 'archive-write-file-member) 953 (add-hook 'local-write-file-hooks 'archive-write-file-member)
928 (setq archive-subfile-mode descr) 954 (setq archive-subfile-mode descr)
955 (setq archive-file-name-coding-system file-name-coding)
929 (if (and 956 (if (and
930 (null 957 (null
931 (let (;; We may have to encode file name arguement for 958 (let (;; We may have to encode file name arguement for
932 ;; external programs. 959 ;; external programs.
933 (coding-system-for-write 960 (coding-system-for-write
934 (and enable-multibyte-characters 961 (and enable-multibyte-characters
935 file-name-coding-system)) 962 archive-file-name-coding-system))
936 ;; We read an archive member by no-conversion at 963 ;; We read an archive member by no-conversion at
937 ;; first, then decode appropriately by calling 964 ;; first, then decode appropriately by calling
938 ;; archive-set-buffer-as-visiting-file later. 965 ;; archive-set-buffer-as-visiting-file later.
939 (coding-system-for-read 'no-conversion)) 966 (coding-system-for-read 'no-conversion))
940 (condition-case err 967 (condition-case err
1114 ;; archive-write-file-member, above). 1141 ;; archive-write-file-member, above).
1115 (setq archive-member-coding-system last-coding-system-used) 1142 (setq archive-member-coding-system last-coding-system-used)
1116 (if (aref descr 3) 1143 (if (aref descr 3)
1117 ;; Set the file modes, but make sure we can read it. 1144 ;; Set the file modes, but make sure we can read it.
1118 (set-file-modes tmpfile (logior ?\400 (aref descr 3)))) 1145 (set-file-modes tmpfile (logior ?\400 (aref descr 3))))
1119 (if enable-multibyte-characters 1146 (setq ename
1120 (setq ename 1147 (encode-coding-string ename archive-file-name-coding-system))
1121 (encode-coding-string ename file-name-coding-system))) 1148 (let* ((coding-system-for-write 'no-conversion)
1122 (let ((exitcode (apply 'call-process 1149 (exitcode (apply 'call-process
1123 (car command) 1150 (car command)
1124 nil 1151 nil
1125 nil 1152 nil
1126 nil 1153 nil
1127 (append (cdr command) (list archive ename))))) 1154 (append (cdr command)
1155 (list archive ename)))))
1128 (if (equal exitcode 0) 1156 (if (equal exitcode 0)
1129 nil 1157 nil
1130 (error "Updating was unsuccessful (%S)" exitcode)))) 1158 (error "Updating was unsuccessful (%S)" exitcode))))
1131 (archive-delete-local tmpfile)))) 1159 (archive-delete-local tmpfile))))
1132 1160
1295 (let ((func (archive-name "rename-entry")) 1323 (let ((func (archive-name "rename-entry"))
1296 (descr (archive-get-descr))) 1324 (descr (archive-get-descr)))
1297 (if (fboundp func) 1325 (if (fboundp func)
1298 (progn 1326 (progn
1299 (funcall func (buffer-file-name) 1327 (funcall func (buffer-file-name)
1300 (if enable-multibyte-characters 1328 (encode-coding-string newname
1301 (encode-coding-string newname file-name-coding-system) 1329 archive-file-name-coding-system)
1302 newname)
1303 descr) 1330 descr)
1304 (archive-resummarize)) 1331 (archive-resummarize))
1305 (error "Renaming is not supported for this archive type")))) 1332 (error "Renaming is not supported for this archive type"))))
1306 1333
1307 ;; Revert the buffer and recompute the dired-like listing. 1334 ;; Revert the buffer and recompute the dired-like listing.
1308 (defun archive-mode-revert (&optional no-auto-save no-confirm) 1335 (defun archive-mode-revert (&optional no-auto-save no-confirm)
1309 (let ((no (archive-get-lineno))) 1336 (let ((no (archive-get-lineno)))
1310 (setq archive-files nil) 1337 (setq archive-files nil)
1311 (let ((revert-buffer-function nil) 1338 (let ((revert-buffer-function nil)
1312 (coding-system-for-read 'no-conversion)) 1339 (coding-system-for-read 'no-conversion))
1313 (set-buffer-multibyte nil)
1314 (revert-buffer t t)) 1340 (revert-buffer t t))
1315 (archive-mode) 1341 (archive-mode)
1316 (goto-char archive-file-list-start) 1342 (goto-char archive-file-list-start)
1317 (archive-next-line no))) 1343 (archive-next-line no)))
1318 1344
1330 (totalsize 0) 1356 (totalsize 0)
1331 (maxlen 8) 1357 (maxlen 8)
1332 files 1358 files
1333 visual) 1359 visual)
1334 (while (and (< (+ p 29) (point-max)) 1360 (while (and (< (+ p 29) (point-max))
1335 (= (char-after p) ?\C-z) 1361 (= (byte-after p) ?\C-z)
1336 (> (char-after (1+ p)) 0)) 1362 (> (byte-after (1+ p)) 0))
1337 (let* ((namefld (buffer-substring (+ p 2) (+ p 2 13))) 1363 (let* ((namefld (buffer-substring (+ p 2) (+ p 2 13)))
1338 (fnlen (or (string-match "\0" namefld) 13)) 1364 (fnlen (or (string-match "\0" namefld) 13))
1339 (efnname (substring namefld 0 fnlen)) 1365 (efnname (decode-coding-string (substring namefld 0 fnlen)
1366 archive-file-name-coding-system))
1340 (csize (archive-l-e (+ p 15) 4)) 1367 (csize (archive-l-e (+ p 15) 4))
1341 (moddate (archive-l-e (+ p 19) 2)) 1368 (moddate (archive-l-e (+ p 19) 2))
1342 (modtime (archive-l-e (+ p 21) 2)) 1369 (modtime (archive-l-e (+ p 21) 2))
1343 (ucsize (archive-l-e (+ p 25) 4)) 1370 (ucsize (archive-l-e (+ p 25) 4))
1344 (fiddle (string= efnname (upcase efnname))) 1371 (fiddle (string= efnname (upcase efnname)))
1381 (length newname)))) 1408 (length newname))))
1382 buffer-read-only) 1409 buffer-read-only)
1383 (save-restriction 1410 (save-restriction
1384 (save-excursion 1411 (save-excursion
1385 (widen) 1412 (widen)
1386 (set-buffer-multibyte nil)
1387 (goto-char (+ archive-proper-file-start (aref descr 4) 2)) 1413 (goto-char (+ archive-proper-file-start (aref descr 4) 2))
1388 (delete-char 13) 1414 (delete-char 13)
1389 (insert name))))) 1415 (insert-unibyte name)))))
1390 ;; ------------------------------------------------------------------------- 1416 ;; -------------------------------------------------------------------------
1391 ;; Section: Lzh Archives 1417 ;; Section: Lzh Archives
1392 1418
1393 (defun archive-lzh-summarize () 1419 (defun archive-lzh-summarize ()
1394 (let ((p 1) 1420 (let ((p 1)
1396 (maxlen 8) 1422 (maxlen 8)
1397 files 1423 files
1398 visual) 1424 visual)
1399 (while (progn (goto-char p) 1425 (while (progn (goto-char p)
1400 (looking-at "\\(.\\|\n\\)\\(.\\|\n\\)-l[hz][0-9ds]-")) 1426 (looking-at "\\(.\\|\n\\)\\(.\\|\n\\)-l[hz][0-9ds]-"))
1401 (let* ((hsize (char-after p)) 1427 (let* ((hsize (byte-after p))
1402 (csize (archive-l-e (+ p 7) 4)) 1428 (csize (archive-l-e (+ p 7) 4))
1403 (ucsize (archive-l-e (+ p 11) 4)) 1429 (ucsize (archive-l-e (+ p 11) 4))
1404 (modtime (archive-l-e (+ p 15) 2)) 1430 (modtime (archive-l-e (+ p 15) 2))
1405 (moddate (archive-l-e (+ p 17) 2)) 1431 (moddate (archive-l-e (+ p 17) 2))
1406 (hdrlvl (char-after (+ p 20))) 1432 (hdrlvl (byte-after (+ p 20)))
1407 (fnlen (char-after (+ p 21))) 1433 (fnlen (byte-after (+ p 21)))
1408 (efnname (let ((str (buffer-substring (+ p 22) (+ p 22 fnlen)))) 1434 (efnname (let ((str (buffer-substring (+ p 22) (+ p 22 fnlen))))
1409 (if file-name-coding-system 1435 (decode-coding-string
1410 (decode-coding-string str file-name-coding-system) 1436 str archive-file-name-coding-system)))
1411 (string-as-multibyte str))))
1412 (fiddle (string= efnname (upcase efnname))) 1437 (fiddle (string= efnname (upcase efnname)))
1413 (ifnname (if fiddle (downcase efnname) efnname)) 1438 (ifnname (if fiddle (downcase efnname) efnname))
1414 (width (string-width ifnname)) 1439 (width (string-width ifnname))
1415 (p2 (+ p 22 fnlen)) 1440 (p2 (+ p 22 fnlen))
1416 (creator (if (>= (- hsize fnlen) 24) (char-after (+ p2 2)) 0)) 1441 (creator (if (>= (- hsize fnlen) 24) (byte-after (+ p2 2)) 0))
1417 mode modestr uid gid text path prname 1442 mode modestr uid gid text path prname
1418 ) 1443 )
1419 (if (= hdrlvl 0) 1444 (if (= hdrlvl 0)
1420 (setq mode (if (= creator ?U) (archive-l-e (+ p2 8) 2) ?\666) 1445 (setq mode (if (= creator ?U) (archive-l-e (+ p2 8) 2) ?\666)
1421 uid (if (= creator ?U) (archive-l-e (+ p2 10) 2)) 1446 uid (if (= creator ?U) (archive-l-e (+ p2 10) 2))
1422 gid (if (= creator ?U) (archive-l-e (+ p2 12) 2))) 1447 gid (if (= creator ?U) (archive-l-e (+ p2 12) 2)))
1423 (if (= creator ?U) 1448 (if (= creator ?U)
1424 (let* ((p3 (+ p2 3)) 1449 (let* ((p3 (+ p2 3))
1425 (hsize (archive-l-e p3 2)) 1450 (hsize (archive-l-e p3 2))
1426 (etype (char-after (+ p3 2)))) 1451 (etype (byte-after (+ p3 2))))
1427 (while (not (= hsize 0)) 1452 (while (not (= hsize 0))
1428 (cond 1453 (cond
1429 ((= etype 2) (let ((i (+ p3 3))) 1454 ((= etype 2) (let ((i (+ p3 3)))
1430 (while (< i (+ p3 hsize)) 1455 (while (< i (+ p3 hsize))
1431 (setq path (concat path 1456 (setq path (concat path
1432 (if (= (char-after i) 1457 (if (= (byte-after i)
1433 255) 1458 255)
1434 "/" 1459 "/"
1435 (char-to-string 1460 (char-to-string
1436 (char-after i))))) 1461 (byte-after i)))))
1437 (setq i (1+ i))))) 1462 (setq i (1+ i)))))
1438 ((= etype 80) (setq mode (archive-l-e (+ p3 3) 2))) 1463 ((= etype 80) (setq mode (archive-l-e (+ p3 3) 2)))
1439 ((= etype 81) (progn (setq uid (archive-l-e (+ p3 3) 2)) 1464 ((= etype 81) (progn (setq uid (archive-l-e (+ p3 3) 2))
1440 (setq gid (archive-l-e (+ p3 5) 2)))) 1465 (setq gid (archive-l-e (+ p3 5) 2))))
1441 ) 1466 )
1442 (setq p3 (+ p3 hsize)) 1467 (setq p3 (+ p3 hsize))
1443 (setq hsize (archive-l-e p3 2)) 1468 (setq hsize (archive-l-e p3 2))
1444 (setq etype (char-after (+ p3 2))))))) 1469 (setq etype (byte-after (+ p3 2)))))))
1445 (setq prname (if path (concat path ifnname) ifnname)) 1470 (setq prname (if path (concat path ifnname) ifnname))
1446 (setq modestr (if mode (archive-int-to-mode mode) "??????????")) 1471 (setq modestr (if mode (archive-int-to-mode mode) "??????????"))
1447 (setq text (if archive-alternate-display 1472 (setq text (if archive-alternate-display
1448 (format " %8d %5S %5S %s" 1473 (format " %8d %5S %5S %s"
1449 ucsize 1474 ucsize
1464 visual) 1489 visual)
1465 files (cons (vector prname ifnname fiddle mode (1- p)) 1490 files (cons (vector prname ifnname fiddle mode (1- p))
1466 files) 1491 files)
1467 p (+ p hsize 2 csize)))) 1492 p (+ p hsize 2 csize))))
1468 (goto-char (point-min)) 1493 (goto-char (point-min))
1469 (set-buffer-multibyte default-enable-multibyte-characters)
1470 (let ((dash (concat (if archive-alternate-display 1494 (let ((dash (concat (if archive-alternate-display
1471 "- -------- ----- ----- " 1495 "- -------- ----- ----- "
1472 "- ---------- -------- ----------- -------- ") 1496 "- ---------- -------- ----------- -------- ")
1473 (make-string maxlen ?-) 1497 (make-string maxlen ?-)
1474 "\n")) 1498 "\n"))
1495 1519
1496 (defun archive-lzh-resum (p count) 1520 (defun archive-lzh-resum (p count)
1497 (let ((sum 0)) 1521 (let ((sum 0))
1498 (while (> count 0) 1522 (while (> count 0)
1499 (setq count (1- count) 1523 (setq count (1- count)
1500 sum (+ sum (char-after p)) 1524 sum (+ sum (byte-after p))
1501 p (1+ p))) 1525 p (1+ p)))
1502 (logand sum 255))) 1526 (logand sum 255)))
1503 1527
1504 (defun archive-lzh-rename-entry (archive newname descr) 1528 (defun archive-lzh-rename-entry (archive newname descr)
1505 (save-restriction 1529 (save-restriction
1506 (save-excursion 1530 (save-excursion
1507 (widen) 1531 (widen)
1508 (set-buffer-multibyte nil)
1509 (let* ((p (+ archive-proper-file-start (aref descr 4))) 1532 (let* ((p (+ archive-proper-file-start (aref descr 4)))
1510 (oldhsize (char-after p)) 1533 (oldhsize (byte-after p))
1511 (oldfnlen (char-after (+ p 21))) 1534 (oldfnlen (byte-after (+ p 21)))
1512 (newfnlen (length newname)) 1535 (newfnlen (length newname))
1513 (newhsize (+ oldhsize newfnlen (- oldfnlen))) 1536 (newhsize (+ oldhsize newfnlen (- oldfnlen)))
1514 buffer-read-only) 1537 buffer-read-only)
1515 (if (> newhsize 255) 1538 (if (> newhsize 255)
1516 (error "The file name is too long")) 1539 (error "The file name is too long"))
1517 (goto-char (+ p 21)) 1540 (goto-char (+ p 21))
1518 (delete-char (1+ oldfnlen)) 1541 (delete-char (1+ oldfnlen))
1519 (insert newfnlen newname) 1542 (insert-unibyte newfnlen newname)
1520 (goto-char p) 1543 (goto-char p)
1521 (delete-char 2) 1544 (delete-char 2)
1522 (insert newhsize (archive-lzh-resum p newhsize)))))) 1545 (insert-unibyte newhsize (archive-lzh-resum p newhsize))))))
1523 1546
1524 (defun archive-lzh-ogm (newval files errtxt ofs) 1547 (defun archive-lzh-ogm (newval files errtxt ofs)
1525 (save-restriction 1548 (save-restriction
1526 (save-excursion 1549 (save-excursion
1527 (widen) 1550 (widen)
1528 (set-buffer-multibyte nil)
1529 (while files 1551 (while files
1530 (let* ((fil (car files)) 1552 (let* ((fil (car files))
1531 (p (+ archive-proper-file-start (aref fil 4))) 1553 (p (+ archive-proper-file-start (aref fil 4)))
1532 (hsize (char-after p)) 1554 (hsize (byte-after p))
1533 (fnlen (char-after (+ p 21))) 1555 (fnlen (byte-after (+ p 21)))
1534 (p2 (+ p 22 fnlen)) 1556 (p2 (+ p 22 fnlen))
1535 (creator (if (>= (- hsize fnlen) 24) (char-after (+ p2 2)) 0)) 1557 (creator (if (>= (- hsize fnlen) 24) (byte-after (+ p2 2)) 0))
1536 buffer-read-only) 1558 buffer-read-only)
1537 (if (= creator ?U) 1559 (if (= creator ?U)
1538 (progn 1560 (progn
1539 (or (numberp newval) 1561 (or (numberp newval)
1540 (setq newval (funcall newval (archive-l-e (+ p2 ofs) 2)))) 1562 (setq newval (funcall newval (archive-l-e (+ p2 ofs) 2))))
1541 (goto-char (+ p2 ofs)) 1563 (goto-char (+ p2 ofs))
1542 (delete-char 2) 1564 (delete-char 2)
1543 (insert (logand newval 255) (lsh newval -8)) 1565 (insert-unibyte (logand newval 255) (lsh newval -8))
1544 (goto-char (1+ p)) 1566 (goto-char (1+ p))
1545 (delete-char 1) 1567 (delete-char 1)
1546 (insert (archive-lzh-resum (1+ p) hsize))) 1568 (insert-unibyte (archive-lzh-resum (1+ p) hsize)))
1547 (message "Member %s does not have %s field" 1569 (message "Member %s does not have %s field"
1548 (aref fil 1) errtxt))) 1570 (aref fil 1) errtxt)))
1549 (setq files (cdr files)))))) 1571 (setq files (cdr files))))))
1550 1572
1551 (defun archive-lzh-chown-entry (newuid files) 1573 (defun archive-lzh-chown-entry (newuid files)
1569 (maxlen 8) 1591 (maxlen 8)
1570 (totalsize 0) 1592 (totalsize 0)
1571 files 1593 files
1572 visual) 1594 visual)
1573 (while (string= "PK\001\002" (buffer-substring p (+ p 4))) 1595 (while (string= "PK\001\002" (buffer-substring p (+ p 4)))
1574 (let* ((creator (char-after (+ p 5))) 1596 (let* ((creator (byte-after (+ p 5)))
1575 (method (archive-l-e (+ p 10) 2)) 1597 (method (archive-l-e (+ p 10) 2))
1576 (modtime (archive-l-e (+ p 12) 2)) 1598 (modtime (archive-l-e (+ p 12) 2))
1577 (moddate (archive-l-e (+ p 14) 2)) 1599 (moddate (archive-l-e (+ p 14) 2))
1578 (ucsize (archive-l-e (+ p 24) 4)) 1600 (ucsize (archive-l-e (+ p 24) 4))
1579 (fnlen (archive-l-e (+ p 28) 2)) 1601 (fnlen (archive-l-e (+ p 28) 2))
1580 (exlen (archive-l-e (+ p 30) 2)) 1602 (exlen (archive-l-e (+ p 30) 2))
1581 (fclen (archive-l-e (+ p 32) 2)) 1603 (fclen (archive-l-e (+ p 32) 2))
1582 (lheader (archive-l-e (+ p 42) 4)) 1604 (lheader (archive-l-e (+ p 42) 4))
1583 (efnname (let ((str (buffer-substring (+ p 46) (+ p 46 fnlen)))) 1605 (efnname (let ((str (buffer-substring (+ p 46) (+ p 46 fnlen))))
1584 (if file-name-coding-system 1606 (decode-coding-string
1585 (decode-coding-string str file-name-coding-system) 1607 str archive-file-name-coding-system)))
1586 (string-as-multibyte str))))
1587 (isdir (and (= ucsize 0) 1608 (isdir (and (= ucsize 0)
1588 (string= (file-name-nondirectory efnname) ""))) 1609 (string= (file-name-nondirectory efnname) "")))
1589 (mode (cond ((memq creator '(2 3)) ; Unix + VMS 1610 (mode (cond ((memq creator '(2 3)) ; Unix + VMS
1590 (archive-l-e (+ p 40) 2)) 1611 (archive-l-e (+ p 40) 2))
1591 ((memq creator '(0 5 6 7 10 11 15)) ; Dos etc. 1612 ((memq creator '(0 5 6 7 10 11 15)) ; Dos etc.
1592 (logior ?\444 1613 (logior ?\444
1593 (if isdir (logior 16384 ?\111) 0) 1614 (if isdir (logior 16384 ?\111) 0)
1594 (if (zerop 1615 (if (zerop
1595 (logand 1 (char-after (+ p 38)))) 1616 (logand 1 (byte-after (+ p 38))))
1596 ?\222 0))) 1617 ?\222 0)))
1597 (t nil))) 1618 (t nil)))
1598 (modestr (if mode (archive-int-to-mode mode) "??????????")) 1619 (modestr (if mode (archive-int-to-mode mode) "??????????"))
1599 (fiddle (and archive-zip-case-fiddle 1620 (fiddle (and archive-zip-case-fiddle
1600 (not (not (memq creator '(0 2 4 5 9)))) 1621 (not (not (memq creator '(0 2 4 5 9))))
1647 1668
1648 (defun archive-zip-chmod-entry (newmode files) 1669 (defun archive-zip-chmod-entry (newmode files)
1649 (save-restriction 1670 (save-restriction
1650 (save-excursion 1671 (save-excursion
1651 (widen) 1672 (widen)
1652 (set-buffer-multibyte nil)
1653 (while files 1673 (while files
1654 (let* ((fil (car files)) 1674 (let* ((fil (car files))
1655 (p (+ archive-proper-file-start (car (aref fil 4)))) 1675 (p (+ archive-proper-file-start (car (aref fil 4))))
1656 (creator (char-after (+ p 5))) 1676 (creator (byte-after (+ p 5)))
1657 (oldmode (aref fil 3)) 1677 (oldmode (aref fil 3))
1658 (newval (archive-calc-mode oldmode newmode t)) 1678 (newval (archive-calc-mode oldmode newmode t))
1659 buffer-read-only) 1679 buffer-read-only)
1660 (cond ((memq creator '(2 3)) ; Unix + VMS 1680 (cond ((memq creator '(2 3)) ; Unix + VMS
1661 (goto-char (+ p 40)) 1681 (goto-char (+ p 40))
1662 (delete-char 2) 1682 (delete-char 2)
1663 (insert (logand newval 255) (lsh newval -8))) 1683 (insert-unibyte (logand newval 255) (lsh newval -8)))
1664 ((memq creator '(0 5 6 7 10 11 15)) ; Dos etc. 1684 ((memq creator '(0 5 6 7 10 11 15)) ; Dos etc.
1665 (goto-char (+ p 38)) 1685 (goto-char (+ p 38))
1666 (insert (logior (logand (char-after (point)) 254) 1686 (insert-unibyte (logior (logand (byte-after (point)) 254)
1667 (logand (logxor 1 (lsh newval -7)) 1))) 1687 (logand (logxor 1 (lsh newval -7)) 1)))
1668 (delete-char 1)) 1688 (delete-char 1))
1669 (t (message "Don't know how to change mode for this member")))) 1689 (t (message "Don't know how to change mode for this member"))))
1670 (setq files (cdr files)))))) 1690 (setq files (cdr files))))))
1671 ;; ------------------------------------------------------------------------- 1691 ;; -------------------------------------------------------------------------
1672 ;; Section: Zoo Archives 1692 ;; Section: Zoo Archives
1682 (let* ((next (1+ (archive-l-e (+ p 6) 4))) 1702 (let* ((next (1+ (archive-l-e (+ p 6) 4)))
1683 (moddate (archive-l-e (+ p 14) 2)) 1703 (moddate (archive-l-e (+ p 14) 2))
1684 (modtime (archive-l-e (+ p 16) 2)) 1704 (modtime (archive-l-e (+ p 16) 2))
1685 (ucsize (archive-l-e (+ p 20) 4)) 1705 (ucsize (archive-l-e (+ p 20) 4))
1686 (namefld (buffer-substring (+ p 38) (+ p 38 13))) 1706 (namefld (buffer-substring (+ p 38) (+ p 38 13)))
1687 (dirtype (char-after (+ p 4))) 1707 (dirtype (byte-after (+ p 4)))
1688 (lfnlen (if (= dirtype 2) (char-after (+ p 56)) 0)) 1708 (lfnlen (if (= dirtype 2) (byte-after (+ p 56)) 0))
1689 (ldirlen (if (= dirtype 2) (char-after (+ p 57)) 0)) 1709 (ldirlen (if (= dirtype 2) (byte-after (+ p 57)) 0))
1690 (fnlen (or (string-match "\0" namefld) 13)) 1710 (fnlen (or (string-match "\0" namefld) 13))
1691 (efnname (let ((str 1711 (efnname (let ((str
1692 (concat 1712 (concat
1693 (if (> ldirlen 0) 1713 (if (> ldirlen 0)
1694 (concat (buffer-substring 1714 (concat (buffer-substring
1698 "") 1718 "")
1699 (if (> lfnlen 0) 1719 (if (> lfnlen 0)
1700 (buffer-substring (+ p 58) 1720 (buffer-substring (+ p 58)
1701 (+ p 58 lfnlen -1)) 1721 (+ p 58 lfnlen -1))
1702 (substring namefld 0 fnlen))))) 1722 (substring namefld 0 fnlen)))))
1703 (if file-name-coding-system 1723 (decode-coding-string
1704 (decode-coding-string str file-name-coding-system) 1724 str archive-file-name-coding-system)))
1705 (string-as-multibyte str))))
1706 (fiddle (and (= lfnlen 0) (string= efnname (upcase efnname)))) 1725 (fiddle (and (= lfnlen 0) (string= efnname (upcase efnname))))
1707 (ifnname (if fiddle (downcase efnname) efnname)) 1726 (ifnname (if fiddle (downcase efnname) efnname))
1708 (width (string-width ifnname)) 1727 (width (string-width ifnname))
1709 (text (format " %8d %-11s %-8s %s" 1728 (text (format " %8d %-11s %-8s %s"
1710 ucsize 1729 ucsize