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