;;;
-;;; tm-vm.el : tm-MUA for vm
+;;; tm-vm.el --- tm-MUA for VM
;;;
-;;; by MASUTANI Yasuhiro <masutani@me.es.osaka-u.ac.jp>
-;;; modified by SHIONO <jun@p5.nm.fujitsu.co.jp>
+;;; Copyright (C) 1995 Free Software Foundation, Inc.
+;;;
+;;; Author: MASUTANI Yasuhiro <masutani@me.es.osaka-u.ac.jp>
+;;; and Kenji Wakamiya <wkenji@flab.fujitsu.co.jp>
+;;; modified by SHIONO <jun@p5.nm.fujitsu.co.jp>,
+;;; Steinar Bang <steinarb@falch.no>,
+;;; and MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;;; Keywords: news, MIME, multimedia, multilingual, encoded-word
;;;
-;;; Plese insert (load "tm-vm") in .vm or .emacs.
+;;; This file is part of tm (Tools for MIME).
+;;;
+;;; This version is tested under VM-5.76 with tm-6.20.
+;;;
+;;; Plese insert (require 'tm-vm) in your .vm or .emacs.
;;;
-(provide 'tm-vm)
-
-(require 'tl-list)
(require 'tm-view)
+(require 'vm)
(defconst tm-vm/RCS-ID
- "$Id: tm-vm.el,v 1.5 1994/11/01 16:30:12 morioka Exp $")
+ "$Id: tm-vm.el,v 7.0 1995/10/03 05:04:35 morioka Exp $")
(defconst tm-vm/version (get-version-string tm-vm/RCS-ID))
(define-key vm-mode-map "Z" 'tm-vm/view-message)
+(define-key vm-mode-map "T" 'tm-vm/decode-message-header)
-(set-alist 'mime/go-to-top-node-method-alist
+(set-alist 'mime-viewer/quitting-method-alist
'vm-mode
'tm-vm/quit-view-message)
-(set-alist 'mime/go-to-top-node-method-alist
+(set-alist 'mime-viewer/quitting-method-alist
'vm-virtual-mode
'tm-vm/quit-view-message)
-(defun tm-vm/quit-view-message()
- (mime/exit-view-mode)
- (let ((w (get-buffer-window mime/output-buffer-name)))
- (if w (delete-window w)))
- (vm-display vm-summary-buffer t
- '(mime/exit-view-mode)
- '(this-command))
- (vm-widen-page)
- (goto-char (point-max))
- (widen)
- (narrow-to-region (point)
- (vm-vheaders-of
- (car vm-message-pointer)))
- (goto-char (point-min))
- (if vm-honor-page-delimiters
- (vm-narrow-to-page))
- (select-window (get-buffer-window vm-summary-buffer)))
+
+;;; @ for MIME header
+;;;
+;; If you don't use tiny-mime patch for VM (by RIKITAKE Kenji
+;; <kenji@reseau.toyonaka.osaka.jp>), please use following definition:
+
+;; (setq vm-summary-format "%n %*%a %-17.17F %-3.3m %2d %4l/%-5c, %I\"%UA\"\n")
+;; (defun vm-summary-function-A (m)
+;; (mime/decode-encoded-words-string (vm-su-subject m)))
+
+
+;;; @ functions
+;;;
+
+(defun tm-vm/quit-view-message ()
+ "Quit MIME-viewer and go back to VM.
+This function is called by `mime-viewer/quit' command via
+`mime-viewer/quitting-method-alist'."
+ (mime-viewer/kill-buffer)
+ (if (get-buffer mime/output-buffer-name)
+ (bury-buffer mime/output-buffer-name))
+ (vm-select-folder-buffer)
+ (vm-display (current-buffer) t '(mime-viewer/quit mime-viewer/up-content)
+ '(mime-viewer/quit reading-message)))
(defun tm-vm/view-message ()
- "Decode and view MIME message for VM"
+ "Decode and view MIME encoded message, under VM."
(interactive)
(vm-follow-summary-cursor)
(vm-select-folder-buffer)
(vm-error-if-folder-empty)
(vm-display (current-buffer) t '(tm-vm/view-message)
'(tm-vm/view-mesage reading-message))
- (vm-widen-page)
- (goto-char (point-max))
- (widen)
- (narrow-to-region (point) (vm-start-of (car vm-message-pointer)))
- (goto-char (point-min))
- (select-window (vm-get-buffer-window (current-buffer)))
- (mime/viewer-mode))
+ (let* ((mp (car vm-message-pointer))
+ (ct (vm-get-header-contents mp "Content-Type:"))
+ (cte (vm-get-header-contents mp "Content-Transfer-Encoding:"))
+ (exposed (= (point-min) (vm-start-of mp))))
+ (save-restriction
+ (vm-widen-page)
+ ;; vm-widen-page hides exposed header if pages are delimited.
+ ;; So, here we expose it again.
+ (if exposed
+ (narrow-to-region (vm-start-of mp) (point-max)))
+ (select-window (vm-get-buffer-window (current-buffer)))
+ (mime/viewer-mode nil
+ (mime/parse-Content-Type (or ct ""))
+ cte)
+ )))
+
+(defun tm-vm/decode-message-header (&optional count)
+ "Decode MIME header of current message through tiny-mime.
+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))))))
+
+
+;;; @ end
+;;;
+
+(provide 'tm-vm)
projects / elisp / tm.git / blobdiff