+(defvar tm-vm-load-hook nil
+ "*List of functions called after tm-vm is loaded.")
+
+
+;;; @ for MIME encoded-words
+;;;
+
+(defvar tm-vm/use-tm-patch nil
+ "Does not decode encoded-words in summary buffer if it is t.
+If you use tiny-mime patch for VM (by RIKITAKE Kenji
+<kenji@reseau.toyonaka.osaka.jp>), please set it t [tm-vm.el]")
+
+(or tm-vm/use-tm-patch
+ (progn
+;;;
+(defvar tm-vm/chop-full-name-function 'tm-vm/default-chop-full-name)
+(setq vm-chop-full-name-function tm-vm/chop-full-name-function)
+
+(defun tm-vm/default-chop-full-name (address)
+ (let* ((ret (vm-default-chop-full-name address))
+ (full-name (car ret))
+ )
+ (if (stringp full-name)
+ (cons (mime-eword/decode-string full-name)
+ (cdr ret))
+ ret)))
+
+(require 'vm-summary)
+(or (fboundp 'tm:vm-su-subject)
+ (fset 'tm:vm-su-subject (symbol-function 'vm-su-subject))
+ )
+(defun vm-su-subject (m)
+ (mime-eword/decode-string (tm:vm-su-subject m))
+ )
+
+(or (fboundp 'tm:vm-su-full-name)
+ (fset 'tm:vm-su-full-name (symbol-function 'vm-su-full-name))
+ )
+(defun vm-su-full-name (m)
+ (mime-eword/decode-string (tm:vm-su-full-name m))
+ )
+
+(or (fboundp 'tm:vm-su-to-names)
+ (fset 'tm:vm-su-to-names (symbol-function 'vm-su-to-names))
+ )
+(defun vm-su-to-names (m)
+ (mime-eword/decode-string (tm:vm-su-to-names m))
+ )
+;;;
+))
+
+(defun tm-vm/decode-message-header (&optional count)
+ "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.
+When invoked on marked messages (via vm-next-command-uses-marks),
+all marked messages are affected, other messages are ignored."
+ (interactive "p")
+ (or count (setq count 1))
+ (vm-follow-summary-cursor)
+ (vm-select-folder-buffer)
+ (vm-check-for-killed-summary)
+ (vm-error-if-folder-empty)
+ (vm-error-if-folder-read-only)
+ (let ((mlist (vm-select-marked-or-prefixed-messages count))
+ (realm nil)
+ (vlist nil)
+ (vbufs nil))
+ (save-excursion
+ (while mlist
+ (setq realm (vm-real-message-of (car mlist)))
+ ;; Go to real folder of this message.
+ ;; But maybe this message is already real message...
+ (set-buffer (vm-buffer-of realm))
+ (let ((buffer-read-only nil))
+ (vm-save-restriction
+ (narrow-to-region (vm-headers-of realm) (vm-text-of realm))
+ (mime/decode-message-header))
+ (let ((vm-message-pointer (list realm))
+ (last-command nil))
+ (vm-discard-cached-data))
+ ;; Mark each virtual and real message for later summary
+ ;; update.
+ (setq vlist (cons realm (vm-virtual-messages-of realm)))
+ (while vlist
+ (vm-mark-for-summary-update (car vlist))
+ ;; Remember virtual and real folders related this message,
+ ;; for later display update.
+ (or (memq (vm-buffer-of (car vlist)) vbufs)
+ (setq vbufs (cons (vm-buffer-of (car vlist)) vbufs)))
+ (setq vlist (cdr vlist)))
+ (if (eq vm-flush-interval t)
+ (vm-stuff-virtual-attributes realm)
+ (vm-set-modflag-of realm t)))
+ (setq mlist (cdr mlist)))
+ ;; Update mail-buffers and summaries.
+ (while vbufs
+ (set-buffer (car vbufs))
+ (vm-preview-current-message)
+ (setq vbufs (cdr vbufs))))))
+
+\f
+;;; @ automatic MIME preview
+;;;
+
+(defvar tm-vm/automatic-mime-preview t
+ "*If non-nil, show MIME processed article.")
+
+(defvar tm-vm/strict-mime t
+ "*If nil, do MIME processing even if there is not MIME-Version field.")
+
+(defvar tm-vm/select-message-hook nil
+ "*List of functions called every time a message is selected.
+tm-vm uses `vm-select-message-hook', use this hook instead.")
+
+(defvar tm-vm/system-state nil)
+(defun tm-vm/system-state ()
+ (save-excursion
+ (if mime::preview/article-buffer
+ (set-buffer mime::preview/article-buffer)
+ (vm-select-folder-buffer))
+ tm-vm/system-state))
+
+(defun tm-vm/display-preview-buffer ()
+ (let* ((mbuf (current-buffer))
+ (mwin (vm-get-visible-buffer-window mbuf))
+ (pbuf (and mime::article/preview-buffer
+ (get-buffer mime::article/preview-buffer)))
+ (pwin (and pbuf (vm-get-visible-buffer-window pbuf))))
+ (if (and pbuf (tm-vm/system-state))
+ ;; display preview buffer
+ (cond
+ ((and mwin pwin)
+ (vm-undisplay-buffer mbuf)
+ (tm-vm/show-current-message))
+ ((and mwin (not pwin))
+ (set-window-buffer mwin pbuf)
+ (tm-vm/show-current-message))
+ (pwin
+ (tm-vm/show-current-message))
+ (t
+ ;; don't display if neither mwin nor pwin was displayed before.
+ ))
+ ;; display folder buffer
+ (cond
+ ((and mwin pwin)
+ (vm-undisplay-buffer pbuf))
+ ((and (not mwin) pwin)
+ (set-window-buffer pwin mbuf))
+ (mwin
+ ;; folder buffer is already displayed.
+ )
+ (t
+ ;; don't display if neither mwin nor pwin was displayed before.
+ )))
+ (set-buffer mbuf)))
+
+(defun tm-vm/preview-current-message ()
+ ;; assumed current buffer is folder buffer.
+ (setq tm-vm/system-state nil)
+ (if (get-buffer mime/output-buffer-name)
+ (vm-undisplay-buffer mime/output-buffer-name))
+ (if (and vm-message-pointer tm-vm/automatic-mime-preview)
+ (if (or (not tm-vm/strict-mime)
+ (vm-get-header-contents (car vm-message-pointer)
+ "MIME-Version:"))
+ ;; do MIME processiong.
+ (progn
+ (set (make-local-variable 'tm-vm/system-state) 'previewing)
+ (save-window-excursion
+ (vm-widen-page)
+ (goto-char (point-max))
+ (widen)
+ (narrow-to-region (point)
+ (save-excursion
+ (goto-char
+ (vm-start-of (car vm-message-pointer))
+ )
+ (forward-line)
+ (point)
+ ))
+ (mime/viewer-mode)
+ (if (and tm-vm/use-original-url-button
+ vm-use-menus (vm-menu-support-possible-p))
+ (vm-energize-urls))
+ ;; 1996/2/16, fixed by
+ ;; Oscar Figueiredo <figueire@lspsun2.epfl.ch>
+ ;; Highlight message (and display XFace if supported)
+ (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))
+ ))
+ ;; don't do MIME processing. decode header only.
+ (let (buffer-read-only)
+ (mime/decode-message-header))
+ )
+ ;; don't preview; do nothing.
+ )
+ (tm-vm/display-preview-buffer)
+ (run-hooks 'tm-vm/select-message-hook))
+
+(defun tm-vm/show-current-message ()
+ (if mime::preview/article-buffer
+ (set-buffer mime::preview/article-buffer)
+ (vm-select-folder-buffer))
+ ;; Now current buffer is folder buffer.
+ (if (or t ; mime/viewer-mode doesn't support narrowing yet.
+ (null vm-preview-lines)
+ (and (not vm-preview-read-messages)
+ (not (vm-new-flag
+ (car vm-message-pointer)))
+ (not (vm-unread-flag
+ (car vm-message-pointer)))))
+ (save-excursion
+ (set-buffer mime::article/preview-buffer)
+ (save-excursion
+ (save-excursion
+ (goto-char (point-min))
+ (widen))
+ ;; narrow to page; mime/viewer-mode doesn't support narrowing yet.
+ )))
+ (if (vm-get-visible-buffer-window mime::article/preview-buffer)
+ (progn
+ (setq tm-vm/system-state 'reading)
+ (if (vm-new-flag (car vm-message-pointer))
+ (vm-set-new-flag (car vm-message-pointer) nil))
+ (if (vm-unread-flag (car vm-message-pointer))
+ (vm-set-unread-flag (car vm-message-pointer) nil))
+ (vm-update-summary-and-mode-line)
+ (tm-vm/howl-if-eom))
+ (vm-update-summary-and-mode-line)))
+
+(defun tm-vm/toggle-preview-mode ()
+ (interactive)
+ (vm-select-folder-buffer)
+ (vm-display (current-buffer) t (list this-command)
+ (list this-command 'reading-message))
+ (if tm-vm/automatic-mime-preview
+ (setq tm-vm/automatic-mime-preview nil
+ tm-vm/system-state nil)
+ (setq tm-vm/automatic-mime-preview t
+ tm-vm/system-state nil)
+ (save-restriction
+ (vm-widen-page)
+ (let* ((mp (car vm-message-pointer))
+ (exposed (= (point-min) (vm-start-of mp))))
+ (if (or (not tm-vm/strict-mime)
+ (vm-get-header-contents mp "MIME-Version:"))
+ ;; do MIME processiong.
+ (progn
+ (set (make-local-variable 'tm-vm/system-state) 'previewing)
+ (save-window-excursion
+ (mime/viewer-mode)
+ (goto-char (point-min))
+ (narrow-to-region (point)
+ (search-forward "\n\n" nil t))
+ ))
+ ;; don't do MIME processing. decode header only.
+ (let (buffer-read-only)
+ (mime/decode-message-header))
+ )
+ ;; don't preview; do nothing.
+ ))
+ (tm-vm/display-preview-buffer)
+ ))
+
+(add-hook 'vm-select-message-hook 'tm-vm/preview-current-message)
+(add-hook 'vm-visit-folder-hook 'tm-vm/preview-current-message)
+\f
+;;; tm-vm move commands
+;;;
+
+(defmacro tm-vm/save-window-excursion (&rest forms)
+ (list 'let '((tm-vm/selected-window (selected-window)))
+ (list 'unwind-protect
+ (cons 'progn forms)
+ '(if (window-live-p tm-vm/selected-window)
+ (select-window tm-vm/selected-window)))))
+
+;;; based on vm-scroll-forward [vm-page.el]
+(defun tm-vm/scroll-forward (&optional arg)
+ (interactive "P")
+ (let ((this-command 'vm-scroll-forward))
+ (if (not (tm-vm/system-state))
+ (vm-scroll-forward arg)
+ (let* ((mp-changed (vm-follow-summary-cursor))
+ (mbuf (or (vm-select-folder-buffer) (current-buffer)))
+ (mwin (vm-get-buffer-window mbuf))
+ (pbuf (and mime::article/preview-buffer
+ (get-buffer mime::article/preview-buffer)))
+ (pwin (and pbuf (vm-get-buffer-window pbuf)))
+ (was-invisible (and (null mwin) (null pwin)))
+ )
+ ;; now current buffer is folder buffer.
+ (tm-vm/save-window-excursion
+ (if (or mp-changed was-invisible)
+ (vm-display mbuf t '(vm-scroll-forward vm-scroll-backward)
+ (list this-command 'reading-message)))
+ (tm-vm/display-preview-buffer)
+ (setq mwin (vm-get-buffer-window mbuf)
+ pwin (and pbuf (vm-get-buffer-window pbuf)))
+ (cond
+ ((or mp-changed was-invisible)
+ nil
+ )
+ ((null pbuf)
+ ;; preview buffer is killed.
+ (tm-vm/preview-current-message)
+ (vm-update-summary-and-mode-line))
+ ((eq (tm-vm/system-state) 'previewing)
+ (tm-vm/show-current-message))
+ (t
+ (select-window pwin)
+ (set-buffer pbuf)
+ (if (pos-visible-in-window-p (point-max) pwin)
+ (tm-vm/next-message)
+ ;; not end of message. scroll preview buffer only.
+ (scroll-up)
+ (tm-vm/howl-if-eom)
+ (set-buffer mbuf))
+ ))))
+ )))
+
+;;; based on vm-scroll-backward [vm-page.el]
+(defun tm-vm/scroll-backward (&optional arg)
+ (interactive "P")
+ (let ((this-command 'vm-scroll-backward))
+ (if (not (tm-vm/system-state))
+ (vm-scroll-backward arg)
+ (let* ((mp-changed (vm-follow-summary-cursor))
+ (mbuf (or (vm-select-folder-buffer) (current-buffer)))
+ (mwin (vm-get-buffer-window mbuf))
+ (pbuf (and mime::article/preview-buffer
+ (get-buffer mime::article/preview-buffer)))
+ (pwin (and pbuf (vm-get-buffer-window pbuf)))
+ (was-invisible (and (null mwin) (null pwin)))
+ )
+ ;; now current buffer is folder buffer.
+ (if (or mp-changed was-invisible)
+ (vm-display mbuf t '(vm-scroll-forward vm-scroll-backward)
+ (list this-command 'reading-message)))
+ (tm-vm/save-window-excursion
+ (tm-vm/display-preview-buffer)
+ (setq mwin (vm-get-buffer-window mbuf)
+ pwin (and pbuf (vm-get-buffer-window pbuf)))
+ (cond
+ (was-invisible
+ nil
+ )
+ ((null pbuf)
+ ;; preview buffer is killed.
+ (tm-vm/preview-current-message)
+ (vm-update-summary-and-mode-line))
+ ((eq (tm-vm/system-state) 'previewing)
+ (tm-vm/show-current-message))
+ (t
+ (select-window pwin)
+ (set-buffer pbuf)
+ (if (pos-visible-in-window-p (point-min) pwin)
+ nil
+ ;; scroll preview buffer only.
+ (scroll-down)
+ (set-buffer mbuf))
+ ))))
+ )))
+
+;;; based on vm-beginning-of-message [vm-page.el]
+(defun tm-vm/beginning-of-message ()
+ "Moves to the beginning of the current message."
+ (interactive)
+ (if (not (tm-vm/system-state))
+ (progn
+ (setq this-command 'vm-beginning-of-message)
+ (vm-beginning-of-message))
+ (vm-follow-summary-cursor)
+ (vm-select-folder-buffer)
+ (vm-check-for-killed-summary)
+ (vm-error-if-folder-empty)
+ (let ((mbuf (current-buffer))
+ (pbuf (and mime::article/preview-buffer
+ (get-buffer mime::article/preview-buffer))))
+ (if (null pbuf)
+ (progn
+ (tm-vm/preview-current-message)
+ (setq pbuf (get-buffer mime::article/preview-buffer))
+ ))
+ (vm-display mbuf t '(vm-beginning-of-message)
+ '(vm-beginning-of-message reading-message))
+ (tm-vm/display-preview-buffer)
+ (set-buffer pbuf)
+ (tm-vm/save-window-excursion
+ (select-window (vm-get-buffer-window pbuf))
+ (push-mark)
+ (goto-char (point-min))
+ ))))
+
+;;; based on vm-end-of-message [vm-page.el]
+(defun tm-vm/end-of-message ()
+ "Moves to the end of the current message."
+ (interactive)
+ (if (not (tm-vm/system-state))
+ (progn
+ (setq this-command 'vm-end-of-message)
+ (vm-end-of-message))
+ (vm-follow-summary-cursor)
+ (vm-select-folder-buffer)
+ (vm-check-for-killed-summary)
+ (vm-error-if-folder-empty)
+ (let ((mbuf (current-buffer))
+ (pbuf (and mime::article/preview-buffer
+ (get-buffer mime::article/preview-buffer))))
+ (if (null pbuf)
+ (progn
+ (tm-vm/preview-current-message)
+ (setq pbuf (get-buffer mime::article/preview-buffer))
+ ))
+ (vm-display mbuf t '(vm-end-of-message)
+ '(vm-end-of-message reading-message))
+ (tm-vm/display-preview-buffer)
+ (set-buffer pbuf)
+ (tm-vm/save-window-excursion
+ (select-window (vm-get-buffer-window pbuf))
+ (push-mark)
+ (goto-char (point-max))
+ ))))
+
+;;; based on vm-howl-if-eom [vm-page.el]
+(defun tm-vm/howl-if-eom ()
+ (let* ((pbuf (or mime::article/preview-buffer (current-buffer)))
+ (pwin (and (vm-get-visible-buffer-window pbuf))))
+ (and pwin
+ (save-excursion
+ (save-window-excursion
+ (condition-case ()
+ (let ((next-screen-context-lines 0))
+ (select-window pwin)
+ (save-excursion
+ (save-window-excursion
+ (let ((scroll-in-place-replace-original nil))
+ (scroll-up))))
+ nil)
+ (error t))))
+ (tm-vm/emit-eom-blurb)
+ )))
+
+;;; based on vm-emit-eom-blurb [vm-page.el]
+(defun tm-vm/emit-eom-blurb ()
+ (save-excursion
+ (if mime::preview/article-buffer
+ (set-buffer mime::preview/article-buffer))
+ (vm-emit-eom-blurb)))
+
+;;; based on vm-quit [vm-folder.el]
+(defun tm-vm/quit ()
+ (interactive)
+ (save-excursion
+ (vm-select-folder-buffer)
+ (if (and mime::article/preview-buffer
+ (get-buffer mime::article/preview-buffer))
+ (kill-buffer mime::article/preview-buffer)))
+ (vm-quit))
+
+(substitute-key-definition 'vm-scroll-forward
+ 'tm-vm/scroll-forward vm-mode-map)
+(substitute-key-definition 'vm-scroll-backward
+ 'tm-vm/scroll-backward vm-mode-map)
+(substitute-key-definition 'vm-beginning-of-message
+ 'tm-vm/beginning-of-message vm-mode-map)
+(substitute-key-definition 'vm-end-of-message
+ 'tm-vm/end-of-message vm-mode-map)
+(substitute-key-definition 'vm-quit
+ 'tm-vm/quit vm-mode-map)
+
+;;; based on vm-next-message [vm-motion.el]
+(defun tm-vm/next-message ()
+ (set-buffer mime::preview/article-buffer)
+ (let ((this-command 'vm-next-message)
+ (owin (selected-window))
+ (vm-preview-lines nil)
+ )
+ (vm-next-message 1 nil t)
+ (if (window-live-p owin)
+ (select-window owin))))
+
+;;; based on vm-previous-message [vm-motion.el]
+(defun tm-vm/previous-message ()
+ (set-buffer mime::preview/article-buffer)
+ (let ((this-command 'vm-previous-message)
+ (owin (selected-window))
+ (vm-preview-lines nil)
+ )
+ (vm-previous-message 1 nil t)
+ (if (window-live-p owin)
+ (select-window owin))))