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     (let ((mode-line
  89            (with-current-buffer abuf
  90              (setq rmail-view-buffer buf)
  91              mode-line-process)))
  92       (setq mode-line-process mode-line))
  93     (if (and (setq win (get-buffer-window abuf))
  94              buf)
  95         (set-window-buffer win buf))
  96     (bury-buffer rmail-buffer)
  97     (run-hooks 'rmail-show-mime-message-hook)))
  98
  99 (defun rmail-insert-mime-forwarded-message (forward-buffer)
 100   (insert (mime-make-tag "message" "rfc822"))
 101   (insert "\n")
 102   (mime-insert-entity (with-current-buffer forward-buffer
 103                         mime-message-structure)))
 104
 105 (defun rmail-insert-mime-resent-message (forward-buffer)
 106   (mime-insert-entity (with-current-buffer forward-buffer
 107                         mime-message-structure)))
 108
 109 (defun rmail-enable-mime ()
 110   (interactive)
 111   (setq rmail-enable-mime t)
 112   (rmail-show-message))
 113
 114 (defun rmail-disable-mime ()
 115   (interactive)
 116   (let ((buf rmail-buffer))
 117     (when rmail-enable-mime
 118       (remove-hook 'kill-buffer-hook 'rmail-view-kill-rmail-buffer)
 119       (set-window-buffer (selected-window) buf)
 120       (kill-buffer rmail-view-buffer))
 121     (set-buffer buf))
 122   (setq rmail-enable-mime nil
 123         rmail-view-buffer (current-buffer))
 124   (rmail-show-message))
 125
 126 (defun rmail-search-mime-message (msg regexp)
 127   "Search the message of number MSG for REGEXP.
 128 If the search succeeds, return non-nil.  Otherwise, return nil."
 129   (save-excursion
 130     (rmail-decode-mime-message " *RMAIL-temp-VIEW*" (current-buffer) msg)
 131     (goto-char (point-min))
 132     (prog1 (re-search-forward regexp nil t)
 133       (kill-buffer " *RMAIL-temp-VIEW*"))))
 134
 135 (defun rmail-search-mime-header (msg regexp limit)
 136   "Search the message header of number MSG for REGEXP.
 137 The current point is the beginninf of header,
 138 and LIMIT is the end position of header.
 139 If the search succeeds, return non-nil.  Otherwise, return nil."
 140   (save-excursion
 141     (rmail-decode-header " *RMAIL-temp-VIEW*" (current-buffer) (point) limit)
 142     (goto-char (point-min))
 143     (prog1 (re-search-forward regexp nil t)
 144       (kill-buffer " *RMAIL-temp-VIEW*"))))
 145
 146 (set-alist 'mime-raw-representation-type-alist 'rmail-mode
 147            (if rmail-enable-mime
 148                'binary
 149              'cooked))
 150
 151 (set-alist 'mime-preview-over-to-previous-method-alist
 152            'rmail-mode
 153            (function
 154             (lambda ()
 155               (message "Beginning of buffer")
 156               ;; (rmail-previous-undeleted-message 1)
 157               )))
 158
 159 (set-alist 'mime-preview-over-to-next-method-alist
 160            'rmail-mode
 161            (function
 162             (lambda ()
 163               (message "End of buffer")
 164               ;; (rmail-next-undeleted-message 1)
 165               )))
 166
 167 (set-alist 'mime-preview-quitting-method-alist 'rmail-mode #'rmail-quit)
 168
 169 ;; Override values defined in rmail.
 170 (eval-after-load "rmail"
 171   '(progn
 172      (define-key rmail-mode-map "v" 'rmail-enable-mime)
 173      (setq rmail-show-mime-function
 174            (function rmail-show-mime-message)
 175            rmail-insert-mime-forwarded-message-function
 176            (function rmail-insert-mime-forwarded-message)
 177            rmail-insert-mime-resent-message-function
 178            (function rmail-insert-mime-resent-message)
 179            rmail-search-mime-message-function
 180            (function rmail-search-mime-message)
 181            rmail-search-mime-header-function
 182            (function rmail-search-mime-header))
 183      (unless rmail-view-mode-map
 184        (setq rmail-view-mode-map (mime-view-define-keymap rmail-mode-map))
 185        (define-key rmail-view-mode-map
 186          "p" (function rmail-previous-undeleted-message))
 187        (define-key rmail-view-mode-map
 188          "n" (function rmail-next-undeleted-message))
 189        (define-key rmail-view-mode-map
 190          "u" (function rmail-undelete-previous-message))
 191        (define-key rmail-view-mode-map
 192          "a" (function rmail-add-label))
 193        (define-key rmail-view-mode-map
 194          "\C-c\C-c" (function rmail-disable-mime)))))
 195
 196 ;; Override values defined in rmailsum.
 197 (eval-after-load "rmailsum"
 198   '(setq rmail-summary-line-decoder
 199          (function
 200           (lambda (string)
 201             (eword-decode-string
 202              (decode-coding-string string 'undecided))))))
 203
 204 ;; Override values defined in sendmail.
 205 (eval-after-load "sendmail"
 206   '(progn
 207      (add-hook 'mail-setup-hook 'turn-on-mime-edit)
 208      (add-hook 'mail-send-hook 'mime-edit-maybe-translate)))
 209
 210 (provide 'rmail-mime)