mail/rmail-mime.el

   1 ;;; rmail-mime.el --- Add MIME handling facility to RMAIL
   2
   3 ;; Copyright (C) 2001 Free Software Foundation, Inc.
   4
   5 ;; Author: MORIOKA Tomohiko <tomo@m17n.org>
   6 ;; Keywords: mail, news, MIME, multimedia, multilingual, encoded-word
   7
   8 ;; This file is part of SEMI (Setting for 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
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;; Code:
  26
  27 (require 'mime-view)
  28
  29 (defun rmail-decode-header (decoded-buffer original-buffer start end)
  30   (set-buffer (get-buffer-create decoded-buffer))
  31   (erase-buffer)
  32   (insert-buffer-substring original-buffer start end)
  33   (mime-decode-header-in-buffer rmail-enable-mime))
  34
  35 (defun rmail-decode-mime-message (decoded-buffer original-buffer msg)
  36   (save-excursion
  37     (set-buffer original-buffer)
  38     (save-restriction
  39       (narrow-to-region (rmail-msgbeg msg)
  40                         (rmail-msgend 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))
  45
  46 (defun rmail-view-kill-rmail-buffer ()
  47   (if rmail-buffer (kill-buffer rmail-buffer)))
  48
  49 (defvar rmail-view-mode-map nil)
  50
  51 (defun rmail-show-mime-message ()
  52   (let ((abuf (current-buffer))
  53         (buf-name (concat (buffer-name) "-view"))
  54         buf win)
  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
  60                                       buf-name nil
  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
  66             t nil nil nil
  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)
  90     (let ((mode-line
  91            (with-current-buffer abuf
  92              (setq rmail-view-buffer buf)
  93              mode-line-process)))
  94       (setq mode-line-process mode-line))
  95     (if (and (setq win (get-buffer-window abuf))
  96              buf)
  97         (set-window-buffer win buf))
  98     (bury-buffer rmail-buffer)
  99     (run-hooks 'rmail-show-mime-message-hook)))
 100
 101 (defun rmail-insert-mime-forwarded-message (forward-buffer)
 102   (insert (mime-make-tag "message" "rfc822"))
 103   (insert "\n")
 104   (mime-insert-entity (with-current-buffer forward-buffer
 105                         mime-message-structure)))
 106
 107 (defun rmail-insert-mime-resent-message (forward-buffer)
 108   (mime-insert-entity (with-current-buffer forward-buffer
 109                         mime-message-structure)))
 110
 111 (defun rmail-enable-mime ()
 112   (interactive)
 113   (setq rmail-enable-mime t)
 114   (rmail-show-message))
 115
 116 (defun rmail-disable-mime ()
 117   (interactive)
 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))
 123     (set-buffer buf))
 124   (setq rmail-enable-mime nil
 125         rmail-view-buffer (current-buffer))
 126   (rmail-show-message))
 127
 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."
 131   (save-excursion
 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*"))))
 136
 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."
 142   (save-excursion
 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*"))))
 147
 148 (set-alist 'mime-raw-representation-type-alist 'rmail-mode
 149            (if rmail-enable-mime
 150                'binary
 151              'cooked))
 152
 153 (set-alist 'mime-preview-over-to-previous-method-alist
 154            'rmail-mode
 155            (function
 156             (lambda ()
 157               (message "Beginning of buffer")
 158               ;; (rmail-previous-undeleted-message 1)
 159               )))
 160
 161 (set-alist 'mime-preview-over-to-next-method-alist
 162            'rmail-mode
 163            (function
 164             (lambda ()
 165               (message "End of buffer")
 166               ;; (rmail-next-undeleted-message 1)
 167               )))
 168
 169 (set-alist 'mime-preview-quitting-method-alist 'rmail-mode #'rmail-quit)
 170
 171 ;; Override values defined in rmail.
 172 (eval-after-load "rmail"
 173   '(progn
 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)))))
 197
 198 ;; Override values defined in rmailsum.
 199 (eval-after-load "rmailsum"
 200   '(setq rmail-summary-line-decoder
 201          (function
 202           (lambda (string)
 203             (eword-decode-string
 204              (decode-coding-string string 'undecided))))))
 205
 206 ;; Override values defined in sendmail.
 207 (eval-after-load "sendmail"
 208   '(progn
 209      (add-hook 'mail-setup-hook 'turn-on-mime-edit)
 210      (add-hook 'mail-send-hook 'mime-edit-maybe-translate)))
 211
 212 (provide 'rmail-mime)