tm-vm.el

   1 ;;;
   2 ;;; tm-vm.el : tm-MUA for vm
   3 ;;;
   4 ;;; by MASUTANI Yasuhiro <masutani@me.es.osaka-u.ac.jp>
   5 ;;; modified by SHIONO <jun@p5.nm.fujitsu.co.jp>
   6 ;;;
   7 ;;; Plese insert (load "tm-vm") in .vm or .emacs.
   8 ;;;
   9
  10 (provide 'tm-vm)
  11
  12 (require 'tl-list)
  13 (require 'tm-view)
  14
  15
  16 (defconst tm-vm/RCS-ID
  17   "$Id: tm-vm.el,v 1.3 1994/10/29 10:01:21 morioka Exp $")
  18 (defconst tm-vm/version (get-version-string tm-vm/RCS-ID))
  19
  20
  21 (define-key vm-mode-map "Z" 'tm-vm/view-message)
  22
  23 (set-alist mime/go-to-top-node-method-alist
  24            'vm-mode
  25            (function
  26             (lambda ()
  27               (mime/exit-view-mode)
  28               (let ((w (get-buffer-window mime/output-buffer-name)))
  29                 (if w (delete-window w)))
  30               (vm-display vm-summary-buffer t
  31                           '(mime/exit-view-mode)
  32                           '(this-command))
  33               (vm-widen-page)
  34               (goto-char (point-max))
  35               (widen)
  36               (narrow-to-region (point)
  37                                 (vm-vheaders-of
  38                                  (car vm-message-pointer)))
  39               (goto-char (point-min))
  40               (if vm-honor-page-delimiters
  41                   (vm-narrow-to-page))
  42               (select-window (get-buffer-window vm-summary-buffer))
  43               )))
  44 (set-alist mime/go-to-top-node-method-alist
  45            'vm-virtual-mode
  46            (function
  47             (lambda ()
  48               (mime/exit-view-mode)
  49               (let ((w (get-buffer-window mime/output-buffer-name)))
  50                 (if w (delete-window w)))
  51               (vm-display vm-summary-buffer t
  52                           '(mime/exit-view-mode)
  53                           '(this-command))
  54               (vm-widen-page)
  55               (goto-char (point-max))
  56               (widen)
  57               (narrow-to-region (point)
  58                                 (vm-vheaders-of
  59                                  (car vm-message-pointer)))
  60               (goto-char (point-min))
  61               (if vm-honor-page-delimiters
  62                   (vm-narrow-to-page))
  63               (select-window (get-buffer-window vm-summary-buffer))
  64               ))
  65            )
  66
  67 (defun tm-vm/view-message ()
  68   "Decode and view MIME message for VM"
  69   (interactive)
  70   (vm-follow-summary-cursor)
  71   (vm-select-folder-buffer)
  72   (vm-check-for-killed-summary)
  73   (vm-error-if-folder-empty)
  74   (vm-display (current-buffer) t '(tm-vm/view-message)
  75               '(tm-vm/view-mesage reading-message))
  76   (vm-widen-page)
  77   (goto-char (point-max))
  78   (widen)
  79   (narrow-to-region (point) (vm-start-of (car vm-message-pointer)))
  80   (goto-char (point-min))
  81   (select-window (vm-get-buffer-window (current-buffer)))
  82   (mime/viewer-mode))