404 |
then narrow to it, so that only that listing |
then narrow to it, so that only that listing |
405 |
is visible (and the real data of the buffer is hidden)." |
is visible (and the real data of the buffer is hidden)." |
406 |
(set-buffer-multibyte nil) |
(set-buffer-multibyte nil) |
|
(message "Parsing tar file...") |
|
407 |
(let* ((result '()) |
(let* ((result '()) |
408 |
(pos (point-min)) |
(pos (point-min)) |
409 |
(bs (max 1 (- (buffer-size) 1024))) ; always 2+ empty blocks at end. |
(progress-reporter |
410 |
(bs100 (max 1 (/ bs 100))) |
(make-progress-reporter "Parsing tar file..." |
411 |
|
(point-min) (max 1 (- (buffer-size) 1024)))) |
412 |
tokens) |
tokens) |
413 |
(while (and (<= (+ pos 512) (point-max)) |
(while (and (<= (+ pos 512) (point-max)) |
414 |
(not (eq 'empty-tar-block |
(not (eq 'empty-tar-block |
416 |
(tar-header-block-tokenize |
(tar-header-block-tokenize |
417 |
(buffer-substring pos (+ pos 512))))))) |
(buffer-substring pos (+ pos 512))))))) |
418 |
(setq pos (+ pos 512)) |
(setq pos (+ pos 512)) |
419 |
(message "Parsing tar file...%d%%" |
(progress-reporter-update progress-reporter pos) |
|
;(/ (* pos 100) bs) ; this gets round-off lossage |
|
|
(/ pos bs100) ; this doesn't |
|
|
) |
|
420 |
(if (eq (tar-header-link-type tokens) 20) |
(if (eq (tar-header-link-type tokens) 20) |
421 |
;; Foo. There's an extra empty block after these. |
;; Foo. There's an extra empty block after these. |
422 |
(setq pos (+ pos 512))) |
(setq pos (+ pos 512))) |
443 |
;; A tar file should end with a block or two of nulls, |
;; A tar file should end with a block or two of nulls, |
444 |
;; but let's not get a fatal error if it doesn't. |
;; but let's not get a fatal error if it doesn't. |
445 |
(if (eq tokens 'empty-tar-block) |
(if (eq tokens 'empty-tar-block) |
446 |
(message "Parsing tar file...done") |
(progress-reporter-done progress-reporter) |
447 |
(message "Warning: premature EOF parsing tar file"))) |
(message "Warning: premature EOF parsing tar file"))) |
448 |
(save-excursion |
(save-excursion |
449 |
(goto-char (point-min)) |
(goto-char (point-min)) |