mh-e/tm-mh-e.el

   1 ;;;
   2 ;;; A MIME extender for mh-e
   3 ;;;
   4 ;;; by Morioka Tomohiko, 1993/11/21
   5 ;;; modified by YAMAOKA Katsumi <yamaoka@ga.sony.co.jp>
   6 ;;;
   7
   8
   9 ;;; @ require modules
  10 ;;;
  11 (require 'tl-str)
  12 (require 'tl-misc)
  13 (require 'tm-misc)
  14 (require 'mh-e)
  15 (if (not (boundp 'mh-e-version))
  16     (require 'tm-mh-e3)
  17   )
  18 (autoload 'mime/viewer-mode "tm-view" "View MIME message." t)
  19
  20
  21 ;;; @ version
  22 ;;;
  23 (defconst tm-mh-e/RCS-ID
  24   "$Id: tm-mh-e.el,v 6.3 1995/04/23 20:59:27 morioka Exp $")
  25
  26 (defconst tm-mh-e/version (get-version-string tm-mh-e/RCS-ID))
  27
  28
  29 ;;; @ MIME header decoding mode
  30 ;;;
  31 (defun tm-mh-e/toggle-header-decoding-mode (arg)
  32   "Toggle MIME header processing.
  33 With arg, turn MIME processing on if arg is positive."
  34   (interactive "P")
  35   (setq mime/header-decoding-mode
  36         (if (null arg)
  37             (not mime/header-decoding-mode)
  38           arg))
  39   (mh-invalidate-show-buffer)
  40   (mh-show-msg (mh-get-msg-num t))
  41   )
  42
  43
  44 ;;; @ MIME body players
  45 ;;;
  46 (defun tm-mh-e/view-message (arg)
  47   "MIME decode and play this message."
  48   (interactive "P")
  49   (mh-invalidate-show-buffer)
  50   (mh-show-msg (mh-get-msg-num t))
  51   (pop-to-buffer mh-show-buffer t)
  52   ;; patch for mh-narrow.el
  53   ;; by YAMAOKA Katsumi <yamaoka@ga.sony.co.jp>
  54   (if (featurep 'mh-narrow)
  55       (widen)
  56     )
  57   ;; end of patch
  58   (mime/viewer-mode)
  59   )
  60
  61
  62 ;;; @ for tm-comp
  63 ;;;
  64 (defun tm-mh-e::make-message (folder number)
  65   (vector folder number)
  66   )
  67
  68 (defun tm-mh-e::message/folder (message)
  69   (elt message 0)
  70   )
  71
  72 (defun tm-mh-e::message/number (message)
  73   (elt message 1)
  74   )
  75
  76 (defun tm-mh-e::message/file-name (message)
  77   (expand-file-name
  78    (tm-mh-e::message/number message)
  79    (mh-expand-file-name (tm-mh-e::message/folder message))
  80    ))
  81
  82 (defun tm-mh-e::prompt-for-message (prompt folder &optional default)
  83   (let ((files
  84          (directory-files (mh-expand-file-name folder) nil "^[0-9]+$")
  85          ))
  86     (completing-read prompt
  87                      (let ((i 0))
  88                        (mapcar (function
  89                                 (lambda (file)
  90                                   (setq i (+ i 1))
  91                                   (list file i)
  92                                   ))
  93                                files)
  94                        ))
  95     ))
  96
  97 (defun tm-mh-e::query-message ()
  98   (let* ((folder (mh-prompt-for-folder "Visit" "+inbox" nil))
  99          (number (tm-mh-e::prompt-for-message "Number?" folder))
 100          )
 101     (tm-mh-e::make-message folder number)
 102     ))
 103
 104 (defun tm-mh-e::insert-message (&optional message)
 105   (if (null message)
 106       (setq message (tm-mh-e::query-message))
 107     )
 108   (insert-file (tm-mh-e::message/file-name message))
 109   )
 110
 111 (call-after-loaded
 112  'tm-comp
 113  (function
 114   (lambda ()
 115     (set-alist
 116      'tm-comp/message-inserter-alist
 117      'mh-letter-mode (function tm-mh-e::insert-message))
 118     )))
 119
 120
 121 ;;; @ set up
 122 ;;;
 123
 124 (defun tm-mh-e/decode-message-header ()
 125   (make-local-variable 'minor-mode-alist)
 126   (mime/add-header-decoding-mode-to-mode-line)
 127   (let ((buffer-read-only nil))
 128     (mime/decode-message-header-if-you-need)
 129     (set-buffer-modified-p nil)
 130     ))
 131 (add-hook 'mh-show-mode-hook
 132           (function tm-mh-e/decode-message-header))
 133
 134 (define-key mh-folder-mode-map "\et" 'tm-mh-e/toggle-header-decoding-mode)
 135 (define-key mh-folder-mode-map "v" 'tm-mh-e/view-message)
 136 (define-key mh-folder-mode-map "\r"
 137   (function (lambda ()
 138               (interactive)
 139               (scroll-other-window 1)
 140               )))
 141 (define-key mh-folder-mode-map "\e\r"
 142   (function (lambda ()
 143               (interactive)
 144               (scroll-other-window -1)
 145               )))
 146
 147
 148 (provide 'tm-mh-e)