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