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 start end)
37 (set-buffer original-buffer)
39 (narrow-to-region start end)
40 (mime-view-buffer nil decoded-buffer)))
41 (set-buffer decoded-buffer))
43 (defun rmail-view-kill-rmail-buffer ()
44 (if rmail-buffer (kill-buffer rmail-buffer)))
46 (defvar rmail-view-mode-map nil)
48 (defun rmail-show-mime-message ()
49 (let ((abuf (current-buffer))
50 (buf-name (concat (buffer-name) "-view"))
52 (narrow-to-region (rmail-msgbeg rmail-current-message)
53 (rmail-msgend rmail-current-message))
54 (setq mime-message-structure
55 (mime-open-entity 'babyl abuf))
56 (set-buffer (mime-display-message mime-message-structure
58 nil nil rmail-view-mode-map))
59 (setq buf (current-buffer))
60 (make-local-variable 'font-lock-defaults)
61 (setq font-lock-defaults
62 '(rmail-font-lock-keywords
64 (font-lock-maximum-size . nil)
65 (font-lock-fontify-buffer-function
66 . rmail-fontify-buffer-function)
67 (font-lock-unfontify-buffer-function
68 . rmail-unfontify-buffer-function)
69 (font-lock-inhibit-thing-lock
70 . (lazy-lock-mode fast-lock-mode))))
71 (make-local-variable 'rmail-buffer)
72 (setq rmail-buffer abuf)
73 (make-local-variable 'rmail-view-buffer)
74 (setq rmail-view-buffer (current-buffer))
75 (make-local-variable 'rmail-summary-buffer)
76 (setq rmail-summary-buffer
77 (with-current-buffer rmail-buffer
78 rmail-summary-buffer))
79 (make-local-variable 'rmail-current-message)
80 (setq rmail-current-message
81 (with-current-buffer rmail-buffer
82 rmail-current-message))
83 (make-local-variable 'kill-buffer-hook)
84 (add-hook 'kill-buffer-hook 'rmail-view-kill-rmail-buffer)
86 (with-current-buffer abuf
87 (setq rmail-view-buffer buf)
89 (setq mode-line-process mode-line))
90 (if (and (setq win (get-buffer-window abuf))
92 (set-window-buffer win buf))
93 (bury-buffer rmail-buffer)
94 (run-hooks 'rmail-show-mime-message-hook)))
96 (defun rmail-insert-mime-forwarded-message (forward-buffer)
97 (insert (mime-make-tag "message" "rfc822"))
99 (mime-insert-entity (with-current-buffer forward-buffer
100 mime-message-structure)))
102 (defun rmail-enable-mime ()
104 (setq rmail-enable-mime t)
105 (rmail-show-message))
107 (defun rmail-disable-mime ()
109 (let ((buf rmail-buffer))
110 (when rmail-enable-mime
111 (remove-hook 'kill-buffer-hook 'rmail-view-kill-rmail-buffer)
112 (set-window-buffer (selected-window) buf)
113 (kill-buffer rmail-view-buffer))
115 (setq rmail-enable-mime nil
116 rmail-view-buffer (current-buffer))
117 (rmail-show-message))
119 (defun rmail-search-mime-message (msg regexp)
120 "Search the message of number MSG for REGEXP.
121 If the search succeeds, return non-nil. Otherwise, return nil."
123 (rmail-decode-mime-message " *RMAIL-temp-VIEW*"
125 (if (search-forward "\n*** EOOH ***\n"
126 (rmail-msgend msg) t)
130 (goto-char (point-min))
131 (prog1 (re-search-forward regexp nil t)
132 (kill-buffer " *RMAIL-temp-VIEW*"))))
134 (defun rmail-search-mime-header (msg beg end regexp)
135 "Search the message header of number MSG for REGEXP.
136 If the search succeeds, return non-nil. Otherwise, return nil."
138 (rmail-decode-header " *RMAIL-temp-VIEW*"
141 (goto-char (point-min))
142 (prog1 (re-search-forward regexp nil t)
143 (kill-buffer " *RMAIL-temp-VIEW*"))))
145 (set-alist 'mime-raw-representation-type-alist 'rmail-mode
146 (if rmail-enable-mime
150 (set-alist 'mime-preview-over-to-previous-method-alist
154 (message "Beginning of buffer")
155 ;; (rmail-previous-undeleted-message 1)
158 (set-alist 'mime-preview-over-to-next-method-alist
162 (message "End of buffer")
163 ;; (rmail-next-undeleted-message 1)
166 (set-alist 'mime-preview-quitting-method-alist 'rmail-mode #'rmail-quit)
168 ;; Override values defined in rmail.
169 (eval-after-load "rmail"
171 (define-key rmail-mode-map "v" 'rmail-enable-mime)
172 (setq rmail-show-mime-function
173 (function rmail-show-mime-message)
174 rmail-insert-mime-forwarded-message-function
175 (function rmail-insert-mime-forwarded-message))
176 (unless rmail-view-mode-map
177 (setq rmail-view-mode-map (mime-view-define-keymap rmail-mode-map))
178 (define-key rmail-view-mode-map
179 "p" (function rmail-previous-undeleted-message))
180 (define-key rmail-view-mode-map
181 "n" (function rmail-next-undeleted-message))
182 (define-key rmail-view-mode-map
183 "u" (function rmail-undelete-previous-message))
184 (define-key rmail-view-mode-map
185 "a" (function rmail-add-label))
186 (define-key rmail-view-mode-map
187 "\C-c\C-c" (function rmail-disable-mime)))))
189 ;; Override values defined in rmailsum.
190 (eval-after-load "rmailsum"
191 '(setq rmail-summary-line-decoder
195 (decode-coding-string string 'undecided))))))
197 ;; Override values defined in sendmail.
198 (eval-after-load "sendmail"
200 (add-hook 'mail-setup-hook 'turn-on-mime-edit)
201 (add-hook 'mail-send-hook 'mime-edit-maybe-translate)))
203 (provide 'rmail-mime)