|
1
by Tatsuya Kinoshita
Import upstream version 1.14.6+0.20040418 |
1 |
;;; mime-w3.el --- mime-view content filter for text
|
2 |
||
3 |
;; Copyright (C) 1994,95,96,97,98,99,2000 Free Software Foundation, Inc.
|
|
4 |
||
5 |
;; Author: MORIOKA Tomohiko <tomo@m17n.org>
|
|
6 |
;; Keywords: HTML, MIME, multimedia, mail, news
|
|
7 |
||
8 |
;; This file is part of SEMI (Suite of Emacs MIME Interfaces).
|
|
9 |
||
10 |
;; This program is free software; you can redistribute it and/or
|
|
11 |
;; modify it under the terms of the GNU General Public License as
|
|
12 |
;; published by the Free Software Foundation; either version 2, or (at
|
|
13 |
;; your option) any later version.
|
|
14 |
||
15 |
;; This program is distributed in the hope that it will be useful, but
|
|
16 |
;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
17 |
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
18 |
;; General Public License for more details.
|
|
19 |
||
20 |
;; You should have received a copy of the GNU General Public License
|
|
21 |
;; along with GNU Emacs; see the file COPYING. If not, write to the
|
|
|
1.1.3
by Tatsuya Kinoshita
Import upstream version 1.14.6+0.20060328 |
22 |
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
23 |
;; Boston, MA 02110-1301, USA.
|
|
|
1
by Tatsuya Kinoshita
Import upstream version 1.14.6+0.20040418 |
24 |
|
25 |
;;; Code:
|
|
26 |
||
27 |
(condition-case nil |
|
28 |
(require 'w3) |
|
29 |
(error nil)) |
|
30 |
(require 'mime) |
|
31 |
||
32 |
(defmacro mime-put-keymap-region (start end keymap) |
|
33 |
`(put-text-property ,start ,end |
|
34 |
',(if (featurep 'xemacs) |
|
35 |
'keymap
|
|
36 |
'local-map) |
|
37 |
,keymap)) |
|
38 |
||
39 |
(defmacro mime-save-background-color (&rest body) |
|
40 |
(if (featurep 'xemacs) |
|
41 |
`(let ((color (color-name (face-background 'default)))) |
|
42 |
(prog1 |
|
43 |
(progn ,@body) |
|
44 |
(font-set-face-background 'default color (current-buffer)) |
|
45 |
))
|
|
46 |
(cons 'progn body))) |
|
47 |
||
48 |
(defvar mime-w3-message-structure nil) |
|
49 |
||
50 |
(defun mime-preview-text/html (entity situation) |
|
51 |
(setq mime-w3-message-structure (mime-find-root-entity entity)) |
|
52 |
(goto-char (point-max)) |
|
53 |
(let ((p (point))) |
|
54 |
(insert "\n") |
|
55 |
(goto-char p) |
|
56 |
(mime-save-background-color |
|
57 |
(save-restriction |
|
58 |
(narrow-to-region p p) |
|
59 |
(mime-insert-text-content entity) |
|
60 |
(run-hooks 'mime-text-decode-hook) |
|
61 |
(condition-case err |
|
62 |
(w3-region p (point-max)) |
|
63 |
(error (message "%s" err))) |
|
64 |
(mime-put-keymap-region p (point-max) w3-mode-map) |
|
65 |
))))
|
|
66 |
||
67 |
(defun url-cid (url &optional proxy-info) |
|
68 |
(let ((entity |
|
69 |
(mime-find-entity-from-content-id (mime-uri-parse-cid url) |
|
70 |
mime-w3-message-structure)) |
|
71 |
buffer) |
|
72 |
(when entity |
|
73 |
(setq buffer (generate-new-buffer (format " *cid %s" url))) |
|
74 |
(save-excursion |
|
75 |
(set-buffer buffer) |
|
76 |
(mime-insert-entity-content entity) |
|
77 |
(if (boundp 'url-current-mime-type) |
|
78 |
(setq url-current-mime-type (mime-entity-type/subtype entity))))) |
|
79 |
buffer)) |
|
80 |
||
81 |
(if (fboundp 'url-register-protocol) |
|
82 |
(url-register-protocol "cid" |
|
83 |
'url-cid
|
|
84 |
'url-identity-expander) |
|
85 |
(provide 'url-cid)) |
|
86 |
||
87 |
||
88 |
;;; @ end
|
|
89 |
;;;
|
|
90 |
||
91 |
(provide 'mime-w3) |
|
92 |
||
93 |
;;; mime-w3.el ends here
|