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 .. 1996 MORIOKA Tomohiko
   6 ;;;
   7 ;;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
   8 ;;;         OKABE Yasuo <okabe@kudpc.kyoto-u.ac.jp>
   9 ;;; modified by YAMAOKA Katsumi <yamaoka@ga.sony.co.jp>
  10 ;;; Maintainer: MORIOKA Tomohiko <morioka@jaist.ac.jp>
  11 ;;; Created: 1993/11/21 (obsolete mh-e-mime.el)
  12 ;;; Version: $Revision: 7.65 $
  13 ;;; Keywords: mail, MH, MIME, multimedia, encoded-word, multilingual
  14 ;;;
  15 ;;; This file is part of tm (Tools for MIME).
  16 ;;;
  17 ;;; This program is free software; you can redistribute it and/or
  18 ;;; modify it under the terms of the GNU General Public License as
  19 ;;; published by the Free Software Foundation; either version 2, or
  20 ;;; (at your option) any later version.
  21 ;;;
  22 ;;; This program is distributed in the hope that it will be useful,
  23 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  24 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  25 ;;; General Public License for more details.
  26 ;;;
  27 ;;; You should have received a copy of the GNU General Public License
  28 ;;; along with This program.  If not, write to the Free Software
  29 ;;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  30 ;;;
  31 ;;; Code:
  32
  33 (require 'tl-str)
  34 (require 'tl-misc)
  35 (require 'mh-e)
  36 (or (featurep 'mh-utils)
  37     (require 'tm-mh-e3)
  38     )
  39 (require 'tm-view)
  40
  41 (or (fboundp 'mh-get-header-field)
  42     (defalias 'mh-get-header-field 'mh-get-field)
  43     )
  44 (or (boundp 'mh-temp-buffer)
  45     (defconst mh-temp-buffer " *mh-temp*")
  46     )
  47
  48
  49 ;;; @ version
  50 ;;;
  51
  52 (defconst tm-mh-e/RCS-ID
  53   "$Id: tm-mh-e.el,v 7.65 1996/07/18 12:29:17 morioka Exp $")
  54
  55 (defconst tm-mh-e/version (get-version-string tm-mh-e/RCS-ID))
  56
  57
  58 ;;; @ variable
  59 ;;;
  60
  61 (defvar tm-mh-e/automatic-mime-preview t
  62   "*If non-nil, show MIME processed message.")
  63
  64 (defvar tm-mh-e/decode-encoded-word t
  65   "*If non-nil, decode encoded-word when it is not MIME preview mode.")
  66
  67
  68 ;;; @ functions
  69 ;;;
  70
  71 ;; (if (not (fboundp 'tm-mh-e/original-mh-display-msg))
  72 ;;     (fset 'tm-mh-e/original-mh-display-msg
  73 ;;           (symbol-function 'mh-display-msg))
  74 ;;   )
  75
  76 (defun mh-display-msg (msg-num folder &optional show-buffer mode)
  77   (or mode
  78       (setq mode tm-mh-e/automatic-mime-preview)
  79       )
  80   ;; Display message NUMBER of FOLDER.
  81   ;; Sets the current buffer to the show buffer.
  82   (set-buffer folder)
  83   (or show-buffer
  84       (setq show-buffer mh-show-buffer))
  85   ;; Bind variables in folder buffer in case they are local
  86   (let ((msg-filename (mh-msg-filename msg-num)))
  87     (if (not (file-exists-p msg-filename))
  88         (error "Message %d does not exist" msg-num))
  89     (set-buffer show-buffer)
  90     (cond ((not (equal msg-filename buffer-file-name))
  91            ;; Buffer does not yet contain message.
  92            (clear-visited-file-modtime)
  93            (unlock-buffer)
  94            (setq buffer-file-name nil)  ; no locking during setup
  95            (setq buffer-read-only nil)
  96            (erase-buffer)
  97            (if mode
  98                (let* ((aname (concat "article-" folder))
  99                       (abuf (get-buffer aname))
 100                       )
 101                  (if abuf
 102                      (progn
 103                        (set-buffer abuf)
 104                        (setq buffer-read-only nil)
 105                        (erase-buffer)
 106                        )
 107                    (setq abuf (get-buffer-create aname))
 108                    (set-buffer abuf)
 109                    )
 110                  (let ((file-coding-system-for-read
 111                         (if (boundp 'MULE) *noconv*))
 112                        kanji-fileio-code)
 113                    (insert-file-contents msg-filename)
 114                    ;; (goto-char (point-min))
 115                    (while (re-search-forward "\r$" nil t)
 116                      (replace-match "")
 117                      )
 118                    )
 119                  (set-buffer-modified-p nil)
 120                  (setq buffer-read-only t)
 121                  (setq buffer-file-name msg-filename)
 122                  (mh-show-mode)
 123                  (mime/viewer-mode nil nil nil
 124                                    aname (concat "show-" folder))
 125                  (goto-char (point-min))
 126                  )
 127              (let ((clean-message-header mh-clean-message-header)
 128                    (invisible-headers mh-invisible-headers)
 129                    (visible-headers mh-visible-headers)
 130                    )
 131                ;; 1995/9/21
 132                ;;   modified by ARIURA <ariura@cc.tuat.ac.jp>
 133                ;;   to support mhl.
 134                (if mhl-formfile
 135                    (mh-exec-lib-cmd-output "mhl" "-nobell" "-noclear"
 136                                            (if (stringp mhl-formfile)
 137                                                (list "-form" mhl-formfile))
 138                                            msg-filename)
 139                  (insert-file-contents msg-filename))
 140                ;; end
 141                (goto-char (point-min))
 142                (cond (clean-message-header
 143                       (mh-clean-msg-header (point-min)
 144                                            invisible-headers
 145                                            visible-headers)
 146                       (goto-char (point-min)))
 147                      (t
 148                       (mh-start-of-uncleaned-message)))
 149                (if tm-mh-e/decode-encoded-word
 150                    (mime/decode-message-header)
 151                  )
 152                (set-buffer-modified-p nil)
 153                (setq buffer-read-only t)
 154                (setq buffer-file-name msg-filename)
 155                (mh-show-mode)
 156                ))
 157            (or (eq buffer-undo-list t)  ;don't save undo info for prev msgs
 158                (setq buffer-undo-list nil))
 159 ;;; Added by itokon (02/19/96)
 160            (setq buffer-file-name msg-filename)
 161 ;;;
 162            (set-mark nil)
 163            (setq mode-line-buffer-identification
 164                  (list (format mh-show-buffer-mode-line-buffer-id
 165                                folder msg-num)))
 166            (set-buffer folder)
 167            (setq mh-showing-with-headers nil)))))
 168
 169 (defun tm-mh-e/view-message (&optional msg)
 170   "MIME decode and play this message."
 171   (interactive)
 172   (if (or (null tm-mh-e/automatic-mime-preview)
 173           (null (get-buffer mh-show-buffer))
 174           (save-excursion
 175             (set-buffer mh-show-buffer)
 176             (not (eq major-mode 'mime/viewer-mode))
 177             ))
 178       (let ((tm-mh-e/automatic-mime-preview t))
 179         (mh-invalidate-show-buffer)
 180         (mh-show-msg msg)
 181         ))
 182   (pop-to-buffer mh-show-buffer)
 183   )
 184
 185 (defun tm-mh-e/toggle-decoding-mode (arg)
 186   "Toggle MIME processing mode.
 187 With arg, turn MIME processing on if arg is positive."
 188   (interactive "P")
 189   (setq tm-mh-e/automatic-mime-preview
 190         (if (null arg)
 191             (not tm-mh-e/automatic-mime-preview)
 192           arg))
 193   (save-excursion
 194     (set-buffer mh-show-buffer)
 195     (if (null tm-mh-e/automatic-mime-preview)
 196         (if (and mime::preview/article-buffer
 197                  (get-buffer mime::preview/article-buffer))
 198             (kill-buffer mime::preview/article-buffer)
 199           )))
 200   (mh-invalidate-show-buffer)
 201   (mh-show (mh-get-msg-num t))
 202   )
 203
 204 (defun tm-mh-e/show (&optional message)
 205   (interactive)
 206   (mh-invalidate-show-buffer)
 207   (mh-show message)
 208   )
 209
 210 (defun tm-mh-e/header-display ()
 211   (interactive)
 212   (mh-invalidate-show-buffer)
 213   (let ((mime-viewer/ignored-field-regexp "^:$")
 214         tm-mh-e/decode-encoded-word)
 215     (mh-header-display)
 216     ))
 217
 218 (defun tm-mh-e/raw-display ()
 219   (interactive)
 220   (mh-invalidate-show-buffer)
 221   (let (tm-mh-e/automatic-mime-preview
 222         tm-mh-e/decode-encoded-word)
 223     (mh-header-display)
 224     ))
 225
 226 (defun tm-mh-e/scroll-up-msg (&optional arg)
 227   (interactive)
 228   (mh-page-msg (or arg 1))
 229   )
 230
 231 (defun tm-mh-e/scroll-down-msg (&optional arg)
 232   (interactive)
 233   (mh-page-msg (- (or arg 1)))
 234   )
 235
 236 (defun tm-mh-e/burst-multipart/digest ()
 237   "Burst apart the current message, which should be a multipart/digest.
 238 The message is replaced by its table of contents and the letters from the
 239 digest are inserted into the folder after that message."
 240   (interactive)
 241   (let ((digest (mh-get-msg-num t)))
 242     (mh-process-or-undo-commands mh-current-folder)
 243     (mh-set-folder-modified-p t)                ; lock folder while bursting
 244     (message "Bursting digest...")
 245     (mh-exec-cmd "mhn" "-store" mh-current-folder digest)
 246     (mh-scan-folder mh-current-folder (format "%d-last" mh-first-msg-num))
 247     (message "Bursting digest...done")
 248     ))
 249
 250
 251 ;;; @ for tm-view
 252 ;;;
 253
 254 (fset 'tm-mh-e/decode-charset-buffer
 255       (symbol-function 'mime-charset/decode-buffer))
 256
 257 (set-alist 'mime-viewer/code-converter-alist
 258            'mh-show-mode
 259            (function tm-mh-e/decode-charset-buffer))
 260
 261 (defun tm-mh-e/content-header-filter ()
 262   (goto-char (point-min))
 263   (mime-preview/cut-header)
 264   (tm-mh-e/decode-charset-buffer default-mime-charset)
 265   (mime/decode-message-header)
 266   )
 267
 268 (set-alist 'mime-viewer/content-header-filter-alist
 269            'mh-show-mode
 270            (function tm-mh-e/content-header-filter))
 271
 272 (defun tm-mh-e/quitting-method ()
 273   (let ((win (get-buffer-window
 274               mime/output-buffer-name))
 275         (buf (current-buffer))
 276         )
 277     (if win
 278         (delete-window win)
 279       )
 280     (pop-to-buffer
 281      (let ((name (buffer-name buf)))
 282        (substring name 5)
 283        ))
 284     (if (not tm-mh-e/automatic-mime-preview)
 285         (mh-invalidate-show-buffer)
 286       )
 287     (mh-show (mh-get-msg-num t))
 288     ))
 289
 290 (set-alist 'mime-viewer/quitting-method-alist
 291            'mh-show-mode
 292            (function tm-mh-e/quitting-method))
 293 (set-alist 'mime-viewer/show-summary-method
 294            'mh-show-mode
 295            (function tm-mh-e/quitting-method))
 296
 297 (defun tm-mh-e/following-method (buf)
 298   (save-excursion
 299     (set-buffer buf)
 300     (goto-char (point-max))
 301     (setq mh-show-buffer buf)
 302     (apply (function mh-send)
 303            (rfc822/get-field-bodies '("To" "cc" "Subject") ""))
 304     (setq mh-sent-from-folder buf)
 305     (setq mh-sent-from-msg 1)
 306     (let ((last (point)))
 307       (mh-yank-cur-msg)
 308       (goto-char last)
 309       )))
 310
 311 (set-alist 'mime-viewer/following-method-alist
 312            'mh-show-mode
 313            (function tm-mh-e/following-method))
 314
 315
 316 ;;; @@ for tm-partial
 317 ;;;
 318
 319 (call-after-loaded
 320  'tm-partial
 321  (function
 322   (lambda ()
 323     (set-atype 'mime/content-decoding-condition
 324                '((type . "message/partial")
 325                  (method . mime-article/grab-message/partials)
 326                  (major-mode . mh-show-mode)
 327                  (summary-buffer-exp
 328                   . (and (or (string-match "^article-\\(.+\\)$" article-buffer)
 329                              (string-match "^show-\\(.+\\)$" article-buffer))
 330                          (substring article-buffer
 331                                     (match-beginning 1) (match-end 1))
 332                          ))
 333                  ))
 334     (set-alist 'tm-partial/preview-article-method-alist
 335                'mh-show-mode
 336                (function
 337                 (lambda ()
 338                   (let ((tm-mh-e/automatic-mime-preview t))
 339                     (tm-mh-e/show)
 340                     ))))
 341     )))
 342
 343
 344 ;;; @ set up
 345 ;;;
 346
 347 (define-key mh-folder-mode-map "v" (function tm-mh-e/view-message))
 348 (define-key mh-folder-mode-map "\et" (function tm-mh-e/toggle-decoding-mode))
 349 (define-key mh-folder-mode-map "." (function tm-mh-e/show))
 350 (define-key mh-folder-mode-map "," (function tm-mh-e/header-display))
 351 (define-key mh-folder-mode-map "\e," (function tm-mh-e/raw-display))
 352 (define-key mh-folder-mode-map "\r" (function tm-mh-e/scroll-up-msg))
 353 (define-key mh-folder-mode-map "\e\r" (function tm-mh-e/scroll-down-msg))
 354 (define-key mh-folder-mode-map "\C-c\C-b"
 355   (function tm-mh-e/burst-multipart/digest))
 356
 357 (defun tm-mh-e/summary-before-quit ()
 358   (let ((buf (get-buffer mh-show-buffer)))
 359     (if buf
 360         (let ((the-buf (current-buffer)))
 361           (switch-to-buffer buf)
 362           (if (and mime::article/preview-buffer
 363                    (setq buf (get-buffer mime::article/preview-buffer))
 364                    )
 365               (progn
 366                 (switch-to-buffer the-buf)
 367                 (kill-buffer buf)
 368                 )
 369             (switch-to-buffer the-buf)
 370             )
 371           ))))
 372
 373 (add-hook 'mh-before-quit-hook (function tm-mh-e/summary-before-quit))
 374
 375
 376 ;;; @@ for tmh-comp.el
 377 ;;;
 378
 379 (autoload 'tm-mh-e/edit-again "tmh-comp"
 380   "Clean-up a draft or a message previously sent and make it resendable." t)
 381 (autoload 'tm-mh-e/extract-rejected-mail "tmh-comp"
 382   "Extract a letter returned by the mail system and make it re-editable." t)
 383 (autoload 'tm-mh-e/forward "tmh-comp"
 384   "Forward a message or message sequence by MIME style." t)
 385
 386 (call-after-loaded
 387  'mime-setup
 388  (function
 389   (lambda ()
 390     (substitute-key-definition
 391      'mh-edit-again 'tm-mh-e/edit-again mh-folder-mode-map)
 392     (substitute-key-definition
 393      'mh-extract-rejected-mail 'tm-mh-e/extract-rejected-mail
 394      mh-folder-mode-map)
 395     (substitute-key-definition
 396      'mh-forward 'tm-mh-e/forward mh-folder-mode-map)
 397
 398     (call-after-loaded
 399      'mh-comp
 400      (function
 401       (lambda ()
 402         (require 'tmh-comp)
 403         ))
 404      'mh-letter-mode-hook)
 405     )))
 406
 407
 408 ;;; @ for BBDB
 409 ;;;
 410
 411 (call-after-loaded
 412  'bbdb
 413  (function
 414   (lambda ()
 415     (require 'tm-bbdb)
 416     )))
 417
 418
 419 ;;; @ end
 420 ;;;
 421
 422 (provide 'tm-mh-e)
 423
 424 (run-hooks 'tm-mh-e-load-hook)
 425
 426 ;;; tm-mh-e.el ends here