1 ;;; mime-tar.el --- mime-view internal method for tar or tar+gzip format
3 ;; Copyright (C) 1995,1996,1997 Free Software Foundation, Inc.
5 ;; Author: Hiroshi Ueno <zodiac@ibm.net>
6 ;; modified by MORIOKA Tomohiko <morioka@jaist.ac.jp>
7 ;; Renamed: 1997/2/26 from tm-tar.el
8 ;; Version: $Id: mime-tar.el,v 0.7 1997-05-12 12:30:42 morioka Exp $
9 ;; Keywords: tar, tar+gzip, MIME, multimedia, mail, news
11 ;; This file is part of SEMI (SEMI is Emacs MIME Interfaces).
13 ;; This program is free software; you can redistribute it and/or
14 ;; modify it under the terms of the GNU General Public License as
15 ;; published by the Free Software Foundation; either version 2, or (at
16 ;; your option) any later version.
18 ;; This program is distributed in the hope that it will be useful, but
19 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
21 ;; General Public License for more details.
23 ;; You should have received a copy of the GNU General Public License
24 ;; along with GNU Emacs; see the file COPYING. If not, write to the
25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
26 ;; Boston, MA 02111-1307, USA.
30 ;; Internal viewer for
31 ;; - application/x-tar
32 ;; - application/x-gzip, type="tar"
33 ;; - aplication/octet-stream, type="tar"
34 ;; - aplication/octet-stream, type="tar+gzip"
44 (defconst mime-tar-list-buffer "*mime-tar-List*")
45 (defconst mime-tar-view-buffer "*mime-tar-View*")
46 (defconst mime-tar-file-search-regexp "[0-9]+\:[0-9\:]+[ ]+[0-9]+[ ]+")
47 (defconst mime-tar-popup-menu-title "Action Menu")
53 (defvar mime-tar-program "gtar")
54 (defvar mime-tar-decompress-arg '("-z"))
55 (defvar mime-tar-gzip-program "gzip")
56 (defvar mime-tar-mmencode-program "mmencode")
57 (defvar mime-tar-uudecode-program "uudecode")
59 (defvar mime-tar-popup-menu-items
60 '(("View File" . mime-tar-view-file)
61 ("Key Help" . mime-tar-helpful-message)
62 ("Quit mime-tar Mode" . exit-recursive-edit)
65 (cond ((string-match "XEmacs\\|Lucid" emacs-version)
66 (defvar mime-tar-popup-menu
67 (cons mime-tar-popup-menu-title
70 (vector (car item)(cdr item) t)
72 mime-tar-popup-menu-items)))
74 (defun mime-tar-mouse-button-2 (event)
75 (popup-menu mime-tar-popup-menu)
78 ((>= emacs-major-version 19)
79 (defun mime-tar-mouse-button-2 (event)
81 (cons mime-tar-popup-menu-title
82 (list (cons "Menu Items" mime-tar-popup-menu-items))
84 (let ((func (x-popup-menu event menu)))
91 (defvar mime-tar-mode-map nil)
94 (setq mime-tar-mode-map (make-keymap))
95 (suppress-keymap mime-tar-mode-map)
96 (define-key mime-tar-mode-map "\C-c" 'exit-recursive-edit)
97 (define-key mime-tar-mode-map "q" 'exit-recursive-edit)
98 (define-key mime-tar-mode-map "n" 'mime-tar-next-line)
99 (define-key mime-tar-mode-map " " 'mime-tar-next-line)
100 (define-key mime-tar-mode-map "\C-m" 'mime-tar-next-line)
101 (define-key mime-tar-mode-map "p" 'mime-tar-previous-line)
102 (define-key mime-tar-mode-map "\177" 'mime-tar-previous-line)
103 (define-key mime-tar-mode-map "\C-\M-m" 'mime-tar-previous-line)
104 (define-key mime-tar-mode-map "v" 'mime-tar-view-file)
105 (define-key mime-tar-mode-map "\C-h" 'Helper-help)
106 (define-key mime-tar-mode-map "?" 'mime-tar-helpful-message)
108 (define-key mime-tar-mode-map
109 mouse-button-2 'mime-button-dispatcher))
113 ;;; @@ mime-tar mode functions
116 (defun mime-tar-mode (&optional prev-buf)
117 "Major mode for listing the contents of a tar archive file."
119 (let ((buffer-read-only t)
120 (mode-name "mime-tar")
121 (mode-line-buffer-identification '("%17b"))
123 (goto-char (point-min))
124 (mime-tar-move-to-filename)
125 (catch 'mime-tar-mode (mime-tar-command-loop))
128 (switch-to-buffer prev-buf)
132 (defun mime-tar-command-loop ()
133 (let ((old-local-map (current-local-map)))
136 (use-local-map mime-tar-mode-map)
137 (mime-tar-helpful-message)
141 (use-local-map old-local-map)
145 (defun mime-tar-next-line ()
148 (mime-tar-move-to-filename)
151 (defun mime-tar-previous-line ()
154 (mime-tar-move-to-filename)
157 (defun mime-tar-view-file ()
159 (let ((name (mime-tar-get-filename))
162 (switch-to-buffer mime-tar-view-buffer)
163 (setq buffer-read-only nil)
165 (message "Reading a file from an archive. Please wait...")
166 (apply 'call-process mime-tar-program
167 nil t nil (append mime-tar-view-args (list name)))
168 (goto-char (point-min))
170 (view-buffer mime-tar-view-buffer)
173 (defun mime-tar-get-filename ()
180 (if (re-search-forward "^d" eol t)
181 (error "Cannot view a directory"))
183 (if (re-search-forward mime-tar-file-search-regexp eol t)
185 (skip-chars-forward "^ \n")
186 (buffer-substring beg (point))
188 (error "No file on this line")
192 (defun mime-tar-move-to-filename ()
193 (let ((eol (progn (end-of-line) (point))))
195 (re-search-forward mime-tar-file-search-regexp eol t)
198 (defun mime-tar-set-properties ()
200 (let ((beg (point-min))
205 (while (re-search-forward mime-tar-file-search-regexp end t)
206 (mime-add-button (point)
214 (defun mime-tar-helpful-message ()
216 (message "Type %s, %s, %s, %s, %s, %s."
217 (substitute-command-keys "\\[Helper-help] for help")
218 (substitute-command-keys "\\[mime-tar-helpful-message] for keys")
219 (substitute-command-keys "\\[mime-tar-next-line] to next")
220 (substitute-command-keys "\\[mime-tar-previous-line] to prev")
221 (substitute-command-keys "\\[mime-tar-view-file] to view")
222 (substitute-command-keys "\\[exit-recursive-edit] to quit")
225 (defun mime-tar-y-or-n-p (prompt)
231 ;;; @@ tar message decoder
234 (defun mime-decode-message/tar (beg end cal)
235 (if (mime-tar-y-or-n-p "Do you want to enter mime-tar mode? ")
236 (let ((coding (cdr (assoc 'encoding cal)))
237 (cur-buf (current-buffer))
240 (concat (make-temp-name
241 (expand-file-name "tm" mime-temp-directory)) ".tar")))
242 (mime-tar-tmp-file-name
244 (make-temp-name (expand-file-name "tm" mime-temp-directory))))
246 (find-file mime-tar-tmp-file-name)
247 (setq new-buf (current-buffer))
248 (setq buffer-read-only nil)
253 (re-search-forward "^$")
254 (append-to-buffer new-buf (+ (match-end 0) 1) end)
256 (if (member coding mime-view-uuencode-encoding-name-list)
258 (goto-char (point-min))
259 (if (re-search-forward "^begin [0-9]+ " nil t)
262 (insert mime-tar-file-name)
265 (set-buffer-modified-p nil)
266 (kill-buffer new-buf)
267 (error "uuencode file signature was not found")
270 (kill-buffer new-buf)
271 (message "Listing the contents of an archive. Please wait...")
272 (cond ((string-equal coding "base64")
273 (call-process mime-tar-mmencode-program nil nil nil "-u"
274 "-o" mime-tar-file-name mime-tar-tmp-file-name)
276 ((string-equal coding "quoted-printable")
277 (call-process mime-tar-mmencode-program nil nil nil "-u" "-q"
278 "-o" mime-tar-file-name mime-tar-tmp-file-name)
280 ((member coding mime-view-uuencode-encoding-name-list)
281 (call-process mime-tar-uudecode-program nil nil nil
282 mime-tar-tmp-file-name)
285 (copy-file mime-tar-tmp-file-name mime-tar-file-name t)
287 (delete-file mime-tar-tmp-file-name)
288 (setq mime-tar-list-args (list "-tvf" mime-tar-file-name))
289 (setq mime-tar-view-args (list "-xOf" mime-tar-file-name))
290 (if (eq 0 (call-process mime-tar-gzip-program
291 nil nil nil "-t" mime-tar-file-name))
293 (setq mime-tar-list-args
294 (append mime-tar-decompress-arg mime-tar-list-args))
295 (setq mime-tar-view-args
296 (append mime-tar-decompress-arg mime-tar-view-args))
298 (switch-to-buffer mime-tar-view-buffer)
299 (switch-to-buffer mime-tar-list-buffer)
300 (setq buffer-read-only nil)
302 (apply 'call-process mime-tar-program
303 nil t nil mime-tar-list-args)
306 (make-local-variable 'mime-button-mother-dispatcher)
307 (setq mime-button-mother-dispatcher 'mime-tar-mouse-button-2)
309 (mime-tar-set-properties)
310 (mime-tar-mode mime-view-buffer)
311 (kill-buffer mime-tar-view-buffer)
312 (kill-buffer mime-tar-list-buffer)
313 (delete-file mime-tar-file-name)
317 ;;; @@ program/buffer coding system
320 (cond ((boundp 'MULE)
321 (define-program-coding-system mime-tar-view-buffer nil '*autoconv*)
324 (define-program-kanji-code mime-tar-view-buffer nil 1)
327 ;;; @@ message types to use mime-tar
330 (set-atype 'mime-acting-condition
331 '((type . "application/octet-stream")
332 (method . mime-decode-message/tar)
333 (mode . "play") ("type" . "tar")
336 (set-atype 'mime-acting-condition
337 '((type . "application/octet-stream")
338 (method . mime-decode-message/tar)
339 (mode . "play") ("type" . "tar+gzip")
342 (set-atype 'mime-acting-condition
343 '((type . "application/x-gzip")
344 (method . mime-decode-message/tar)
345 (mode . "play") ("type" . "tar")
348 (set-atype 'mime-acting-condition
349 '((type . "application/x-tar")
350 (method . mime-decode-message/tar)
359 ;;; mime-tar.el ends here