1 ;;; tm-vm.el --- tm-MUA (MIME Extension module) for VM
3 ;; Copyright (C) 1994,1995,1996 Free Software Foundation, Inc.
5 ;; Author: MASUTANI Yasuhiro <masutani@me.es.osaka-u.ac.jp>
6 ;; Kenji Wakamiya <wkenji@flab.fujitsu.co.jp>
7 ;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
8 ;; Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp>
9 ;; Oscar Figueiredo <figueire@lspsun2.epfl.ch>
10 ;; Maintainer: Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp>
11 ;; Created: 1994/10/29
12 ;; Version: $Revision: 7.62 $
13 ;; Keywords: mail, MIME, multimedia, multilingual, encoded-word
15 ;; This file is part of tm (Tools for MIME).
17 ;; This program is free software; you can redistribute it and/or
18 ;; modify it under the terms of the GNU General Public License as
19 ;; published by the Free Software Foundation; either version 2, or (at
20 ;; your option) any later version.
22 ;; This program is distributed in the hope that it will be useful, but
23 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
24 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
25 ;; General Public License for more details.
27 ;; You should have received a copy of the GNU General Public License
28 ;; along with this program; see the file COPYING. If not, write to
29 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
30 ;; Boston, MA 02111-1307, USA.
34 ;; Plese insert `(require 'tm-vm)' in your ~/.vm file.
41 (defconst tm-vm/RCS-ID
42 "$Id: tm-vm.el,v 7.62 1996/08/31 14:24:35 morioka Exp $")
43 (defconst tm-vm/version (get-version-string tm-vm/RCS-ID))
45 (define-key vm-mode-map "Z" 'tm-vm/view-message)
46 (define-key vm-mode-map "T" 'tm-vm/decode-message-header)
47 (define-key vm-mode-map "\et" 'tm-vm/toggle-preview-mode)
49 (defvar tm-vm/use-original-url-button nil
50 "*If it is t, use original URL button instead of tm's.")
52 (defvar tm-vm-load-hook nil
53 "*List of functions called after tm-vm is loaded.")
56 ;;; @ for MIME encoded-words
59 (defvar tm-vm/use-tm-patch nil
60 "Does not decode encoded-words in summary buffer if it is t.
61 If you use tiny-mime patch for VM (by RIKITAKE Kenji
62 <kenji@reseau.toyonaka.osaka.jp>), please set it t [tm-vm.el]")
64 (or tm-vm/use-tm-patch
67 (defvar tm-vm/chop-full-name-function 'tm-vm/default-chop-full-name)
68 (setq vm-chop-full-name-function tm-vm/chop-full-name-function)
70 (defun tm-vm/default-chop-full-name (address)
71 (let* ((ret (vm-default-chop-full-name address))
74 (if (stringp full-name)
75 (cons (mime-eword/decode-string full-name)
80 (or (fboundp 'tm:vm-su-subject)
81 (fset 'tm:vm-su-subject (symbol-function 'vm-su-subject))
83 (defun vm-su-subject (m)
84 (mime-eword/decode-string (tm:vm-su-subject m))
87 (or (fboundp 'tm:vm-su-full-name)
88 (fset 'tm:vm-su-full-name (symbol-function 'vm-su-full-name))
90 (defun vm-su-full-name (m)
91 (mime-eword/decode-string (tm:vm-su-full-name m))
94 (or (fboundp 'tm:vm-su-to-names)
95 (fset 'tm:vm-su-to-names (symbol-function 'vm-su-to-names))
97 (defun vm-su-to-names (m)
98 (mime-eword/decode-string (tm:vm-su-to-names m))
103 (defun tm-vm/decode-message-header (&optional count)
104 "Decode MIME header of current message.
105 Numeric prefix argument COUNT means to decode the current message plus
106 the next COUNT-1 messages. A negative COUNT means decode the current
107 message and the previous COUNT-1 messages.
108 When invoked on marked messages (via vm-next-command-uses-marks),
109 all marked messages are affected, other messages are ignored."
111 (or count (setq count 1))
112 (vm-follow-summary-cursor)
113 (vm-select-folder-buffer)
114 (vm-check-for-killed-summary)
115 (vm-error-if-folder-empty)
116 (vm-error-if-folder-read-only)
117 (let ((mlist (vm-select-marked-or-prefixed-messages count))
123 (setq realm (vm-real-message-of (car mlist)))
124 ;; Go to real folder of this message.
125 ;; But maybe this message is already real message...
126 (set-buffer (vm-buffer-of realm))
127 (let ((buffer-read-only nil))
129 (narrow-to-region (vm-headers-of realm) (vm-text-of realm))
130 (mime/decode-message-header))
131 (let ((vm-message-pointer (list realm))
133 (vm-discard-cached-data))
134 ;; Mark each virtual and real message for later summary
136 (setq vlist (cons realm (vm-virtual-messages-of realm)))
138 (vm-mark-for-summary-update (car vlist))
139 ;; Remember virtual and real folders related this message,
140 ;; for later display update.
141 (or (memq (vm-buffer-of (car vlist)) vbufs)
142 (setq vbufs (cons (vm-buffer-of (car vlist)) vbufs)))
143 (setq vlist (cdr vlist)))
144 (if (eq vm-flush-interval t)
145 (vm-stuff-virtual-attributes realm)
146 (vm-set-modflag-of realm t)))
147 (setq mlist (cdr mlist)))
148 ;; Update mail-buffers and summaries.
150 (set-buffer (car vbufs))
151 (vm-preview-current-message)
152 (setq vbufs (cdr vbufs))))))
155 ;;; @ automatic MIME preview
158 (defvar tm-vm/automatic-mime-preview t
159 "*If non-nil, show MIME processed article.")
161 (defvar tm-vm/strict-mime t
162 "*If nil, do MIME processing even if there is not MIME-Version field.")
164 (defvar tm-vm/select-message-hook nil
165 "*List of functions called every time a message is selected.
166 tm-vm uses `vm-select-message-hook', use this hook instead.")
168 (defvar tm-vm/system-state nil)
169 (defun tm-vm/system-state ()
171 (if mime::preview/article-buffer
172 (set-buffer mime::preview/article-buffer)
173 (vm-select-folder-buffer))
176 (defun tm-vm/display-preview-buffer ()
177 (let* ((mbuf (current-buffer))
178 (mwin (vm-get-visible-buffer-window mbuf))
179 (pbuf (and mime::article/preview-buffer
180 (get-buffer mime::article/preview-buffer)))
181 (pwin (and pbuf (vm-get-visible-buffer-window pbuf))))
182 (if (and pbuf (tm-vm/system-state))
183 ;; display preview buffer
186 (vm-undisplay-buffer mbuf)
187 (tm-vm/show-current-message))
188 ((and mwin (not pwin))
189 (set-window-buffer mwin pbuf)
190 (tm-vm/show-current-message))
192 (tm-vm/show-current-message))
194 ;; don't display if neither mwin nor pwin was displayed before.
196 ;; display folder buffer
199 (vm-undisplay-buffer pbuf))
200 ((and (not mwin) pwin)
201 (set-window-buffer pwin mbuf))
203 ;; folder buffer is already displayed.
206 ;; don't display if neither mwin nor pwin was displayed before.
210 (defun tm-vm/preview-current-message ()
211 ;; assumed current buffer is folder buffer.
212 (setq tm-vm/system-state nil)
213 (if (get-buffer mime/output-buffer-name)
214 (vm-undisplay-buffer mime/output-buffer-name))
215 (if (and vm-message-pointer tm-vm/automatic-mime-preview)
216 (if (or (not tm-vm/strict-mime)
217 (vm-get-header-contents (car vm-message-pointer)
219 ;; do MIME processiong.
221 (set (make-local-variable 'tm-vm/system-state) 'previewing)
222 (save-window-excursion
224 (goto-char (point-max))
226 (narrow-to-region (point)
229 (vm-start-of (car vm-message-pointer))
235 (if (and tm-vm/use-original-url-button
236 vm-use-menus (vm-menu-support-possible-p))
238 ;; 1996/2/16, fixed by
239 ;; Oscar Figueiredo <figueire@lspsun2.epfl.ch>
240 ;; Highlight message (and display XFace if supported)
241 (if (or vm-highlighted-header-regexp
242 (and (vm-xemacs-p) vm-use-lucid-highlighting))
243 (vm-highlight-headers))
244 (if (and vm-use-menus (vm-menu-support-possible-p))
245 (vm-energize-headers)) ;;
246 (goto-char (point-min))
247 (narrow-to-region (point) (search-forward "\n\n" nil t))
249 ;; don't do MIME processing. decode header only.
250 (let (buffer-read-only)
251 (mime/decode-message-header))
253 ;; don't preview; do nothing.
255 (tm-vm/display-preview-buffer)
256 (run-hooks 'tm-vm/select-message-hook))
258 (defun tm-vm/show-current-message ()
259 (if mime::preview/article-buffer
260 (set-buffer mime::preview/article-buffer)
261 (vm-select-folder-buffer))
262 ;; Now current buffer is folder buffer.
263 (if (or t ; mime/viewer-mode doesn't support narrowing yet.
264 (null vm-preview-lines)
265 (and (not vm-preview-read-messages)
267 (car vm-message-pointer)))
269 (car vm-message-pointer)))))
271 (set-buffer mime::article/preview-buffer)
274 (goto-char (point-min))
276 ;; narrow to page; mime/viewer-mode doesn't support narrowing yet.
278 (if (vm-get-visible-buffer-window mime::article/preview-buffer)
280 (setq tm-vm/system-state 'reading)
281 (if (vm-new-flag (car vm-message-pointer))
282 (vm-set-new-flag (car vm-message-pointer) nil))
283 (if (vm-unread-flag (car vm-message-pointer))
284 (vm-set-unread-flag (car vm-message-pointer) nil))
285 (vm-update-summary-and-mode-line)
287 (vm-update-summary-and-mode-line)))
289 (defun tm-vm/toggle-preview-mode ()
291 (vm-select-folder-buffer)
292 (vm-display (current-buffer) t (list this-command)
293 (list this-command 'reading-message))
294 (if tm-vm/automatic-mime-preview
295 (setq tm-vm/automatic-mime-preview nil
296 tm-vm/system-state nil)
297 (setq tm-vm/automatic-mime-preview t
298 tm-vm/system-state nil)
301 (let* ((mp (car vm-message-pointer))
302 (exposed (= (point-min) (vm-start-of mp))))
303 (if (or (not tm-vm/strict-mime)
304 (vm-get-header-contents mp "MIME-Version:"))
305 ;; do MIME processiong.
307 (set (make-local-variable 'tm-vm/system-state) 'previewing)
308 (save-window-excursion
310 (goto-char (point-min))
311 (narrow-to-region (point)
312 (search-forward "\n\n" nil t))
314 ;; don't do MIME processing. decode header only.
315 (let (buffer-read-only)
316 (mime/decode-message-header))
318 ;; don't preview; do nothing.
320 (tm-vm/display-preview-buffer)
323 (add-hook 'vm-select-message-hook 'tm-vm/preview-current-message)
324 (add-hook 'vm-visit-folder-hook 'tm-vm/preview-current-message)
326 ;;; tm-vm move commands
329 (defmacro tm-vm/save-window-excursion (&rest forms)
330 (list 'let '((tm-vm/selected-window (selected-window)))
331 (list 'unwind-protect
333 '(if (window-live-p tm-vm/selected-window)
334 (select-window tm-vm/selected-window)))))
336 ;;; based on vm-scroll-forward [vm-page.el]
337 (defun tm-vm/scroll-forward (&optional arg)
339 (let ((this-command 'vm-scroll-forward))
340 (if (not (tm-vm/system-state))
341 (vm-scroll-forward arg)
342 (let* ((mp-changed (vm-follow-summary-cursor))
343 (mbuf (or (vm-select-folder-buffer) (current-buffer)))
344 (mwin (vm-get-buffer-window mbuf))
345 (pbuf (and mime::article/preview-buffer
346 (get-buffer mime::article/preview-buffer)))
347 (pwin (and pbuf (vm-get-buffer-window pbuf)))
348 (was-invisible (and (null mwin) (null pwin)))
350 ;; now current buffer is folder buffer.
351 (tm-vm/save-window-excursion
352 (if (or mp-changed was-invisible)
353 (vm-display mbuf t '(vm-scroll-forward vm-scroll-backward)
354 (list this-command 'reading-message)))
355 (tm-vm/display-preview-buffer)
356 (setq mwin (vm-get-buffer-window mbuf)
357 pwin (and pbuf (vm-get-buffer-window pbuf)))
359 ((or mp-changed was-invisible)
363 ;; preview buffer is killed.
364 (tm-vm/preview-current-message)
365 (vm-update-summary-and-mode-line))
366 ((eq (tm-vm/system-state) 'previewing)
367 (tm-vm/show-current-message))
371 (if (pos-visible-in-window-p (point-max) pwin)
373 ;; not end of message. scroll preview buffer only.
380 ;;; based on vm-scroll-backward [vm-page.el]
381 (defun tm-vm/scroll-backward (&optional arg)
383 (let ((this-command 'vm-scroll-backward))
384 (if (not (tm-vm/system-state))
385 (vm-scroll-backward arg)
386 (let* ((mp-changed (vm-follow-summary-cursor))
387 (mbuf (or (vm-select-folder-buffer) (current-buffer)))
388 (mwin (vm-get-buffer-window mbuf))
389 (pbuf (and mime::article/preview-buffer
390 (get-buffer mime::article/preview-buffer)))
391 (pwin (and pbuf (vm-get-buffer-window pbuf)))
392 (was-invisible (and (null mwin) (null pwin)))
394 ;; now current buffer is folder buffer.
395 (if (or mp-changed was-invisible)
396 (vm-display mbuf t '(vm-scroll-forward vm-scroll-backward)
397 (list this-command 'reading-message)))
398 (tm-vm/save-window-excursion
399 (tm-vm/display-preview-buffer)
400 (setq mwin (vm-get-buffer-window mbuf)
401 pwin (and pbuf (vm-get-buffer-window pbuf)))
407 ;; preview buffer is killed.
408 (tm-vm/preview-current-message)
409 (vm-update-summary-and-mode-line))
410 ((eq (tm-vm/system-state) 'previewing)
411 (tm-vm/show-current-message))
415 (if (pos-visible-in-window-p (point-min) pwin)
417 ;; scroll preview buffer only.
423 ;;; based on vm-beginning-of-message [vm-page.el]
424 (defun tm-vm/beginning-of-message ()
425 "Moves to the beginning of the current message."
427 (if (not (tm-vm/system-state))
429 (setq this-command 'vm-beginning-of-message)
430 (vm-beginning-of-message))
431 (vm-follow-summary-cursor)
432 (vm-select-folder-buffer)
433 (vm-check-for-killed-summary)
434 (vm-error-if-folder-empty)
435 (let ((mbuf (current-buffer))
436 (pbuf (and mime::article/preview-buffer
437 (get-buffer mime::article/preview-buffer))))
440 (tm-vm/preview-current-message)
441 (setq pbuf (get-buffer mime::article/preview-buffer))
443 (vm-display mbuf t '(vm-beginning-of-message)
444 '(vm-beginning-of-message reading-message))
445 (tm-vm/display-preview-buffer)
447 (tm-vm/save-window-excursion
448 (select-window (vm-get-buffer-window pbuf))
450 (goto-char (point-min))
453 ;;; based on vm-end-of-message [vm-page.el]
454 (defun tm-vm/end-of-message ()
455 "Moves to the end of the current message."
457 (if (not (tm-vm/system-state))
459 (setq this-command 'vm-end-of-message)
461 (vm-follow-summary-cursor)
462 (vm-select-folder-buffer)
463 (vm-check-for-killed-summary)
464 (vm-error-if-folder-empty)
465 (let ((mbuf (current-buffer))
466 (pbuf (and mime::article/preview-buffer
467 (get-buffer mime::article/preview-buffer))))
470 (tm-vm/preview-current-message)
471 (setq pbuf (get-buffer mime::article/preview-buffer))
473 (vm-display mbuf t '(vm-end-of-message)
474 '(vm-end-of-message reading-message))
475 (tm-vm/display-preview-buffer)
477 (tm-vm/save-window-excursion
478 (select-window (vm-get-buffer-window pbuf))
480 (goto-char (point-max))
483 ;;; based on vm-howl-if-eom [vm-page.el]
484 (defun tm-vm/howl-if-eom ()
485 (let* ((pbuf (or mime::article/preview-buffer (current-buffer)))
486 (pwin (and (vm-get-visible-buffer-window pbuf))))
489 (save-window-excursion
491 (let ((next-screen-context-lines 0))
494 (save-window-excursion
495 (let ((scroll-in-place-replace-original nil))
499 (tm-vm/emit-eom-blurb)
502 ;;; based on vm-emit-eom-blurb [vm-page.el]
503 (defun tm-vm/emit-eom-blurb ()
505 (if mime::preview/article-buffer
506 (set-buffer mime::preview/article-buffer))
507 (vm-emit-eom-blurb)))
509 ;;; based on vm-quit [vm-folder.el]
513 (vm-select-folder-buffer)
514 (if (and mime::article/preview-buffer
515 (get-buffer mime::article/preview-buffer))
516 (kill-buffer mime::article/preview-buffer)))
519 (substitute-key-definition 'vm-scroll-forward
520 'tm-vm/scroll-forward vm-mode-map)
521 (substitute-key-definition 'vm-scroll-backward
522 'tm-vm/scroll-backward vm-mode-map)
523 (substitute-key-definition 'vm-beginning-of-message
524 'tm-vm/beginning-of-message vm-mode-map)
525 (substitute-key-definition 'vm-end-of-message
526 'tm-vm/end-of-message vm-mode-map)
527 (substitute-key-definition 'vm-quit
528 'tm-vm/quit vm-mode-map)
530 ;;; based on vm-next-message [vm-motion.el]
531 (defun tm-vm/next-message ()
532 (set-buffer mime::preview/article-buffer)
533 (let ((this-command 'vm-next-message)
534 (owin (selected-window))
535 (vm-preview-lines nil)
537 (vm-next-message 1 nil t)
538 (if (window-live-p owin)
539 (select-window owin))))
541 ;;; based on vm-previous-message [vm-motion.el]
542 (defun tm-vm/previous-message ()
543 (set-buffer mime::preview/article-buffer)
544 (let ((this-command 'vm-previous-message)
545 (owin (selected-window))
546 (vm-preview-lines nil)
548 (vm-previous-message 1 nil t)
549 (if (window-live-p owin)
550 (select-window owin))))
552 (set-alist 'mime-viewer/over-to-previous-method-alist
553 'vm-mode 'tm-vm/previous-message)
554 (set-alist 'mime-viewer/over-to-next-method-alist
555 'vm-mode 'tm-vm/next-message)
556 (set-alist 'mime-viewer/over-to-previous-method-alist
557 'vm-virtual-mode 'tm-vm/previous-message)
558 (set-alist 'mime-viewer/over-to-next-method-alist
559 'vm-virtual-mode 'tm-vm/next-message)
561 ;;; @@ vm-yank-message
563 ;; 1996/3/28 by Oscar Figueiredo <figueire@lspsun16.epfl.ch>
567 (defvar tm-vm/yank:message-to-restore nil
568 "For internal use by tm-vm only.")
570 (defun vm-yank-message (&optional message)
571 "Yank message number N into the current buffer at point.
572 When called interactively N is always read from the minibuffer. When
573 called non-interactively the first argument is expected to be a
576 This function originally provided by vm-reply has been patched for TM
577 in order to provide better citation of MIME messages : if a MIME
578 Preview buffer exists for the message then its contents are inserted
579 instead of the raw message.
581 This command is meant to be used in VM created Mail mode buffers; the
582 yanked message comes from the mail buffer containing the message you
583 are replying to, forwarding, or invoked VM's mail command from.
585 All message headers are yanked along with the text. Point is
586 left before the inserted text, the mark after. Any hook
587 functions bound to mail-citation-hook are run, after inserting
588 the text and setting point and mark. For backward compatibility,
589 if mail-citation-hook is set to nil, `mail-yank-hooks' is run
592 If mail-citation-hook and mail-yank-hooks are both nil, this
593 default action is taken: the yanked headers are trimmed as
594 specified by vm-included-text-headers and
595 vm-included-text-discard-header-regexp, and the value of
596 vm-included-text-prefix is prepended to every yanked line."
599 ;; What we really want for the first argument is a message struct,
600 ;; but if called interactively, we let the user type in a message
605 (last-command last-command)
606 (this-command this-command))
607 (if (bufferp vm-mail-buffer)
609 (vm-select-folder-buffer)
610 (setq default (and vm-message-pointer
611 (vm-number-of (car vm-message-pointer)))
613 (format "Yank message number: (default %s) "
615 "Yank message number: "))
616 (while (zerop result)
617 (setq result (read-string prompt))
618 (and (string= result "") default (setq result default))
619 (setq result (string-to-int result)))
620 (if (null (setq mp (nthcdr (1- result) vm-message-list)))
621 (error "No such message."))
622 (setq tm-vm/yank:message-to-restore (string-to-int default))
623 (save-selected-window
624 (vm-goto-message result))
628 (if mail-reply-buffer
630 (error "This is not a VM Mail mode buffer."))
631 (if (null (buffer-name vm-mail-buffer))
632 (error "The folder buffer containing message %d has been killed."
633 (vm-number-of message)))
634 (vm-display nil nil '(vm-yank-message)
635 '(vm-yank-message composing-message))
636 (let ((b (current-buffer)) (start (point)) end)
640 (set-buffer (vm-buffer-of message))
641 (let* ((mbuf (current-buffer))
642 (pbuf (and mime::article/preview-buffer
643 ; is there a preview buffer alive ?
644 (get-buffer mime::article/preview-buffer)
645 ; rebuild preview to ensure it
646 ; corresponds to the current message
648 (save-selected-window
649 (save-window-excursion
650 (tm-vm/view-message))))
651 (get-buffer mime::article/preview-buffer))))
654 (let ((tmp (generate-new-buffer "tm-vm/tmp")))
656 (append-to-buffer tmp (point-min) (point-max))
659 '(lambda (ext maparg)
660 (set-extent-property ext 'begin-glyph nil)))
661 (append-to-buffer b (point-min) (point-max))
663 (+ start (length (buffer-string))) b))
666 (append-to-buffer b (point-min) (point-max))
668 (+ start (length (buffer-string))) b)))
670 (setq message (vm-real-message-of message))
671 (set-buffer (vm-buffer-of message))
674 b (vm-headers-of message) (vm-text-end-of message))
676 (vm-marker (+ start (- (vm-text-end-of message)
677 (vm-headers-of message))) b))))))
679 (cond (mail-citation-hook (run-hooks 'mail-citation-hook))
680 (mail-yank-hooks (run-hooks 'mail-yank-hooks))
681 (t (vm-mail-yank-default message)))
683 (if tm-vm/yank:message-to-restore
684 (save-selected-window
685 (vm-goto-message tm-vm/yank:message-to-restore)
686 (setq tm-vm/yank:message-to-restore nil)))
693 ;;; based on vm-do-reply [vm-reply.el]
694 (defun tm-vm/do-reply (buf to-all include-text)
697 (let ((dir default-directory)
698 to cc subject mp in-reply-to references newsgroups)
700 (let ((reply-to (std11-field-body "Reply-To")))
701 (if (vm-ignored-reply-to reply-to)
704 ((setq to (std11-field-body "From")))
705 ;; (t (error "No From: or Reply-To: header in message"))
708 (setq cc (delq nil (cons cc (std11-field-bodies '("To" "Cc"))))
709 cc (mapconcat 'identity cc ","))
711 (setq subject (std11-field-body "Subject"))
712 (and subject vm-reply-subject-prefix
713 (let ((case-fold-search t))
716 (string-match (regexp-quote vm-reply-subject-prefix)
719 (setq subject (concat vm-reply-subject-prefix subject)))
720 (setq in-reply-to (std11-field-body "Message-Id")
722 (std11-field-bodies '("References" "In-Reply-To"))
724 newsgroups (list (or (and to-all
725 (std11-field-body "Followup-To"))
726 (std11-field-body "Newsgroups"))))
727 (setq to (vm-parse-addresses to)
728 cc (vm-parse-addresses cc))
729 (if vm-reply-ignored-addresses
730 (setq to (vm-strip-ignored-addresses to)
731 cc (vm-strip-ignored-addresses cc)))
732 (setq to (vm-delete-duplicates to nil t))
733 (setq cc (vm-delete-duplicates
734 (append (vm-delete-duplicates cc nil t)
735 to (copy-sequence to))
737 (and to (setq to (mapconcat 'identity to ",\n ")))
738 (and cc (setq cc (mapconcat 'identity cc ",\n ")))
739 (and (null to) (setq to cc cc nil))
740 (setq references (delq nil references)
741 references (mapconcat 'identity references " ")
742 references (vm-parse references "[^<]*\\(<[^>]+>\\)")
743 references (vm-delete-duplicates references)
744 references (if references (mapconcat 'identity references "\n\t")))
745 (setq newsgroups (delq nil newsgroups)
746 newsgroups (mapconcat 'identity newsgroups ",")
747 newsgroups (vm-parse newsgroups "[ \t\f\r\n,]*\\([^ \t\f\r\n,]+\\)")
748 newsgroups (vm-delete-duplicates newsgroups)
749 newsgroups (if newsgroups (mapconcat 'identity newsgroups ",")))
752 (format "reply to %s%s"
753 (std11-full-name-string
754 (car (std11-parse-address-string to)))
756 to subject in-reply-to cc references newsgroups)
757 (setq mail-reply-buffer buf
758 ;; vm-system-state 'replying
759 default-directory dir))
762 (goto-char (point-min))
763 (let ((case-fold-search nil))
765 (concat "^" (regexp-quote mail-header-separator) "$") nil 0))
767 (tm-vm/yank-content)))
768 (run-hooks 'vm-reply-hook)
769 (run-hooks 'vm-mail-mode-hook)
772 (defun tm-vm/following-method (buf)
773 (tm-vm/do-reply buf 'to-all 'include-text)
776 (defun tm-vm/yank-content ()
778 (let ((this-command 'vm-yank-message))
779 (vm-display nil nil '(vm-yank-message)
780 '(vm-yank-message composing-message))
782 (narrow-to-region (point)(point))
783 (insert-buffer mail-reply-buffer)
784 (goto-char (point-max))
786 (goto-char (point-min)))
787 (cond (mail-citation-hook (run-hooks 'mail-citation-hook))
788 (mail-yank-hooks (run-hooks 'mail-yank-hooks))
789 (t (mail-indent-citation)))
792 (set-alist 'mime-viewer/following-method-alist
794 (function tm-vm/following-method))
795 (set-alist 'mime-viewer/following-method-alist
797 (function tm-vm/following-method))
800 (defun tm-vm/quit-view-message ()
801 "Quit MIME-viewer and go back to VM.
802 This function is called by `mime-viewer/quit' command via
803 `mime-viewer/quitting-method-alist'."
804 (if (get-buffer mime/output-buffer-name)
805 (vm-undisplay-buffer mime/output-buffer-name))
806 (if (and tm-vm/automatic-mime-preview
808 (set-buffer mime::preview/article-buffer)
810 (switch-to-buffer mime::preview/article-buffer)
811 (mime-viewer/kill-buffer)
812 (vm-select-folder-buffer)
813 (setq tm-vm/system-state nil))
814 (vm-display (current-buffer) t (list this-command)
815 (list this-command 'reading-message))
816 (tm-vm/display-preview-buffer)
819 (defun tm-vm/view-message ()
820 "Decode and view MIME encoded message, under VM."
822 (vm-follow-summary-cursor)
823 (vm-select-folder-buffer)
824 (vm-check-for-killed-summary)
825 (vm-error-if-folder-empty)
826 (vm-display (current-buffer) t '(tm-vm/view-message)
827 '(tm-vm/view-mesage reading-message))
828 (let* ((mp (car vm-message-pointer))
829 (ct (vm-get-header-contents mp "Content-Type:"))
830 (cte (vm-get-header-contents mp "Content-Transfer-Encoding:"))
831 (exposed (= (point-min) (vm-start-of mp))))
834 ;; vm-widen-page hides exposed header if pages are delimited.
835 ;; So, here we expose it again.
837 (narrow-to-region (vm-start-of mp) (point-max)))
838 (select-window (vm-get-buffer-window (current-buffer)))
839 (mime/viewer-mode nil
840 (mime/parse-Content-Type (or ct ""))
844 (set-alist 'mime-viewer/quitting-method-alist
846 'tm-vm/quit-view-message)
848 (set-alist 'mime-viewer/quitting-method-alist
850 'tm-vm/quit-view-message)
860 (set-atype 'mime/content-decoding-condition
861 '((type . "message/partial")
862 (method . mime-article/grab-message/partials)
863 (major-mode . vm-mode)
864 (summary-buffer-exp . vm-summary-buffer)
866 (set-alist 'tm-partial/preview-article-method-alist
878 ;;; @@ for multipart/digest
881 (defvar tm-vm/forward-message-hook nil
882 "*List of functions called after a Mail mode buffer has been
883 created to forward a message in message/rfc822 type format.
884 If `vm-forwarding-digest-type' is \"rfc1521\", tm-vm runs this
885 hook instead of `vm-forward-message-hook'.")
887 (defvar tm-vm/send-digest-hook nil
888 "*List of functions called after a Mail mode buffer has been
889 created to send a digest in multipart/digest type format.
890 If `vm-digest-send-type' is \"rfc1521\", tm-vm runs this hook
891 instead of `vm-send-digest-hook'.")
893 (defun tm-vm/enclose-messages (mlist &optional preamble)
894 "Enclose the messages in MLIST as multipart/digest.
895 The resulting digest is inserted at point in the current buffer.
897 MLIST should be a list of message structs (real or virtual).
898 These are the messages that will be enclosed."
900 (let ((digest (consp (cdr mlist)))
904 (narrow-to-region (point) (point))
906 (setq m (vm-real-message-of (car mlist)))
907 (mime-editor/insert-tag "message" "rfc822")
908 (tm-mail/insert-message m)
909 (goto-char (point-max))
910 (setq mlist (cdr mlist)))
913 (goto-char (point-min))
914 (mime-editor/insert-tag "text" "plain")
915 (vm-unsaved-message "Building digest preamble...")
917 (let ((vm-summary-uninteresting-senders nil))
919 (vm-sprintf 'vm-digest-preamble-format (car mp)) "\n"))
920 (if vm-digest-center-preamble
925 (setq mp (cdr mp)))))
927 (mime-editor/enclose-digest-region (point-min) (point-max)))
930 (defun tm-vm/forward-message ()
931 "Forward the current message to one or more recipients.
932 You will be placed in a Mail mode buffer as you would with a
933 reply, but you must fill in the To: header and perhaps the
934 Subject: header manually."
936 (if (not (equal vm-forwarding-digest-type "rfc1521"))
938 (vm-follow-summary-cursor)
939 (vm-select-folder-buffer)
940 (vm-check-for-killed-summary)
941 (vm-error-if-folder-empty)
942 (if (eq last-command 'vm-next-command-uses-marks)
943 (let ((vm-digest-send-type vm-forwarding-digest-type))
944 (setq this-command 'vm-next-command-uses-marks)
945 (command-execute 'tm-vm/send-digest))
946 (let ((dir default-directory)
947 (mp vm-message-pointer))
951 (format "forward of %s's note re: %s"
952 (vm-su-full-name (car vm-message-pointer))
953 (vm-su-subject (car vm-message-pointer)))
955 (and vm-forwarding-subject-format
956 (let ((vm-summary-uninteresting-senders nil))
957 (vm-sprintf 'vm-forwarding-subject-format (car mp)))))
958 (make-local-variable 'vm-forward-list)
959 (setq vm-system-state 'forwarding
960 vm-forward-list (list (car mp))
961 default-directory dir)
962 (goto-char (point-min))
964 (concat "^" (regexp-quote mail-header-separator) "\n") nil 0)
965 (tm-vm/enclose-messages vm-forward-list)
966 (mail-position-on-field "To"))
967 (run-hooks 'tm-vm/forward-message-hook)
968 (run-hooks 'vm-mail-mode-hook)))))
970 (defun tm-vm/send-digest (&optional arg)
971 "Send a digest of all messages in the current folder to recipients.
972 The type of the digest is specified by the variable vm-digest-send-type.
973 You will be placed in a Mail mode buffer as is usual with replies, but you
974 must fill in the To: and Subject: headers manually.
976 If invoked on marked messages (via vm-next-command-uses-marks),
977 only marked messages will be put into the digest."
979 (if (not (equal vm-digest-send-type "rfc1521"))
981 (vm-select-folder-buffer)
982 (vm-check-for-killed-summary)
983 (vm-error-if-folder-empty)
984 (let ((dir default-directory)
985 (vm-forward-list (if (eq last-command 'vm-next-command-uses-marks)
986 (vm-select-marked-or-prefixed-messages 0)
991 (vm-mail-internal (format "digest from %s" (buffer-name)))
992 (setq vm-system-state 'forwarding
993 default-directory dir)
994 (goto-char (point-min))
995 (re-search-forward (concat "^" (regexp-quote mail-header-separator)
997 (goto-char (match-end 0))
998 (vm-unsaved-message "Building %s digest..." vm-digest-send-type)
999 (tm-vm/enclose-messages vm-forward-list arg)
1000 (mail-position-on-field "To")
1001 (message "Building %s digest... done" vm-digest-send-type)))
1002 (run-hooks 'tm-vm/send-digest-hook)
1003 (run-hooks 'vm-mail-mode-hook)))
1005 (substitute-key-definition 'vm-forward-message
1006 'tm-vm/forward-message vm-mode-map)
1007 (substitute-key-definition 'vm-send-digest
1008 'tm-vm/send-digest vm-mode-map)
1014 (defvar tm-vm/use-xemacs-popup-menu t)
1016 ;;; modified by Steven L. Baur <steve@miranova.com>
1017 ;;; 1995/12/6 (c.f. [tm-en:209])
1018 (defun mime-editor/attach-to-vm-mode-menu ()
1019 "Arrange to attach MIME editor's popup menu to VM's"
1020 (if (boundp 'vm-menu-mail-menu)
1022 (setq vm-menu-mail-menu
1023 (append vm-menu-mail-menu
1025 mime-editor/popup-menu-for-xemacs)))
1026 (remove-hook 'vm-mail-mode-hook 'mime-editor/attach-to-vm-mode-menu)
1033 (autoload 'tm-mail/insert-message "tm-mail")
1034 (set-alist 'mime-editor/message-inserter-alist
1035 'mail-mode (function tm-mail/insert-message))
1036 (set-alist 'mime-editor/split-message-sender-alist
1037 'mail-mode (function
1042 (if (and (string-match "XEmacs\\|Lucid" emacs-version)
1043 tm-vm/use-xemacs-popup-menu)
1044 (add-hook 'vm-mail-mode-hook 'mime-editor/attach-to-vm-mode-menu)
1052 (setq vm-forwarding-digest-type "rfc1521")
1053 (setq vm-digest-send-type "rfc1521")
1066 (or (fboundp 'tm:bbdb/vm-update-record)
1067 (fset 'tm:bbdb/vm-update-record
1068 (symbol-function 'bbdb/vm-update-record)))
1069 (defun bbdb/vm-update-record (&optional offer-to-create)
1070 (vm-select-folder-buffer)
1071 (if (and (tm-vm/system-state)
1072 mime::article/preview-buffer
1073 (get-buffer mime::article/preview-buffer))
1074 (tm-bbdb/update-record offer-to-create)
1075 (tm:bbdb/vm-update-record offer-to-create)
1077 (remove-hook 'vm-select-message-hook 'bbdb/vm-update-record)
1078 (remove-hook 'vm-show-message-hook 'bbdb/vm-update-record)
1079 (add-hook 'tm-vm/select-message-hook 'bbdb/vm-update-record)
1088 (run-hooks 'tm-vm-load-hook)
1090 ;;; tm-vm.el ends here.