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