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 "- -------- ----- ----- " |