diff options
| author | Richard M. Stallman | 1994-03-31 17:16:37 +0000 |
|---|---|---|
| committer | Richard M. Stallman | 1994-03-31 17:16:37 +0000 |
| commit | 439fa06f53218d4f0e16ef9c0b01285bdb4c61e4 (patch) | |
| tree | 9b73cb9facbc4e37ca3603d75322e1c6f3afec2e | |
| parent | 80eb0a994f6a81e408a1e8ebc8011bfb142580e5 (diff) | |
| download | emacs-439fa06f53218d4f0e16ef9c0b01285bdb4c61e4.tar.gz emacs-439fa06f53218d4f0e16ef9c0b01285bdb4c61e4.zip | |
Fix error message syntax.
(tar-mode): Doc fix.
(tar-mouse-extract): New command.
(tar-mode-map): Bind mouse-2.
(tar-get-descriptor): New function.
(tar-extract, tar-copy): Use that.
(tar-mode-maybe-write-tar-file): Renamed from maybe-write-tar-file.
| -rw-r--r-- | lisp/tar-mode.el | 75 |
1 files changed, 46 insertions, 29 deletions
diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el index 715814d85cc..0343c477f6e 100644 --- a/lisp/tar-mode.el +++ b/lisp/tar-mode.el | |||
| @@ -265,7 +265,7 @@ write-date, checksum, link-type, and link-name." | |||
| 265 | (tar-dotimes (i L) | 265 | (tar-dotimes (i L) |
| 266 | (if (or (< (aref string i) ?0) | 266 | (if (or (< (aref string i) ?0) |
| 267 | (> (aref string i) ?7)) | 267 | (> (aref string i) ?7)) |
| 268 | (error "'%c' is not an octal digit.")))) | 268 | (error "'%c' is not an octal digit")))) |
| 269 | (tar-parse-octal-integer string)) | 269 | (tar-parse-octal-integer string)) |
| 270 | 270 | ||
| 271 | 271 | ||
| @@ -393,13 +393,13 @@ is visible (and the real data of the buffer is hidden)." | |||
| 393 | ) | 393 | ) |
| 394 | (if (eq tokens 'empty-tar-block) | 394 | (if (eq tokens 'empty-tar-block) |
| 395 | nil | 395 | nil |
| 396 | (if (null tokens) (error "premature EOF parsing tar file.")) | 396 | (if (null tokens) (error "premature EOF parsing tar file")) |
| 397 | (if (eq (tar-header-link-type tokens) 20) | 397 | (if (eq (tar-header-link-type tokens) 20) |
| 398 | ;; Foo. There's an extra empty block after these. | 398 | ;; Foo. There's an extra empty block after these. |
| 399 | (setq pos (+ pos 512))) | 399 | (setq pos (+ pos 512))) |
| 400 | (let ((size (tar-header-size tokens))) | 400 | (let ((size (tar-header-size tokens))) |
| 401 | (if (< size 0) | 401 | (if (< size 0) |
| 402 | (error "%s has size %s - corrupted." | 402 | (error "%s has size %s - corrupted" |
| 403 | (tar-header-name tokens) size)) | 403 | (tar-header-name tokens) size)) |
| 404 | ; | 404 | ; |
| 405 | ; This is just too slow. Don't really need it anyway.... | 405 | ; This is just too slow. Don't really need it anyway.... |
| @@ -431,7 +431,7 @@ is visible (and the real data of the buffer is hidden)." | |||
| 431 | (set-buffer-modified-p nil))) | 431 | (set-buffer-modified-p nil))) |
| 432 | (message "parsing tar file...done.")) | 432 | (message "parsing tar file...done.")) |
| 433 | 433 | ||
| 434 | (defvar tar-mode-map nil "*Local keymap for tar-mode listings.") | 434 | (defvar tar-mode-map nil "*Local keymap for Tar mode listings.") |
| 435 | 435 | ||
| 436 | (if tar-mode-map | 436 | (if tar-mode-map |
| 437 | nil | 437 | nil |
| @@ -443,6 +443,7 @@ is visible (and the real data of the buffer is hidden)." | |||
| 443 | (define-key tar-mode-map "\^D" 'tar-flag-deleted) | 443 | (define-key tar-mode-map "\^D" 'tar-flag-deleted) |
| 444 | (define-key tar-mode-map "e" 'tar-extract) | 444 | (define-key tar-mode-map "e" 'tar-extract) |
| 445 | (define-key tar-mode-map "f" 'tar-extract) | 445 | (define-key tar-mode-map "f" 'tar-extract) |
| 446 | (define-key tar-mode-map [mouse-2] 'tar-mouse-extract) | ||
| 446 | (define-key tar-mode-map "g" 'revert-buffer) | 447 | (define-key tar-mode-map "g" 'revert-buffer) |
| 447 | (define-key tar-mode-map "h" 'describe-mode) | 448 | (define-key tar-mode-map "h" 'describe-mode) |
| 448 | (define-key tar-mode-map "n" 'tar-next-line) | 449 | (define-key tar-mode-map "n" 'tar-next-line) |
| @@ -513,7 +514,8 @@ is visible (and the real data of the buffer is hidden)." | |||
| 513 | "Major mode for viewing a tar file as a dired-like listing of its contents. | 514 | "Major mode for viewing a tar file as a dired-like listing of its contents. |
| 514 | You can move around using the usual cursor motion commands. | 515 | You can move around using the usual cursor motion commands. |
| 515 | Letters no longer insert themselves. | 516 | Letters no longer insert themselves. |
| 516 | Type `e' to pull a file out of the tar file and into its own buffer. | 517 | Type `e' to pull a file out of the tar file and into its own buffer; |
| 518 | or click mouse-2 on the file's line in the Tar mode buffer. | ||
| 517 | Type `c' to copy an entry from the tar file into another file on disk. | 519 | Type `c' to copy an entry from the tar file into another file on disk. |
| 518 | 520 | ||
| 519 | If you edit a sub-file of this archive (as with the `e' command) and | 521 | If you edit a sub-file of this archive (as with the `e' command) and |
| @@ -604,29 +606,47 @@ save your changes to disk." | |||
| 604 | tar-parse-info) | 606 | tar-parse-info) |
| 605 | (if noerror | 607 | (if noerror |
| 606 | nil | 608 | nil |
| 607 | (error "This line does not describe a tar-file entry.")))) | 609 | (error "This line does not describe a tar-file entry")))) |
| 608 | 610 | ||
| 611 | (defun tar-get-descriptor () | ||
| 612 | (let* ((descriptor (tar-current-descriptor)) | ||
| 613 | (tokens (tar-desc-tokens descriptor)) | ||
| 614 | (size (tar-header-size tokens)) | ||
| 615 | (link-p (tar-header-link-type tokens))) | ||
| 616 | (if link-p | ||
| 617 | (error "This is a %s, not a real file" | ||
| 618 | (cond ((eq link-p 5) "directory") | ||
| 619 | ((eq link-p 20) "tar directory header") | ||
| 620 | ((eq link-p 29) "multivolume-continuation") | ||
| 621 | ((eq link-p 35) "sparse entry") | ||
| 622 | ((eq link-p 38) "volume header") | ||
| 623 | (t "link")))) | ||
| 624 | (if (zerop size) (error "This is a zero-length file")) | ||
| 625 | descriptor)) | ||
| 626 | |||
| 627 | (defun tar-mouse-extract (event) | ||
| 628 | "Extract a file whose tar directory line you click on." | ||
| 629 | (interactive "e") | ||
| 630 | (save-excursion | ||
| 631 | (set-buffer (window-buffer (posn-window (event-end event)))) | ||
| 632 | (save-excursion | ||
| 633 | (goto-char (posn-point (event-end event))) | ||
| 634 | ;; Just make sure this doesn't get an error. | ||
| 635 | (tar-get-descriptor))) | ||
| 636 | (select-window (posn-window (event-end event))) | ||
| 637 | (goto-char (posn-point (event-end event))) | ||
| 638 | (tar-extract)) | ||
| 609 | 639 | ||
| 610 | (defun tar-extract (&optional other-window-p) | 640 | (defun tar-extract (&optional other-window-p) |
| 611 | "In Tar mode, extract this entry of the tar file into its own buffer." | 641 | "In Tar mode, extract this entry of the tar file into its own buffer." |
| 612 | (interactive) | 642 | (interactive) |
| 613 | (let* ((view-p (eq other-window-p 'view)) | 643 | (let* ((view-p (eq other-window-p 'view)) |
| 614 | (descriptor (tar-current-descriptor)) | 644 | (descriptor (tar-get-descriptor)) |
| 615 | (tokens (tar-desc-tokens descriptor)) | 645 | (tokens (tar-desc-tokens descriptor)) |
| 616 | (name (tar-header-name tokens)) | 646 | (name (tar-header-name tokens)) |
| 617 | (size (tar-header-size tokens)) | 647 | (size (tar-header-size tokens)) |
| 618 | (link-p (tar-header-link-type tokens)) | ||
| 619 | (start (+ (tar-desc-data-start descriptor) tar-header-offset -1)) | 648 | (start (+ (tar-desc-data-start descriptor) tar-header-offset -1)) |
| 620 | (end (+ start size))) | 649 | (end (+ start size))) |
| 621 | (if link-p | ||
| 622 | (error "This is a %s, not a real file." | ||
| 623 | (cond ((eq link-p 5) "directory") | ||
| 624 | ((eq link-p 20) "tar directory header") | ||
| 625 | ((eq link-p 29) "multivolume-continuation") | ||
| 626 | ((eq link-p 35) "sparse entry") | ||
| 627 | ((eq link-p 38) "volume header") | ||
| 628 | (t "link")))) | ||
| 629 | (if (zerop size) (error "This is a zero-length file.")) | ||
| 630 | (let* ((tar-buffer (current-buffer)) | 650 | (let* ((tar-buffer (current-buffer)) |
| 631 | (bufname (concat (file-name-nondirectory name) | 651 | (bufname (concat (file-name-nondirectory name) |
| 632 | " (" name " in " | 652 | " (" name " in " |
| @@ -714,15 +734,12 @@ save your changes to disk." | |||
| 714 | If TO-FILE is not supplied, it is prompted for, defaulting to the name of | 734 | If TO-FILE is not supplied, it is prompted for, defaulting to the name of |
| 715 | the current tar-entry." | 735 | the current tar-entry." |
| 716 | (interactive (list (tar-read-file-name))) | 736 | (interactive (list (tar-read-file-name))) |
| 717 | (let* ((descriptor (tar-current-descriptor)) | 737 | (let* ((descriptor (tar-get-descriptor)) |
| 718 | (tokens (tar-desc-tokens descriptor)) | 738 | (tokens (tar-desc-tokens descriptor)) |
| 719 | (name (tar-header-name tokens)) | 739 | (name (tar-header-name tokens)) |
| 720 | (size (tar-header-size tokens)) | 740 | (size (tar-header-size tokens)) |
| 721 | (link-p (tar-header-link-type tokens)) | ||
| 722 | (start (+ (tar-desc-data-start descriptor) tar-header-offset -1)) | 741 | (start (+ (tar-desc-data-start descriptor) tar-header-offset -1)) |
| 723 | (end (+ start size))) | 742 | (end (+ start size))) |
| 724 | (if link-p (error "This is a link, not a real file.")) | ||
| 725 | (if (zerop size) (error "This is a zero-length file.")) | ||
| 726 | (let* ((tar-buffer (current-buffer)) | 743 | (let* ((tar-buffer (current-buffer)) |
| 727 | buffer) | 744 | buffer) |
| 728 | (unwind-protect | 745 | (unwind-protect |
| @@ -908,8 +925,8 @@ for this to be permanent." | |||
| 908 | (interactive | 925 | (interactive |
| 909 | (list (read-string "New name: " | 926 | (list (read-string "New name: " |
| 910 | (tar-header-name (tar-desc-tokens (tar-current-descriptor)))))) | 927 | (tar-header-name (tar-desc-tokens (tar-current-descriptor)))))) |
| 911 | (if (string= "" new-name) (error "zero length name.")) | 928 | (if (string= "" new-name) (error "zero length name")) |
| 912 | (if (> (length new-name) 98) (error "name too long.")) | 929 | (if (> (length new-name) 98) (error "name too long")) |
| 913 | (tar-setf (tar-header-name (tar-desc-tokens (tar-current-descriptor))) | 930 | (tar-setf (tar-header-name (tar-desc-tokens (tar-current-descriptor))) |
| 914 | new-name) | 931 | new-name) |
| 915 | (tar-alter-one-field 0 | 932 | (tar-alter-one-field 0 |
| @@ -983,9 +1000,9 @@ This doesn't write anything to disk; you must save the parent tar-file buffer | |||
| 983 | to make your changes permanent." | 1000 | to make your changes permanent." |
| 984 | (interactive) | 1001 | (interactive) |
| 985 | (if (not (and (boundp 'tar-superior-buffer) tar-superior-buffer)) | 1002 | (if (not (and (boundp 'tar-superior-buffer) tar-superior-buffer)) |
| 986 | (error "this buffer has no superior tar file buffer.")) | 1003 | (error "This buffer has no superior tar file buffer")) |
| 987 | (if (not (and (boundp 'tar-superior-descriptor) tar-superior-descriptor)) | 1004 | (if (not (and (boundp 'tar-superior-descriptor) tar-superior-descriptor)) |
| 988 | (error "this buffer doesn't have an index into its superior tar file!")) | 1005 | (error "This buffer doesn't have an index into its superior tar file!")) |
| 989 | (save-excursion | 1006 | (save-excursion |
| 990 | (let ((subfile (current-buffer)) | 1007 | (let ((subfile (current-buffer)) |
| 991 | (subfile-size (buffer-size)) | 1008 | (subfile-size (buffer-size)) |
| @@ -1101,8 +1118,8 @@ Leaves the region wide." | |||
| 1101 | ))) | 1118 | ))) |
| 1102 | 1119 | ||
| 1103 | 1120 | ||
| 1104 | (defun maybe-write-tar-file () | 1121 | ;; Used in write-file-hook to write tar-files out correctly. |
| 1105 | "Used as a write-file-hook to write tar-files out correctly." | 1122 | (defun tar-mode-maybe-write-tar-file () |
| 1106 | ;; | 1123 | ;; |
| 1107 | ;; If the current buffer is in Tar mode and has its header-offset set, | 1124 | ;; If the current buffer is in Tar mode and has its header-offset set, |
| 1108 | ;; only write out the part of the file after the header-offset. | 1125 | ;; only write out the part of the file after the header-offset. |
| @@ -1127,9 +1144,9 @@ Leaves the region wide." | |||
| 1127 | 1144 | ||
| 1128 | ;;; Patch it in. | 1145 | ;;; Patch it in. |
| 1129 | 1146 | ||
| 1130 | (or (memq 'maybe-write-tar-file write-file-hooks) | 1147 | (or (memq 'tar-mode-maybe-write-tar-file write-file-hooks) |
| 1131 | (setq write-file-hooks | 1148 | (setq write-file-hooks |
| 1132 | (cons 'maybe-write-tar-file write-file-hooks))) | 1149 | (cons 'tar-mode-maybe-write-tar-file write-file-hooks))) |
| 1133 | 1150 | ||
| 1134 | (provide 'tar-mode) | 1151 | (provide 'tar-mode) |
| 1135 | 1152 | ||