2 ;;; $Id: tm-tar.el,v 1.22 1995/10/21 15:34:33 H.Ueno Exp $
6 ;;; Internal viewer for
7 ;;; - application/x-tar
8 ;;; - application/x-gzip, type="tar"
9 ;;; - aplication/octet-stream, type="tar"
10 ;;; - aplication/octet-stream, type="tar+gzip"
12 ;;; by Hiroshi Ueno <zodiac@ibm.net>
13 ;;; modified by Tomohiko Morioka <morioka@jaist.ac.jp>
16 ;;; @ required modules
25 (defconst tm-tar/list-buffer "*tm-tar/List*")
26 (defconst tm-tar/view-buffer "*tm-tar/View*")
27 (defconst tm-tar/file-search-regexp "[0-9]+\:[0-9\:]+[ ]+[0-9]+[ ]+")
28 (defconst tm-tar/popup-menu-title "Action Menu")
33 (defvar tm-tar/tar-program "gtar")
34 (defvar tm-tar/tar-decompress-arg '("-z"))
35 (defvar tm-tar/gzip-program "gzip")
36 (defvar tm-tar/mmencode-program "mmencode")
37 (defvar tm-tar/uudecode-program "uudecode")
39 (defvar tm-tar/popup-menu-items
40 '(("View File" . tm-tar/view-file)
41 ("Key Help" . tm-tar/helpful-message)
42 ("Quit tm-tar Mode" . exit-recursive-edit)
45 (cond ((string-match "XEmacs\\|Lucid" emacs-version)
46 (defvar tm-tar/popup-menu
47 (cons tm-tar/popup-menu-title
50 (vector (car item)(cdr item) t)
52 tm-tar/popup-menu-items)))
54 (defun tm-tar/mouse-button-2 (event)
55 (popup-menu tm-tar/popup-menu)
58 ((>= emacs-major-version 19)
59 (defun tm-tar/mouse-button-2 (event)
61 (cons tm-tar/popup-menu-title
62 (list (cons "Menu Items" tm-tar/popup-menu-items))
64 (let ((func (x-popup-menu event menu)))
71 (defvar tm-tar/tar-mode-map nil)
72 (if tm-tar/tar-mode-map
74 (setq tm-tar/tar-mode-map (make-keymap))
75 (suppress-keymap tm-tar/tar-mode-map)
76 (define-key tm-tar/tar-mode-map "\C-c" 'exit-recursive-edit)
77 (define-key tm-tar/tar-mode-map "q" 'exit-recursive-edit)
78 (define-key tm-tar/tar-mode-map "n" 'tm-tar/next-line)
79 (define-key tm-tar/tar-mode-map " " 'tm-tar/next-line)
80 (define-key tm-tar/tar-mode-map "\C-m" 'tm-tar/next-line)
81 (define-key tm-tar/tar-mode-map "p" 'tm-tar/previous-line)
82 (define-key tm-tar/tar-mode-map "\177" 'tm-tar/previous-line)
83 (define-key tm-tar/tar-mode-map "\C-\M-m" 'tm-tar/previous-line)
84 (define-key tm-tar/tar-mode-map "v" 'tm-tar/view-file)
85 (define-key tm-tar/tar-mode-map "\C-h" 'Helper-help)
86 (define-key tm-tar/tar-mode-map "?" 'tm-tar/helpful-message)
88 (define-key tm-tar/tar-mode-map
89 mouse-button-2 'tm:button-dispatcher)
93 ;;; @@ tm-tar mode functions
96 (defun tm-tar/tar-mode (&optional prev-buf)
97 "Major mode for listing the contents of a tar archive file."
99 (let ((buffer-read-only t)
101 (mode-line-buffer-identification '("%17b"))
103 (goto-char (point-min))
104 (tm-tar/move-to-filename)
105 (catch 'tm-tar/tar-mode (tm-tar/command-loop))
108 (switch-to-buffer prev-buf)
112 (defun tm-tar/command-loop ()
113 (let ((old-local-map (current-local-map))
117 (use-local-map tm-tar/tar-mode-map)
118 (tm-tar/helpful-message)
122 (use-local-map old-local-map)
126 (defun tm-tar/next-line ()
129 (tm-tar/move-to-filename)
132 (defun tm-tar/previous-line ()
135 (tm-tar/move-to-filename)
138 (defun tm-tar/view-file ()
140 (let ((name (tm-tar/get-filename))
143 (switch-to-buffer tm-tar/view-buffer)
144 (setq buffer-read-only nil)
146 (message "Reading a file from an archive. Please wait...")
147 (apply 'call-process tm-tar/tar-program
148 nil t nil (append tm-tar/view-args (list name)))
149 (goto-char (point-min))
151 (view-buffer tm-tar/view-buffer)
154 (defun tm-tar/get-filename ()
161 (if (re-search-forward "^d" eol t)
162 (error "Cannot view a directory"))
164 (if (re-search-forward tm-tar/file-search-regexp eol t)
165 (progn (let ((beg (point))
167 (skip-chars-forward "^ \n")
168 (buffer-substring beg (point))
170 (error "No file on this line")
174 (defun tm-tar/move-to-filename ()
175 (let ((eol (progn (end-of-line) (point)))
178 (re-search-forward tm-tar/file-search-regexp eol t)
181 (defun tm-tar/set-properties ()
183 (let ((beg (point-min))
188 (while (re-search-forward tm-tar/file-search-regexp end t)
189 (tm:add-button (point)
197 (defun tm-tar/helpful-message ()
199 (message "Type %s, %s, %s, %s, %s, %s."
200 (substitute-command-keys "\\[Helper-help] for help")
201 (substitute-command-keys "\\[tm-tar/helpful-message] for keys")
202 (substitute-command-keys "\\[tm-tar/next-line] to next")
203 (substitute-command-keys "\\[tm-tar/previous-line] to prev")
204 (substitute-command-keys "\\[tm-tar/view-file] to view")
205 (substitute-command-keys "\\[exit-recursive-edit] to quit")
208 (defun tm-tar/y-or-n-p (prompt)
214 ;;; @@ tar message decoder
217 (defun mime/decode-message/tar (beg end cal)
218 (if (tm-tar/y-or-n-p "Do you want to enter tm-tar mode? ")
219 (let ((coding (cdr (assoc 'encoding cal)))
220 (cur-buf (current-buffer))
221 (tm-tar/tar-file-name (expand-file-name (concat (make-temp-name
222 (expand-file-name "tm" mime/tmp-dir)) ".tar")))
223 (tm-tar/tmp-file-name (expand-file-name (make-temp-name
224 (expand-file-name "tm" mime/tmp-dir))))
227 (find-file tm-tar/tmp-file-name)
228 (setq new-buf (current-buffer))
229 (setq buffer-read-only nil)
234 (re-search-forward "^$")
235 (append-to-buffer new-buf (+ (match-end 0) 1) end)
237 (if (member coding mime-viewer/uuencode-encoding-name-list)
239 (goto-char (point-min))
240 (if (re-search-forward "^begin [0-9]+ " nil t)
243 (insert tm-tar/tar-file-name)
246 (set-buffer-modified-p nil)
247 (kill-buffer new-buf)
248 (error "uuencode file signature was not found")
251 (kill-buffer new-buf)
252 (message "Listing the contents of an archive. Please wait...")
253 (cond ((string-equal coding "base64")
254 (call-process tm-tar/mmencode-program nil nil nil "-u"
255 "-o" tm-tar/tar-file-name tm-tar/tmp-file-name)
257 ((string-equal coding "quoted-printable")
258 (call-process tm-tar/mmencode-program nil nil nil "-u" "-q"
259 "-o" tm-tar/tar-file-name tm-tar/tmp-file-name)
261 ((member coding mime-viewer/uuencode-encoding-name-list)
262 (call-process tm-tar/uudecode-program nil nil nil
263 tm-tar/tmp-file-name)
266 (copy-file tm-tar/tmp-file-name tm-tar/tar-file-name t)
268 (delete-file tm-tar/tmp-file-name)
269 (setq tm-tar/list-args (list "-tvf" tm-tar/tar-file-name))
270 (setq tm-tar/view-args (list "-xOf" tm-tar/tar-file-name))
271 (if (eq 0 (call-process tm-tar/gzip-program
272 nil nil nil "-t" tm-tar/tar-file-name))
274 (setq tm-tar/list-args
275 (append tm-tar/tar-decompress-arg tm-tar/list-args))
276 (setq tm-tar/view-args
277 (append tm-tar/tar-decompress-arg tm-tar/view-args))
279 (switch-to-buffer tm-tar/view-buffer)
280 (switch-to-buffer tm-tar/list-buffer)
281 (setq buffer-read-only nil)
283 (apply 'call-process tm-tar/tar-program
284 nil t nil tm-tar/list-args)
287 (make-local-variable 'tm:mother-button-dispatcher)
288 (setq tm:mother-button-dispatcher 'tm-tar/mouse-button-2)
290 (tm-tar/set-properties)
291 (tm-tar/tar-mode mime::article/preview-buffer)
292 (kill-buffer tm-tar/view-buffer)
293 (kill-buffer tm-tar/list-buffer)
294 (delete-file tm-tar/tar-file-name)
298 ;;; @@ program/buffer coding system
301 (cond ((boundp 'MULE)
302 (define-program-coding-system tm-tar/view-buffer nil *autoconv*)
305 (define-program-kanji-code tm-tar/view-buffer nil 1)
308 ;;; @@ message types to use tm-tar
311 (set-atype 'mime/content-decoding-condition
312 '((type . "application/octet-stream")
313 (method . mime/decode-message/tar)
314 (mode . "play") ("type" . "tar")
317 (set-atype 'mime/content-decoding-condition
318 '((type . "application/octet-stream")
319 (method . mime/decode-message/tar)
320 (mode . "play") ("type" . "tar+gzip")
323 (set-atype 'mime/content-decoding-condition
324 '((type . "application/x-gzip")
325 (method . mime/decode-message/tar)
326 (mode . "play") ("type" . "tar")
329 (set-atype 'mime/content-decoding-condition
330 '((type . "application/x-tar")
331 (method . mime/decode-message/tar)
342 ;;; mode: outline-minor
343 ;;; outline-regexp: ";;; @+\\|(......"