tm-vm.el

   1 ;;;
   2 ;;; tm-vm.el: tm-MUA for VM
   3 ;;; This version is tested under VM-5.76 with tm-6.20
   4 ;;;
   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>
   9 ;;;
  10 ;;; Plese insert (require 'tm-vm) in your .vm or .emacs.
  11 ;;;
  12
  13 (provide 'tm-vm)
  14 (require 'tm-view)
  15 (require 'vm)
  16
  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))
  20
  21 (define-key vm-mode-map "Z" 'tm-vm/view-message)
  22 (define-key vm-mode-map "T" 'tm-vm/decode-message-header)
  23
  24 (set-alist 'mime-viewer/quitting-method-alist
  25            'vm-mode
  26            'tm-vm/quit-view-message)
  27
  28 (set-alist 'mime-viewer/quitting-method-alist
  29            'vm-virtual-mode
  30            'tm-vm/quit-view-message)
  31
  32 ;;; @ for MIME header
  33 ;;;
  34 ;; If you don't use tiny-mime patch for VM (by RIKITAKE Kenji
  35 ;; <kenji@reseau.toyonaka.osaka.jp>), please use following definition:
  36
  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)))
  40
  41
  42 ;;; @ functions
  43 ;;;
  44
  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)))
  55
  56 (defun tm-vm/view-message ()
  57   "Decode and view MIME encoded message, under VM."
  58   (interactive)
  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))))
  69     (save-restriction
  70       (vm-widen-page)
  71       ;; vm-widen-page hides exposed header if pages are delimited.
  72       ;; So, here we expose it again.
  73       (if exposed
  74           (narrow-to-region (vm-start-of mp) (point-max)))
  75       (select-window (vm-get-buffer-window (current-buffer)))
  76       (mime/viewer-mode nil
  77                         (mime::parse-field-body/Content-Type
  78                          (message/unfolding-string (or ct "")))
  79                         cte))))
  80
  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."
  88   (interactive "p")
  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))
  96         (realm nil)
  97         (vlist nil)
  98         (vbufs nil))
  99     (save-excursion
 100       (while mlist
 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))
 106           (vm-save-restriction
 107            (narrow-to-region (vm-headers-of realm) (vm-text-of realm))
 108            (mime/decode-message-header))
 109           (let ((vm-message-pointer (list realm))
 110                 (last-command nil))
 111             (vm-discard-cached-data))
 112           ;; Mark each virtual and real message for later summary
 113           ;; update.
 114           (setq vlist (cons realm (vm-virtual-messages-of realm)))
 115           (while vlist
 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.
 127       (while vbufs
 128         (set-buffer (car vbufs))
 129         (vm-preview-current-message)
 130         (setq vbufs (cdr vbufs))))))