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