1 ;;; rmail-mime.el --- Add MIME handling facility to RMAIL
3 ;; Copyright (C) 2001 Free Software Foundation, Inc.
5 ;; Author: MORIOKA Tomohiko <tomo@m17n.org>
6 ;; Keywords: mail, news, MIME, multimedia, multilingual, encoded-word
8 ;; This file is part of SEMI (Setting for Emacs MIME Interfaces).
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.
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.
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
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
29 (defun rmail-decode-header (decoded-buffer original-buffer start end)
30 (set-buffer (get-buffer-create decoded-buffer))
32 (insert-buffer-substring original-buffer start end)
33 (mime-decode-header-in-buffer rmail-enable-mime))
35 (defun rmail-decode-mime-message (decoded-buffer original-buffer msg)
37 (set-buffer original-buffer)
39 (narrow-to-region (rmail-msgbeg msg)
41 (setq mime-message-structure
42 (mime-open-entity 'babyl original-buffer))
43 (mime-display-message mime-message-structure decoded-buffer)))
44 (set-buffer decoded-buffer))
46 (defun rmail-view-kill-rmail-buffer ()
47 (if rmail-buffer (kill-buffer rmail-buffer)))
49 (defvar rmail-view-mode-map nil)
51 (defun rmail-show-mime-message ()
52 (let ((abuf (current-buffer))
53 (buf-name (concat (buffer-name) "-view"))
55 (narrow-to-region (rmail-msgbeg rmail-current-message)
56 (rmail-msgend rmail-current-message))
57 (setq mime-message-structure
58 (mime-open-entity 'babyl abuf))
59 (set-buffer (mime-display-message mime-message-structure
61 nil nil rmail-view-mode-map))
62 (setq buf (current-buffer))
63 (make-local-variable 'font-lock-defaults)
64 (setq font-lock-defaults
65 '(rmail-font-lock-keywords
67 (font-lock-maximum-size . nil)
68 (font-lock-fontify-buffer-function
69 . rmail-fontify-buffer-function)
70 (font-lock-unfontify-buffer-function
71 . rmail-unfontify-buffer-function)
72 (font-lock-inhibit-thing-lock
73 . (lazy-lock-mode fast-lock-mode))))
74 (make-local-variable 'rmail-buffer)
75 (setq rmail-buffer abuf)
76 (make-local-variable 'rmail-view-buffer)
77 (setq rmail-view-buffer (current-buffer))
78 (make-local-variable 'rmail-summary-buffer)
79 (setq rmail-summary-buffer
80 (with-current-buffer rmail-buffer
81 rmail-summary-buffer))
82 (make-local-variable 'rmail-current-message)
83 (setq rmail-current-message
84 (with-current-buffer rmail-buffer
85 rmail-current-message))
86 (make-local-variable 'kill-buffer-hook)
87 (add-hook 'kill-buffer-hook 'rmail-view-kill-rmail-buffer)
88 (make-local-variable 'revert-buffer-function)
89 (setq revert-buffer-function 'rmail-revert)
91 (with-current-buffer abuf
92 (setq rmail-view-buffer buf)
94 (setq mode-line-process mode-line))
95 (if (and (setq win (get-buffer-window abuf))
97 (set-window-buffer win buf))
98 (bury-buffer rmail-buffer)
99 (run-hooks 'rmail-show-mime-message-hook)))
101 (defun rmail-insert-mime-forwarded-message (forward-buffer)
102 (insert (mime-make-tag "message" "rfc822"))
104 (mime-insert-entity (with-current-buffer forward-buffer
105 mime-message-structure)))
107 (defun rmail-insert-mime-resent-message (forward-buffer)
108 (mime-insert-entity (with-current-buffer forward-buffer
109 mime-message-structure)))
111 (defun rmail-enable-mime ()
113 (setq rmail-enable-mime t)
114 (rmail-show-message))
116 (defun rmail-disable-mime ()
118 (let ((buf rmail-buffer))
119 (when rmail-enable-mime
120 (remove-hook 'kill-buffer-hook 'rmail-view-kill-rmail-buffer)
121 (set-window-buffer (selected-window) buf)
122 (kill-buffer rmail-view-buffer))
124 (setq rmail-enable-mime nil
125 rmail-view-buffer (current-buffer))
126 (rmail-show-message))
128 (defun rmail-search-mime-message (msg regexp)
129 "Search the message of number MSG for REGEXP.
130 If the search succeeds, return non-nil. Otherwise, return nil."
132 (rmail-decode-mime-message " *RMAIL-temp-VIEW*" (current-buffer) msg)
133 (goto-char (point-min))
134 (prog1 (re-search-forward regexp nil t)
135 (kill-buffer " *RMAIL-temp-VIEW*"))))
137 (defun rmail-search-mime-header (msg regexp limit)
138 "Search the message header of number MSG for REGEXP.
139 The current point is the beginninf of header,
140 and LIMIT is the end position of header.
141 If the search succeeds, return non-nil. Otherwise, return nil."
143 (rmail-decode-header " *RMAIL-temp-VIEW*" (current-buffer) (point) limit)
144 (goto-char (point-min))
145 (prog1 (re-search-forward regexp nil t)
146 (kill-buffer " *RMAIL-temp-VIEW*"))))
148 (set-alist 'mime-raw-representation-type-alist 'rmail-mode
149 (if rmail-enable-mime
153 (set-alist 'mime-preview-over-to-previous-method-alist
157 (message "Beginning of buffer")
158 ;; (rmail-previous-undeleted-message 1)
161 (set-alist 'mime-preview-over-to-next-method-alist
165 (message "End of buffer")
166 ;; (rmail-next-undeleted-message 1)
169 (set-alist 'mime-preview-quitting-method-alist 'rmail-mode #'rmail-quit)
171 ;; Override values defined in rmail.
172 (eval-after-load "rmail"
174 (define-key rmail-mode-map "v" 'rmail-enable-mime)
175 (setq rmail-show-mime-function
176 (function rmail-show-mime-message)
177 rmail-insert-mime-forwarded-message-function
178 (function rmail-insert-mime-forwarded-message)
179 rmail-insert-mime-resent-message-function
180 (function rmail-insert-mime-resent-message)
181 rmail-search-mime-message-function
182 (function rmail-search-mime-message)
183 rmail-search-mime-header-function
184 (function rmail-search-mime-header))
185 (unless rmail-view-mode-map
186 (setq rmail-view-mode-map (mime-view-define-keymap rmail-mode-map))
187 (define-key rmail-view-mode-map
188 "p" (function rmail-previous-undeleted-message))
189 (define-key rmail-view-mode-map
190 "n" (function rmail-next-undeleted-message))
191 (define-key rmail-view-mode-map
192 "u" (function rmail-undelete-previous-message))
193 (define-key rmail-view-mode-map
194 "a" (function rmail-add-label))
195 (define-key rmail-view-mode-map
196 "\C-c\C-c" (function rmail-disable-mime)))))
198 ;; Override values defined in rmailsum.
199 (eval-after-load "rmailsum"
200 '(setq rmail-summary-line-decoder
204 (decode-coding-string string 'undecided))))))
206 ;; Override values defined in sendmail.
207 (eval-after-load "sendmail"
209 (add-hook 'mail-setup-hook 'turn-on-mime-edit)
210 (add-hook 'mail-send-hook 'mime-edit-maybe-translate)))
212 (provide 'rmail-mime)