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