mh-e/tm-mh-e.el

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