tm-rmail.el

   1 ;;;
   2 ;;; $Id: tm-rmail.el,v 6.5 1995/06/26 06:58:11 morioka Exp $
   3 ;;;
   4
   5 (require 'tl-header)
   6 (require 'tl-list)
   7 (require 'tl-misc)
   8
   9 (autoload 'mime/viewer-mode "tm-view" "View MIME message." t)
  10 (autoload 'mime/decode-message-header "tiny-mime" "Decode MIME header." t)
  11
  12 (defun tm-rmail/show-all-header-p ()
  13   (save-restriction
  14     (narrow-to-region (point-min)
  15                       (and (re-search-forward "^$" nil t)
  16                            (match-beginning 0)))
  17     (goto-char (point-min))
  18     (re-search-forward rmail-ignored-headers nil t)
  19     ))
  20
  21 (defun tm-rmail/view-message ()
  22   (interactive)
  23   (let ((ret (rmail-widen-to-current-msgbeg
  24               (function
  25                (lambda ()
  26                  (cons (mime/Content-Type (mail-fetch-field "Content-Type"))
  27                        (mail-fetch-field "Content-Transfer-Encoding"))
  28                  )))))
  29     (mime/viewer-mode nil (car ret)(cdr ret))
  30     ))
  31
  32 (defun tm-rmail/quitting-method-to-summary ()
  33   (mime-viewer/kill-buffer)
  34   (rmail-summary)
  35   (delete-other-windows)
  36   )
  37
  38 (defun tm-rmail/quitting-method-to-article ()
  39   (mime-viewer/kill-buffer)
  40   )
  41
  42 (defalias 'tm-rmail/quitting-method 'tm-rmail/quitting-method-to-article)
  43
  44 (add-hook 'rmail-show-message-hook
  45           (function
  46            (lambda ()
  47              (let ((mf (buffer-modified-p))
  48                    (buffer-read-only nil))
  49                (mime/decode-message-header)
  50                (set-buffer-modified-p mf)
  51                ))))
  52
  53 (add-hook 'rmail-mode-hook
  54           (function
  55            (lambda ()
  56              (local-set-key "v" (function tm-rmail/view-message))
  57              )))
  58
  59 (add-hook 'rmail-summary-mode-hook
  60           (function
  61            (lambda ()
  62              (local-set-key "v"
  63                             (function
  64                              (lambda ()
  65                                (interactive)
  66                                (pop-to-buffer rmail-buffer)
  67                                (tm-rmail/view-message)
  68                                )))
  69              )))
  70
  71 (call-after-loaded 'tm-view
  72                    (function
  73                     (lambda ()
  74                       (set-alist 'mime-viewer/quitting-method
  75                                  'rmail-mode
  76                                  (function tm-rmail/quitting-method))
  77                       )))
  78
  79 (provide 'tm-rmail)
  80
  81 (run-hooks 'tm-rmail-load-hook)