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 (require 'tm-view)
  19
  20
  21 ;;; @ version
  22 ;;;
  23 (defconst tm-mh-e/RCS-ID
  24   "$Id: tm-mh-e.el,v 6.10 1995/06/12 01:53:19 morioka Exp $")
  25
  26 (defconst tm-mh-e/version (get-version-string tm-mh-e/RCS-ID))
  27
  28
  29 ;;; @ variable
  30 ;;;
  31 (defvar tm-mh-e/decode-all t
  32   "*If t, decode all of the message. Otherwise decode header only.")
  33
  34
  35 ;;; @ functions
  36 ;;;
  37
  38 (defun tm-mh-e/display-msg (msg-num folder &optional show-buffer mode)
  39   (or mode
  40       (setq mode tm-mh-e/decode-all)
  41       )
  42   ;; Display message NUMBER of FOLDER.
  43   ;; Sets the current buffer to the show buffer.
  44   (set-buffer folder)
  45   (or show-buffer
  46       (setq show-buffer mh-show-buffer))
  47   ;; Bind variables in folder buffer in case they are local
  48   (let ((msg-filename (mh-msg-filename msg-num)))
  49     (if (not (file-exists-p msg-filename))
  50         (error "Message %d does not exist" msg-num))
  51     (set-buffer show-buffer)
  52     (cond ((not (equal msg-filename buffer-file-name))
  53            ;; Buffer does not yet contain message.
  54            (clear-visited-file-modtime)
  55            (unlock-buffer)
  56            (setq buffer-file-name nil)  ; no locking during setup
  57            (let (buffer-read-only)
  58              (erase-buffer)
  59              (if mode
  60                  (progn
  61                    (let ((file-coding-system-for-read
  62                           (if (boundp 'MULE) *noconv*))
  63                          kanji-fileio-code)
  64                      (insert-file-contents msg-filename)
  65                      )
  66                    (set-buffer-modified-p nil)
  67                    (mh-show-mode)
  68                    (mime/viewer-mode)
  69                    (goto-char (point-min))
  70                    )
  71                (let ((clean-message-header mh-clean-message-header)
  72                      (invisible-headers mh-invisible-headers)
  73                      (visible-headers mh-visible-headers)
  74                      )
  75                  (insert-file-contents msg-filename)
  76                  (goto-char (point-min))
  77                  (cond (clean-message-header
  78                         (mh-clean-msg-header (point-min)
  79                                              invisible-headers
  80                                              visible-headers)
  81                         (goto-char (point-min)))
  82                        (t
  83                         (mh-start-of-uncleaned-message)))
  84                  (mime/decode-message-header)
  85                  (set-buffer-modified-p nil)
  86                  (mh-show-mode)
  87                  )))
  88            (or (eq buffer-undo-list t)  ;don't save undo info for prev msgs
  89                (setq buffer-undo-list nil))
  90            (setq buffer-file-name msg-filename)
  91            (set-mark nil)
  92            (setq mode-line-buffer-identification
  93                  (list (format mh-show-buffer-mode-line-buffer-id
  94                                folder msg-num)))
  95            (set-buffer folder)
  96            (setq mh-showing-with-headers nil)))))
  97
  98 (fset 'mh-display-msg (symbol-function 'tm-mh-e/display-msg))
  99
 100 (defun tm-mh-e/view-message (&optional msg)
 101   "MIME decode and play this message."
 102   (interactive)
 103   (mh-invalidate-show-buffer)
 104   (let ((tm-mh-e/decode-all t))
 105     (mh-show-msg msg)
 106     )
 107   (pop-to-buffer (save-window-excursion
 108                    (switch-to-buffer mh-show-buffer)
 109                    mime::article/preview-buffer))
 110   )
 111
 112 (defun tm-mh-e/toggle-decoding-mode (arg)
 113   "Toggle MIME processing mode.
 114 With arg, turn MIME processing on if arg is positive."
 115   (interactive "P")
 116   (setq tm-mh-e/decode-all
 117         (if (null arg)
 118             (not tm-mh-e/decode-all)
 119           arg))
 120   (mh-show (mh-get-msg-num t))
 121   (if tm-mh-e/decode-all
 122       (let ((the-buf (current-buffer)))
 123         (pop-to-buffer (save-excursion
 124                          (switch-to-buffer mh-show-buffer)
 125                          mime::article/preview-buffer))
 126         (pop-to-buffer the-buf)
 127         )))
 128
 129 (defun tm-mh-e/cite ()
 130   (interactive)
 131   (if tm-mh-e/decode-all
 132       (save-excursion
 133         (save-restriction
 134           (insert-buffer
 135            (save-window-excursion
 136              (switch-to-buffer (concat "show-" mh-sent-from-folder))
 137              mime::article/preview-buffer))
 138           (if (looking-at "^\\[.+\\]\n")
 139               (replace-match ""))
 140           (run-hooks 'mail-citation-hook)
 141           ))
 142     (mh-yank-cur-msg)
 143     ))
 144
 145
 146 ;;; @ for tm-view
 147 ;;;
 148
 149 (defun tm-mh-e/content-header-filter ()
 150   (goto-char (point-min))
 151   (while (and (re-search-forward
 152                (concat "^" mime-viewer/ignored-field-regexp ":")
 153                nil t)
 154               (progn
 155                 (delete-region
 156                  (match-beginning 0)
 157                  (save-excursion
 158                    (and
 159                     (re-search-forward "^\\([^ \t]\\|$\\)" nil t)
 160                     (match-beginning 0)
 161                     )))
 162                 t)))
 163   (mime/code-convert-region-to-emacs (point-min)(point-max)
 164                                      mime/default-coding-system)
 165   (mime/decode-message-header)
 166   )
 167
 168 (defun tm-mh-e/quitting-method ()
 169   (let ((win (get-buffer-window
 170               mime/output-buffer-name))
 171         (buf mime::preview/article-buffer)
 172         )
 173     (if win
 174         (delete-window win)
 175       )
 176     (pop-to-buffer
 177      (let ((name (buffer-name buf)))
 178        (substring name 5)
 179        ))
 180     (if (not tm-mh-e/decode-all)
 181         (mh-show (mh-get-msg-num t))
 182       )))
 183
 184
 185 ;;; @ for tm-comp
 186 ;;;
 187 (defun tm-mh-e::make-message (folder number)
 188   (vector folder number)
 189   )
 190
 191 (defun tm-mh-e::message/folder (message)
 192   (elt message 0)
 193   )
 194
 195 (defun tm-mh-e::message/number (message)
 196   (elt message 1)
 197   )
 198
 199 (defun tm-mh-e::message/file-name (message)
 200   (expand-file-name
 201    (tm-mh-e::message/number message)
 202    (mh-expand-file-name (tm-mh-e::message/folder message))
 203    ))
 204
 205 (defun tm-mh-e::prompt-for-message (prompt folder &optional default)
 206   (let ((files
 207          (directory-files (mh-expand-file-name folder) nil "^[0-9]+$")
 208          ))
 209     (completing-read prompt
 210                      (let ((i 0))
 211                        (mapcar (function
 212                                 (lambda (file)
 213                                   (setq i (+ i 1))
 214                                   (list file i)
 215                                   ))
 216                                files)
 217                        ))
 218     ))
 219
 220 (defun tm-mh-e::query-message ()
 221   (let* ((folder (mh-prompt-for-folder "Visit" "+inbox" nil))
 222          (number (tm-mh-e::prompt-for-message "Number?" folder))
 223          )
 224     (tm-mh-e::make-message folder number)
 225     ))
 226
 227 (defun tm-mh-e::insert-message (&optional message)
 228   (if (null message)
 229       (setq message (tm-mh-e::query-message))
 230     )
 231   (insert-file (tm-mh-e::message/file-name message))
 232   )
 233
 234 (call-after-loaded
 235  'tm-comp
 236  (function
 237   (lambda ()
 238     (set-alist
 239      'tm-comp/message-inserter-alist
 240      'mh-letter-mode (function tm-mh-e::insert-message))
 241     )))
 242
 243
 244 ;;; @ set up
 245 ;;;
 246
 247 ;;(add-hook 'mh-show-mode-hook (function mime/viewer-mode))
 248
 249 (define-key mh-folder-mode-map "v" (function tm-mh-e/view-message))
 250 (define-key mh-folder-mode-map "\et" (function tm-mh-e/toggle-decoding-mode))
 251 (define-key mh-folder-mode-map "\r"
 252   (function (lambda ()
 253               (interactive)
 254               (scroll-other-window 1)
 255               )))
 256 (define-key mh-folder-mode-map "\e\r"
 257   (function (lambda ()
 258               (interactive)
 259               (scroll-other-window -1)
 260               )))
 261 (define-key mh-folder-mode-map " "
 262   (function (lambda ()
 263               (interactive)
 264               (scroll-other-window)
 265               )))
 266 (define-key mh-folder-mode-map "\177"
 267   (function (lambda ()
 268               (interactive)
 269               (scroll-other-window (- (save-window-excursion
 270                                         (other-window 1)
 271                                         (window-height))))
 272               )))
 273
 274 (add-hook 'mh-letter-mode-hook
 275           (function
 276            (lambda ()
 277              (define-key mh-letter-mode-map "\C-c\C-y" (function tm-mh-e/cite))
 278              )))
 279
 280 (set-alist 'mime-viewer/quitting-method-alist
 281            'mh-show-mode
 282            (function tm-mh-e/quitting-method))
 283
 284 (set-alist 'mime-viewer/content-header-filter-alist
 285            'mh-show-mode
 286            (function tm-mh-e/content-header-filter))
 287
 288 (run-hooks 'tm-mh-e-load-hook)
 289
 290 (provide 'tm-mh-e)