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