aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorRichard M. Stallman1994-03-31 17:16:37 +0000
committerRichard M. Stallman1994-03-31 17:16:37 +0000
commit439fa06f53218d4f0e16ef9c0b01285bdb4c61e4 (patch)
tree9b73cb9facbc4e37ca3603d75322e1c6f3afec2e
parent80eb0a994f6a81e408a1e8ebc8011bfb142580e5 (diff)
downloademacs-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.el75
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.
514You can move around using the usual cursor motion commands. 515You can move around using the usual cursor motion commands.
515Letters no longer insert themselves. 516Letters no longer insert themselves.
516Type `e' to pull a file out of the tar file and into its own buffer. 517Type `e' to pull a file out of the tar file and into its own buffer;
518or click mouse-2 on the file's line in the Tar mode buffer.
517Type `c' to copy an entry from the tar file into another file on disk. 519Type `c' to copy an entry from the tar file into another file on disk.
518 520
519If you edit a sub-file of this archive (as with the `e' command) and 521If 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."
714If TO-FILE is not supplied, it is prompted for, defaulting to the name of 734If TO-FILE is not supplied, it is prompted for, defaulting to the name of
715the current tar-entry." 735the 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
983to make your changes permanent." 1000to 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