2 ;;; tm-vm.el: tm-MUA for VM
3 ;;; This version is tested under VM-5.76 with tm-6.20
5 ;;; Written by MASUTANI Yasuhiro <masutani@me.es.osaka-u.ac.jp>
6 ;;; Modified by SHIONO <jun@p5.nm.fujitsu.co.jp>
7 ;;; and Steinar Bang <steinarb@falch.no>
8 ;;; and Kenji Wakamiya <wkenji@flab.fujitsu.co.jp>
10 ;;; Plese insert (require 'tm-vm) in your .vm or .emacs.
17 (defconst tm-vm/RCS-ID
18 "$Id: tm-vm.el,v 6.1 1995/05/16 12:33:21 morioka Exp $")
19 (defconst tm-vm/version (get-version-string tm-vm/RCS-ID))
21 (define-key vm-mode-map "Z" 'tm-vm/view-message)
22 (define-key vm-mode-map "T" 'tm-vm/decode-message-header)
24 (set-alist 'mime-viewer/quitting-method-alist
26 'tm-vm/quit-view-message)
28 (set-alist 'mime-viewer/quitting-method-alist
30 'tm-vm/quit-view-message)
34 ;; If you don't use tiny-mime patch for VM (by RIKITAKE Kenji
35 ;; <kenji@reseau.toyonaka.osaka.jp>), please use following definition:
37 ;; (setq vm-summary-format "%n %*%a %-17.17F %-3.3m %2d %4l/%-5c, %I\"%UA\"\n")
38 ;; (defun vm-summary-function-A (m)
39 ;; (mime/decode-string (vm-su-subject m)))
45 (defun tm-vm/quit-view-message ()
46 "Quit MIME-viewer and go back to VM.
47 This function is called by `mime-viewer/quit' command via
48 `mime-viewer/quitting-method-alist'."
49 (mime-viewer/kill-buffer)
50 (if (get-buffer mime/output-buffer-name)
51 (bury-buffer mime/output-buffer-name))
52 (vm-select-folder-buffer)
53 (vm-display (current-buffer) t '(mime-viewer/quit mime-viewer/up-content)
54 '(mime-viewer/quit reading-message)))
56 (defun tm-vm/view-message ()
57 "Decode and view MIME encoded message, under VM."
59 (vm-follow-summary-cursor)
60 (vm-select-folder-buffer)
61 (vm-check-for-killed-summary)
62 (vm-error-if-folder-empty)
63 (vm-display (current-buffer) t '(tm-vm/view-message)
64 '(tm-vm/view-mesage reading-message))
65 (let* ((mp (car vm-message-pointer))
66 (ct (vm-get-header-contents mp "Content-Type:"))
67 (cte (vm-get-header-contents mp "Content-Transfer-Encoding:"))
68 (exposed (= (point-min) (vm-start-of mp))))
71 ;; vm-widen-page hides exposed header if pages are delimited.
72 ;; So, here we expose it again.
74 (narrow-to-region (vm-start-of mp) (point-max)))
75 (select-window (vm-get-buffer-window (current-buffer)))
77 (mime::parse-field-body/Content-Type
78 (message/unfolding-string (or ct "")))
81 (defun tm-vm/decode-message-header (&optional count)
82 "Decode MIME header of current message through tiny-mime.
83 Numeric prefix argument COUNT means to decode the current message plus
84 the next COUNT-1 messages. A negative COUNT means decode the current
85 message and the previous COUNT-1 messages.
86 When invoked on marked messages (via vm-next-command-uses-marks),
87 all marked messages are affected, other messages are ignored."
89 (or count (setq count 1))
90 (vm-follow-summary-cursor)
91 (vm-select-folder-buffer)
92 (vm-check-for-killed-summary)
93 (vm-error-if-folder-empty)
94 (vm-error-if-folder-read-only)
95 (let ((mlist (vm-select-marked-or-prefixed-messages count))
101 (setq realm (vm-real-message-of (car mlist)))
102 ;; Go to real folder of this message.
103 ;; But maybe this message is already real message...
104 (set-buffer (vm-buffer-of realm))
105 (let ((buffer-read-only nil))
107 (narrow-to-region (vm-headers-of realm) (vm-text-of realm))
108 (mime/decode-message-header))
109 (let ((vm-message-pointer (list realm))
111 (vm-discard-cached-data))
112 ;; Mark each virtual and real message for later summary
114 (setq vlist (cons realm (vm-virtual-messages-of realm)))
116 (vm-mark-for-summary-update (car vlist))
117 ;; Remember virtual and real folders related this message,
118 ;; for later display update.
119 (or (memq (vm-buffer-of (car vlist)) vbufs)
120 (setq vbufs (cons (vm-buffer-of (car vlist)) vbufs)))
121 (setq vlist (cdr vlist)))
122 (if (eq vm-flush-interval t)
123 (vm-stuff-virtual-attributes realm)
124 (vm-set-modflag-of realm t)))
125 (setq mlist (cdr mlist)))
126 ;; Update mail-buffers and summaries.
128 (set-buffer (car vbufs))
129 (vm-preview-current-message)
130 (setq vbufs (cdr vbufs))))))