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