emh.el

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