X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=tm-tar.el;h=cddb11f3e51a13d0e0a6c8063692b4299bb8a071;hb=53ab6c426401d04d0d0ce99d6df144187be6ba01;hp=7af896f1d7e92f253abab92cae044b7326a5306e;hpb=85e625be2efa8aa5aad0386fefe5e10d99c21dc2;p=elisp%2Ftm.git

diff --git a/tm-tar.el b/tm-tar.el
index 7af896f..cddb11f 100644
--- a/tm-tar.el
+++ b/tm-tar.el
@@ -1,5 +1,5 @@
 ;;;
-;;; $Id: tm-tar.el,v 1.2 1995/10/07 21:47:24 H.Ueno Exp $
+;;; $Id: tm-tar.el,v 1.22 1995/10/21 15:34:33 H.Ueno Exp $
 ;;;
 ;;; tm-tar.el
 ;;;
@@ -10,6 +10,7 @@
 ;;;    - aplication/octet-stream, type="tar+gzip"
 ;;;
 ;;; by Hiroshi Ueno <zodiac@ibm.net>
+;;;	modified by Tomohiko Morioka <morioka@jaist.ac.jp>
 ;;;
 
 ;;; @ required modules
@@ -35,44 +36,36 @@
 (defvar tm-tar/mmencode-program "mmencode")
 (defvar tm-tar/uudecode-program "uudecode")
 
-(defvar tm-tar/show-popup-menu (>= emacs-major-version 19)
-  "*if non nil, TAR Mode popup menu will be shown to select an action.
-if nil, a selected file will be shown in a buffer")
-
 (defvar tm-tar/popup-menu-items
-  '(("View File"      . tm-tar/view-file)
-    ("Key Help"       . tm-tar/helpful-message)
-    ("Quit TAR Mode"  . exit-recursive-edit)
+  '(("View File"         . tm-tar/view-file)
+    ("Key Help"          . tm-tar/helpful-message)
+    ("Quit tm-tar Mode"  . exit-recursive-edit)
     ))
 
 (cond ((string-match "XEmacs\\|Lucid" emacs-version)
        (defvar tm-tar/popup-menu
 	 (cons tm-tar/popup-menu-title
-	       (mapcar (function
+		(mapcar (function
 			(lambda (item)
 			  (vector (car item)(cdr item) t)
 			  ))
-		       tm-tar/popup-menu-items)))
-       
-       (defun tm-tar/mouse-button-2 ()
-	 (if tm-tar/show-popup-menu
-	     (popup-menu tm-tar/popup-menu)
-	   (tm-tar/view-file)
-	   ))
+			 tm-tar/popup-menu-items)))
+
+       (defun tm-tar/mouse-button-2 (event)
+	   (popup-menu tm-tar/popup-menu)
+	   )
        )
       ((>= emacs-major-version 19)
-       (defun tm-tar/mouse-button-2 ()
+       (defun tm-tar/mouse-button-2 (event)
 	 (let ((menu
 		(cons tm-tar/popup-menu-title
-		      (list (cons "Menu Items" tm-tar/popup-menu-items))
-		      )))
-	   (if tm-tar/show-popup-menu
-	       (let ((func (x-popup-menu last-input-event menu)))
+			(list (cons "Menu Items" tm-tar/popup-menu-items))
+			)))
+	   (let ((func (x-popup-menu event menu)))
 		 (if func
 		     (funcall func)
 		   ))
-	     (tm-tar/view-file)
-	     )))
+	     ))
        ))
 
 (defvar tm-tar/tar-mode-map nil)
@@ -92,9 +85,9 @@ if nil, a selected file will be shown in a buffer")
     (define-key tm-tar/tar-mode-map "\C-h"    'Helper-help)
     (define-key tm-tar/tar-mode-map "?"       'tm-tar/helpful-message)
     (if mouse-button-2
-        (define-key tm-tar/tar-mode-map
-                               mouse-button-2 'tm:button-dispatcher)
-        )
+	(define-key tm-tar/tar-mode-map
+				  mouse-button-2 'tm:button-dispatcher)
+	)
   )
 
 ;;; @@ tm-tar mode functions
@@ -103,31 +96,31 @@ if nil, a selected file will be shown in a buffer")
 (defun tm-tar/tar-mode (&optional prev-buf)
   "Major mode for listing the contents of a tar archive file."
     (unwind-protect
-        (let ((buffer-read-only t)
-              (mode-name "tm-tar")
-              (mode-line-buffer-identification '("%17b"))
-              )
-            (goto-char (point-min))
-            (tm-tar/move-to-filename)
-            (catch 'tm-tar/tar-mode (tm-tar/command-loop))
-         )
-        (if prev-buf
-            (switch-to-buffer prev-buf)
-         )
+	(let ((buffer-read-only t)
+	      (mode-name "tm-tar")
+	      (mode-line-buffer-identification '("%17b"))
+	      )
+	    (goto-char (point-min))
+	    (tm-tar/move-to-filename)
+	    (catch 'tm-tar/tar-mode (tm-tar/command-loop))
+	 )
+	(if prev-buf
+	    (switch-to-buffer prev-buf)
+	 )
      ))
 
 (defun tm-tar/command-loop ()
     (let ((old-local-map (current-local-map))
-          )
-        (unwind-protect
-            (progn
-                (use-local-map tm-tar/tar-mode-map)
-                (tm-tar/helpful-message)
-                (recursive-edit)
-             )
-            (save-excursion
-                (use-local-map old-local-map)
-             ))
+	  )
+	(unwind-protect
+	    (progn
+		(use-local-map tm-tar/tar-mode-map)
+		(tm-tar/helpful-message)
+		(recursive-edit)
+	     )
+	    (save-excursion
+		(use-local-map old-local-map)
+	     ))
      ))
 
 (defun tm-tar/next-line ()
@@ -145,148 +138,161 @@ if nil, a selected file will be shown in a buffer")
 (defun tm-tar/view-file ()
     (interactive)
     (let ((name (tm-tar/get-filename))
-          )
+	  )
       (save-excursion
-          (switch-to-buffer tm-tar/view-buffer)
-          (setq buffer-read-only nil)
-          (erase-buffer)
-          (message "Reading a file from an archive. Please wait...")
-          (apply 'call-process tm-tar/tar-program
-                       nil t nil (append tm-tar/view-args (list name)))
-          (goto-char (point-min))
+	  (switch-to-buffer tm-tar/view-buffer)
+	  (setq buffer-read-only nil)
+	  (erase-buffer)
+	  (message "Reading a file from an archive. Please wait...")
+	  (apply 'call-process tm-tar/tar-program
+			 nil t nil (append tm-tar/view-args (list name)))
+	  (goto-char (point-min))
        )
-        (view-buffer tm-tar/view-buffer)
+	(view-buffer tm-tar/view-buffer)
      ))
 
 (defun tm-tar/get-filename ()
     (let (eol)
-        (save-excursion
-            (end-of-line)
-            (setq eol (point))
-            (beginning-of-line)
-            (save-excursion
-                (if (re-search-forward "^d" eol t)
-                       (error "Cannot view a directory"))
-             )
-            (if (re-search-forward tm-tar/file-search-regexp eol t)
-                     (progn (let ((beg (point))
-                                  )
-                                (skip-chars-forward "^ \n")
-                                (buffer-substring beg (point))
-                             ))
-                     (error "No file on this line")
-             ))
+	(save-excursion
+	    (end-of-line)
+	    (setq eol (point))
+	    (beginning-of-line)
+	    (save-excursion
+		(if (re-search-forward "^d" eol t)
+			 (error "Cannot view a directory"))
+	     )
+	    (if (re-search-forward tm-tar/file-search-regexp eol t)
+		     (progn (let ((beg (point))
+				  )
+				(skip-chars-forward "^ \n")
+				(buffer-substring beg (point))
+				))
+		     (error "No file on this line")
+	     ))
      ))
 
 (defun tm-tar/move-to-filename ()
     (let ((eol (progn (end-of-line) (point)))
-          )
-        (beginning-of-line)
-        (re-search-forward tm-tar/file-search-regexp eol t)
+	  )
+	(beginning-of-line)
+	(re-search-forward tm-tar/file-search-regexp eol t)
      ))
 
 (defun tm-tar/set-properties ()
     (if mouse-button-2
-        (let ((beg (point-min))
-              (end (point-max))
-              )
-            (goto-char beg)
-            (save-excursion
-                (while (re-search-forward tm-tar/file-search-regexp end t)
-                    (tm:add-button (point)
-                                       (progn
-                                           (end-of-line)
-                                           (point))
-                                       'tm-tar/mouse-button-2)
-                 ))
-         )))
+	(let ((beg (point-min))
+	      (end (point-max))
+	      )
+	    (goto-char beg)
+	    (save-excursion
+		(while (re-search-forward tm-tar/file-search-regexp end t)
+		    (tm:add-button (point)
+					   (progn
+						(end-of-line)
+						(point))
+					   'tm-tar/view-file)
+		 ))
+	 )))
 
 (defun tm-tar/helpful-message ()
     (interactive)
     (message "Type %s, %s, %s, %s, %s, %s."
-        (substitute-command-keys "\\[Helper-help] for help")
-        (substitute-command-keys "\\[tm-tar/helpful-message] for keys")
-        (substitute-command-keys "\\[tm-tar/next-line] to next")
-        (substitute-command-keys "\\[tm-tar/previous-line] to prev")
-        (substitute-command-keys "\\[tm-tar/view-file] to view")
-        (substitute-command-keys "\\[exit-recursive-edit] to quit")
+	(substitute-command-keys "\\[Helper-help] for help")
+	(substitute-command-keys "\\[tm-tar/helpful-message] for keys")
+	(substitute-command-keys "\\[tm-tar/next-line] to next")
+	(substitute-command-keys "\\[tm-tar/previous-line] to prev")
+	(substitute-command-keys "\\[tm-tar/view-file] to view")
+	(substitute-command-keys "\\[exit-recursive-edit] to quit")
+     ))
+
+(defun tm-tar/y-or-n-p (prompt)
+    (prog1
+	(y-or-n-p prompt)
+	(message "")
      ))
 
 ;;; @@ tar message decoder
 ;;
 
 (defun mime/decode-message/tar (beg end cal)
-    (let ((coding (cdr (assoc 'encoding cal)))
-          (cur-buf (current-buffer))
-          (tm-tar/tar-file-name (expand-file-name (concat (make-temp-name
-                      (expand-file-name "tm" mime/tmp-dir)) ".tar")))
-          (tm-tar/tmp-file-name (expand-file-name (make-temp-name
-                      (expand-file-name "tm" mime/tmp-dir))))
-          new-buf
-          )
-        (find-file tm-tar/tmp-file-name)
-        (setq new-buf (current-buffer))
-        (setq buffer-read-only nil)
-        (erase-buffer)
-        (save-excursion
-            (set-buffer cur-buf)
-            (goto-char beg)
-            (re-search-forward "^$")
-            (append-to-buffer new-buf (+ (match-end 0) 1) end)
-         )
-        (if (member coding mime-viewer/uuencode-encoding-name-list)
-            (progn
-                (goto-char (point-min))
-                (if (re-search-forward "^begin [0-9]+ " nil t)
-                    (progn
-                        (kill-line)
-                        (insert tm-tar/tar-file-name)
-                     )
-                    (progn
-                        (set-buffer-modified-p nil)
-                        (kill-buffer new-buf)
-                        (error "uuencode file signature was not found")
-                     ))))
-        (save-buffer)
-        (kill-buffer new-buf)
-        (message "Listing the contents of an archive.  Please wait...")
-        (cond ((string-equal coding "base64")
-                 (call-process tm-tar/mmencode-program nil nil nil "-u"
-                             "-o" tm-tar/tar-file-name tm-tar/tmp-file-name)
-                )
-              ((string-equal coding "quoted-printable")
-                 (call-process tm-tar/mmencode-program nil nil nil "-u" "-q"
-                             "-o" tm-tar/tar-file-name tm-tar/tmp-file-name)
-                )
-              ((member coding mime-viewer/uuencode-encoding-name-list)
-                 (call-process tm-tar/uudecode-program nil nil nil
-                             tm-tar/tmp-file-name)
-                )
-              (t
-                 (copy-file tm-tar/tmp-file-name tm-tar/tar-file-name t)
-                ))
-        (delete-file tm-tar/tmp-file-name)
-        (setq tm-tar/list-args (list "-tvf" tm-tar/tar-file-name))
-        (setq tm-tar/view-args (list "-xOf" tm-tar/tar-file-name))
-        (if (eq 0 (call-process tm-tar/gzip-program
-                            nil nil nil "-t" tm-tar/tar-file-name))
-            (progn
-                (setq tm-tar/list-args
-                      (append tm-tar/tar-decompress-arg tm-tar/list-args))
-                (setq tm-tar/view-args
-                      (append tm-tar/tar-decompress-arg tm-tar/view-args))
-             ))
-        (switch-to-buffer tm-tar/view-buffer)
-        (switch-to-buffer tm-tar/list-buffer)
-        (setq buffer-read-only nil)
-        (erase-buffer)
-        (apply 'call-process tm-tar/tar-program
-                             nil t nil tm-tar/list-args)
-        (tm-tar/set-properties)
-        (tm-tar/tar-mode mime::article/preview-buffer)
-        (kill-buffer tm-tar/view-buffer)
-        (kill-buffer tm-tar/list-buffer)
-        (delete-file tm-tar/tar-file-name)
+    (if (tm-tar/y-or-n-p "Do you want to enter tm-tar mode? ")
+	(let ((coding (cdr (assoc 'encoding cal)))
+	      (cur-buf (current-buffer))
+	      (tm-tar/tar-file-name (expand-file-name (concat (make-temp-name
+			(expand-file-name "tm" mime/tmp-dir)) ".tar")))
+	      (tm-tar/tmp-file-name (expand-file-name (make-temp-name
+			(expand-file-name "tm" mime/tmp-dir))))
+	      new-buf
+	      )
+	    (find-file tm-tar/tmp-file-name)
+	    (setq new-buf (current-buffer))
+	    (setq buffer-read-only nil)
+	    (erase-buffer)
+	    (save-excursion
+		 (set-buffer cur-buf)
+		(goto-char beg)
+		(re-search-forward "^$")
+		(append-to-buffer new-buf (+ (match-end 0) 1) end)
+	     )
+	    (if (member coding mime-viewer/uuencode-encoding-name-list)
+		(progn
+		    (goto-char (point-min))
+		    (if (re-search-forward "^begin [0-9]+ " nil t)
+			(progn
+			    (kill-line)
+			    (insert tm-tar/tar-file-name)
+			 )
+			(progn
+			    (set-buffer-modified-p nil)
+			    (kill-buffer new-buf)
+			    (error "uuencode file signature was not found")
+			 ))))
+	    (save-buffer)
+	    (kill-buffer new-buf)
+	    (message "Listing the contents of an archive.  Please wait...")
+	    (cond ((string-equal coding "base64")
+		   (call-process tm-tar/mmencode-program nil nil nil "-u"
+				"-o" tm-tar/tar-file-name tm-tar/tmp-file-name)
+		   )
+		  ((string-equal coding "quoted-printable")
+		   (call-process tm-tar/mmencode-program nil nil nil "-u" "-q"
+				"-o" tm-tar/tar-file-name tm-tar/tmp-file-name)
+		   )
+		  ((member coding mime-viewer/uuencode-encoding-name-list)
+		   (call-process tm-tar/uudecode-program nil nil nil
+				tm-tar/tmp-file-name)
+		   )
+		  (t
+		   (copy-file tm-tar/tmp-file-name tm-tar/tar-file-name t)
+		   ))
+	    (delete-file tm-tar/tmp-file-name)
+	    (setq tm-tar/list-args (list "-tvf" tm-tar/tar-file-name))
+	    (setq tm-tar/view-args (list "-xOf" tm-tar/tar-file-name))
+	    (if (eq 0 (call-process tm-tar/gzip-program
+			    nil nil nil "-t" tm-tar/tar-file-name))
+		(progn
+		    (setq tm-tar/list-args
+			  (append tm-tar/tar-decompress-arg tm-tar/list-args))
+		    (setq tm-tar/view-args
+			  (append tm-tar/tar-decompress-arg tm-tar/view-args))
+		 ))
+	    (switch-to-buffer tm-tar/view-buffer)
+	    (switch-to-buffer tm-tar/list-buffer)
+	    (setq buffer-read-only nil)
+	    (erase-buffer)
+	    (apply 'call-process tm-tar/tar-program
+		   nil t nil tm-tar/list-args)
+	    (if mouse-button-2
+		 (progn
+		    (make-local-variable 'tm:mother-button-dispatcher)
+		    (setq tm:mother-button-dispatcher 'tm-tar/mouse-button-2)
+		 ))
+	    (tm-tar/set-properties)
+	    (tm-tar/tar-mode mime::article/preview-buffer)
+	    (kill-buffer tm-tar/view-buffer)
+	    (kill-buffer tm-tar/list-buffer)
+	    (delete-file tm-tar/tar-file-name)
+	 )
      ))
 
 ;;; @@ program/buffer coding system
@@ -303,30 +309,36 @@ if nil, a selected file will be shown in a buffer")
 ;;;
 
 (set-atype 'mime/content-decoding-condition
-           '((type . "application/octet-stream")
-             (method . mime/decode-message/tar)
-             (mode . "play") ("type" . "tar")
-             ))
+	   '((type . "application/octet-stream")
+	     (method . mime/decode-message/tar)
+	     (mode . "play") ("type" . "tar")
+	     ))
 
 (set-atype 'mime/content-decoding-condition
-           '((type . "application/octet-stream")
-             (method . mime/decode-message/tar)
-             (mode . "play") ("type" . "tar+gzip")
-             ))
+	   '((type . "application/octet-stream")
+	     (method . mime/decode-message/tar)
+	     (mode . "play") ("type" . "tar+gzip")
+	     ))
 
 (set-atype 'mime/content-decoding-condition
-           '((type . "application/x-gzip")
-             (method . mime/decode-message/tar)
-             (mode . "play") ("type" . "tar")
-             ))
+	   '((type . "application/x-gzip")
+	     (method . mime/decode-message/tar)
+	     (mode . "play") ("type" . "tar")
+	     ))
 
 (set-atype 'mime/content-decoding-condition
-           '((type . "application/x-tar")
-             (method . mime/decode-message/tar)
-             (mode . "play")
-             ))
+	   '((type . "application/x-tar")
+	     (method . mime/decode-message/tar)
+	     (mode . "play")
+	     ))
 
 ;;; @ end
 ;;;
 
 (provide 'tm-tar)
+
+;;; Local Variables:
+;;; mode: emacs-lisp
+;;; mode: outline-minor
+;;; outline-regexp: ";;; @+\\|(......"
+;;; End: