tm-rmail.el

   1 ;;;
   2 ;;; Copyright (C) 1995 Free Software Foundation, Inc.
   3 ;;; Copyright (C) 1994,1995 MORIOKA Tomohiko
   4 ;;;
   5 ;;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
   6 ;;; modified by KOBAYASHI Shuhei <shuhei-k@jaist.ac.jp>
   7 ;;; Created: 1994/8/30
   8 ;;; Version:
   9 ;;;     $Revision: 7.24 $
  10 ;;; Keywords: mail, MIME, multimedia, multilingual, encoded-word
  11 ;;;
  12 ;;; This file is part of tm (Tools for MIME).
  13 ;;;
  14 ;;; This program is free software; you can redistribute it and/or
  15 ;;; modify it under the terms of the GNU General Public License as
  16 ;;; published by the Free Software Foundation; either version 2, or
  17 ;;; (at your option) any later version.
  18 ;;;
  19 ;;; This program is distributed in the hope that it will be useful,
  20 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  21 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  22 ;;; General Public License for more details.
  23 ;;;
  24 ;;; You should have received a copy of the GNU General Public License
  25 ;;; along with This program.  If not, write to the Free Software
  26 ;;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  27 ;;;
  28 ;;; Code:
  29
  30 (require 'tl-list)
  31 (require 'tl-misc)
  32 (require 'rmail)
  33
  34 (autoload 'mime/viewer-mode "tm-view" "View MIME message." t)
  35 (autoload 'mime/Content-Type "tm-view" "parse Content-Type field.")
  36 (autoload 'mime/decode-message-header "tm-ew-d" "Decode MIME encoded-word." t)
  37
  38
  39 ;;; @ variables
  40 ;;;
  41
  42 (defconst tm-rmail/RCS-ID
  43   "$Id: tm-rmail.el,v 7.24 1996/04/16 18:24:58 morioka Exp $")
  44 (defconst tm-rmail/version (get-version-string tm-rmail/RCS-ID))
  45
  46 (defvar tm-rmail/decode-all nil)
  47
  48
  49 ;;; @ message filter
  50 ;;;
  51
  52 (setq rmail-message-filter
  53       (function
  54        (lambda ()
  55          (let ((mf (buffer-modified-p))
  56                (buffer-read-only nil))
  57            (mime/decode-message-header)
  58            (set-buffer-modified-p mf)
  59            ))))
  60
  61
  62 ;;; @ MIME preview
  63 ;;;
  64
  65 (defun tm-rmail/show-all-header-p ()
  66   (save-restriction
  67     (narrow-to-region (point-min)
  68                       (and (re-search-forward "^$" nil t)
  69                            (match-beginning 0)))
  70     (goto-char (point-min))
  71     (re-search-forward rmail-ignored-headers nil t)
  72     ))
  73
  74 (defun tm-rmail/preview-message ()
  75   (interactive)
  76   (setq tm-rmail/decode-all t)
  77   (let ((ret (tm-rmail/get-Content-Type-and-Content-Transfer-Encoding)))
  78     (narrow-to-region (point-min)
  79                       (save-excursion
  80                         (goto-char (point-max))
  81                         (if (and (re-search-backward "^\n")
  82                                  (eq (match-end 0)(point-max)))
  83                             (match-beginning 0)
  84                           (point-max)
  85                           )))
  86     (let ((abuf (current-buffer))
  87           (buf-name (format "*Preview-%s [%d/%d]*"
  88                             (buffer-name)
  89                             rmail-current-message rmail-total-messages))
  90           buf win)
  91       (if (and mime::article/preview-buffer
  92                  (setq buf (get-buffer mime::article/preview-buffer))
  93                  )
  94           (progn
  95             (save-excursion
  96               (set-buffer buf)
  97               (rename-buffer buf-name)
  98               )
  99             (if (setq win (get-buffer-window buf))
 100                 (progn
 101                   (delete-window (get-buffer-window abuf))
 102                   (set-window-buffer win abuf)
 103                   (set-buffer abuf)
 104                   ))
 105             ))
 106       (setq win (get-buffer-window abuf))
 107       (save-window-excursion
 108         (mime/viewer-mode nil (car ret)(cdr ret) nil buf-name)
 109         (or buf
 110             (setq buf (current-buffer))
 111             )
 112         )
 113       (set-window-buffer win buf)
 114       )))
 115
 116 (defun tm-rmail/preview-message-if-you-need ()
 117   (if tm-rmail/decode-all
 118       (tm-rmail/preview-message)
 119     ))
 120
 121 (add-hook 'rmail-show-message-hook 'tm-rmail/preview-message-if-you-need)
 122
 123 (cond ((fboundp 'rmail-summary-rmail-update)
 124        ;; for Emacs 19 or later
 125        (or (fboundp 'tm:rmail-summary-rmail-update)
 126            (fset 'tm:rmail-summary-rmail-update
 127                  (symbol-function 'rmail-summary-rmail-update))
 128            )
 129
 130        (defun rmail-summary-rmail-update ()
 131          (tm:rmail-summary-rmail-update)
 132          (if tm-rmail/decode-all
 133              (let ((win (get-buffer-window rmail-buffer)))
 134                (if win
 135                    (delete-window win)
 136                  )))
 137          )
 138
 139        (defun tm-rmail/get-Content-Type-and-Content-Transfer-Encoding ()
 140          (rmail-widen-to-current-msgbeg
 141           (function
 142            (lambda ()
 143              (cons (mime/Content-Type)
 144                    (mime/Content-Transfer-Encoding "7bit")
 145                    )))))
 146        )
 147       (t
 148        ;; for Emacs 18
 149        (defun tm-rmail/get-Content-Type-and-Content-Transfer-Encoding ()
 150          (save-restriction
 151            (rmail-widen-to-current-msgbeg
 152             (function
 153              (lambda ()
 154                (goto-char (point-min))
 155                (narrow-to-region (or (and (re-search-forward "^.+:" nil t)
 156                                           (match-beginning 0))
 157                                      (point-min))
 158                                  (point-max))
 159                )))
 160            (cons (mime/Content-Type)
 161                  (mime/Content-Transfer-Encoding "7bit")
 162                  )))
 163        ))
 164
 165 (define-key rmail-mode-map "v" (function tm-rmail/preview-message))
 166
 167 (defun tm-rmail/setup ()
 168   (local-set-key "v" (function
 169                       (lambda ()
 170                         (interactive)
 171                         (set-buffer rmail-buffer)
 172                         (tm-rmail/preview-message)
 173                         )))
 174   )
 175
 176 (add-hook 'rmail-summary-mode-hook 'tm-rmail/setup)
 177
 178
 179 ;;; @ over-to-* and quitting methods
 180 ;;;
 181
 182 (defun tm-rmail/quitting-method-to-summary ()
 183   (mime-viewer/kill-buffer)
 184   (rmail-summary)
 185   (delete-other-windows)
 186   )
 187
 188 (defun tm-rmail/quitting-method-to-article ()
 189   (setq tm-rmail/decode-all nil)
 190   (mime-viewer/kill-buffer)
 191   )
 192
 193 (defalias 'tm-rmail/quitting-method 'tm-rmail/quitting-method-to-article)
 194
 195
 196 (defun tm-rmail/over-to-previous-method ()
 197   (let (tm-rmail/decode-all)
 198     (mime-viewer/quit)
 199     )
 200   (if (not (eq (rmail-next-undeleted-message -1) t))
 201       (tm-rmail/preview-message)
 202     )
 203   )
 204
 205 (defun tm-rmail/over-to-next-method ()
 206   (let (tm-rmail/decode-all)
 207     (mime-viewer/quit)
 208     )
 209   (if (not (eq (rmail-next-undeleted-message 1) t))
 210       (tm-rmail/preview-message)
 211     )
 212   )
 213
 214 (defun tm-rmail/show-summary-method ()
 215   (save-excursion
 216     (set-buffer mime::preview/article-buffer)
 217     (rmail-summary)
 218     ))
 219
 220 (call-after-loaded
 221  'tm-view
 222  (function
 223   (lambda ()
 224     (set-alist 'mime-viewer/quitting-method-alist
 225                'rmail-mode
 226                (function tm-rmail/quitting-method))
 227
 228     (set-alist 'mime-viewer/over-to-previous-method-alist
 229                'rmail-mode
 230                (function tm-rmail/over-to-previous-method))
 231
 232     (set-alist 'mime-viewer/over-to-next-method-alist
 233                'rmail-mode
 234                (function tm-rmail/over-to-next-method))
 235
 236     (set-alist 'mime-viewer/show-summary-method
 237                'rmail-mode
 238                (function tm-rmail/show-summary-method))
 239     )))
 240
 241
 242 ;;; @ for tm-partial
 243 ;;;
 244
 245 (call-after-loaded
 246  'tm-partial
 247  (function
 248   (lambda ()
 249     (set-atype 'mime/content-decoding-condition
 250                '((type . "message/partial")
 251                  (method . mime-article/grab-message/partials)
 252                  (major-mode . rmail-mode)
 253                  (summary-buffer-exp
 254                   . (progn
 255                       (rmail-summary)
 256                       (pop-to-buffer rmail-buffer)
 257                       rmail-summary-buffer))
 258                  ))
 259     (set-alist 'tm-partial/preview-article-method-alist
 260                'rmail-mode
 261                (function
 262                 (lambda ()
 263                   (rmail-summary-goto-msg (count-lines 1 (point)))
 264                   (pop-to-buffer rmail-buffer)
 265                   (tm-rmail/preview-message)
 266                   )))
 267     )))
 268
 269
 270 ;;; @ for tm-edit
 271 ;;;
 272
 273 (defun tm-rmail/forward ()
 274   "Forward current message in message/rfc822 content-type message
 275 from rmail. The message will be appended if being composed."
 276   (interactive)
 277   ;;>> this gets set even if we abort. Can't do anything about it, though.
 278   (rmail-set-attribute "forwarded" t)
 279   (let ((initialized nil)
 280         (beginning nil)
 281         (msgnum rmail-current-message)
 282         (rmail-buffer (current-buffer))
 283         (subject (concat "["
 284                          (mail-strip-quoted-names
 285                           (mail-fetch-field "From"))
 286                          ": " (or (mail-fetch-field "Subject") "") "]")))
 287     ;; If only one window, use it for the mail buffer.
 288     ;; Otherwise, use another window for the mail buffer
 289     ;; so that the Rmail buffer remains visible
 290     ;; and sending the mail will get back to it.
 291     (setq initialized
 292           (if (one-window-p t)
 293               (mail nil nil subject)
 294             (mail-other-window nil nil subject)))
 295     (save-excursion
 296       ;; following two variables are used in 19.29 or later.
 297       (make-local-variable 'rmail-send-actions-rmail-buffer)
 298       (make-local-variable 'rmail-send-actions-rmail-msg-number)
 299       (make-local-variable 'mail-reply-buffer)
 300       (setq rmail-send-actions-rmail-buffer rmail-buffer)
 301       (setq rmail-send-actions-rmail-msg-number msgnum)
 302       (setq mail-reply-buffer rmail-buffer)
 303       (goto-char (point-max))
 304       (forward-line 1)
 305       (setq beginning (point))
 306       (mime-editor/insert-tag "message" "rfc822")
 307 ;;       (insert-buffer rmail-buffer))
 308 ;;       (mime-editor/inserted-message-filter))
 309       (tm-mail/insert-message))
 310     (if (not initialized)
 311         (goto-char beginning))
 312     ))
 313
 314 (defun gnus-mail-forward-using-mail-mime ()
 315   "Forward current article in message/rfc822 content-type message from
 316 GNUS. The message will be appended if being composed."
 317   (let ((initialized nil)
 318         (beginning nil)
 319         (forwarding-buffer (current-buffer))
 320         (subject
 321          (concat "[" gnus-newsgroup-name "] "
 322                  ;;(mail-strip-quoted-names (gnus-fetch-field "From")) ": "
 323                  (or (gnus-fetch-field "Subject") ""))))
 324     ;; If only one window, use it for the mail buffer.
 325     ;; Otherwise, use another window for the mail buffer
 326     ;; so that the Rmail buffer remains visible
 327     ;; and sending the mail will get back to it.
 328     (setq initialized
 329           (if (one-window-p t)
 330               (mail nil nil subject)
 331             (mail-other-window nil nil subject)))
 332     (save-excursion
 333       (goto-char (point-max))
 334       (setq beginning (point))
 335       (mime-editor/insert-tag "message" "rfc822")
 336       (insert-buffer forwarding-buffer)
 337       ;; You have a chance to arrange the message.
 338       (run-hooks 'gnus-mail-forward-hook)
 339       )
 340     (if (not initialized)
 341         (goto-char beginning))
 342     ))
 343
 344 (call-after-loaded
 345  'mime-setup
 346  (function
 347   (lambda ()
 348     (substitute-key-definition
 349      'rmail-forward 'tm-rmail/forward rmail-mode-map)
 350
 351     ;; (setq gnus-mail-forward-method 'gnus-mail-forward-using-mail-mime)
 352
 353     (call-after-loaded
 354      'tm-edit
 355      (function
 356       (lambda ()
 357         (require 'tm-mail)
 358         (set-alist 'mime-editor/message-inserter-alist
 359                    'mail-mode (function tm-mail/insert-message))
 360         )))
 361     )))
 362
 363
 364 ;;; @ for BBDB
 365 ;;;
 366
 367 (call-after-loaded
 368  'bbdb
 369  (function
 370   (lambda ()
 371     (require 'tm-bbdb)
 372     )))
 373
 374
 375 ;;; @ end
 376 ;;;
 377
 378 (provide 'tm-rmail)
 379
 380 (run-hooks 'tm-rmail-load-hook)
 381
 382 ;;; tm-rmail.el ends here.