tm-vm.el

   1 ;;;
   2 ;;; tm-vm.el --- tm-MUA for VM
   3 ;;;
   4 ;;; Copyright (C) 1995 Free Software Foundation, Inc.
   5 ;;;
   6 ;;; Author:   MASUTANI Yasuhiro <masutani@me.es.osaka-u.ac.jp>
   7 ;;;           Kenji Wakamiya <wkenji@flab.fujitsu.co.jp>
   8 ;;;           MORIOKA Tomohiko <morioka@jaist.ac.jp>
   9 ;;;           Shuhei KOBAYASHI <shuhei@cmpt01.phys.tohoku.ac.jp>
  10 ;;;           Oscar Figueiredo <figueire@lspsun2.epfl.ch>
  11 ;;; modified by SHIONO Jun'ichi <jun@case.nm.fujitsu.co.jp>
  12 ;;; Maintainer: MORIOKA Tomohiko <morioka@jaist.ac.jp>
  13 ;;; Created: 1994/10/29
  14 ;;; Version: $Revision: 7.23 $
  15 ;;; Keywords: news, MIME, multimedia, multilingual, encoded-word
  16 ;;;
  17 ;;; This file is part of tm (Tools for MIME).
  18 ;;;
  19 ;;; Plese insert (require 'tm-vm) in your ~/.vm or ~/.emacs file.
  20 ;;;
  21 ;;; This program is free software; you can redistribute it and/or
  22 ;;; modify it under the terms of the GNU General Public License as
  23 ;;; published by the Free Software Foundation; either version 2, or
  24 ;;; (at your option) any later version.
  25 ;;;
  26 ;;; This program is distributed in the hope that it will be useful,
  27 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  28 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  29 ;;; General Public License for more details.
  30 ;;;
  31 ;;; You should have received a copy of the GNU General Public License
  32 ;;; along with This program.  If not, write to the Free Software
  33 ;;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  34
  35 (require 'tm-view)
  36 (require 'vm)
  37
  38 (defconst tm-vm/RCS-ID
  39   "$Id: tm-vm.el,v 7.23 1995/12/03 14:09:18 morioka Exp $")
  40 (defconst tm-vm/version (get-version-string tm-vm/RCS-ID))
  41
  42 (define-key vm-mode-map "Z" 'tm-vm/view-message)
  43 (define-key vm-mode-map "T" 'tm-vm/decode-message-header)
  44 (define-key vm-mode-map "\et" 'tm-vm/toggle-preview-mode)
  45
  46
  47 ;;; @ for MIME encoded-words
  48 ;;;
  49
  50 (defvar tm-vm/use-tm-patch nil
  51   "Does not decode encoded-words in summary buffer if it is t.
  52 If you use tiny-mime patch for VM (by RIKITAKE Kenji
  53 <kenji@reseau.toyonaka.osaka.jp>), please set it t [tm-vm.el]")
  54
  55 (or tm-vm/use-tm-patch
  56     (progn
  57 ;;;
  58 (defvar tm-vm/chop-full-name-function 'tm-vm/default-chop-full-name)
  59 (setq vm-chop-full-name-function tm-vm/chop-full-name-function)
  60
  61 (defun tm-vm/default-chop-full-name (address)
  62   (let* ((ret (vm-default-chop-full-name address))
  63          (full-name (car ret))
  64          )
  65     (if (stringp full-name)
  66         (cons (mime-eword/decode-string full-name)
  67               (cdr ret))
  68       ret)))
  69
  70 (require 'vm-summary)
  71 (or (fboundp 'tm:vm-su-subject)
  72     (fset 'tm:vm-su-subject (symbol-function 'vm-su-subject))
  73     )
  74 (defun vm-su-subject (m)
  75   (mime-eword/decode-string (tm:vm-su-subject m))
  76   )
  77 ;;;
  78 ))
  79
  80 (defun tm-vm/decode-message-header (&optional count)
  81   "Decode MIME header of current message through tiny-mime.
  82 Numeric prefix argument COUNT means to decode the current message plus
  83 the next COUNT-1 messages.  A negative COUNT means decode the current
  84 message and the previous COUNT-1 messages.
  85 When invoked on marked messages (via vm-next-command-uses-marks),
  86 all marked messages are affected, other messages are ignored."
  87   (interactive "p")
  88   (or count (setq count 1))
  89   (vm-follow-summary-cursor)
  90   (vm-select-folder-buffer)
  91   (vm-check-for-killed-summary)
  92   (vm-error-if-folder-empty)
  93   (vm-error-if-folder-read-only)
  94   (let ((mlist (vm-select-marked-or-prefixed-messages count))
  95         (realm nil)
  96         (vlist nil)
  97         (vbufs nil))
  98     (save-excursion
  99       (while mlist
 100         (setq realm (vm-real-message-of (car mlist)))
 101         ;; Go to real folder of this message.
 102         ;; But maybe this message is already real message...
 103         (set-buffer (vm-buffer-of realm))
 104         (let ((buffer-read-only nil))
 105           (vm-save-restriction
 106            (narrow-to-region (vm-headers-of realm) (vm-text-of realm))
 107            (mime/decode-message-header))
 108           (let ((vm-message-pointer (list realm))
 109                 (last-command nil))
 110             (vm-discard-cached-data))
 111           ;; Mark each virtual and real message for later summary
 112           ;; update.
 113           (setq vlist (cons realm (vm-virtual-messages-of realm)))
 114           (while vlist
 115             (vm-mark-for-summary-update (car vlist))
 116             ;; Remember virtual and real folders related this message,
 117             ;; for later display update.
 118             (or (memq (vm-buffer-of (car vlist)) vbufs)
 119                 (setq vbufs (cons (vm-buffer-of (car vlist)) vbufs)))
 120             (setq vlist (cdr vlist)))
 121           (if (eq vm-flush-interval t)
 122               (vm-stuff-virtual-attributes realm)
 123             (vm-set-modflag-of realm t)))
 124         (setq mlist (cdr mlist)))
 125       ;; Update mail-buffers and summaries.
 126       (while vbufs
 127         (set-buffer (car vbufs))
 128         (vm-preview-current-message)
 129         (setq vbufs (cdr vbufs))))))
 130
 131
 132 ;;; @ automatic MIME preview
 133 ;;;
 134
 135 (defvar tm-vm/automatic-mime-preview t
 136   "If non-nil, show MIME processed article.")
 137
 138 (defun tm-vm/preview-current-message ()
 139   ;;; suggested by Simon Rowe <smr@robots.oxford.ac.uk>
 140   ;;;   (cf. [tm-eng:163])
 141   ;; Selecting a new mail message, but we're already displaying a mime
 142   ;; on in the window, make sure that the mail buffer is displayed.
 143   (if (get-buffer-window "*MIME-out*")
 144       (delete-window (get-buffer-window (get-buffer "*MIME-out*")))
 145     )
 146   (if (and tm-vm/automatic-mime-preview
 147            ;; fixed by SHIONO Jun'ichi <jun@case.nm.fujitsu.co.jp>
 148            ;;   1995/11/17 (cf.[tm-ja:1120])
 149            (display-buffer (current-buffer))
 150            (let* ((mp (car vm-message-pointer))
 151                   (ct  (vm-get-header-contents mp "Content-Type:"))
 152                   (cte (vm-get-header-contents
 153                         mp "Content-Transfer-Encoding:"))
 154                   )
 155              ;; Check if this message actually is a mime, or just a text
 156              ;; one sent by someone using PINE or similar.
 157              (and ct
 158                   (not (and (string= (car (mime/parse-Content-Type ct))
 159                                      "text/plain")
 160                             (member cte '("7bit" "8bit" "binary"))
 161                             ))))
 162            )
 163       (let ((win (selected-window)))
 164         (let ((pwin (and mime::article/preview-buffer
 165                          (get-buffer mime::article/preview-buffer)
 166                          (get-buffer-window mime::article/preview-buffer))))
 167           (if pwin
 168               (delete-window pwin)
 169             ))
 170         (vm-display nil nil
 171                     '(vm-next-message
 172                       vm-delete-message
 173                       vm-undelete-message
 174                       vm-scroll-forward vm-scroll-backward)
 175                     (list this-command 'reading-message))
 176         (vm-select-folder-buffer)
 177         (vm-display (current-buffer) t
 178                     '(vm-scroll-forward vm-scroll-backward)
 179                     (list this-command 'reading-message))
 180         (select-window (get-buffer-window (current-buffer)))
 181         (mime/viewer-mode)
 182         (run-hooks 'tm-vm/vm-select-message-hook)
 183         (select-window win)
 184         )
 185     ;; fixed by Oscar Figueiredo <figueire@lspsun2.epfl.ch>
 186     ;;  1995/11/17
 187     (if (and mime::article/preview-buffer
 188              (get-buffer mime::article/preview-buffer))
 189         (kill-buffer mime::article/preview-buffer))
 190     (if tm-vm/automatic-mime-preview
 191         (let (buffer-read-only)
 192           (mime/decode-message-header)
 193           (run-hooks 'tm-vm/vm-select-message-hook)
 194           ))
 195     ))
 196
 197 (add-hook 'vm-select-message-hook 'tm-vm/preview-current-message)
 198
 199 (defun tm-vm/visit-folder-function ()
 200   (tm-vm/preview-current-message)
 201   (and vm-mail-buffer (set-buffer vm-mail-buffer))
 202   )
 203
 204 (add-hook 'vm-visit-folder-hook 'tm-vm/visit-folder-function)
 205
 206 ;; fixed by Oscar Figueiredo <figueire@lspsun2.epfl.ch>
 207 ;;      1995/11/14 (cf.[tm-eng:162])
 208 (defun tm-vm/scroll-forward (&optional arg)
 209   (interactive "P")
 210   (if (not tm-vm/automatic-mime-preview)
 211       ;; fixed by SHIONO Jun'ichi <jun@case.nm.fujitsu.co.jp>
 212       ;;        1995/11/17 (cf.[tm-ja:1119])
 213       (progn
 214         (setq this-command 'vm-scroll-forward)
 215         (vm-scroll-forward arg))
 216     (let* ((summary-buffer (or vm-summary-buffer
 217                                (and (eq major-mode 'vm-summary-mode)
 218                                     (current-buffer))))
 219            (summary-win (get-buffer-window summary-buffer))
 220            (mail-buffer (save-excursion
 221                           (set-buffer summary-buffer)
 222                           vm-mail-buffer))
 223            (mail-win (get-buffer-window mail-buffer))
 224            (preview-buf (save-excursion
 225                           (set-buffer mail-buffer)
 226                           mime::article/preview-buffer))
 227            (preview-win (and preview-buf (get-buffer-window preview-buf)))
 228            )
 229       (if preview-win
 230           (progn
 231             (select-window preview-win)
 232             (if (pos-visible-in-window-p (point-max) preview-win)
 233                 (progn
 234                   (switch-to-buffer mail-buffer)
 235                   (goto-char (point-max))
 236                   (select-window summary-win))
 237               (scroll-up)
 238               (switch-to-buffer mail-buffer)
 239               (select-window summary-win))))
 240       ;; fixed by SHIONO Jun'ichi <jun@case.nm.fujitsu.co.jp>
 241       ;;        1995/11/17 (cf.[tm-ja:1119])
 242       (setq this-command 'vm-scroll-forward)
 243       (vm-scroll-forward arg)
 244       (save-excursion
 245         (set-buffer summary-buffer)
 246         (setq mail-win (get-buffer-window vm-mail-buffer)))
 247       ;; fixed by Oscar Figueiredo <figueire@lspsun2.epfl.ch>
 248       ;;        1995/11/17
 249       (if (and mail-win
 250                mime::article/preview-buffer
 251                (get-buffer mime::article/preview-buffer))
 252           (progn
 253             (select-window mail-win)
 254             (switch-to-buffer mime::article/preview-buffer)
 255             (select-window summary-win)))
 256       )))
 257
 258 (defun tm-vm/scroll-backward (&optional arg)
 259   (interactive "P")
 260   (if (not tm-vm/automatic-mime-preview)
 261       ;; fixed by SHIONO Jun'ichi <jun@case.nm.fujitsu.co.jp>
 262       ;;        1995/11/17 (cf.[tm-ja:1119])
 263       (progn
 264         (setq this-command 'vm-scroll-backward)
 265         (vm-scroll-backward arg))
 266     (let* ((summary-buffer (or vm-summary-buffer
 267                                (and (eq major-mode 'vm-summary-mode)
 268                                     (current-buffer))))
 269            (summary-win (get-buffer-window summary-buffer))
 270            (mail-buffer (save-excursion
 271                           (set-buffer summary-buffer)
 272                           vm-mail-buffer))
 273            (mail-win (get-buffer-window mail-buffer))
 274            (preview-buf (save-excursion
 275                           (set-buffer mail-buffer)
 276                           mime::article/preview-buffer))
 277            (preview-win (and preview-buf (get-buffer-window preview-buf)))
 278            )
 279       (if preview-win
 280           (progn
 281             (select-window preview-win)
 282             (if (pos-visible-in-window-p (point-min) preview-win)
 283                 (progn
 284                   (switch-to-buffer mail-buffer)
 285                   (goto-char (point-min))
 286                   (select-window summary-win))
 287               (scroll-down)
 288               (switch-to-buffer mail-buffer)
 289               (select-window summary-win))))
 290       ;; fixed by SHIONO Jun'ichi <jun@case.nm.fujitsu.co.jp>
 291       ;;        1995/11/17 (cf.[tm-ja:1119])
 292       (setq this-command 'vm-scroll-backward)
 293       (vm-scroll-backward arg)
 294       (save-excursion
 295         (set-buffer summary-buffer)
 296         (setq mail-win (get-buffer-window vm-mail-buffer)))
 297       (if (and mail-win
 298                mime::article/preview-buffer
 299                (get-buffer mime::article/preview-buffer))
 300           (progn
 301             (select-window mail-win)
 302             (goto-char (point-max))
 303             (switch-to-buffer mime::article/preview-buffer)
 304             (select-window summary-win)))
 305       )))
 306
 307 ;; 1995/11/16 by Oscar Figueiredo <figueire@lspsun2.epfl.ch>
 308 (defun tm-vm/expunge-folder ()
 309   (interactive)
 310   (let* ((summary-buf (or (and (eq major-mode 'vm-summary-mode)
 311                                (current-buffer))
 312                           vm-summary-buffer))
 313          (preview-buf (save-excursion
 314                         (set-buffer (save-excursion
 315                                       (set-buffer summary-buf)
 316                                       vm-mail-buffer))
 317                         mime::article/preview-buffer))
 318          (preview-win (and preview-buf
 319                            (get-buffer-window preview-buf)))
 320          (win (selected-window)))
 321
 322     (vm-expunge-folder)
 323     (if preview-win
 324         (save-excursion
 325           (set-buffer summary-buf)
 326           (set-buffer vm-mail-buffer)
 327           (if (eq (point-min) (point-max))
 328               (kill-buffer preview-buf))))
 329     ))
 330
 331 ;; fixed by Oscar Figueiredo <figueire@lspsun2.epfl.ch>
 332 ;;      1995/11/14 (cf. [tm-eng:162])
 333 (defun tm-vm/quit ()
 334   (interactive)
 335   (save-excursion
 336     (vm-select-folder-buffer)
 337     (if (and mime::article/preview-buffer
 338              (get-buffer mime::article/preview-buffer))
 339         (kill-buffer mime::article/preview-buffer)))
 340   (vm-quit)
 341   )
 342
 343 (substitute-key-definition 'vm-scroll-forward
 344                            'tm-vm/scroll-forward vm-mode-map)
 345 (substitute-key-definition 'vm-scroll-backward
 346                            'tm-vm/scroll-backward vm-mode-map)
 347 (substitute-key-definition 'vm-expunge-folder
 348                            'tm-vm/expunge-folder vm-mode-map)
 349 (substitute-key-definition 'vm-quit
 350                            'tm-vm/quit vm-mode-map)
 351 ;; end
 352
 353
 354 (defun tm-vm/toggle-preview-mode ()
 355   (interactive)
 356   (if tm-vm/automatic-mime-preview
 357       (progn
 358         (setq tm-vm/automatic-mime-preview nil)
 359         (vm-select-folder-buffer)
 360         (vm-display (current-buffer) t
 361                     '(tm-vm/toggle-preview-mode)
 362                     '(tm-vm/toggle-preview-mode reading-message))
 363         )
 364     (setq tm-vm/automatic-mime-preview t)
 365     (let ((win (selected-window)))
 366       (vm-select-folder-buffer)
 367       (save-window-excursion
 368         (let* ((mp (car vm-message-pointer))
 369                (ct  (vm-get-header-contents mp "Content-Type:"))
 370                (cte (vm-get-header-contents mp "Content-Transfer-Encoding:"))
 371                )
 372           (mime/viewer-mode nil (mime/parse-Content-Type (or ct "")) cte)
 373           ))
 374       (vm-display mime::article/preview-buffer t
 375                   '(tm-vm/toggle-preview-mode)
 376                   '(tm-vm/toggle-preview-mode reading-message))
 377       (select-window win)
 378       )
 379     ))
 380
 381
 382 ;;; @ for tm-view
 383 ;;;
 384
 385 (defun tm-vm/quit-view-message ()
 386   "Quit MIME-viewer and go back to VM.
 387 This function is called by `mime-viewer/quit' command via
 388 `mime-viewer/quitting-method-alist'."
 389   (mime-viewer/kill-buffer)
 390   (if (get-buffer mime/output-buffer-name)
 391       (bury-buffer mime/output-buffer-name))
 392   (vm-select-folder-buffer)
 393   (vm-display (current-buffer) t '(mime-viewer/quit mime-viewer/up-content)
 394               '(mime-viewer/quit reading-message)))
 395
 396 (defun tm-vm/view-message ()
 397   "Decode and view MIME encoded message, under VM."
 398   (interactive)
 399   (vm-follow-summary-cursor)
 400   (vm-select-folder-buffer)
 401   (vm-check-for-killed-summary)
 402   (vm-error-if-folder-empty)
 403   (vm-display (current-buffer) t '(tm-vm/view-message)
 404               '(tm-vm/view-mesage reading-message))
 405   (let* ((mp (car vm-message-pointer))
 406          (ct  (vm-get-header-contents mp "Content-Type:"))
 407          (cte (vm-get-header-contents mp "Content-Transfer-Encoding:"))
 408          (exposed (= (point-min) (vm-start-of mp))))
 409     (save-restriction
 410       (vm-widen-page)
 411       ;; vm-widen-page hides exposed header if pages are delimited.
 412       ;; So, here we expose it again.
 413       (if exposed
 414           (narrow-to-region (vm-start-of mp) (point-max)))
 415       (select-window (vm-get-buffer-window (current-buffer)))
 416       (mime/viewer-mode nil
 417                         (mime/parse-Content-Type (or ct ""))
 418                         cte)
 419       )))
 420
 421 (set-alist 'mime-viewer/quitting-method-alist
 422            'vm-mode
 423            'tm-vm/quit-view-message)
 424
 425 (set-alist 'mime-viewer/quitting-method-alist
 426            'vm-virtual-mode
 427            'tm-vm/quit-view-message)
 428
 429
 430 ;;; @ for tm-partial
 431 ;;;
 432
 433 (call-after-loaded
 434  'tm-partial
 435  (function
 436   (lambda ()
 437     (set-atype 'mime/content-decoding-condition
 438                '((type . "message/partial")
 439                  (method . mime-article/grab-message/partials)
 440                  (major-mode . vm-mode)
 441                  (summary-buffer-exp . vm-summary-buffer)
 442                  ))
 443     (set-alist 'tm-partial/preview-article-method-alist
 444                'vm-mode
 445                (function
 446                 (lambda ()
 447                   (tm-vm/view-message)
 448                   )))
 449     )))
 450
 451
 452 ;;; @ for tm-edit
 453 ;;;
 454
 455 ;;; @@ for multipart/digest
 456 ;;;
 457
 458 (defun tm-vm/enclose-messages (mlist)
 459   "Enclose the messages in MLIST as multipart/digest.
 460 The resulting digest is inserted at point in the current buffer.
 461
 462 MLIST should be a list of message structs (real or virtual).
 463 These are the messages that will be enclosed."
 464   (if mlist
 465       (let ((digest (consp (cdr mlist)))
 466             m)
 467         (save-restriction
 468           (narrow-to-region (point) (point))
 469           (while mlist
 470             (setq m (vm-real-message-of (car mlist)))
 471             (mime-editor/insert-tag "message" "rfc822")
 472             (tm-mail/insert-message m)
 473             (goto-char (point-max))
 474             (setq mlist (cdr mlist)))
 475           (if digest
 476               (mime-editor/enclose-digest-region (point-min) (point-max)))
 477           ))))
 478
 479 (defun tm-vm/forward-message ()
 480   "Forward the current message to one or more recipients.
 481 You will be placed in a Mail mode buffer as you would with a
 482 reply, but you must fill in the To: header and perhaps the
 483 Subject: header manually."
 484   (interactive)
 485   (if (not (equal vm-forwarding-digest-type "rfc1521"))
 486       (vm-forward-message)
 487     (vm-follow-summary-cursor)
 488     (vm-select-folder-buffer)
 489     (vm-check-for-killed-summary)
 490     (vm-error-if-folder-empty)
 491     (if (eq last-command 'vm-next-command-uses-marks)
 492         (let ((vm-digest-send-type vm-forwarding-digest-type))
 493           (setq this-command 'vm-next-command-uses-marks)
 494           (command-execute 'tm-vm/send-digest))
 495       (let ((dir default-directory)
 496             (mp vm-message-pointer))
 497         (save-restriction
 498           (widen)
 499           (vm-mail-internal
 500            (format "forward of %s's note re: %s"
 501                    (vm-su-full-name (car vm-message-pointer))
 502                    (vm-su-subject (car vm-message-pointer)))
 503            nil
 504            (and vm-forwarding-subject-format
 505                 (let ((vm-summary-uninteresting-senders nil))
 506                   (vm-sprintf 'vm-forwarding-subject-format (car mp)))))
 507           (make-local-variable 'vm-forward-list)
 508           (setq vm-system-state 'forwarding
 509                 vm-forward-list (list (car mp))
 510                 default-directory dir)
 511           (goto-char (point-min))
 512           (re-search-forward
 513            (concat "^" (regexp-quote mail-header-separator) "\n") nil 0)
 514           (tm-vm/enclose-messages vm-forward-list)
 515           (mail-position-on-field "To"))
 516         ;; (run-hooks 'tm-vm/forward-message-hook) ; Is it necessary?
 517         (run-hooks 'vm-mail-mode-hook)))))
 518
 519 (defun tm-vm/send-digest (&optional prefix)
 520   "Send a digest of all messages in the current folder to recipients.
 521 The type of the digest is specified by the variable vm-digest-send-type.
 522 You will be placed in a Mail mode buffer as is usual with replies, but you
 523 must fill in the To: and Subject: headers manually.
 524
 525 If invoked on marked messages (via vm-next-command-uses-marks),
 526 only marked messages will be put into the digest."
 527   (interactive "P")
 528   (if (not (equal vm-digest-send-type "rfc1521"))
 529       (vm-send-digest prefix)
 530     (vm-select-folder-buffer)
 531     (vm-check-for-killed-summary)
 532     (vm-error-if-folder-empty)
 533     (let ((dir default-directory)
 534           (mp vm-message-pointer)
 535           (mlist (if (eq last-command 'vm-next-command-uses-marks)
 536                      (vm-select-marked-or-prefixed-messages 0)
 537                    vm-message-list))
 538           start)
 539       (save-restriction
 540         (widen)
 541         (vm-mail-internal (format "digest from %s" (buffer-name)))
 542         (setq vm-system-state 'forwarding
 543               vm-forward-list mlist
 544               default-directory dir)
 545         (goto-char (point-min))
 546         (re-search-forward (concat "^" (regexp-quote mail-header-separator)
 547                                    "\n"))
 548         (goto-char (match-end 0))
 549         (setq start (point)
 550               mp mlist)
 551         (vm-unsaved-message "Building %s digest..." vm-digest-send-type)
 552         (tm-vm/enclose-messages mlist)
 553         (goto-char start)
 554         (setq mp mlist)
 555         (if prefix
 556           (progn
 557             (mime-editor/insert-tag "text" "plain")
 558             (vm-unsaved-message "Building digest preamble...")
 559             (while mp
 560               (let ((vm-summary-uninteresting-senders nil))
 561                 (insert (vm-sprintf 'vm-digest-preamble-format (car mp)) "\n"))
 562               (if vm-digest-center-preamble
 563                   (progn
 564                     (forward-char -1)
 565                     (center-line)
 566                     (forward-char 1)))
 567               (setq mp (cdr mp)))))
 568         (mail-position-on-field "To")
 569         (message "Building %s digest... done" vm-digest-send-type)))
 570     ;; (run-hooks 'tm-vm/send-digest-hook) ; Is it necessary?
 571     (run-hooks 'vm-mail-mode-hook)))
 572
 573
 574 ;;; @@ setting
 575 ;;;
 576
 577 (substitute-key-definition 'vm-forward-message
 578                            'tm-vm/forward-message vm-mode-map)
 579 (substitute-key-definition 'vm-send-digest
 580                            'tm-vm/send-digest vm-mode-map)
 581
 582 (call-after-loaded
 583  'tm-edit
 584  (function
 585   (lambda ()
 586     (autoload 'tm-mail/insert-message "tm-mail")
 587     (set-alist 'mime-editor/message-inserter-alist
 588                'mail-mode (function tm-mail/insert-message))
 589     )))
 590
 591 (call-after-loaded
 592  'mime-setup
 593  (function
 594   (lambda ()
 595     ;;(remove-hook 'mail-mode-hook 'mime/editor-mode)
 596     ;;(add-hook 'vm-mail-mode-hook 'mime/editor-mode)
 597     (setq vm-forwarding-digest-type "rfc1521")
 598     (setq vm-digest-send-type "rfc1521")
 599     )))
 600
 601
 602 ;;; @ for BBDB
 603 ;;;
 604
 605 (call-after-loaded
 606  'bbdb-vm
 607  (function
 608   (lambda ()
 609     (or (fboundp 'tm:bbdb/vm-update-record)
 610         (fset 'tm:bbdb/vm-update-record
 611               (symbol-function 'bbdb/vm-update-record))
 612         )
 613     (defun bbdb/vm-update-record (&optional offer-to-create)
 614       (vm-select-folder-buffer)
 615       (let ((vm-mail-buffer
 616              (if (and mime::article/preview-buffer
 617                       (get-buffer mime::article/preview-buffer))
 618                  mime::article/preview-buffer
 619                (current-buffer)
 620                ))
 621             (bbdb/vm-update-record-recursive
 622              (boundp 'bbdb/vm-update-record-recursive))
 623             bbdb/vm-update-record-recursive ret)
 624         (let ((bbdb/vm-update-record-answer
 625                (if (boundp 'bbdb/vm-update-record-answer)
 626                    (setq bbdb/vm-update-record-answer
 627                          (or bbdb/vm-update-record-answer
 628                              (tm:bbdb/vm-update-record)
 629                              ))
 630                  (setq ret (tm:bbdb/vm-update-record))
 631                  nil)))
 632           (or bbdb/vm-update-record-answer ret)
 633           )))
 634     (defun tm-vm/bbdb-update-record (&optional offer-to-create)
 635       (let ((vm-mail-buffer (current-buffer)))
 636         (tm:bbdb/vm-update-record offer-to-create)
 637         ))
 638     (remove-hook 'vm-select-message-hook 'bbdb/vm-update-record)
 639     (remove-hook 'vm-show-message-hook 'bbdb/vm-update-record)
 640     (add-hook 'tm-vm/select-message-hook 'tm-vm/update-record)
 641     )))
 642
 643
 644 ;;; @ end
 645 ;;;
 646
 647 (provide 'tm-vm)