This commit was generated by cvs2svn to compensate for changes in r491,

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

diff --git a/tm-vm.el b/tm-vm.el
index 3e6479c..962cc18 100644 (file)
--- a/tm-vm.el
+++ b/tm-vm.el
@@ -1,49 +1,45 @@
-;;;
-;;; tm-vm.el --- tm-MUA for VM
-;;;
-;;; Copyright (C) 1994 MASUTANI Yasuhiro
-;;; Copyright (C) 1995 WAKAMIYA Kenji
-;;; Copyright (C) 1995,1996 KOBAYASHI Shuhei
-;;; Copyright (C) 1996 Oscar Figueiredo
-;;;
-;;; Author: MASUTANI Yasuhiro <masutani@me.es.osaka-u.ac.jp>
-;;;         Kenji Wakamiya <wkenji@flab.fujitsu.co.jp>
-;;;         MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;;;         Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp>
-;;;         Oscar Figueiredo <figueire@lspsun2.epfl.ch>
-;;; modified by SHIONO Jun'ichi <jun@case.nm.fujitsu.co.jp>
-;;;             ISHIHARA Akito <aki@bpel.tutics.tut.ac.jp>
-;;;             Rob Kooper <kooper@cc.gatech.edu>
-;;; Maintainer: KOBAYASHI Shuhei <shuhei-k@jaist.ac.jp>
-;;; Created: 1994/10/29
-;;; Version: $Revision: 7.51 $
-;;; Keywords: mail, MIME, multimedia, multilingual, encoded-word
-;;;
-;;; This file is part of tm (Tools for MIME).
-;;;
-;;; Plese insert `(require 'tm-vm)' in your ~/.vm file.
-;;;
-;;; 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.
-;;;
+;;; tm-vm.el --- tm-MUA (MIME Extension module) for VM
+
+;; Copyright (C) 1994,1995,1996 Free Software Foundation, Inc.
+
+;; Author: MASUTANI Yasuhiro <masutani@me.es.osaka-u.ac.jp>
+;;         Kenji Wakamiya <wkenji@flab.fujitsu.co.jp>
+;;         MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;;         Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp>
+;;         Oscar Figueiredo <figueire@lspsun2.epfl.ch>
+;; Maintainer: Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp>
+;; Created: 1994/10/29
+;; Version: $Revision: 7.62 $
+;; 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; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;     Plese insert `(require 'tm-vm)' in your ~/.vm file.
+

 ;;; Code:
 
 (require 'tm-view)
 (require 'vm)
 
 (defconst tm-vm/RCS-ID
 ;;; Code:
 
 (require 'tm-view)
 (require 'vm)
 
 (defconst tm-vm/RCS-ID

-  "$Id: tm-vm.el,v 7.51 1996/04/16 18:26:13 morioka Exp $")
+  "$Id: tm-vm.el,v 7.62 1996/08/31 14:24:35 morioka Exp $")

 (defconst tm-vm/version (get-version-string tm-vm/RCS-ID))
 
 (define-key vm-mode-map "Z" 'tm-vm/view-message)
 (defconst tm-vm/version (get-version-string tm-vm/RCS-ID))
 
 (define-key vm-mode-map "Z" 'tm-vm/view-message)

@@ -105,7 +101,7 @@ If you use tiny-mime patch for VM (by RIKITAKE Kenji
 ))
 
 (defun tm-vm/decode-message-header (&optional count)
 ))
 
 (defun tm-vm/decode-message-header (&optional count)

-  "Decode MIME header of current message through tiny-mime.
+  "Decode MIME header of current message.

 Numeric prefix argument COUNT means to decode the current message plus
 the next COUNT-1 messages.  A negative COUNT means decode the current
 message and the previous COUNT-1 messages.
 Numeric prefix argument COUNT means to decode the current message plus
 the next COUNT-1 messages.  A negative COUNT means decode the current
 message and the previous COUNT-1 messages.

@@ -245,7 +241,8 @@ tm-vm uses `vm-select-message-hook', use this hook instead.")
              (if (or vm-highlighted-header-regexp
                      (and (vm-xemacs-p) vm-use-lucid-highlighting))
                  (vm-highlight-headers))
              (if (or vm-highlighted-header-regexp
                      (and (vm-xemacs-p) vm-use-lucid-highlighting))
                  (vm-highlight-headers))

-             ;;
+             (if (and vm-use-menus (vm-menu-support-possible-p))
+                 (vm-energize-headers))              ;;

              (goto-char (point-min))
               (narrow-to-region (point) (search-forward "\n\n" nil t))
               ))
              (goto-char (point-min))
               (narrow-to-region (point) (search-forward "\n\n" nil t))
               ))

@@ -564,12 +561,23 @@ tm-vm uses `vm-select-message-hook', use this hook instead.")
 ;;; @@ vm-yank-message
 ;;;
 ;; 1996/3/28 by Oscar Figueiredo <figueire@lspsun16.epfl.ch>
 ;;; @@ vm-yank-message
 ;;;
 ;; 1996/3/28 by Oscar Figueiredo <figueire@lspsun16.epfl.ch>

-(defun vm-yank-message (message)
+
+(require 'vm-reply)
+
+(defvar tm-vm/yank:message-to-restore nil
+  "For internal use by tm-vm only.")
+
+(defun vm-yank-message (&optional message)

   "Yank message number N into the current buffer at point.
 When called interactively N is always read from the minibuffer.  When
 called non-interactively the first argument is expected to be a
 message struct.
 
   "Yank message number N into the current buffer at point.
 When called interactively N is always read from the minibuffer.  When
 called non-interactively the first argument is expected to be a
 message struct.
 

+This function originally provided by vm-reply has been patched for TM
+in order to provide better citation of MIME messages : if a MIME
+Preview buffer exists for the message then its contents are inserted
+instead of the raw message.
+

 This command is meant to be used in VM created Mail mode buffers; the
 yanked message comes from the mail buffer containing the message you
 are replying to, forwarding, or invoked VM's mail command from.
 This command is meant to be used in VM created Mail mode buffers; the
 yanked message comes from the mail buffer containing the message you
 are replying to, forwarding, or invoked VM's mail command from.

@@ -596,68 +604,199 @@ vm-included-text-prefix is prepended to every yanked line."
             prompt
             (last-command last-command)
             (this-command this-command))
             prompt
             (last-command last-command)
             (this-command this-command))

-      (save-excursion
-       (vm-select-folder-buffer)
-       (setq default (and vm-message-pointer
-                          (vm-number-of (car vm-message-pointer)))
-             prompt (if default
-                        (format "Yank message number: (default %s) "
-                                default)
-                      "Yank message number: "))
-       (while (zerop result)
-         (setq result (read-string prompt))
-         (and (string= result "") default (setq result default))
-         (setq result (string-to-int result)))
-       (if (null (setq mp (nthcdr (1- result) vm-message-list)))
-           (error "No such message.")))
-      (car mp))))
-  (if (not (bufferp vm-mail-buffer))
-      (error "This is not a VM Mail mode buffer."))
-  (if (null (buffer-name vm-mail-buffer))
-      (error "The folder buffer containing message %d has been killed."
-            (vm-number-of message)))
-  (vm-display nil nil '(vm-yank-message) '(vm-yank-message composing-message))
-  (setq message (vm-real-message-of message))
-  (let ((b (current-buffer)) (start (point)) end)
-    (save-restriction
-      (widen)
-      (save-excursion
-       (set-buffer (vm-buffer-of message))
-       (let* ((mbuf (current-buffer))
-              (pbuf (and mime::article/preview-buffer
-                         (get-buffer mime::article/preview-buffer)))
-              (pwin (and pbuf (vm-get-visible-buffer-window pbuf))))
-         (if pwin
-             (if running-xemacs
-                 (let ((tmp (generate-new-buffer "tm-vm/tmp")))
-                   (set-buffer pbuf)
-                   (append-to-buffer tmp (point-min) (point-max))
-                   (set-buffer tmp)
-                   (map-extents
-                    '(lambda (ext maparg) 
-                       (set-extent-property ext 'begin-glyph nil)))
-                   (append-to-buffer b (point-min) (point-max))
-                   (setq end (vm-marker (+ start (length (buffer-string))) b))
-                   (kill-buffer tmp))
-               (set-buffer pbuf)
-               (append-to-buffer b (point-min) (point-max))
-               (setq end (vm-marker (+ start (length (buffer-string))) b)))
-           (save-restriction
-             (widen)
-             (append-to-buffer
-              b (vm-headers-of message) (vm-text-end-of message))
-             (setq end
-                   (vm-marker (+ start (- (vm-text-end-of message)
-                                          (vm-headers-of message))) b))))))
-      (push-mark end)
-      (cond (mail-citation-hook (run-hooks 'mail-citation-hook))
-           (mail-yank-hooks (run-hooks 'mail-yank-hooks))
-           (t (vm-mail-yank-default message))))))
+      (if (bufferp vm-mail-buffer)
+          (save-excursion
+            (vm-select-folder-buffer)
+            (setq default (and vm-message-pointer
+                               (vm-number-of (car vm-message-pointer)))
+                  prompt (if default
+                             (format "Yank message number: (default %s) "
+                                     default)
+                           "Yank message number: "))
+            (while (zerop result)
+              (setq result (read-string prompt))
+              (and (string= result "") default (setq result default))
+              (setq result (string-to-int result)))
+            (if (null (setq mp (nthcdr (1- result) vm-message-list)))
+                (error "No such message."))
+           (setq tm-vm/yank:message-to-restore (string-to-int default))
+           (save-selected-window
+             (vm-goto-message result))
+            (car mp))
+        nil))))
+  (if (null message)
+      (if mail-reply-buffer
+          (tm-vm/yank-content)
+        (error "This is not a VM Mail mode buffer."))
+    (if (null (buffer-name vm-mail-buffer))
+        (error "The folder buffer containing message %d has been killed."
+               (vm-number-of message)))
+    (vm-display nil nil '(vm-yank-message)
+                '(vm-yank-message composing-message))
+    (let ((b (current-buffer)) (start (point)) end)
+      (save-restriction
+        (widen)
+        (save-excursion
+          (set-buffer (vm-buffer-of message))
+          (let* ((mbuf (current-buffer))
+                 (pbuf (and mime::article/preview-buffer
+                                       ; is there a preview buffer alive ?
+                           (get-buffer mime::article/preview-buffer)
+                                       ; rebuild preview to ensure it
+                                       ; corresponds to the current message
+                           (save-excursion
+                             (save-selected-window
+                               (save-window-excursion
+                                 (tm-vm/view-message))))
+                            (get-buffer mime::article/preview-buffer))))
+            (if pbuf
+                (if running-xemacs
+                    (let ((tmp (generate-new-buffer "tm-vm/tmp")))
+                      (set-buffer pbuf)
+                      (append-to-buffer tmp (point-min) (point-max))
+                      (set-buffer tmp)
+                      (map-extents
+                       '(lambda (ext maparg) 
+                          (set-extent-property ext 'begin-glyph nil)))
+                      (append-to-buffer b (point-min) (point-max))
+                      (setq end (vm-marker
+                                 (+ start (length (buffer-string))) b))
+                      (kill-buffer tmp))
+                  (set-buffer pbuf)
+                  (append-to-buffer b (point-min) (point-max))
+                  (setq end (vm-marker
+                             (+ start (length (buffer-string))) b)))
+              (save-restriction
+               (setq message (vm-real-message-of message))
+               (set-buffer (vm-buffer-of message))
+               (widen)
+                (append-to-buffer
+                 b (vm-headers-of message) (vm-text-end-of message))
+                (setq end
+                      (vm-marker (+ start (- (vm-text-end-of message)
+                                             (vm-headers-of message))) b))))))
+        (push-mark end)
+        (cond (mail-citation-hook (run-hooks 'mail-citation-hook))
+              (mail-yank-hooks (run-hooks 'mail-yank-hooks))
+              (t (vm-mail-yank-default message)))
+        ))
+    (if tm-vm/yank:message-to-restore
+       (save-selected-window
+         (vm-goto-message tm-vm/yank:message-to-restore)
+         (setq tm-vm/yank:message-to-restore nil)))
+    ))

 
 \f
 ;;; @ for tm-view
 ;;;
 
 
 \f
 ;;; @ for tm-view
 ;;;
 

+;;; based on vm-do-reply [vm-reply.el]
+(defun tm-vm/do-reply (buf to-all include-text)
+  (save-excursion
+    (set-buffer buf)
+    (let ((dir default-directory)
+          to cc subject mp in-reply-to references newsgroups)
+      (cond ((setq to
+                   (let ((reply-to (std11-field-body "Reply-To")))
+                     (if (vm-ignored-reply-to reply-to)
+                         nil
+                       reply-to))))
+            ((setq to (std11-field-body "From")))
+            ;; (t (error "No From: or Reply-To: header in message"))
+            )
+      (if to-all
+          (setq cc (delq nil (cons cc (std11-field-bodies '("To" "Cc"))))
+                cc (mapconcat 'identity cc ","))
+        )
+      (setq subject (std11-field-body "Subject"))
+      (and subject vm-reply-subject-prefix
+           (let ((case-fold-search t))
+             (not
+              (equal
+               (string-match (regexp-quote vm-reply-subject-prefix)
+                             subject)
+               0)))
+           (setq subject (concat vm-reply-subject-prefix subject)))
+      (setq in-reply-to (std11-field-body "Message-Id")
+            references (nconc
+                        (std11-field-bodies '("References" "In-Reply-To"))
+                        (list in-reply-to))
+            newsgroups (list (or (and to-all
+                                      (std11-field-body "Followup-To"))
+                                 (std11-field-body "Newsgroups"))))
+      (setq to (vm-parse-addresses to)
+            cc (vm-parse-addresses cc))
+      (if vm-reply-ignored-addresses
+          (setq to (vm-strip-ignored-addresses to)
+                cc (vm-strip-ignored-addresses cc)))
+      (setq to (vm-delete-duplicates to nil t))
+      (setq cc (vm-delete-duplicates
+                (append (vm-delete-duplicates cc nil t)
+                        to (copy-sequence to))
+                t t))
+      (and to (setq to (mapconcat 'identity to ",\n ")))
+      (and cc (setq cc (mapconcat 'identity cc ",\n ")))
+      (and (null to) (setq to cc cc nil))
+      (setq references (delq nil references)
+            references (mapconcat 'identity references " ")
+            references (vm-parse references "[^<]*\\(<[^>]+>\\)")
+            references (vm-delete-duplicates references)
+            references (if references (mapconcat 'identity references "\n\t")))
+      (setq newsgroups (delq nil newsgroups)
+            newsgroups (mapconcat 'identity newsgroups ",")
+            newsgroups (vm-parse newsgroups "[ \t\f\r\n,]*\\([^ \t\f\r\n,]+\\)")
+            newsgroups (vm-delete-duplicates newsgroups)
+            newsgroups (if newsgroups (mapconcat 'identity newsgroups ",")))
+      (vm-mail-internal
+       (if to
+           (format "reply to %s%s"
+                   (std11-full-name-string
+                   (car (std11-parse-address-string to)))
+                  (if cc ", ..." "")))
+       to subject in-reply-to cc references newsgroups)
+      (setq mail-reply-buffer buf
+            ;; vm-system-state 'replying
+            default-directory dir))
+    (if include-text
+        (save-excursion
+          (goto-char (point-min))
+          (let ((case-fold-search nil))
+            (re-search-forward
+             (concat "^" (regexp-quote mail-header-separator) "$") nil 0))
+          (forward-char 1)
+          (tm-vm/yank-content)))
+    (run-hooks 'vm-reply-hook)
+    (run-hooks 'vm-mail-mode-hook)
+    ))
+
+(defun tm-vm/following-method (buf)
+  (tm-vm/do-reply buf 'to-all 'include-text)
+  )
+
+(defun tm-vm/yank-content ()
+  (interactive)
+  (let ((this-command 'vm-yank-message))
+    (vm-display nil nil '(vm-yank-message)
+                '(vm-yank-message composing-message))
+    (save-restriction
+      (narrow-to-region (point)(point))
+      (insert-buffer mail-reply-buffer)
+      (goto-char (point-max))
+      (push-mark)
+      (goto-char (point-min)))
+    (cond (mail-citation-hook (run-hooks 'mail-citation-hook))
+          (mail-yank-hooks (run-hooks 'mail-yank-hooks))
+          (t (mail-indent-citation)))
+    ))
+
+(set-alist 'mime-viewer/following-method-alist
+          'vm-mode
+          (function tm-vm/following-method))
+(set-alist 'mime-viewer/following-method-alist
+          'vm-virtual-mode
+          (function tm-vm/following-method))
+
+

 (defun tm-vm/quit-view-message ()
   "Quit MIME-viewer and go back to VM.
 This function is called by `mime-viewer/quit' command via
 (defun tm-vm/quit-view-message ()
   "Quit MIME-viewer and go back to VM.
 This function is called by `mime-viewer/quit' command via

@@ -751,7 +890,7 @@ created to send a digest in multipart/digest type format.
 If `vm-digest-send-type' is \"rfc1521\", tm-vm runs this hook
 instead of `vm-send-digest-hook'.")
 
 If `vm-digest-send-type' is \"rfc1521\", tm-vm runs this hook
 instead of `vm-send-digest-hook'.")
 

-(defun tm-vm/enclose-messages (mlist)
+(defun tm-vm/enclose-messages (mlist &optional preamble)

   "Enclose the messages in MLIST as multipart/digest.
 The resulting digest is inserted at point in the current buffer.
 
   "Enclose the messages in MLIST as multipart/digest.
 The resulting digest is inserted at point in the current buffer.
 

@@ -759,6 +898,7 @@ MLIST should be a list of message structs (real or virtual).
 These are the messages that will be enclosed."
   (if mlist
       (let ((digest (consp (cdr mlist)))
 These are the messages that will be enclosed."
   (if mlist
       (let ((digest (consp (cdr mlist)))

+            (mp mlist)

             m)
        (save-restriction
          (narrow-to-region (point) (point))
             m)
        (save-restriction
          (narrow-to-region (point) (point))

@@ -768,6 +908,21 @@ These are the messages that will be enclosed."
             (tm-mail/insert-message m)
             (goto-char (point-max))
            (setq mlist (cdr mlist)))
             (tm-mail/insert-message m)
             (goto-char (point-max))
            (setq mlist (cdr mlist)))

+          (if preamble
+              (progn
+                (goto-char (point-min))
+                (mime-editor/insert-tag "text" "plain")
+                (vm-unsaved-message "Building digest preamble...")
+                (while mp
+                  (let ((vm-summary-uninteresting-senders nil))
+                    (insert
+                     (vm-sprintf 'vm-digest-preamble-format (car mp)) "\n"))
+                  (if vm-digest-center-preamble
+                      (progn
+                        (forward-char -1)
+                        (center-line)
+                        (forward-char 1)))
+                  (setq mp (cdr mp)))))

           (if digest
               (mime-editor/enclose-digest-region (point-min) (point-max)))
           ))))
           (if digest
               (mime-editor/enclose-digest-region (point-min) (point-max)))
           ))))

@@ -812,7 +967,7 @@ Subject: header manually."
         (run-hooks 'tm-vm/forward-message-hook)
         (run-hooks 'vm-mail-mode-hook)))))
 
         (run-hooks 'tm-vm/forward-message-hook)
         (run-hooks 'vm-mail-mode-hook)))))
 

-(defun tm-vm/send-digest (&optional prefix)
+(defun tm-vm/send-digest (&optional arg)

   "Send a digest of all messages in the current folder to recipients.
 The type of the digest is specified by the variable vm-digest-send-type.
 You will be placed in a Mail mode buffer as is usual with replies, but you
   "Send a digest of all messages in the current folder to recipients.
 The type of the digest is specified by the variable vm-digest-send-type.
 You will be placed in a Mail mode buffer as is usual with replies, but you

@@ -822,45 +977,26 @@ If invoked on marked messages (via vm-next-command-uses-marks),
 only marked messages will be put into the digest."
   (interactive "P")
   (if (not (equal vm-digest-send-type "rfc1521"))
 only marked messages will be put into the digest."
   (interactive "P")
   (if (not (equal vm-digest-send-type "rfc1521"))

-      (vm-send-digest prefix)
+      (vm-send-digest arg)

     (vm-select-folder-buffer)
     (vm-check-for-killed-summary)
     (vm-error-if-folder-empty)
     (let ((dir default-directory)
     (vm-select-folder-buffer)
     (vm-check-for-killed-summary)
     (vm-error-if-folder-empty)
     (let ((dir default-directory)

-          (mp vm-message-pointer)
-          (mlist (if (eq last-command 'vm-next-command-uses-marks)
-                     (vm-select-marked-or-prefixed-messages 0)
-                   vm-message-list))
+          (vm-forward-list (if (eq last-command 'vm-next-command-uses-marks)
+                               (vm-select-marked-or-prefixed-messages 0)
+                             vm-message-list))

           start)
       (save-restriction
         (widen)
         (vm-mail-internal (format "digest from %s" (buffer-name)))
         (setq vm-system-state 'forwarding
           start)
       (save-restriction
         (widen)
         (vm-mail-internal (format "digest from %s" (buffer-name)))
         (setq vm-system-state 'forwarding

-              vm-forward-list mlist

               default-directory dir)
         (goto-char (point-min))
         (re-search-forward (concat "^" (regexp-quote mail-header-separator)
                                    "\n"))
         (goto-char (match-end 0))
               default-directory dir)
         (goto-char (point-min))
         (re-search-forward (concat "^" (regexp-quote mail-header-separator)
                                    "\n"))
         (goto-char (match-end 0))

-        (setq start (point)
-              mp mlist)

         (vm-unsaved-message "Building %s digest..." vm-digest-send-type)
         (vm-unsaved-message "Building %s digest..." vm-digest-send-type)

-        (tm-vm/enclose-messages mlist)
-        (goto-char start)
-        (setq mp mlist)
-        (if prefix
-         (progn
-            (mime-editor/insert-tag "text" "plain")
-           (vm-unsaved-message "Building digest preamble...")
-           (while mp
-             (let ((vm-summary-uninteresting-senders nil))
-               (insert (vm-sprintf 'vm-digest-preamble-format (car mp)) "\n"))
-             (if vm-digest-center-preamble
-                 (progn
-                   (forward-char -1)
-                   (center-line)
-                   (forward-char 1)))
-             (setq mp (cdr mp)))))
+        (tm-vm/enclose-messages vm-forward-list arg)

         (mail-position-on-field "To")
         (message "Building %s digest... done" vm-digest-send-type)))
     (run-hooks 'tm-vm/send-digest-hook)
         (mail-position-on-field "To")
         (message "Building %s digest... done" vm-digest-send-type)))
     (run-hooks 'tm-vm/send-digest-hook)

@@ -870,9 +1006,6 @@ only marked messages will be put into the digest."
                           'tm-vm/forward-message vm-mode-map)
 (substitute-key-definition 'vm-send-digest
                           'tm-vm/send-digest vm-mode-map)
                           'tm-vm/forward-message vm-mode-map)
 (substitute-key-definition 'vm-send-digest
                           'tm-vm/send-digest vm-mode-map)

-
-;;; @@ for message/rfc822
-;;;

 \f
 
 ;;; @@ setting
 \f
 
 ;;; @@ setting

@@ -900,6 +1033,12 @@ only marked messages will be put into the digest."
     (autoload 'tm-mail/insert-message "tm-mail")
     (set-alist 'mime-editor/message-inserter-alist
               'mail-mode (function tm-mail/insert-message))
     (autoload 'tm-mail/insert-message "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)
+                             )))

     (if (and (string-match "XEmacs\\|Lucid" emacs-version)
             tm-vm/use-xemacs-popup-menu)
        (add-hook 'vm-mail-mode-hook 'mime-editor/attach-to-vm-mode-menu)
     (if (and (string-match "XEmacs\\|Lucid" emacs-version)
             tm-vm/use-xemacs-popup-menu)
        (add-hook 'vm-mail-mode-hook 'mime-editor/attach-to-vm-mode-menu)