;;; mime-tar.el --- mime-view internal method for tar or tar+gzip format

;; Copyright (C) 1995,1996,1997 Free Software Foundation, Inc.

;; Author: Hiroshi Ueno <zodiac@ibm.net>
;;	modified by MORIOKA Tomohiko <morioka@jaist.ac.jp>
;; Renamed: 1997/2/26 from tm-tar.el
;; Version: $Id: mime-tar.el,v 0.7 1997-05-12 12:30:42 morioka Exp $
;; Keywords: tar, tar+gzip, MIME, multimedia, mail, news

;; This file is part of SEMI (SEMI is Emacs MIME Interfaces).

;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2, or (at
;; your option) any later version.

;; This program is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; Internal viewer for
;;    - application/x-tar
;;    - application/x-gzip, type="tar"
;;    - aplication/octet-stream, type="tar"
;;    - aplication/octet-stream, type="tar+gzip"

;;; Code:

(require 'mime-view)


;;; @ constants
;;;

(defconst mime-tar-list-buffer "*mime-tar-List*")
(defconst mime-tar-view-buffer "*mime-tar-View*")
(defconst mime-tar-file-search-regexp "[0-9]+\:[0-9\:]+[ ]+[0-9]+[ ]+")
(defconst mime-tar-popup-menu-title "Action Menu")


;;; @ variables
;;;

(defvar mime-tar-program "gtar")
(defvar mime-tar-decompress-arg '("-z"))
(defvar mime-tar-gzip-program "gzip")
(defvar mime-tar-mmencode-program "mmencode")
(defvar mime-tar-uudecode-program "uudecode")

(defvar mime-tar-popup-menu-items
  '(("View File"		. mime-tar-view-file)
    ("Key Help"			. mime-tar-helpful-message)
    ("Quit mime-tar Mode"	. exit-recursive-edit)
    ))

(cond ((string-match "XEmacs\\|Lucid" emacs-version)
       (defvar mime-tar-popup-menu
	 (cons mime-tar-popup-menu-title
	       (mapcar (function
			(lambda (item)
			  (vector (car item)(cdr item) t)
			  ))
		       mime-tar-popup-menu-items)))
       
       (defun mime-tar-mouse-button-2 (event)
	 (popup-menu mime-tar-popup-menu)
	 )
       )
      ((>= emacs-major-version 19)
       (defun mime-tar-mouse-button-2 (event)
	 (let ((menu
		(cons mime-tar-popup-menu-title
		      (list (cons "Menu Items" mime-tar-popup-menu-items))
		      )))
	   (let ((func (x-popup-menu event menu)))
	     (if func
		 (funcall func)
	       ))
	   ))
       ))

(defvar mime-tar-mode-map nil)
(if mime-tar-mode-map
    nil
  (setq mime-tar-mode-map (make-keymap))
  (suppress-keymap mime-tar-mode-map)
  (define-key mime-tar-mode-map "\C-c"    'exit-recursive-edit)
  (define-key mime-tar-mode-map "q"       'exit-recursive-edit)
  (define-key mime-tar-mode-map "n"       'mime-tar-next-line)
  (define-key mime-tar-mode-map " "       'mime-tar-next-line)
  (define-key mime-tar-mode-map "\C-m"    'mime-tar-next-line)
  (define-key mime-tar-mode-map "p"       'mime-tar-previous-line)
  (define-key mime-tar-mode-map "\177"    'mime-tar-previous-line)
  (define-key mime-tar-mode-map "\C-\M-m" 'mime-tar-previous-line)
  (define-key mime-tar-mode-map "v"       'mime-tar-view-file)
  (define-key mime-tar-mode-map "\C-h"    'Helper-help)
  (define-key mime-tar-mode-map "?"       'mime-tar-helpful-message)
  (if mouse-button-2
      (define-key mime-tar-mode-map
	mouse-button-2 'mime-button-dispatcher))
  )


;;; @@ mime-tar mode functions
;;;

(defun mime-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 "mime-tar")
	    (mode-line-buffer-identification '("%17b"))
	    )
	(goto-char (point-min))
	(mime-tar-move-to-filename)
	(catch 'mime-tar-mode (mime-tar-command-loop))
	)
    (if prev-buf
	(switch-to-buffer prev-buf)
      )
    ))

(defun mime-tar-command-loop ()
  (let ((old-local-map (current-local-map)))
    (unwind-protect
	(progn
	  (use-local-map mime-tar-mode-map)
	  (mime-tar-helpful-message)
	  (recursive-edit)
	  )
      (save-excursion
	(use-local-map old-local-map)
	))
    ))

(defun mime-tar-next-line ()
  (interactive)
  (next-line 1)
  (mime-tar-move-to-filename)
  )

(defun mime-tar-previous-line ()
  (interactive)
  (previous-line 1)
  (mime-tar-move-to-filename)
  )

(defun mime-tar-view-file ()
  (interactive)
  (let ((name (mime-tar-get-filename))
	)
    (save-excursion
      (switch-to-buffer mime-tar-view-buffer)
      (setq buffer-read-only nil)
      (erase-buffer)
      (message "Reading a file from an archive. Please wait...")
      (apply 'call-process mime-tar-program
	     nil t nil (append mime-tar-view-args (list name)))
      (goto-char (point-min))
      )
    (view-buffer mime-tar-view-buffer)
    ))

(defun mime-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 mime-tar-file-search-regexp eol t)
	  (let ((beg (point)))
	    (skip-chars-forward "^ \n")
	    (buffer-substring beg (point))
	    )
	(error "No file on this line")
	))
    ))

(defun mime-tar-move-to-filename ()
  (let ((eol (progn (end-of-line) (point))))
    (beginning-of-line)
    (re-search-forward mime-tar-file-search-regexp eol t)
    ))

(defun mime-tar-set-properties ()
  (if mouse-button-2
      (let ((beg (point-min))
	    (end (point-max))
	    )
	(goto-char beg)
	(save-excursion
	  (while (re-search-forward mime-tar-file-search-regexp end t)
	    (mime-add-button (point)
			     (progn
			       (end-of-line)
			       (point))
			     'mime-tar-view-file)
	    ))
	)))

(defun mime-tar-helpful-message ()
  (interactive)
  (message "Type %s, %s, %s, %s, %s, %s."
	   (substitute-command-keys "\\[Helper-help] for help")
	   (substitute-command-keys "\\[mime-tar-helpful-message] for keys")
	   (substitute-command-keys "\\[mime-tar-next-line] to next")
	   (substitute-command-keys "\\[mime-tar-previous-line] to prev")
	   (substitute-command-keys "\\[mime-tar-view-file] to view")
	   (substitute-command-keys "\\[exit-recursive-edit] to quit")
	   ))

(defun mime-tar-y-or-n-p (prompt)
  (prog1
      (y-or-n-p prompt)
    (message "")
    ))

;;; @@ tar message decoder
;;

(defun mime-decode-message/tar (beg end cal)
  (if (mime-tar-y-or-n-p "Do you want to enter mime-tar mode? ")
      (let ((coding (cdr (assoc 'encoding cal)))
	    (cur-buf (current-buffer))
	    (mime-tar-file-name
	     (expand-file-name
	      (concat (make-temp-name
		       (expand-file-name "tm" mime-temp-directory)) ".tar")))
	    (mime-tar-tmp-file-name
	     (expand-file-name
	      (make-temp-name (expand-file-name "tm" mime-temp-directory))))
	    new-buf)
	(find-file mime-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-view-uuencode-encoding-name-list)
	    (progn
	      (goto-char (point-min))
	      (if (re-search-forward "^begin [0-9]+ " nil t)
		  (progn
		    (kill-line)
		    (insert mime-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 mime-tar-mmencode-program nil nil nil "-u"
			     "-o" mime-tar-file-name mime-tar-tmp-file-name)
	       )
	      ((string-equal coding "quoted-printable")
	       (call-process mime-tar-mmencode-program nil nil nil "-u" "-q"
			     "-o" mime-tar-file-name mime-tar-tmp-file-name)
	       )
	      ((member coding mime-view-uuencode-encoding-name-list)
	       (call-process mime-tar-uudecode-program nil nil nil
			     mime-tar-tmp-file-name)
	       )
	      (t
	       (copy-file mime-tar-tmp-file-name mime-tar-file-name t)
	       ))
	(delete-file mime-tar-tmp-file-name)
	(setq mime-tar-list-args (list "-tvf" mime-tar-file-name))
	(setq mime-tar-view-args (list "-xOf" mime-tar-file-name))
	(if (eq 0 (call-process mime-tar-gzip-program
				nil nil nil "-t" mime-tar-file-name))
	    (progn
	      (setq mime-tar-list-args
		    (append mime-tar-decompress-arg mime-tar-list-args))
	      (setq mime-tar-view-args
		    (append mime-tar-decompress-arg mime-tar-view-args))
	      ))
	(switch-to-buffer mime-tar-view-buffer)
	(switch-to-buffer mime-tar-list-buffer)
	(setq buffer-read-only nil)
	(erase-buffer)
	(apply 'call-process mime-tar-program
	       nil t nil mime-tar-list-args)
	(if mouse-button-2
	    (progn
	      (make-local-variable 'mime-button-mother-dispatcher)
	      (setq mime-button-mother-dispatcher 'mime-tar-mouse-button-2)
	      ))
	(mime-tar-set-properties)
	(mime-tar-mode mime-view-buffer)
	(kill-buffer mime-tar-view-buffer)
	(kill-buffer mime-tar-list-buffer)
	(delete-file mime-tar-file-name)
	)
    ))

;;; @@ program/buffer coding system
;;;

(cond ((boundp 'MULE)
       (define-program-coding-system mime-tar-view-buffer nil '*autoconv*)
       )
      ((boundp 'NEMACS)
       (define-program-kanji-code mime-tar-view-buffer nil 1)
       ))

;;; @@ message types to use mime-tar
;;;

(set-atype 'mime-acting-condition
	   '((type . "application/octet-stream")
	     (method . mime-decode-message/tar)
	     (mode . "play") ("type" . "tar")
	     ))

(set-atype 'mime-acting-condition
	   '((type . "application/octet-stream")
	     (method . mime-decode-message/tar)
	     (mode . "play") ("type" . "tar+gzip")
	     ))

(set-atype 'mime-acting-condition
	   '((type . "application/x-gzip")
	     (method . mime-decode-message/tar)
	     (mode . "play") ("type" . "tar")
	     ))

(set-atype 'mime-acting-condition
	   '((type . "application/x-tar")
	     (method . mime-decode-message/tar)
	     (mode . "play")
	     ))

;;; @ end
;;;

(provide 'mime-tar)

;;; mime-tar.el ends here