Mercurial > emacs
annotate lisp/gnus/mm-view.el @ 42315:33d9eae5bb32
Remove empty lines at the end of file.
author | Pavel Janík <Pavel@Janik.cz> |
---|---|
date | Tue, 25 Dec 2001 11:02:43 +0000 |
parents | b4833df45a4c |
children | aa31e3865857 |
rev | line source |
---|---|
38413
a26d9b55abb6
Some fixes to follow coding conventions in files from Gnus.
Pavel Janík <Pavel@Janik.cz>
parents:
33329
diff
changeset
|
1 ;;; mm-view.el --- functions for viewing MIME objects |
38635
b6a0070476c7
(autoload): Don't autoload `diff-mode' if it's
Gerd Moellmann <gerd@gnu.org>
parents:
38413
diff
changeset
|
2 ;; Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc. |
31717 | 3 |
4 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> | |
5 ;; This file is part of GNU Emacs. | |
6 | |
7 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
8 ;; it under the terms of the GNU General Public License as published by | |
9 ;; the Free Software Foundation; either version 2, or (at your option) | |
10 ;; any later version. | |
11 | |
12 ;; GNU Emacs is distributed in the hope that it will be useful, | |
13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
15 ;; GNU General Public License for more details. | |
16 | |
17 ;; You should have received a copy of the GNU General Public License | |
18 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
19 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
20 ;; Boston, MA 02111-1307, USA. | |
21 | |
22 ;;; Commentary: | |
23 | |
24 ;;; Code: | |
25 | |
26 (eval-when-compile (require 'cl)) | |
27 (require 'mail-parse) | |
28 (require 'mailcap) | |
29 (require 'mm-bodies) | |
30 (require 'mm-decode) | |
31 | |
32 (eval-and-compile | |
33 (autoload 'gnus-article-prepare-display "gnus-art") | |
34 (autoload 'vcard-parse-string "vcard") | |
35 (autoload 'vcard-format-string "vcard") | |
36 (autoload 'fill-flowed "flow-fill") | |
38635
b6a0070476c7
(autoload): Don't autoload `diff-mode' if it's
Gerd Moellmann <gerd@gnu.org>
parents:
38413
diff
changeset
|
37 (unless (fboundp 'diff-mode) |
b6a0070476c7
(autoload): Don't autoload `diff-mode' if it's
Gerd Moellmann <gerd@gnu.org>
parents:
38413
diff
changeset
|
38 (autoload 'diff-mode "diff-mode" "" t nil))) |
31717 | 39 |
40 ;;; | |
41 ;;; Functions for displaying various formats inline | |
42 ;;; | |
43 (defun mm-inline-image-emacs (handle) | |
44 (let ((b (point-marker)) | |
45 buffer-read-only) | |
46 (insert "\n") | |
47 (put-image (mm-get-image handle) b) | |
48 (mm-handle-set-undisplayer | |
49 handle | |
50 `(lambda () (remove-images ,b (1+ ,b)))))) | |
51 | |
52 (defun mm-inline-image-xemacs (handle) | |
41829
b4833df45a4c
2001-12-05 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
38635
diff
changeset
|
53 (insert "\n") |
b4833df45a4c
2001-12-05 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
38635
diff
changeset
|
54 (forward-char -1) |
31717 | 55 (let ((b (point)) |
56 (annot (make-annotation (mm-get-image handle) nil 'text)) | |
57 buffer-read-only) | |
58 (mm-handle-set-undisplayer | |
59 handle | |
60 `(lambda () | |
61 (let (buffer-read-only) | |
62 (delete-annotation ,annot) | |
63 (delete-region ,(set-marker (make-marker) b) | |
64 ,(set-marker (make-marker) (point)))))) | |
65 (set-extent-property annot 'mm t) | |
66 (set-extent-property annot 'duplicable t))) | |
67 | |
68 (eval-and-compile | |
33329 | 69 (if (featurep 'xemacs) |
31717 | 70 (defalias 'mm-inline-image 'mm-inline-image-xemacs) |
71 (defalias 'mm-inline-image 'mm-inline-image-emacs))) | |
72 | |
73 (defvar mm-w3-setup nil) | |
74 (defun mm-setup-w3 () | |
75 (unless mm-w3-setup | |
76 (require 'w3) | |
77 (w3-do-setup) | |
78 (require 'url) | |
79 (require 'w3-vars) | |
80 (require 'url-vars) | |
81 (setq mm-w3-setup t))) | |
82 | |
83 (defun mm-inline-text (handle) | |
84 (let ((type (mm-handle-media-subtype handle)) | |
85 text buffer-read-only) | |
86 (cond | |
87 ((equal type "html") | |
88 (mm-setup-w3) | |
89 (setq text (mm-get-part handle)) | |
90 (let ((b (point)) | |
91 (url-standalone-mode t) | |
92 (url-current-object | |
93 (url-generic-parse-url (format "cid:%s" (mm-handle-id handle)))) | |
94 (width (window-width)) | |
95 (charset (mail-content-type-get | |
96 (mm-handle-type handle) 'charset))) | |
97 (save-excursion | |
98 (insert text) | |
99 (save-restriction | |
100 (narrow-to-region b (point)) | |
101 (goto-char (point-min)) | |
102 (if (or (and (boundp 'w3-meta-content-type-charset-regexp) | |
103 (re-search-forward | |
104 w3-meta-content-type-charset-regexp nil t)) | |
105 (and (boundp 'w3-meta-charset-content-type-regexp) | |
106 (re-search-forward | |
107 w3-meta-charset-content-type-regexp nil t))) | |
41829
b4833df45a4c
2001-12-05 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
38635
diff
changeset
|
108 (setq charset |
b4833df45a4c
2001-12-05 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
38635
diff
changeset
|
109 (or (let ((bsubstr (buffer-substring-no-properties |
b4833df45a4c
2001-12-05 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
38635
diff
changeset
|
110 (match-beginning 2) |
b4833df45a4c
2001-12-05 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
38635
diff
changeset
|
111 (match-end 2)))) |
b4833df45a4c
2001-12-05 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
38635
diff
changeset
|
112 (if (fboundp 'w3-coding-system-for-mime-charset) |
b4833df45a4c
2001-12-05 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
38635
diff
changeset
|
113 (w3-coding-system-for-mime-charset bsubstr) |
b4833df45a4c
2001-12-05 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
38635
diff
changeset
|
114 (mm-charset-to-coding-system bsubstr))) |
b4833df45a4c
2001-12-05 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
38635
diff
changeset
|
115 charset))) |
31717 | 116 (delete-region (point-min) (point-max)) |
117 (insert (mm-decode-string text charset)) | |
118 (save-window-excursion | |
119 (save-restriction | |
120 (let ((w3-strict-width width) | |
121 ;; Don't let w3 set the global version of | |
122 ;; this variable. | |
123 (fill-column fill-column) | |
124 (url-standalone-mode t)) | |
125 (condition-case var | |
126 (w3-region (point-min) (point-max)) | |
41829
b4833df45a4c
2001-12-05 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
38635
diff
changeset
|
127 (error |
b4833df45a4c
2001-12-05 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
38635
diff
changeset
|
128 (delete-region (point-min) (point-max)) |
b4833df45a4c
2001-12-05 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
38635
diff
changeset
|
129 (let ((b (point)) |
b4833df45a4c
2001-12-05 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
38635
diff
changeset
|
130 (charset (mail-content-type-get |
b4833df45a4c
2001-12-05 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
38635
diff
changeset
|
131 (mm-handle-type handle) 'charset))) |
b4833df45a4c
2001-12-05 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
38635
diff
changeset
|
132 (if (or (eq charset 'gnus-decoded) |
b4833df45a4c
2001-12-05 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
38635
diff
changeset
|
133 (eq mail-parse-charset 'gnus-decoded)) |
b4833df45a4c
2001-12-05 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
38635
diff
changeset
|
134 (save-restriction |
b4833df45a4c
2001-12-05 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
38635
diff
changeset
|
135 (narrow-to-region (point) (point)) |
b4833df45a4c
2001-12-05 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
38635
diff
changeset
|
136 (mm-insert-part handle) |
b4833df45a4c
2001-12-05 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
38635
diff
changeset
|
137 (goto-char (point-max))) |
b4833df45a4c
2001-12-05 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
38635
diff
changeset
|
138 (insert (mm-decode-string (mm-get-part handle) |
b4833df45a4c
2001-12-05 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
38635
diff
changeset
|
139 charset)))) |
b4833df45a4c
2001-12-05 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
38635
diff
changeset
|
140 (message |
b4833df45a4c
2001-12-05 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
38635
diff
changeset
|
141 "Error while rendering html; showing as text/plain")))))) |
31717 | 142 (mm-handle-set-undisplayer |
143 handle | |
144 `(lambda () | |
145 (let (buffer-read-only) | |
146 (if (functionp 'remove-specifier) | |
147 (mapcar (lambda (prop) | |
148 (remove-specifier | |
149 (face-property 'default prop) | |
150 (current-buffer))) | |
151 '(background background-pixmap foreground))) | |
152 (delete-region ,(point-min-marker) | |
153 ,(point-max-marker))))))))) | |
154 ((equal type "x-vcard") | |
155 (mm-insert-inline | |
156 handle | |
157 (concat "\n-- \n" | |
41829
b4833df45a4c
2001-12-05 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
38635
diff
changeset
|
158 (ignore-errors |
b4833df45a4c
2001-12-05 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
38635
diff
changeset
|
159 (if (fboundp 'vcard-pretty-print) |
b4833df45a4c
2001-12-05 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
38635
diff
changeset
|
160 (vcard-pretty-print (mm-get-part handle)) |
b4833df45a4c
2001-12-05 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
38635
diff
changeset
|
161 (vcard-format-string |
b4833df45a4c
2001-12-05 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
38635
diff
changeset
|
162 (vcard-parse-string (mm-get-part handle) |
b4833df45a4c
2001-12-05 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
38635
diff
changeset
|
163 'vcard-standard-filter))))))) |
31717 | 164 (t |
165 (let ((b (point)) | |
166 (charset (mail-content-type-get | |
167 (mm-handle-type handle) 'charset))) | |
168 (if (or (eq charset 'gnus-decoded) | |
169 ;; This is probably not entirely correct, but | |
41829
b4833df45a4c
2001-12-05 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
38635
diff
changeset
|
170 ;; makes rfc822 parts with embedded multiparts work. |
31717 | 171 (eq mail-parse-charset 'gnus-decoded)) |
41829
b4833df45a4c
2001-12-05 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
38635
diff
changeset
|
172 (save-restriction |
b4833df45a4c
2001-12-05 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
38635
diff
changeset
|
173 (narrow-to-region (point) (point)) |
b4833df45a4c
2001-12-05 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
38635
diff
changeset
|
174 (mm-insert-part handle) |
b4833df45a4c
2001-12-05 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
38635
diff
changeset
|
175 (goto-char (point-max))) |
31717 | 176 (insert (mm-decode-string (mm-get-part handle) charset))) |
177 (when (and (equal type "plain") | |
178 (equal (cdr (assoc 'format (mm-handle-type handle))) | |
179 "flowed")) | |
180 (save-restriction | |
181 (narrow-to-region b (point)) | |
182 (goto-char b) | |
183 (fill-flowed) | |
184 (goto-char (point-max)))) | |
185 (save-restriction | |
186 (narrow-to-region b (point)) | |
187 (set-text-properties (point-min) (point-max) nil) | |
41829
b4833df45a4c
2001-12-05 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
38635
diff
changeset
|
188 (when (or (equal type "enriched") |
b4833df45a4c
2001-12-05 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
38635
diff
changeset
|
189 (equal type "richtext")) |
b4833df45a4c
2001-12-05 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
38635
diff
changeset
|
190 (enriched-decode (point-min) (point-max))) |
31717 | 191 (mm-handle-set-undisplayer |
192 handle | |
193 `(lambda () | |
194 (let (buffer-read-only) | |
195 (delete-region ,(point-min-marker) | |
196 ,(point-max-marker))))))))))) | |
197 | |
198 (defun mm-insert-inline (handle text) | |
199 "Insert TEXT inline from HANDLE." | |
200 (let ((b (point))) | |
201 (insert text) | |
202 (mm-handle-set-undisplayer | |
203 handle | |
204 `(lambda () | |
205 (let (buffer-read-only) | |
206 (delete-region ,(set-marker (make-marker) b) | |
207 ,(set-marker (make-marker) (point)))))))) | |
208 | |
209 (defun mm-inline-audio (handle) | |
210 (message "Not implemented")) | |
211 | |
212 (defun mm-view-sound-file () | |
213 (message "Not implemented")) | |
214 | |
215 (defun mm-w3-prepare-buffer () | |
216 (require 'w3) | |
217 (let ((url-standalone-mode t)) | |
218 (w3-prepare-buffer))) | |
219 | |
220 (defun mm-view-message () | |
221 (mm-enable-multibyte) | |
222 (let (handles) | |
223 (let (gnus-article-mime-handles) | |
224 ;; Double decode problem may happen. See mm-inline-message. | |
225 (run-hooks 'gnus-article-decode-hook) | |
226 (gnus-article-prepare-display) | |
227 (setq handles gnus-article-mime-handles)) | |
228 (when handles | |
229 (setq gnus-article-mime-handles | |
230 (nconc gnus-article-mime-handles | |
231 (if (listp (car handles)) | |
232 handles (list handles)))))) | |
233 (fundamental-mode) | |
234 (goto-char (point-min))) | |
235 | |
236 (defun mm-inline-message (handle) | |
237 (let ((b (point)) | |
41829
b4833df45a4c
2001-12-05 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
38635
diff
changeset
|
238 (bolp (bolp)) |
31717 | 239 (charset (mail-content-type-get |
240 (mm-handle-type handle) 'charset)) | |
241 gnus-displaying-mime handles) | |
242 (when (and charset | |
243 (stringp charset)) | |
244 (setq charset (intern (downcase charset))) | |
245 (when (eq charset 'us-ascii) | |
246 (setq charset nil))) | |
247 (save-excursion | |
248 (save-restriction | |
249 (narrow-to-region b b) | |
250 (mm-insert-part handle) | |
251 (let (gnus-article-mime-handles | |
41829
b4833df45a4c
2001-12-05 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
38635
diff
changeset
|
252 ;; disable prepare hook |
b4833df45a4c
2001-12-05 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
38635
diff
changeset
|
253 gnus-article-prepare-hook |
31717 | 254 (gnus-newsgroup-charset |
255 (or charset gnus-newsgroup-charset))) | |
256 (run-hooks 'gnus-article-decode-hook) | |
257 (gnus-article-prepare-display) | |
258 (setq handles gnus-article-mime-handles)) | |
41829
b4833df45a4c
2001-12-05 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
38635
diff
changeset
|
259 (goto-char (point-min)) |
b4833df45a4c
2001-12-05 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
38635
diff
changeset
|
260 (unless bolp |
b4833df45a4c
2001-12-05 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
38635
diff
changeset
|
261 (insert "\n")) |
31717 | 262 (goto-char (point-max)) |
263 (unless (bolp) | |
264 (insert "\n")) | |
265 (insert "----------\n\n") | |
266 (when handles | |
267 (setq gnus-article-mime-handles | |
268 (nconc gnus-article-mime-handles | |
269 (if (listp (car handles)) | |
270 handles (list handles))))) | |
271 (mm-handle-set-undisplayer | |
272 handle | |
273 `(lambda () | |
274 (let (buffer-read-only) | |
33329 | 275 (if (fboundp 'remove-specifier) |
31717 | 276 ;; This is only valid on XEmacs. |
277 (mapcar (lambda (prop) | |
278 (remove-specifier | |
279 (face-property 'default prop) (current-buffer))) | |
33329 | 280 '(background background-pixmap foreground))) |
31717 | 281 (delete-region ,(point-min-marker) ,(point-max-marker))))))))) |
282 | |
31764 | 283 (defun mm-display-inline-fontify (handle mode) |
31717 | 284 (let (text) |
285 (with-temp-buffer | |
286 (mm-insert-part handle) | |
31764 | 287 (funcall mode) |
31717 | 288 (font-lock-fontify-buffer) |
289 (when (fboundp 'extent-list) | |
290 (map-extents (lambda (ext ignored) | |
291 (set-extent-property ext 'duplicable t) | |
292 nil) | |
293 nil nil nil nil nil 'text-prop)) | |
294 (setq text (buffer-string))) | |
295 (mm-insert-inline handle text))) | |
296 | |
31764 | 297 (defun mm-display-patch-inline (handle) |
298 (mm-display-inline-fontify handle 'diff-mode)) | |
299 | |
300 (defun mm-display-elisp-inline (handle) | |
301 (mm-display-inline-fontify handle 'emacs-lisp-mode)) | |
302 | |
31717 | 303 (provide 'mm-view) |
304 | |
38413
a26d9b55abb6
Some fixes to follow coding conventions in files from Gnus.
Pavel Janík <Pavel@Janik.cz>
parents:
33329
diff
changeset
|
305 ;;; mm-view.el ends here |