|
4
|
1 ;;;
|
|
70
|
2 ;;; $Id: tm-tar.el,v 1.1.1.1 1996/12/18 22:43:37 steve Exp $
|
|
4
|
3 ;;;
|
|
|
4 ;;; tm-tar.el
|
|
|
5 ;;;
|
|
|
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"
|
|
|
11 ;;;
|
|
|
12 ;;; by Hiroshi Ueno <zodiac@ibm.net>
|
|
|
13 ;;; modified by Tomohiko Morioka <morioka@jaist.ac.jp>
|
|
|
14 ;;;
|
|
|
15
|
|
|
16 ;;; @ required modules
|
|
|
17 ;;;
|
|
|
18
|
|
|
19 (require 'emu)
|
|
|
20 (require 'tm-view)
|
|
|
21
|
|
|
22 ;;; @ constants
|
|
|
23 ;;;
|
|
|
24
|
|
|
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")
|
|
|
29
|
|
|
30 ;;; @ variables
|
|
|
31 ;;;
|
|
|
32
|
|
|
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")
|
|
|
38
|
|
|
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)
|
|
|
43 ))
|
|
|
44
|
|
|
45 (cond ((string-match "XEmacs\\|Lucid" emacs-version)
|
|
|
46 (defvar tm-tar/popup-menu
|
|
|
47 (cons tm-tar/popup-menu-title
|
|
|
48 (mapcar (function
|
|
|
49 (lambda (item)
|
|
|
50 (vector (car item)(cdr item) t)
|
|
|
51 ))
|
|
|
52 tm-tar/popup-menu-items)))
|
|
|
53
|
|
|
54 (defun tm-tar/mouse-button-2 (event)
|
|
|
55 (popup-menu tm-tar/popup-menu)
|
|
|
56 )
|
|
|
57 )
|
|
|
58 ((>= emacs-major-version 19)
|
|
|
59 (defun tm-tar/mouse-button-2 (event)
|
|
|
60 (let ((menu
|
|
|
61 (cons tm-tar/popup-menu-title
|
|
|
62 (list (cons "Menu Items" tm-tar/popup-menu-items))
|
|
|
63 )))
|
|
|
64 (let ((func (x-popup-menu event menu)))
|
|
|
65 (if func
|
|
|
66 (funcall func)
|
|
|
67 ))
|
|
|
68 ))
|
|
|
69 ))
|
|
|
70
|
|
|
71 (defvar tm-tar/tar-mode-map nil)
|
|
|
72 (if tm-tar/tar-mode-map
|
|
|
73 nil
|
|
|
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)
|
|
|
87 (if mouse-button-2
|
|
|
88 (define-key tm-tar/tar-mode-map
|
|
|
89 mouse-button-2 'tm:button-dispatcher)
|
|
|
90 )
|
|
|
91 )
|
|
|
92
|
|
|
93 ;;; @@ tm-tar mode functions
|
|
|
94 ;;;
|
|
|
95
|
|
|
96 (defun tm-tar/tar-mode (&optional prev-buf)
|
|
|
97 "Major mode for listing the contents of a tar archive file."
|
|
|
98 (unwind-protect
|
|
|
99 (let ((buffer-read-only t)
|
|
|
100 (mode-name "tm-tar")
|
|
|
101 (mode-line-buffer-identification '("%17b"))
|
|
|
102 )
|
|
|
103 (goto-char (point-min))
|
|
|
104 (tm-tar/move-to-filename)
|
|
|
105 (catch 'tm-tar/tar-mode (tm-tar/command-loop))
|
|
|
106 )
|
|
|
107 (if prev-buf
|
|
|
108 (switch-to-buffer prev-buf)
|
|
|
109 )
|
|
|
110 ))
|
|
|
111
|
|
|
112 (defun tm-tar/command-loop ()
|
|
|
113 (let ((old-local-map (current-local-map))
|
|
|
114 )
|
|
|
115 (unwind-protect
|
|
|
116 (progn
|
|
|
117 (use-local-map tm-tar/tar-mode-map)
|
|
|
118 (tm-tar/helpful-message)
|
|
|
119 (recursive-edit)
|
|
|
120 )
|
|
|
121 (save-excursion
|
|
|
122 (use-local-map old-local-map)
|
|
|
123 ))
|
|
|
124 ))
|
|
|
125
|
|
|
126 (defun tm-tar/next-line ()
|
|
|
127 (interactive)
|
|
|
128 (next-line 1)
|
|
|
129 (tm-tar/move-to-filename)
|
|
|
130 )
|
|
|
131
|
|
|
132 (defun tm-tar/previous-line ()
|
|
|
133 (interactive)
|
|
|
134 (previous-line 1)
|
|
|
135 (tm-tar/move-to-filename)
|
|
|
136 )
|
|
|
137
|
|
|
138 (defun tm-tar/view-file ()
|
|
|
139 (interactive)
|
|
|
140 (let ((name (tm-tar/get-filename))
|
|
|
141 )
|
|
|
142 (save-excursion
|
|
|
143 (switch-to-buffer tm-tar/view-buffer)
|
|
|
144 (setq buffer-read-only nil)
|
|
|
145 (erase-buffer)
|
|
|
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))
|
|
|
150 )
|
|
|
151 (view-buffer tm-tar/view-buffer)
|
|
|
152 ))
|
|
|
153
|
|
|
154 (defun tm-tar/get-filename ()
|
|
|
155 (let (eol)
|
|
|
156 (save-excursion
|
|
|
157 (end-of-line)
|
|
|
158 (setq eol (point))
|
|
|
159 (beginning-of-line)
|
|
|
160 (save-excursion
|
|
|
161 (if (re-search-forward "^d" eol t)
|
|
|
162 (error "Cannot view a directory"))
|
|
|
163 )
|
|
|
164 (if (re-search-forward tm-tar/file-search-regexp eol t)
|
|
|
165 (progn (let ((beg (point))
|
|
|
166 )
|
|
|
167 (skip-chars-forward "^ \n")
|
|
|
168 (buffer-substring beg (point))
|
|
|
169 ))
|
|
|
170 (error "No file on this line")
|
|
|
171 ))
|
|
|
172 ))
|
|
|
173
|
|
|
174 (defun tm-tar/move-to-filename ()
|
|
|
175 (let ((eol (progn (end-of-line) (point)))
|
|
|
176 )
|
|
|
177 (beginning-of-line)
|
|
|
178 (re-search-forward tm-tar/file-search-regexp eol t)
|
|
|
179 ))
|
|
|
180
|
|
|
181 (defun tm-tar/set-properties ()
|
|
|
182 (if mouse-button-2
|
|
|
183 (let ((beg (point-min))
|
|
|
184 (end (point-max))
|
|
|
185 )
|
|
|
186 (goto-char beg)
|
|
|
187 (save-excursion
|
|
|
188 (while (re-search-forward tm-tar/file-search-regexp end t)
|
|
|
189 (tm:add-button (point)
|
|
|
190 (progn
|
|
|
191 (end-of-line)
|
|
|
192 (point))
|
|
|
193 'tm-tar/view-file)
|
|
|
194 ))
|
|
|
195 )))
|
|
|
196
|
|
|
197 (defun tm-tar/helpful-message ()
|
|
|
198 (interactive)
|
|
|
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")
|
|
|
206 ))
|
|
|
207
|
|
|
208 (defun tm-tar/y-or-n-p (prompt)
|
|
|
209 (prog1
|
|
|
210 (y-or-n-p prompt)
|
|
|
211 (message "")
|
|
|
212 ))
|
|
|
213
|
|
|
214 ;;; @@ tar message decoder
|
|
|
215 ;;
|
|
|
216
|
|
|
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))))
|
|
|
225 new-buf
|
|
|
226 )
|
|
|
227 (find-file tm-tar/tmp-file-name)
|
|
|
228 (setq new-buf (current-buffer))
|
|
|
229 (setq buffer-read-only nil)
|
|
|
230 (erase-buffer)
|
|
|
231 (save-excursion
|
|
|
232 (set-buffer cur-buf)
|
|
|
233 (goto-char beg)
|
|
|
234 (re-search-forward "^$")
|
|
|
235 (append-to-buffer new-buf (+ (match-end 0) 1) end)
|
|
|
236 )
|
|
|
237 (if (member coding mime-viewer/uuencode-encoding-name-list)
|
|
|
238 (progn
|
|
|
239 (goto-char (point-min))
|
|
|
240 (if (re-search-forward "^begin [0-9]+ " nil t)
|
|
|
241 (progn
|
|
|
242 (kill-line)
|
|
|
243 (insert tm-tar/tar-file-name)
|
|
|
244 )
|
|
|
245 (progn
|
|
|
246 (set-buffer-modified-p nil)
|
|
|
247 (kill-buffer new-buf)
|
|
|
248 (error "uuencode file signature was not found")
|
|
|
249 ))))
|
|
|
250 (save-buffer)
|
|
|
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)
|
|
|
256 )
|
|
|
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)
|
|
|
260 )
|
|
|
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)
|
|
|
264 )
|
|
|
265 (t
|
|
|
266 (copy-file tm-tar/tmp-file-name tm-tar/tar-file-name t)
|
|
|
267 ))
|
|
|
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))
|
|
|
273 (progn
|
|
|
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))
|
|
|
278 ))
|
|
|
279 (switch-to-buffer tm-tar/view-buffer)
|
|
|
280 (switch-to-buffer tm-tar/list-buffer)
|
|
|
281 (setq buffer-read-only nil)
|
|
|
282 (erase-buffer)
|
|
|
283 (apply 'call-process tm-tar/tar-program
|
|
|
284 nil t nil tm-tar/list-args)
|
|
|
285 (if mouse-button-2
|
|
|
286 (progn
|
|
|
287 (make-local-variable 'tm:mother-button-dispatcher)
|
|
|
288 (setq tm:mother-button-dispatcher 'tm-tar/mouse-button-2)
|
|
|
289 ))
|
|
|
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)
|
|
|
295 )
|
|
|
296 ))
|
|
|
297
|
|
|
298 ;;; @@ program/buffer coding system
|
|
|
299 ;;;
|
|
|
300
|
|
|
301 (cond ((boundp 'MULE)
|
|
|
302 (define-program-coding-system tm-tar/view-buffer nil *autoconv*)
|
|
|
303 )
|
|
|
304 ((boundp 'NEMACS)
|
|
|
305 (define-program-kanji-code tm-tar/view-buffer nil 1)
|
|
|
306 ))
|
|
|
307
|
|
|
308 ;;; @@ message types to use tm-tar
|
|
|
309 ;;;
|
|
|
310
|
|
|
311 (set-atype 'mime/content-decoding-condition
|
|
|
312 '((type . "application/octet-stream")
|
|
|
313 (method . mime/decode-message/tar)
|
|
|
314 (mode . "play") ("type" . "tar")
|
|
|
315 ))
|
|
|
316
|
|
|
317 (set-atype 'mime/content-decoding-condition
|
|
|
318 '((type . "application/octet-stream")
|
|
|
319 (method . mime/decode-message/tar)
|
|
|
320 (mode . "play") ("type" . "tar+gzip")
|
|
|
321 ))
|
|
|
322
|
|
|
323 (set-atype 'mime/content-decoding-condition
|
|
|
324 '((type . "application/x-gzip")
|
|
|
325 (method . mime/decode-message/tar)
|
|
|
326 (mode . "play") ("type" . "tar")
|
|
|
327 ))
|
|
|
328
|
|
|
329 (set-atype 'mime/content-decoding-condition
|
|
|
330 '((type . "application/x-tar")
|
|
|
331 (method . mime/decode-message/tar)
|
|
|
332 (mode . "play")
|
|
|
333 ))
|
|
|
334
|
|
|
335 ;;; @ end
|
|
|
336 ;;;
|
|
|
337
|
|
|
338 (provide 'tm-tar)
|
|
|
339
|
|
|
340 ;;; Local Variables:
|
|
|
341 ;;; mode: emacs-lisp
|
|
|
342 ;;; mode: outline-minor
|
|
|
343 ;;; outline-regexp: ";;; @+\\|(......"
|
|
|
344 ;;; End:
|
