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)
89 (with-current-buffer abuf
90 (setq rmail-view-buffer buf)
92 (setq mode-line-process mode-line))
93 (if (and (setq win (get-buffer-window abuf))
95 (set-window-buffer win buf))
96 (bury-buffer rmail-buffer)
97 (run-hooks 'rmail-show-mime-message-hook)))
99 (defun rmail-insert-mime-forwarded-message (forward-buffer)
100 (insert (mime-make-tag "message" "rfc822"))
102 (mime-insert-entity (with-current-buffer forward-buffer
103 mime-message-structure)))
105 (defun rmail-enable-mime ()
107 (setq rmail-enable-mime t)
108 (rmail-show-message))
110 (defun rmail-disable-mime ()
112 (let ((buf rmail-buffer))
113 (when rmail-enable-mime
114 (remove-hook 'kill-buffer-hook 'rmail-view-kill-rmail-buffer)
115 (set-window-buffer (selected-window) buf)
116 (kill-buffer rmail-view-buffer))
118 (setq rmail-enable-mime nil
119 rmail-view-buffer (current-buffer))
120 (rmail-show-message))
122 (defun rmail-search-mime-message (msg regexp)
123 "Search the message of number MSG for REGEXP.
124 If the search succeeds, return non-nil. Otherwise, return nil."
126 (rmail-decode-mime-message " *RMAIL-temp-VIEW*" (current-buffer) msg)
127 (goto-char (point-min))
128 (prog1 (re-search-forward regexp nil t)
129 (kill-buffer " *RMAIL-temp-VIEW*"))))
131 (defun rmail-search-mime-header (msg beg end regexp)
132 "Search the message header of number MSG for REGEXP.
133 If the search succeeds, return non-nil. Otherwise, return nil."
135 (rmail-decode-header " *RMAIL-temp-VIEW*"
138 (goto-char (point-min))
139 (prog1 (re-search-forward regexp nil t)
140 (kill-buffer " *RMAIL-temp-VIEW*"))))
142 (set-alist 'mime-raw-representation-type-alist 'rmail-mode
143 (if rmail-enable-mime
147 (set-alist 'mime-preview-over-to-previous-method-alist
151 (message "Beginning of buffer")
152 ;; (rmail-previous-undeleted-message 1)
155 (set-alist 'mime-preview-over-to-next-method-alist
159 (message "End of buffer")
160 ;; (rmail-next-undeleted-message 1)
163 (set-alist 'mime-preview-quitting-method-alist 'rmail-mode #'rmail-quit)
165 ;; Override values defined in rmail.
166 (eval-after-load "rmail"
168 (define-key rmail-mode-map "v" 'rmail-enable-mime)
169 (setq rmail-show-mime-function
170 (function rmail-show-mime-message)
171 rmail-insert-mime-forwarded-message-function
172 (function rmail-insert-mime-forwarded-message))
173 (unless rmail-view-mode-map
174 (setq rmail-view-mode-map (mime-view-define-keymap rmail-mode-map))
175 (define-key rmail-view-mode-map
176 "p" (function rmail-previous-undeleted-message))
177 (define-key rmail-view-mode-map
178 "n" (function rmail-next-undeleted-message))
179 (define-key rmail-view-mode-map
180 "u" (function rmail-undelete-previous-message))
181 (define-key rmail-view-mode-map
182 "a" (function rmail-add-label))
183 (define-key rmail-view-mode-map
184 "\C-c\C-c" (function rmail-disable-mime)))))
186 ;; Override values defined in rmailsum.
187 (eval-after-load "rmailsum"
188 '(setq rmail-summary-line-decoder
192 (decode-coding-string string 'undecided))))))
194 ;; Override values defined in sendmail.
195 (eval-after-load "sendmail"
197 (add-hook 'mail-setup-hook 'turn-on-mime-edit)
198 (add-hook 'mail-send-hook 'mime-edit-maybe-translate)))
200 (provide 'rmail-mime)