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 ;;;          and Kenji Wakamiya <wkenji@flab.fujitsu.co.jp>
   8 ;;;          modified by SHIONO <jun@p5.nm.fujitsu.co.jp>,
   9 ;;;                Steinar Bang <steinarb@falch.no>,
  10 ;;;        and MORIOKA Tomohiko <morioka@jaist.ac.jp>
  11 ;;; Keywords: news, MIME, multimedia, multilingual, encoded-word
  12 ;;;
  13 ;;; This file is part of tm (Tools for MIME).
  14 ;;;
  15 ;;; This version is tested under VM-5.76 with tm-6.20.
  16 ;;;
  17 ;;; Plese insert (require 'tm-vm) in your .vm or .emacs.
  18 ;;;
  19
  20 (require 'tm-view)
  21 (require 'vm)
  22
  23 (defconst tm-vm/RCS-ID
  24   "$Id: tm-vm.el,v 7.1 1995/10/17 16:49:51 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
  30 (set-alist 'mime-viewer/quitting-method-alist
  31            'vm-mode
  32            'tm-vm/quit-view-message)
  33
  34 (set-alist 'mime-viewer/quitting-method-alist
  35            'vm-virtual-mode
  36            'tm-vm/quit-view-message)
  37
  38
  39 ;;; @ for MIME header
  40 ;;;
  41 ;; If you don't use tiny-mime patch for VM (by RIKITAKE Kenji
  42 ;; <kenji@reseau.toyonaka.osaka.jp>), please use following definition:
  43
  44 ;; (setq vm-summary-format "%n %*%a %-17.17F %-3.3m %2d %4l/%-5c, %I\"%UA\"\n")
  45 ;; (defun vm-summary-function-A (m)
  46 ;;   (mime-ewords/decode-string (vm-su-subject m)))
  47
  48
  49 ;;; @ functions
  50 ;;;
  51
  52 (defun tm-vm/quit-view-message ()
  53   "Quit MIME-viewer and go back to VM.
  54 This function is called by `mime-viewer/quit' command via
  55 `mime-viewer/quitting-method-alist'."
  56   (mime-viewer/kill-buffer)
  57   (if (get-buffer mime/output-buffer-name)
  58       (bury-buffer mime/output-buffer-name))
  59   (vm-select-folder-buffer)
  60   (vm-display (current-buffer) t '(mime-viewer/quit mime-viewer/up-content)
  61               '(mime-viewer/quit reading-message)))
  62
  63 (defun tm-vm/view-message ()
  64   "Decode and view MIME encoded message, under VM."
  65   (interactive)
  66   (vm-follow-summary-cursor)
  67   (vm-select-folder-buffer)
  68   (vm-check-for-killed-summary)
  69   (vm-error-if-folder-empty)
  70   (vm-display (current-buffer) t '(tm-vm/view-message)
  71               '(tm-vm/view-mesage reading-message))
  72   (let* ((mp (car vm-message-pointer))
  73          (ct  (vm-get-header-contents mp "Content-Type:"))
  74          (cte (vm-get-header-contents mp "Content-Transfer-Encoding:"))
  75          (exposed (= (point-min) (vm-start-of mp))))
  76     (save-restriction
  77       (vm-widen-page)
  78       ;; vm-widen-page hides exposed header if pages are delimited.
  79       ;; So, here we expose it again.
  80       (if exposed
  81           (narrow-to-region (vm-start-of mp) (point-max)))
  82       (select-window (vm-get-buffer-window (current-buffer)))
  83       (mime/viewer-mode nil
  84                         (mime/parse-Content-Type (or ct ""))
  85                         cte)
  86       )))
  87
  88 (defun tm-vm/decode-message-header (&optional count)
  89   "Decode MIME header of current message through tiny-mime.
  90 Numeric prefix argument COUNT means to decode the current message plus
  91 the next COUNT-1 messages.  A negative COUNT means decode the current
  92 message and the previous COUNT-1 messages.
  93 When invoked on marked messages (via vm-next-command-uses-marks),
  94 all marked messages are affected, other messages are ignored."
  95   (interactive "p")
  96   (or count (setq count 1))
  97   (vm-follow-summary-cursor)
  98   (vm-select-folder-buffer)
  99   (vm-check-for-killed-summary)
 100   (vm-error-if-folder-empty)
 101   (vm-error-if-folder-read-only)
 102   (let ((mlist (vm-select-marked-or-prefixed-messages count))
 103         (realm nil)
 104         (vlist nil)
 105         (vbufs nil))
 106     (save-excursion
 107       (while mlist
 108         (setq realm (vm-real-message-of (car mlist)))
 109         ;; Go to real folder of this message.
 110         ;; But maybe this message is already real message...
 111         (set-buffer (vm-buffer-of realm))
 112         (let ((buffer-read-only nil))
 113           (vm-save-restriction
 114            (narrow-to-region (vm-headers-of realm) (vm-text-of realm))
 115            (mime/decode-message-header))
 116           (let ((vm-message-pointer (list realm))
 117                 (last-command nil))
 118             (vm-discard-cached-data))
 119           ;; Mark each virtual and real message for later summary
 120           ;; update.
 121           (setq vlist (cons realm (vm-virtual-messages-of realm)))
 122           (while vlist
 123             (vm-mark-for-summary-update (car vlist))
 124             ;; Remember virtual and real folders related this message,
 125             ;; for later display update.
 126             (or (memq (vm-buffer-of (car vlist)) vbufs)
 127                 (setq vbufs (cons (vm-buffer-of (car vlist)) vbufs)))
 128             (setq vlist (cdr vlist)))
 129           (if (eq vm-flush-interval t)
 130               (vm-stuff-virtual-attributes realm)
 131             (vm-set-modflag-of realm t)))
 132         (setq mlist (cdr mlist)))
 133       ;; Update mail-buffers and summaries.
 134       (while vbufs
 135         (set-buffer (car vbufs))
 136         (vm-preview-current-message)
 137         (setq vbufs (cdr vbufs))))))
 138
 139
 140 ;;; @ end
 141 ;;;
 142
 143 (provide 'tm-vm)