tm 7.102.

[elisp/tm.git] / tm-rmail.el

diff --git a/tm-rmail.el b/tm-rmail.el
index 13afb96..24f4971 100644 (file)
--- a/tm-rmail.el
+++ b/tm-rmail.el
@@ -1,14 +1,31 @@
 ;;;
 ;;; Copyright (C) 1995 Free Software Foundation, Inc.
 ;;;
 ;;; Copyright (C) 1995 Free Software Foundation, Inc.

-;;; Copyright (C) 1994,1995 MORIOKA Tomohiko
+;;; Copyright (C) 1994 .. 1996 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:
 ;;; Version:

-;;;    $Id: tm-rmail.el,v 7.16 1995/12/03 13:46:59 morioka Exp $
+;;;    $Revision: 7.25 $

 ;;; Keywords: mail, MIME, multimedia, multilingual, encoded-word
 ;;;
 ;;; This file is part of tm (Tools for MIME).
 ;;;
 ;;; 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)
 
 (require 'tl-list)
 (require 'tl-misc)

@@ -22,6 +39,10 @@
 ;;; @ variables
 ;;;
 
 ;;; @ variables
 ;;;
 

+(defconst tm-rmail/RCS-ID
+  "$Id: tm-rmail.el,v 7.25 1996/06/12 05:38:23 morioka Exp $")
+(defconst tm-rmail/version (get-version-string tm-rmail/RCS-ID))
+

 (defvar tm-rmail/decode-all nil)
 
 
 (defvar tm-rmail/decode-all nil)
 
 

@@ -53,13 +74,7 @@
 (defun tm-rmail/preview-message ()
   (interactive)
   (setq tm-rmail/decode-all t)
 (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))
     (narrow-to-region (point-min)
                      (save-excursion
                        (goto-char (point-max))

@@ -68,11 +83,35 @@
                            (match-beginning 0)
                          (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
 
 (defun tm-rmail/preview-message-if-you-need ()
   (if tm-rmail/decode-all

@@ -81,13 +120,55 @@
 
 (add-hook 'rmail-show-message-hook 'tm-rmail/preview-message-if-you-need)
 
 
 (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)
 (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)
                        )))
   )
                        (tm-rmail/preview-message)
                        )))
   )

@@ -130,6 +211,12 @@
     )
   )
 
     )
   )
 

+(defun tm-rmail/show-summary-method ()
+  (save-excursion
+    (set-buffer mime::preview/article-buffer)
+    (rmail-summary)
+    ))
+

 (call-after-loaded
  'tm-view
  (function
 (call-after-loaded
  'tm-view
  (function

@@ -145,6 +232,10 @@
     (set-alist 'mime-viewer/over-to-next-method-alist
               'rmail-mode
               (function tm-rmail/over-to-next-method))
     (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))

     )))
 
 
     )))
 
 

@@ -179,21 +270,16 @@
 ;;; @ for tm-edit
 ;;;
 
 ;;; @ for tm-edit
 ;;;
 

-(call-after-loaded
- 'tm-edit
- (function
-  (lambda ()
-    

 (defun tm-rmail/forward ()
 (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)
 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"))
        (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
              (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")
       (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))
     ))
 
     (if (not initialized)
        (goto-char beginning))
     ))
 

-(substitute-key-definition 'rmail-forward
-                          'tm-rmail/forward
-                          rmail-mode-map)
-

 (defun gnus-mail-forward-using-mail-mime ()
 (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)
 GNUS. The message will be appended if being composed."
   (let ((initialized nil)
        (beginning nil)

@@ -251,18 +341,41 @@ GNUS. The message will be appended if being composed."
        (goto-char beginning))
     ))
 
        (goto-char beginning))
     ))
 

-;; (setq gnus-mail-forward-method 'mime-forward-from-gnus-using-mail)
-

 (call-after-loaded
 (call-after-loaded

- 'tm-edit
+ 'mime-setup

  (function
   (lambda ()
  (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))
+       (set-alist 'mime-editor/split-message-sender-alist
+                  'mail-mode (function
+                              (lambda ()
+                                (interactive)
+                                (sendmail-send-it)
+                                )))
+       )))

     )))
 
     )))
 

-)))
+
+;;; @ for BBDB
+;;;
+
+(call-after-loaded
+ 'bbdb
+ (function
+  (lambda ()
+    (require 'tm-bbdb)
+    )))

 
 
 ;;; @ end
 
 
 ;;; @ end

@@ -271,3 +384,5 @@ GNUS. The message will be appended if being composed."
 (provide 'tm-rmail)
 
 (run-hooks 'tm-rmail-load-hook)
 (provide 'tm-rmail)
 
 (run-hooks 'tm-rmail-load-hook)

+
+;;; tm-rmail.el ends here.