Mercurial > emacs
comparison lisp/arc-mode.el @ 20767:ad6c6f1bd674
(archive-find-type): Accept d or s after digit, for lzh.
(archive-rename-entry): Likewise. Parse mode, uid and gid right.
Allow newline in header.
(archive-lzh-summarize): Fix paren error. Use prname to set `files'.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Sun, 25 Jan 1998 01:57:08 +0000 |
parents | 5bf13ca1dbac |
children | e21c343b0c6e |
comparison
equal
deleted
inserted
replaced
20766:92c662c4ab0e | 20767:ad6c6f1bd674 |
---|---|
669 (goto-char (point-min)) | 669 (goto-char (point-min)) |
670 ;; The funny [] here make it unlikely that the .elc file will be treated | 670 ;; The funny [] here make it unlikely that the .elc file will be treated |
671 ;; as an archive by other software. | 671 ;; as an archive by other software. |
672 (let (case-fold-search) | 672 (let (case-fold-search) |
673 (cond ((looking-at "[P]K\003\004") 'zip) | 673 (cond ((looking-at "[P]K\003\004") 'zip) |
674 ((looking-at "..-l[hz][0-9]-") 'lzh) | 674 ((looking-at "..-l[hz][0-9ds]-") 'lzh) |
675 ((looking-at "....................[\334]\247\304\375") 'zoo) | 675 ((looking-at "....................[\334]\247\304\375") 'zoo) |
676 ((and (looking-at "\C-z") ; signature too simple, IMHO | 676 ((and (looking-at "\C-z") ; signature too simple, IMHO |
677 (string-match "\\.[aA][rR][cC]$" | 677 (string-match "\\.[aA][rR][cC]$" |
678 (or buffer-file-name (buffer-name)))) | 678 (or buffer-file-name (buffer-name)))) |
679 'arc) | 679 'arc) |
1274 (let ((p 1) | 1274 (let ((p 1) |
1275 (totalsize 0) | 1275 (totalsize 0) |
1276 (maxlen 8) | 1276 (maxlen 8) |
1277 files | 1277 files |
1278 visual) | 1278 visual) |
1279 (while (progn (goto-char p) (looking-at "..-l[hz][0-9]-")) | 1279 (while (progn (goto-char p) |
1280 (looking-at "\\(.\\|\n\\)\\(.\\|\n\\)-l[hz][0-9ds]-")) | |
1280 (let* ((hsize (char-after p)) | 1281 (let* ((hsize (char-after p)) |
1281 (csize (archive-l-e (+ p 7) 4)) | 1282 (csize (archive-l-e (+ p 7) 4)) |
1282 (ucsize (archive-l-e (+ p 11) 4)) | 1283 (ucsize (archive-l-e (+ p 11) 4)) |
1283 (modtime (archive-l-e (+ p 15) 2)) | 1284 (modtime (archive-l-e (+ p 15) 2)) |
1284 (moddate (archive-l-e (+ p 17) 2)) | 1285 (moddate (archive-l-e (+ p 17) 2)) |
1286 (hdrlvl (char-after (+ p 20))) | |
1285 (fnlen (char-after (+ p 21))) | 1287 (fnlen (char-after (+ p 21))) |
1286 (efnname (buffer-substring (+ p 22) (+ p 22 fnlen))) | 1288 (efnname (buffer-substring (+ p 22) (+ p 22 fnlen))) |
1287 (fiddle (string= efnname (upcase efnname))) | 1289 (fiddle (string= efnname (upcase efnname))) |
1288 (ifnname (if fiddle (downcase efnname) efnname)) | 1290 (ifnname (if fiddle (downcase efnname) efnname)) |
1289 (p2 (+ p 22 fnlen)) | 1291 (p2 (+ p 22 fnlen)) |
1290 (creator (if (>= (- hsize fnlen) 24) (char-after (+ p2 2)) 0)) | 1292 (creator (if (>= (- hsize fnlen) 24) (char-after (+ p2 2)) 0)) |
1291 (mode (if (= creator ?U) (archive-l-e (+ p2 8) 2) ?\666)) | 1293 mode modestr uid gid text path prname |
1292 (modestr (if mode (archive-int-to-mode mode) "??????????")) | 1294 ) |
1293 (uid (if (= creator ?U) (archive-l-e (+ p2 10) 2))) | 1295 (if (= hdrlvl 0) |
1294 (gid (if (= creator ?U) (archive-l-e (+ p2 12) 2))) | 1296 (setq mode (if (= creator ?U) (archive-l-e (+ p2 8) 2) ?\666) |
1295 (text (if archive-alternate-display | 1297 uid (if (= creator ?U) (archive-l-e (+ p2 10) 2)) |
1298 gid (if (= creator ?U) (archive-l-e (+ p2 12) 2))) | |
1299 (if (= creator ?U) | |
1300 (let* ((p3 (+ p2 3)) | |
1301 (hsize (archive-l-e p3 2)) | |
1302 (etype (char-after (+ p3 2)))) | |
1303 (while (not (= hsize 0)) | |
1304 (cond | |
1305 ((= etype 2) (let ((i (+ p3 3))) | |
1306 (while (< i (+ p3 hsize)) | |
1307 (setq path (concat path | |
1308 (if (= (char-after i) | |
1309 255) | |
1310 "/" | |
1311 (char-to-string | |
1312 (char-after i))))) | |
1313 (setq i (1+ i))))) | |
1314 ((= etype 80) (setq mode (archive-l-e (+ p3 3) 2))) | |
1315 ((= etype 81) (progn (setq uid (archive-l-e (+ p3 3) 2)) | |
1316 (setq gid (archive-l-e (+ p3 5) 2)))) | |
1317 ) | |
1318 (setq p3 (+ p3 hsize)) | |
1319 (setq hsize (archive-l-e p3 2)) | |
1320 (setq etype (char-after (+ p3 2))))))) | |
1321 (setq prname (if path (concat path ifnname) ifnname)) | |
1322 (setq modestr (if mode (archive-int-to-mode mode) "??????????")) | |
1323 (setq text (if archive-alternate-display | |
1296 (format " %8d %5S %5S %s" | 1324 (format " %8d %5S %5S %s" |
1297 ucsize | 1325 ucsize |
1298 (or uid "?") | 1326 (or uid "?") |
1299 (or gid "?") | 1327 (or gid "?") |
1300 ifnname) | 1328 ifnname) |
1301 (format " %10s %8d %-11s %-8s %s" | 1329 (format " %10s %8d %-11s %-8s %s" |
1302 modestr | 1330 modestr |
1303 ucsize | 1331 ucsize |
1304 (archive-dosdate moddate) | 1332 (archive-dosdate moddate) |
1305 (archive-dostime modtime) | 1333 (archive-dostime modtime) |
1306 ifnname)))) | 1334 ifnname))) |
1307 (setq maxlen (max maxlen fnlen) | 1335 (setq maxlen (max maxlen fnlen) |
1308 totalsize (+ totalsize ucsize) | 1336 totalsize (+ totalsize ucsize) |
1309 visual (cons (vector text | 1337 visual (cons (vector text |
1310 (- (length text) (length ifnname)) | 1338 (- (length text) (length ifnname)) |
1311 (length text)) | 1339 (length text)) |
1312 visual) | 1340 visual) |
1313 files (cons (vector efnname ifnname fiddle mode (1- p)) | 1341 files (cons (vector prname ifnname fiddle mode (1- p)) |
1314 files) | 1342 files) |
1315 p (+ p hsize 2 csize)))) | 1343 p (+ p hsize 2 csize)))) |
1316 (goto-char (point-min)) | 1344 (goto-char (point-min)) |
1317 (let ((dash (concat (if archive-alternate-display | 1345 (let ((dash (concat (if archive-alternate-display |
1318 "- -------- ----- ----- " | 1346 "- -------- ----- ----- " |