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-enable-mime ()
 106   (interactive)
 107   (setq rmail-enable-mime t)
 108   (rmail-show-message))
 109
 110 (defun rmail-disable-mime ()
 111   (interactive)
 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))
 117     (set-buffer buf))
 118   (setq rmail-enable-mime nil
 119         rmail-view-buffer (current-buffer))
 120   (rmail-show-message))
 121
 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."
 125   (save-excursion
 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*"))))
 130
 131 (defun rmail-search-mime-header (msg regexp limit)
 132   "Search the message header of number MSG for REGEXP.
 133 The current point is the beginninf of header,
 134 and LIMIT is the end position of header.
 135 If the search succeeds, return non-nil.  Otherwise, return nil."
 136   (save-excursion
 137     (rmail-decode-header " *RMAIL-temp-VIEW*" (current-buffer) (point) limit)
 138     (goto-char (point-min))
 139     (prog1 (re-search-forward regexp nil t)
 140       (kill-buffer " *RMAIL-temp-VIEW*"))))
 141
 142 (set-alist 'mime-raw-representation-type-alist 'rmail-mode
 143            (if rmail-enable-mime
 144                'binary
 145              'cooked))
 146
 147 (set-alist 'mime-preview-over-to-previous-method-alist
 148            'rmail-mode
 149            (function
 150             (lambda ()
 151               (message "Beginning of buffer")
 152               ;; (rmail-previous-undeleted-message 1)
 153               )))
 154
 155 (set-alist 'mime-preview-over-to-next-method-alist
 156            'rmail-mode
 157            (function
 158             (lambda ()
 159               (message "End of buffer")
 160               ;; (rmail-next-undeleted-message 1)
 161               )))
 162
 163 (set-alist 'mime-preview-quitting-method-alist 'rmail-mode #'rmail-quit)
 164
 165 ;; Override values defined in rmail.
 166 (eval-after-load "rmail"
 167   '(progn
 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            rmail-search-mime-message-function
 174            (function rmail-search-mime-message)
 175            rmail-search-mime-header-function
 176            (function rmail-search-mime-header))
 177      (unless rmail-view-mode-map
 178        (setq rmail-view-mode-map (mime-view-define-keymap rmail-mode-map))
 179        (define-key rmail-view-mode-map
 180          "p" (function rmail-previous-undeleted-message))
 181        (define-key rmail-view-mode-map
 182          "n" (function rmail-next-undeleted-message))
 183        (define-key rmail-view-mode-map
 184          "u" (function rmail-undelete-previous-message))
 185        (define-key rmail-view-mode-map
 186          "a" (function rmail-add-label))
 187        (define-key rmail-view-mode-map
 188          "\C-c\C-c" (function rmail-disable-mime)))))
 189
 190 ;; Override values defined in rmailsum.
 191 (eval-after-load "rmailsum"
 192   '(setq rmail-summary-line-decoder
 193          (function
 194           (lambda (string)
 195             (eword-decode-string
 196              (decode-coding-string string 'undecided))))))
 197
 198 ;; Override values defined in sendmail.
 199 (eval-after-load "sendmail"
 200   '(progn
 201      (add-hook 'mail-setup-hook 'turn-on-mime-edit)
 202      (add-hook 'mail-send-hook 'mime-edit-maybe-translate)))
 203
 204 (provide 'rmail-mime)