mh-e/tm-mh-e.el

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