1 ;;; mm-view.el --- functions for viewing MIME objects
2 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003 Free Software Foundation, Inc.
4 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
5 ;; This file is part of GNU Emacs.
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)
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.
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.
26 (eval-when-compile (require 'cl))
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")
37 (autoload 'html2text "html2text")
38 (unless (fboundp 'diff-mode)
39 (autoload 'diff-mode "diff-mode" "" t nil)))
41 (defvar mm-text-html-renderer-alist
42 '((w3 . mm-inline-text-html-render-with-w3)
43 (w3m . mm-inline-text-html-render-with-w3m)
44 (w3m-standalone mm-inline-render-with-stdin nil
45 "w3m" "-dump" "-T" "text/html")
46 (links mm-inline-render-with-file
47 mm-links-remove-leading-blank
49 (lynx mm-inline-render-with-stdin nil
50 "lynx" "-dump" "-force_html" "-stdin" "-nolist")
51 (html2text mm-inline-render-with-function html2text))
52 "The attributes of renderer types for text/html.")
54 (defvar mm-text-html-washer-alist
55 '((w3 . gnus-article-wash-html-with-w3)
56 (w3m . gnus-article-wash-html-with-w3m)
57 (w3m-standalone mm-inline-render-with-stdin nil
58 "w3m" "-dump" "-T" "text/html")
59 (links mm-inline-wash-with-file
60 mm-links-remove-leading-blank
62 (lynx mm-inline-wash-with-stdin nil
63 "lynx" "-dump" "-force_html" "-stdin" "-nolist")
64 (html2text html2text))
65 "The attributes of washer types for text/html.")
67 ;;; Internal variables.
70 ;;; Functions for displaying various formats inline
73 (defun mm-inline-image-emacs (handle)
74 (let ((b (point-marker))
76 (put-image (mm-get-image handle) b)
78 (mm-handle-set-undisplayer
84 (delete-region b (+ b 2)))))))
86 (defun mm-inline-image-xemacs (handle)
89 (let ((annot (make-annotation (mm-get-image handle) nil 'text))
91 (mm-handle-set-undisplayer
94 (let ((b ,(point-marker))
96 (delete-annotation ,annot)
97 (delete-region (- b 2) b))))
98 (set-extent-property annot 'mm t)
99 (set-extent-property annot 'duplicable t)))
102 (if (featurep 'xemacs)
103 (defalias 'mm-inline-image 'mm-inline-image-xemacs)
104 (defalias 'mm-inline-image 'mm-inline-image-emacs)))
106 (defvar mm-w3-setup nil)
107 (defun mm-setup-w3 ()
114 (setq mm-w3-setup t)))
116 (defun mm-inline-text-html-render-with-w3 (handle)
118 (let ((text (mm-get-part handle))
120 (url-standalone-mode t)
121 (url-gateway-unplugged t)
122 (w3-honor-stylesheets nil)
124 (url-generic-parse-url (format "cid:%s" (mm-handle-id handle))))
125 (width (window-width))
126 (charset (mail-content-type-get
127 (mm-handle-type handle) 'charset)))
131 (narrow-to-region b (point))
132 (goto-char (point-min))
133 (if (or (and (boundp 'w3-meta-content-type-charset-regexp)
135 w3-meta-content-type-charset-regexp nil t))
136 (and (boundp 'w3-meta-charset-content-type-regexp)
138 w3-meta-charset-content-type-regexp nil t)))
140 (or (let ((bsubstr (buffer-substring-no-properties
143 (if (fboundp 'w3-coding-system-for-mime-charset)
144 (w3-coding-system-for-mime-charset bsubstr)
145 (mm-charset-to-coding-system bsubstr)))
147 (delete-region (point-min) (point-max))
148 (insert (mm-decode-string text charset))
149 (save-window-excursion
151 (let ((w3-strict-width width)
152 ;; Don't let w3 set the global version of
154 (fill-column fill-column))
155 (if (or debug-on-error debug-on-quit)
156 (w3-region (point-min) (point-max))
158 (w3-region (point-min) (point-max))
160 (delete-region (point-min) (point-max))
162 (charset (mail-content-type-get
163 (mm-handle-type handle) 'charset)))
164 (if (or (eq charset 'gnus-decoded)
165 (eq mail-parse-charset 'gnus-decoded))
167 (narrow-to-region (point) (point))
168 (mm-insert-part handle)
169 (goto-char (point-max)))
170 (insert (mm-decode-string (mm-get-part handle)
173 "Error while rendering html; showing as text/plain")))))))
174 (mm-handle-set-undisplayer
177 (let (buffer-read-only)
178 (if (functionp 'remove-specifier)
179 (mapcar (lambda (prop)
181 (face-property 'default prop)
183 '(background background-pixmap foreground)))
184 (delete-region ,(point-min-marker)
185 ,(point-max-marker)))))))))
187 (defvar mm-w3m-setup nil
188 "Whether gnus-article-mode has been setup to use emacs-w3m.")
190 (defun mm-setup-w3m ()
191 "Setup gnus-article-mode to use emacs-w3m."
194 (unless (assq 'gnus-article-mode w3m-cid-retrieve-function-alist)
195 (push (cons 'gnus-article-mode 'mm-w3m-cid-retrieve)
196 w3m-cid-retrieve-function-alist))
197 (setq mm-w3m-setup t))