tm 7.67.
[elisp/tm.git] / tm-rmail.el
index 13afb96..d6a40b6 100644 (file)
@@ -2,13 +2,30 @@
 ;;; Copyright (C) 1995 Free Software Foundation, Inc.
 ;;; Copyright (C) 1994,1995 MORIOKA Tomohiko
 ;;;
-;;; Author:   MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;;; modified by KOBAYASHI Shuhei <shuhei-k@jaist.ac.jp>
+;;; Created: 1994/8/30
 ;;; Version:
-;;;    $Id: tm-rmail.el,v 7.16 1995/12/03 13:46:59 morioka Exp $
+;;;    $Revision: 7.24 $
 ;;; Keywords: mail, MIME, multimedia, multilingual, encoded-word
 ;;;
 ;;; This file is part of tm (Tools for MIME).
 ;;;
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU General Public License as
+;;; published by the Free Software Foundation; either version 2, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with This program.  If not, write to the Free Software
+;;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;;;
+;;; Code:
 
 (require 'tl-list)
 (require 'tl-misc)
 ;;; @ variables
 ;;;
 
+(defconst tm-rmail/RCS-ID
+  "$Id: tm-rmail.el,v 7.24 1996/04/16 18:24:58 morioka Exp $")
+(defconst tm-rmail/version (get-version-string tm-rmail/RCS-ID))
+
 (defvar tm-rmail/decode-all nil)
 
 
 (defun tm-rmail/preview-message ()
   (interactive)
   (setq tm-rmail/decode-all t)
-  (let ((ret (rmail-widen-to-current-msgbeg
-             (function
-              (lambda ()
-                (cons (mime/Content-Type)
-                      (mime/Content-Transfer-Encoding "7bit")
-                      )
-                )))))
+  (let ((ret (tm-rmail/get-Content-Type-and-Content-Transfer-Encoding)))
     (narrow-to-region (point-min)
                      (save-excursion
                        (goto-char (point-max))
                            (match-beginning 0)
                          (point-max)
                          )))
-    (mime/viewer-mode nil (car ret)(cdr ret) nil
-                     (format "*Preview-%s [%d/%d]*"
-                             (buffer-name)
-                             rmail-current-message rmail-total-messages))
-    ))
+    (let ((abuf (current-buffer))
+         (buf-name (format "*Preview-%s [%d/%d]*"
+                           (buffer-name)
+                           rmail-current-message rmail-total-messages))
+         buf win)
+      (if (and mime::article/preview-buffer
+                (setq buf (get-buffer mime::article/preview-buffer))
+                )
+         (progn
+           (save-excursion
+             (set-buffer buf)
+             (rename-buffer buf-name)
+             )
+           (if (setq win (get-buffer-window buf))
+               (progn
+                 (delete-window (get-buffer-window abuf))
+                 (set-window-buffer win abuf)
+                 (set-buffer abuf)
+                 ))
+           ))
+      (setq win (get-buffer-window abuf))
+      (save-window-excursion
+       (mime/viewer-mode nil (car ret)(cdr ret) nil buf-name)
+       (or buf
+           (setq buf (current-buffer))
+           )
+       )
+      (set-window-buffer win buf)
+      )))
 
 (defun tm-rmail/preview-message-if-you-need ()
   (if tm-rmail/decode-all
 
 (add-hook 'rmail-show-message-hook 'tm-rmail/preview-message-if-you-need)
 
+(cond ((fboundp 'rmail-summary-rmail-update)
+       ;; for Emacs 19 or later
+       (or (fboundp 'tm:rmail-summary-rmail-update)
+          (fset 'tm:rmail-summary-rmail-update
+                (symbol-function 'rmail-summary-rmail-update))
+          )
+       
+       (defun rmail-summary-rmail-update ()
+        (tm:rmail-summary-rmail-update)
+        (if tm-rmail/decode-all
+            (let ((win (get-buffer-window rmail-buffer)))
+              (if win
+                  (delete-window win)
+                )))
+        )
+       
+       (defun tm-rmail/get-Content-Type-and-Content-Transfer-Encoding ()
+        (rmail-widen-to-current-msgbeg
+         (function
+          (lambda ()
+            (cons (mime/Content-Type)
+                  (mime/Content-Transfer-Encoding "7bit")
+                  )))))
+       )
+      (t
+       ;; for Emacs 18
+       (defun tm-rmail/get-Content-Type-and-Content-Transfer-Encoding ()
+        (save-restriction
+          (rmail-widen-to-current-msgbeg
+           (function
+            (lambda ()
+              (goto-char (point-min))
+              (narrow-to-region (or (and (re-search-forward "^.+:" nil t)
+                                         (match-beginning 0))
+                                    (point-min))
+                                (point-max))
+              )))
+          (cons (mime/Content-Type)
+                (mime/Content-Transfer-Encoding "7bit")
+                )))
+       ))
+
 (define-key rmail-mode-map "v" (function tm-rmail/preview-message))
 
 (defun tm-rmail/setup ()
   (local-set-key "v" (function
                      (lambda ()
                        (interactive)
-                       (pop-to-buffer rmail-buffer)
+                       (set-buffer rmail-buffer)
                        (tm-rmail/preview-message)
                        )))
   )
     )
   )
 
+(defun tm-rmail/show-summary-method ()
+  (save-excursion
+    (set-buffer mime::preview/article-buffer)
+    (rmail-summary)
+    ))
+
 (call-after-loaded
  'tm-view
  (function
     (set-alist 'mime-viewer/over-to-next-method-alist
               'rmail-mode
               (function tm-rmail/over-to-next-method))
+
+    (set-alist 'mime-viewer/show-summary-method
+              'rmail-mode
+              (function tm-rmail/show-summary-method))
     )))
 
 
 ;;; @ for tm-edit
 ;;;
 
-(call-after-loaded
- 'tm-edit
- (function
-  (lambda ()
-    
 (defun tm-rmail/forward ()
-  "\
-Forward current message in message/rfc822 content-type message
+  "Forward current message in message/rfc822 content-type message
 from rmail. The message will be appended if being composed."
   (interactive)
   ;;>> this gets set even if we abort. Can't do anything about it, though.
   (rmail-set-attribute "forwarded" t)
   (let ((initialized nil)
        (beginning nil)
-       (forwarding-buffer (current-buffer))
+       (msgnum rmail-current-message)
+       (rmail-buffer (current-buffer))
        (subject (concat "["
                         (mail-strip-quoted-names
                          (mail-fetch-field "From"))
@@ -207,22 +293,26 @@ from rmail. The message will be appended if being composed."
              (mail nil nil subject)
            (mail-other-window nil nil subject)))
     (save-excursion
+      ;; following two variables are used in 19.29 or later.
+      (make-local-variable 'rmail-send-actions-rmail-buffer)
+      (make-local-variable 'rmail-send-actions-rmail-msg-number)
+      (make-local-variable 'mail-reply-buffer)
+      (setq rmail-send-actions-rmail-buffer rmail-buffer)
+      (setq rmail-send-actions-rmail-msg-number msgnum)
+      (setq mail-reply-buffer rmail-buffer)
       (goto-char (point-max))
       (forward-line 1)
       (setq beginning (point))
       (mime-editor/insert-tag "message" "rfc822")
-      (insert-buffer forwarding-buffer))
+;;       (insert-buffer rmail-buffer))
+;;       (mime-editor/inserted-message-filter))
+      (tm-mail/insert-message))
     (if (not initialized)
        (goto-char beginning))
     ))
 
-(substitute-key-definition 'rmail-forward
-                          'tm-rmail/forward
-                          rmail-mode-map)
-
 (defun gnus-mail-forward-using-mail-mime ()
-  "\
-Forward current article in message/rfc822 content-type message from
+  "Forward current article in message/rfc822 content-type message from
 GNUS. The message will be appended if being composed."
   (let ((initialized nil)
        (beginning nil)
@@ -251,18 +341,35 @@ GNUS. The message will be appended if being composed."
        (goto-char beginning))
     ))
 
-;; (setq gnus-mail-forward-method 'mime-forward-from-gnus-using-mail)
-
 (call-after-loaded
- 'tm-edit
+ 'mime-setup
  (function
   (lambda ()
-    (autoload 'tm-mail/insert-message "tm-mail")
-    (set-alist 'mime-editor/message-inserter-alist
-              'mail-mode (function tm-mail/insert-message))
+    (substitute-key-definition
+     'rmail-forward 'tm-rmail/forward rmail-mode-map)
+    
+    ;; (setq gnus-mail-forward-method 'gnus-mail-forward-using-mail-mime)
+    
+    (call-after-loaded
+     'tm-edit
+     (function
+      (lambda ()
+       (require 'tm-mail)
+       (set-alist 'mime-editor/message-inserter-alist
+                  'mail-mode (function tm-mail/insert-message))
+       )))
     )))
 
-)))
+
+;;; @ for BBDB
+;;;
+
+(call-after-loaded
+ 'bbdb
+ (function
+  (lambda ()
+    (require 'tm-bbdb)
+    )))
 
 
 ;;; @ end
@@ -271,3 +378,5 @@ GNUS. The message will be appended if being composed."
 (provide 'tm-rmail)
 
 (run-hooks 'tm-rmail-load-hook)
+
+;;; tm-rmail.el ends here.