|
4
|
1 ;;; tm-image.el --- tm-view filter to display images in XEmacs or MULE buffers
|
|
|
2
|
|
70
|
3 ;; Copyright (C) 1995,1996 MORIOKA Tomohiko
|
|
4
|
4 ;; Copyright (C) 1996 Dan Rich
|
|
|
5
|
|
|
6 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
|
|
|
7 ;; Dan Rich <drich@morpheus.corp.sgi.com>
|
|
|
8 ;; Maintainer: MORIOKA Tomohiko <morioka@jaist.ac.jp>
|
|
|
9 ;; Created: 1995/12/15
|
|
96
|
10 ;; Version: $Id: tm-image.el,v 1.3 1997/02/08 03:26:13 steve Exp $
|
|
4
|
11
|
|
70
|
12 ;; Keywords: mail, news, MIME, multimedia, image, picture, X-Face
|
|
4
|
13
|
|
70
|
14 ;; This file is part of tm (Tools for MIME).
|
|
4
|
15
|
|
|
16 ;; This program is free software; you can redistribute it and/or
|
|
|
17 ;; modify it under the terms of the GNU General Public License as
|
|
|
18 ;; published by the Free Software Foundation; either version 2, or (at
|
|
|
19 ;; your option) any later version.
|
|
|
20
|
|
|
21 ;; This program is distributed in the hope that it will be useful, but
|
|
|
22 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
23 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
|
24 ;; General Public License for more details.
|
|
|
25
|
|
|
26 ;; You should have received a copy of the GNU General Public License
|
|
70
|
27 ;; along with this program; see the file COPYING. If not, write to
|
|
|
28 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
4
|
29 ;; Boston, MA 02111-1307, USA.
|
|
|
30
|
|
|
31 ;;; Commentary:
|
|
|
32 ;; If you use this program with MULE, please install
|
|
|
33 ;; etl8x16-bitmap.bdf font included in tl package.
|
|
|
34
|
|
|
35 ;;; Code:
|
|
|
36
|
|
|
37 (require 'tm-view)
|
|
|
38
|
|
|
39 (cond (running-xemacs
|
|
70
|
40 (require 'annotations)
|
|
|
41
|
|
|
42 (set-alist 'mime-viewer/content-filter-alist
|
|
|
43 "image/jpeg"
|
|
|
44 (if (featurep 'jpeg) ; Use built-in suport if available
|
|
|
45 (function mime-preview/filter-for-inline-image)
|
|
|
46 (function mime-preview/filter-for-image)
|
|
|
47 ))
|
|
|
48
|
|
|
49 (set-alist 'mime-viewer/content-filter-alist
|
|
|
50 "image/gif"
|
|
|
51 (if (featurep 'gif) ; Use built-in suport if available
|
|
|
52 (function mime-preview/filter-for-inline-image)
|
|
|
53 (function mime-preview/filter-for-image)
|
|
|
54 ))
|
|
4
|
55
|
|
70
|
56 (set-alist 'mime-viewer/content-filter-alist
|
|
|
57 "image/x-xpixmap"
|
|
|
58 (if (featurep 'xpm) ; Use built-in suport if available
|
|
|
59 (function mime-preview/filter-for-inline-image)
|
|
|
60 (function mime-preview/filter-for-image)
|
|
|
61 ))
|
|
|
62
|
|
|
63 (set-alist 'mime-viewer/content-filter-alist
|
|
|
64 "image/tiff" (function mime-preview/filter-for-image))
|
|
|
65 (set-alist 'mime-viewer/content-filter-alist
|
|
|
66 "image/x-tiff" (function mime-preview/filter-for-image))
|
|
4
|
67
|
|
70
|
68 (set-alist 'mime-viewer/content-filter-alist
|
|
|
69 "image/x-pic" (function mime-preview/filter-for-image))
|
|
|
70
|
|
|
71 (set-alist 'mime-viewer/content-filter-alist
|
|
|
72 "image/x-mag" (function mime-preview/filter-for-image))
|
|
|
73
|
|
|
74 (defvar tm-image/inline-image-types
|
|
|
75 (if (featurep 'gif)
|
|
|
76 (nconc
|
|
|
77 '("image/jpeg" "image/gif" "image/tiff"
|
|
|
78 "image/x-tiff" "image/x-pic" "image/x-mag"
|
|
|
79 "image/x-xbm" "image/x-xpixmap")
|
|
|
80 (if (featurep 'gif)
|
|
|
81 '("application/postscript")
|
|
|
82 )
|
|
|
83 )))
|
|
4
|
84
|
|
|
85 (defun bitmap-insert-xbm-file (file)
|
|
70
|
86 (let (gl)
|
|
|
87 (while (progn
|
|
|
88 (setq gl (make-glyph file))
|
|
|
89 (eq (image-instance-type (glyph-image-instance gl))
|
|
|
90 'text)
|
|
|
91 ))
|
|
|
92 (make-annotation gl (point) 'text)
|
|
4
|
93 ))
|
|
|
94
|
|
70
|
95 (defvar mime-viewer/image-converter-alist
|
|
|
96 '(("image/jpeg" . jpeg)
|
|
|
97 ("image/gif" . gif)
|
|
|
98 ("image/x-png" . png)
|
|
|
99 ("image/x-xpixmap" . xpm)
|
|
|
100 ))
|
|
|
101
|
|
|
102 (defvar mime-preview/x-face-function
|
|
|
103 (function mime-preview/x-face-function-use-highlight-headers))
|
|
|
104
|
|
4
|
105 (autoload 'highlight-headers "highlight-headers")
|
|
|
106
|
|
|
107 (defun mime-preview/x-face-function-use-highlight-headers ()
|
|
|
108 (highlight-headers (point-min) (re-search-forward "^$" nil t) t)
|
|
|
109 )
|
|
|
110 )
|
|
|
111 ((featurep 'mule)
|
|
|
112 ;; for MULE 2.* or mule merged EMACS
|
|
|
113 (require 'x-face-mule)
|
|
|
114
|
|
70
|
115 (defvar tm-image/inline-image-types '("image/x-mag" "image/x-xbm"))
|
|
4
|
116
|
|
70
|
117 (defvar mime-preview/x-face-function
|
|
|
118 (function x-face-decode-message-header))
|
|
4
|
119 ))
|
|
|
120
|
|
70
|
121 (defvar mime-viewer/shell-command "/bin/sh")
|
|
|
122 (defvar mime-viewer/shell-arguments '("-c"))
|
|
4
|
123
|
|
|
124 (defvar mime-viewer/ps-to-gif-command "pstogif")
|
|
|
125
|
|
70
|
126 (defvar mime-viewer/graphic-converter-alist
|
|
|
127 '(("image/jpeg" . "djpeg -color 256 < %s | ppmtoxpm > %s")
|
|
|
128 ("image/gif" . "giftopnm < %s | ppmtoxpm > %s")
|
|
|
129 ("image/tiff" . "tifftopnm < %s | ppmquant 256 | ppmtoxpm > %s")
|
|
|
130 ("image/x-tiff" . "tifftopnm < %s | ppmquant 256 | ppmtoxpm > %s")
|
|
|
131 ("image/x-pic" . "pictoppm < %s | ppmquant 256 | ppmtoxpm > %s")
|
|
|
132 ("image/x-mag" . "magtoppm < %s | ppmtoxpm > %s")
|
|
|
133 ))
|
|
|
134
|
|
|
135
|
|
|
136 ;;; @ X-Face
|
|
|
137 ;;;
|
|
|
138
|
|
|
139 (defvar mime-viewer/x-face-to-xbm-command
|
|
|
140 (concat mime-viewer/x-face-to-pbm-command " | pbmtoxbm"))
|
|
|
141
|
|
|
142 (if mime-preview/x-face-function
|
|
|
143 (add-hook 'mime-viewer/content-header-filter-hook
|
|
|
144 mime-preview/x-face-function)
|
|
|
145 )
|
|
|
146
|
|
4
|
147
|
|
|
148 ;;; @ content filter for images
|
|
|
149 ;;;
|
|
|
150 ;; (for XEmacs 19.12 or later)
|
|
|
151
|
|
|
152 (defun mime-preview/filter-for-image (ctype params encoding)
|
|
|
153 (let* ((mode mime::preview/original-major-mode)
|
|
|
154 (m (assq mode mime-viewer/code-converter-alist))
|
|
70
|
155 (filter (assoc-value ctype mime-viewer/graphic-converter-alist))
|
|
|
156 )
|
|
|
157 (if filter
|
|
|
158 (let* ((beg (point-min)) (end (point-max))
|
|
|
159 (orig-file
|
|
|
160 (make-temp-name (expand-file-name "tm" mime/tmp-dir)))
|
|
|
161 (xbm-file (concat orig-file ".xbm"))
|
|
|
162 gl annot)
|
|
|
163 ;;(remove-text-properties beg end '(face nil))
|
|
|
164 (mime-decode-region beg end encoding)
|
|
|
165 (write-region (point-min)(point-max) orig-file)
|
|
|
166 (delete-region (point-min)(point-max))
|
|
|
167 (message "Now translating, please wait...")
|
|
|
168 (apply (function call-process)
|
|
|
169 mime-viewer/shell-command nil nil nil
|
|
|
170 (append mime-viewer/shell-arguments
|
|
|
171 (list (format filter orig-file xbm-file)))
|
|
|
172 )
|
|
|
173 (setq gl (make-glyph xbm-file))
|
|
|
174 (setq annot (make-annotation gl (point) 'text))
|
|
|
175 (unwind-protect
|
|
|
176 (delete-file orig-file)
|
|
|
177 (condition-case nil
|
|
|
178 (delete-file xbm-file)
|
|
|
179 (error nil)))
|
|
|
180 (goto-char (point-max))
|
|
|
181 (insert "\n")
|
|
|
182 (message "Translation done.")
|
|
|
183 )
|
|
|
184 (message (format "%s is not supported." ctype))
|
|
|
185 )))
|
|
|
186
|
|
|
187
|
|
|
188 ;;; @ content filter for xbm
|
|
|
189 ;;;
|
|
|
190
|
|
|
191 (defun mime-preview/filter-for-image/xbm (ctype params encoding)
|
|
|
192 (let* ((mode mime::preview/original-major-mode)
|
|
|
193 (m (assq mode mime-viewer/code-converter-alist))
|
|
|
194 (charset (assoc "charset" params))
|
|
|
195 (beg (point-min)) (end (point-max))
|
|
|
196 (xbm-file (make-temp-name (expand-file-name "tm" mime/tmp-dir)))
|
|
|
197 )
|
|
|
198 (remove-text-properties beg end '(face nil))
|
|
|
199 (mime-decode-region beg end encoding)
|
|
|
200 (write-region (point-min)(point-max) xbm-file)
|
|
|
201 (delete-region (point-min)(point-max))
|
|
|
202 (bitmap-insert-xbm-file xbm-file)
|
|
|
203 (delete-file xbm-file)
|
|
|
204 ))
|
|
|
205
|
|
|
206 (set-alist 'mime-viewer/content-filter-alist
|
|
|
207 "image/xbm" (function mime-preview/filter-for-image/xbm))
|
|
|
208
|
|
|
209 (set-alist 'mime-viewer/content-filter-alist
|
|
|
210 "image/x-xbm" (function mime-preview/filter-for-image/xbm))
|
|
|
211
|
|
|
212
|
|
|
213 ;;; @ content filter for support in-line image types
|
|
|
214 ;;;
|
|
|
215 ;; (for XEmacs 19.14 or later)
|
|
|
216
|
|
|
217 (defun mime-preview/filter-for-inline-image (ctype params encoding)
|
|
|
218 (let* ((mode mime::preview/original-major-mode)
|
|
|
219 (m (assq mode mime-viewer/code-converter-alist))
|
|
4
|
220 (charset (assoc "charset" params))
|
|
|
221 (beg (point-min)) (end (point-max))
|
|
|
222 )
|
|
|
223 (remove-text-properties beg end '(face nil))
|
|
|
224 (mime-decode-region beg end encoding)
|
|
70
|
225 (let ((data (buffer-string))
|
|
|
226 (minor (assoc-value ctype mime-viewer/image-converter-alist))
|
|
96
|
227 gl e)
|
|
4
|
228 (delete-region (point-min)(point-max))
|
|
70
|
229 (while (progn
|
|
|
230 (setq gl (make-glyph (vector minor :data data)))
|
|
|
231 (eq (image-instance-type (glyph-image-instance gl))
|
|
|
232 'text)
|
|
|
233 ))
|
|
96
|
234 (setq e (make-extent (point) (point)))
|
|
|
235 (set-extent-end-glyph e gl)
|
|
4
|
236 )
|
|
|
237 (insert "\n")
|
|
|
238 ))
|
|
|
239
|
|
|
240
|
|
|
241 ;;; @ content filter for Postscript
|
|
|
242 ;;;
|
|
|
243 ;; (for XEmacs 19.14 or later)
|
|
|
244
|
|
|
245 (defun mime-preview/filter-for-application/postscript (ctype params encoding)
|
|
|
246 (let* ((mode mime::preview/original-major-mode)
|
|
|
247 (m (assq mode mime-viewer/code-converter-alist))
|
|
|
248 (beg (point-min)) (end (point-max))
|
|
|
249 (file-base (make-temp-name (expand-file-name "tm" mime/tmp-dir)))
|
|
|
250 (ps-file (concat file-base ".ps"))
|
|
|
251 (gif-file (concat file-base ".gif"))
|
|
|
252 )
|
|
|
253 (remove-text-properties beg end '(face nil))
|
|
|
254 (mime-decode-region beg end encoding)
|
|
|
255 (write-region (point-min)(point-max) ps-file)
|
|
|
256 (delete-region (point-min)(point-max))
|
|
|
257 (call-process mime-viewer/ps-to-gif-command nil nil nil ps-file)
|
|
70
|
258 (let (gl)
|
|
|
259 (while (progn
|
|
|
260 (setq gl (make-glyph (vector 'gif :file gif-file)))
|
|
|
261 (eq (image-instance-type (glyph-image-instance gl))
|
|
|
262 'text)
|
|
|
263 ))
|
|
|
264 (make-annotation gl (point) 'text)
|
|
|
265 )
|
|
4
|
266 (delete-file ps-file)
|
|
|
267 (delete-file gif-file)
|
|
|
268 ))
|
|
|
269
|
|
|
270 (set-alist 'mime-viewer/content-filter-alist
|
|
|
271 "application/postscript"
|
|
|
272 (function mime-preview/filter-for-application/postscript))
|
|
|
273
|
|
70
|
274
|
|
|
275 ;;; @ setting
|
|
|
276 ;;;
|
|
|
277
|
|
|
278 (mapcar
|
|
|
279 (lambda (ctype)
|
|
|
280 (or (member ctype mime-viewer/default-showing-Content-Type-list)
|
|
|
281 (setq mime-viewer/default-showing-Content-Type-list
|
|
|
282 (cons ctype
|
|
|
283 mime-viewer/default-showing-Content-Type-list))
|
|
|
284 ))
|
|
|
285 tm-image/inline-image-types)
|
|
4
|
286
|
|
|
287
|
|
|
288 ;;; @ end
|
|
|
289 ;;;
|
|
|
290
|
|
|
291 (provide 'tm-image)
|
|
|
292
|
|
|
293 ;;; tm-image.el ends here
|
