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