|
4
|
1 ;;; tm-image.el --- tm-view filter to display images in XEmacs or MULE buffers
|
|
|
2
|
|
98
|
3 ;; Copyright (C) 1995,1996,1997 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
|
|
98
|
10 ;; Version: $Id: tm-image.el,v 1.4 1997/02/15 22:21:29 steve Exp $
|
|
4
|
11
|
|
98
|
12 ;; Keywords: image, picture, X-Face, MIME, multimedia, mail, news
|
|
4
|
13
|
|
98
|
14 ;; This file is part of XEmacs.
|
|
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
|
|
98
|
27 ;; along with GNU XEmacs; see the file COPYING. If not, write to the
|
|
|
28 ;; 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
|
|
98
|
40 (require 'images)
|
|
4
|
41
|
|
98
|
42 (defun-maybe image-inline-p (format)
|
|
|
43 (or (memq format image-native-formats)
|
|
|
44 (find-if (function
|
|
|
45 (lambda (native)
|
|
|
46 (image-converter-chain format native)
|
|
|
47 ))
|
|
|
48 image-native-formats)
|
|
|
49 ))
|
|
4
|
50
|
|
98
|
51 (image-register-netpbm-utilities)
|
|
|
52 (image-register-converter 'pic 'ppm "pictoppm")
|
|
|
53 (image-register-converter 'mag 'ppm "magtoppm")
|
|
4
|
54
|
|
|
55 (defun bitmap-insert-xbm-file (file)
|
|
98
|
56 (let ((gl (make-glyph (list (cons 'x file))))
|
|
|
57 (e (make-extent (point) (point)))
|
|
|
58 )
|
|
|
59 (set-extent-end-glyph e gl)
|
|
4
|
60 ))
|
|
|
61
|
|
98
|
62 ;;
|
|
|
63 ;; X-Face
|
|
|
64 ;;
|
|
4
|
65 (autoload 'highlight-headers "highlight-headers")
|
|
|
66
|
|
|
67 (defun mime-preview/x-face-function-use-highlight-headers ()
|
|
|
68 (highlight-headers (point-min) (re-search-forward "^$" nil t) t)
|
|
|
69 )
|
|
98
|
70
|
|
|
71 (add-hook 'mime-viewer/content-header-filter-hook
|
|
|
72 'mime-preview/x-face-function-use-highlight-headers)
|
|
|
73
|
|
4
|
74 )
|
|
|
75 ((featurep 'mule)
|
|
|
76 ;; for MULE 2.* or mule merged EMACS
|
|
|
77 (require 'x-face-mule)
|
|
98
|
78
|
|
|
79 (defvar image-native-formats '(xbm))
|
|
4
|
80
|
|
98
|
81 (defun-maybe image-inline-p (format)
|
|
|
82 (memq format image-native-formats)
|
|
|
83 )
|
|
4
|
84
|
|
98
|
85 (defun-maybe image-normalize (format data)
|
|
|
86 (and (eq format 'xbm)
|
|
|
87 (vector 'xbm ':data data)
|
|
|
88 ))
|
|
|
89
|
|
|
90 ;;
|
|
|
91 ;; X-Face
|
|
|
92 ;;
|
|
|
93 (if (file-installed-p uncompface-program exec-path)
|
|
|
94 (add-hook 'mime-viewer/content-header-filter-hook
|
|
|
95 'x-face-decode-message-header)
|
|
|
96 )
|
|
4
|
97 ))
|
|
|
98
|
|
98
|
99 (or (fboundp 'image-invalid-glyph-p)
|
|
|
100 (defsubst image-invalid-glyph-p (glyph)
|
|
|
101 (or (null (aref glyph 0))
|
|
|
102 (null (aref glyph 2))
|
|
|
103 (equal (aref glyph 2) "")
|
|
|
104 ))
|
|
|
105 )
|
|
|
106
|
|
|
107 (defvar mime-viewer/image-converter-alist nil)
|
|
|
108
|
|
|
109 (mapcar (function
|
|
|
110 (lambda (rule)
|
|
|
111 (let ((ctype (car rule))
|
|
|
112 (format (cdr rule))
|
|
|
113 )
|
|
|
114 (if (image-inline-p format)
|
|
|
115 (progn
|
|
|
116 (set-alist 'mime-viewer/content-filter-alist
|
|
|
117 ctype
|
|
|
118 (function mime-preview/filter-for-image))
|
|
|
119 (set-alist 'mime-viewer/image-converter-alist
|
|
|
120 ctype format)
|
|
|
121 (add-to-list
|
|
|
122 'mime-viewer/default-showing-Content-Type-list
|
|
|
123 ctype)
|
|
|
124 )
|
|
|
125 ))))
|
|
|
126 '(("image/jpeg" . jpeg)
|
|
|
127 ("image/gif" . gif)
|
|
|
128 ("image/tiff" . tiff)
|
|
|
129 ("image/x-tiff" . tiff)
|
|
|
130 ("image/xbm" . xbm)
|
|
|
131 ("image/x-xbm" . xbm)
|
|
|
132 ("image/x-xpixmap" . xpm)
|
|
|
133 ("image/x-pic" . pic)
|
|
|
134 ("image/x-mag" . mag)
|
|
|
135 ))
|
|
4
|
136
|
|
|
137 (defvar mime-viewer/ps-to-gif-command "pstogif")
|
|
|
138
|
|
|
139
|
|
|
140 ;;; @ content filter for images
|
|
|
141 ;;;
|
|
|
142 ;; (for XEmacs 19.12 or later)
|
|
|
143
|
|
|
144 (defun mime-preview/filter-for-image (ctype params encoding)
|
|
|
145 (let* ((mode mime::preview/original-major-mode)
|
|
|
146 (m (assq mode mime-viewer/code-converter-alist))
|
|
|
147 (charset (assoc "charset" params))
|
|
|
148 (beg (point-min)) (end (point-max))
|
|
|
149 )
|
|
|
150 (remove-text-properties beg end '(face nil))
|
|
98
|
151 (message "Decoding image...")
|
|
4
|
152 (mime-decode-region beg end encoding)
|
|
98
|
153 (let* ((minor (assoc-value ctype mime-viewer/image-converter-alist))
|
|
|
154 (gl (image-normalize minor (buffer-string)))
|
|
|
155 e)
|
|
4
|
156 (delete-region (point-min)(point-max))
|
|
98
|
157 (cond ((image-invalid-glyph-p gl)
|
|
|
158 (setq gl nil)
|
|
|
159 (message "Invalid glyph!")
|
|
|
160 )
|
|
|
161 ((eq (aref gl 0) 'xbm)
|
|
|
162 (let ((xbm-file
|
|
|
163 (make-temp-name (expand-file-name "tm" mime/tmp-dir))))
|
|
|
164 (insert (aref gl 2))
|
|
|
165 (write-region (point-min)(point-max) xbm-file)
|
|
|
166 (message "Decoding image...")
|
|
|
167 (delete-region (point-min)(point-max))
|
|
|
168 (bitmap-insert-xbm-file xbm-file)
|
|
|
169 (delete-file xbm-file)
|
|
|
170 )
|
|
|
171 (message "Decoding image... done")
|
|
|
172 )
|
|
|
173 (t
|
|
|
174 (setq gl (make-glyph gl))
|
|
|
175 (setq e (make-extent (point) (point)))
|
|
|
176 (set-extent-end-glyph e gl)
|
|
|
177 (message "Decoding image... done")
|
|
|
178 ))
|
|
4
|
179 )
|
|
|
180 (insert "\n")
|
|
|
181 ))
|
|
|
182
|
|
|
183
|
|
|
184 ;;; @ content filter for Postscript
|
|
|
185 ;;;
|
|
|
186 ;; (for XEmacs 19.14 or later)
|
|
|
187
|
|
|
188 (defun mime-preview/filter-for-application/postscript (ctype params encoding)
|
|
|
189 (let* ((mode mime::preview/original-major-mode)
|
|
|
190 (m (assq mode mime-viewer/code-converter-alist))
|
|
|
191 (beg (point-min)) (end (point-max))
|
|
|
192 (file-base (make-temp-name (expand-file-name "tm" mime/tmp-dir)))
|
|
|
193 (ps-file (concat file-base ".ps"))
|
|
|
194 (gif-file (concat file-base ".gif"))
|
|
|
195 )
|
|
|
196 (remove-text-properties beg end '(face nil))
|
|
98
|
197 (message "Decoding Postscript...")
|
|
4
|
198 (mime-decode-region beg end encoding)
|
|
|
199 (write-region (point-min)(point-max) ps-file)
|
|
98
|
200 (message "Decoding Postscript...")
|
|
4
|
201 (delete-region (point-min)(point-max))
|
|
|
202 (call-process mime-viewer/ps-to-gif-command nil nil nil ps-file)
|
|
98
|
203 (set-extent-end-glyph (make-extent (point) (point))
|
|
|
204 (make-glyph (vector 'gif :file gif-file)))
|
|
|
205 (message "Decoding Postscript... done")
|
|
4
|
206 (delete-file ps-file)
|
|
|
207 (delete-file gif-file)
|
|
|
208 ))
|
|
|
209
|
|
|
210 (set-alist 'mime-viewer/content-filter-alist
|
|
|
211 "application/postscript"
|
|
|
212 (function mime-preview/filter-for-application/postscript))
|
|
|
213
|
|
98
|
214 (if (featurep 'gif)
|
|
|
215 (add-to-list 'mime-viewer/default-showing-Content-Type-list
|
|
|
216 "application/postscript")
|
|
|
217 )
|
|
4
|
218
|
|
|
219
|
|
|
220 ;;; @ end
|
|
|
221 ;;;
|
|
|
222
|
|
|
223 (provide 'tm-image)
|
|
|
224
|
|
|
225 ;;; tm-image.el ends here
|
